From 699afb2c00358aa0e16f36c6c50ef07c64e90626 Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 29 Jun 2023 12:18:14 -0600 Subject: [PATCH 01/11] introduce tests-pl/iso-conformity-tests.pl --- tests-pl/iso-conformity-tests.pl | 1023 ++++++++++++++++++++++++++++++ 1 file changed, 1023 insertions(+) create mode 100644 tests-pl/iso-conformity-tests.pl diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl new file mode 100644 index 00000000..e263fa9f --- /dev/null +++ b/tests-pl/iso-conformity-tests.pl @@ -0,0 +1,1023 @@ +:- module(iso_conformity_tests, []). + +:- use_module(library(charsio)). +:- use_module(library(dcgs)). +:- use_module(library(files)). +:- use_module(library(format)). +:- use_module(library(iso_ext)). +:- use_module(library(lists), [append/3]). + +writeq_term_to_chars(Term, Chars) :- + Options = [ignore_ops(false), numbervars(true), quoted(true), variable_names([])], + write_term_to_chars(Term, Options, Chars). + +write_term_to_chars(Term, Chars) :- + Options = [ignore_ops(false), numbervars(false), quoted(false), variable_names([])], + write_term_to_chars(Term, Options, Chars). + +write_canonical_term_to_chars(Term, Chars) :- + Options = [ignore_ops(true), numbervars(false), quoted(true), variable_names([])], + write_term_to_chars(Term, Options, Chars). + +test_syntax_error(ReadString, Error) :- + catch((once(read_from_chars(ReadString, _)), + false), + error(Error, _), + true). + +test_1 :- write_term_to_chars('\n', Chars), + Chars = "\n". + +test_2 :- test_syntax_error("'\n", syntax_error(_)). + +test_3 :- test_syntax_error(")\n", syntax_error(incomplete_reduction)). + +test_261 :- test_syntax_error(")\n'\n", syntax_error(invalid_single_quoted_character)). + +test_4 :- test_syntax_error(".\n", syntax_error(incomplete_reduction)). + +test_177 :- test_syntax_error("0'\t=0' .", syntax_error(unexpected_char)). + +test_6 :- test_syntax_error("writeq('\n').", syntax_error(invalid_single_quoted_character)). + +test_7 :- read_from_chars("writeq('\\\n').", T), + T == writeq(''). + +test_8 :- read_from_chars("writeq('\\\na').", T), + T == writeq(a). + +test_9 :- read_from_chars("writeq('a\\\nb').", T), + T == writeq(ab). + +test_10 :- read_from_chars("writeq('a\\\n b').", T), + T == writeq('a b'). + +test_11 :- test_syntax_error("writeq('\\ ').", syntax_error(invalid_single_quoted_character)). + +test_193 :- test_syntax_error("writeq('\\ \n').", syntax_error(invalid_single_quoted_character)). + +test_12 :- test_syntax_error("writeq('\\\t').", syntax_error(invalid_single_quoted_character)). + +test_13 :- read_from_chars("writeq('\\t').", T), + T == writeq('\t'). + +test_14 :- read_from_chars("writeq('\\a').", T), + T == writeq('\a'). + +test_15 :- read_from_chars("writeq('\\7\\').", T), + T == writeq('\a'). + +test_16 :- test_syntax_error("writeq('\\ca').", syntax_error(invalid_single_quoted_character)). + +test_241 :- test_syntax_error("writeq('\\d').", syntax_error(invalid_single_quoted_character)). + +test_17 :- test_syntax_error("writeq('\\e').", syntax_error(invalid_single_quoted_character)). + +test_18 :- read_from_chars("writeq('\\033\\').", T), + T = writeq('\x1b\'). + +test_301 :- read_from_chars("writeq('\\0\\').", T), + T = writeq('\x0\'). + +test_19 :- test_syntax_error("char_code('\\e', C).", syntax_error(invalid_single_quoted_character)). + +test_21 :- test_syntax_error("char_code('\\d', C).", syntax_error(invalid_single_quoted_character)). + +test_22 :- test_syntax_error("writeq('\\u1').", syntax_error(invalid_single_quoted_character)). + +test_23 :- test_syntax_error("X = 0'\\u1.", syntax_error(unexpected_char)). + +test_24 :- test_syntax_error("writeq('\n", syntax_error(invalid_single_quoted_character)). + +test_25 :- test_syntax_error("writeq(.", syntax_error(incomplete_reduction)). + +test_26 :- test_syntax_error("'\\\n''.\n", syntax_error(invalid_single_quoted_character)). + +test_210 :- test_syntax_error("X = 0'\\.", syntax_error(unexpected_char)). + +test_211 :- test_syntax_error("X = 0'\\. .", syntax_error(unexpected_char)). + +test_222 :- writeq_term_to_chars((-)-(-), T), + T == "(-)-(-)". + +test_223 :- writeq_term_to_chars(((:-):-(:-)), T), + T == "(:-):-(:-)". + +test_27 :- writeq_term_to_chars((*)=(*), T), + T == "(*)=(*)". + +test_28 :- writeq_term_to_chars([:-,-], T), + T == "[:-,-]". + +test_29 :- writeq_term_to_chars(f(*), T), + T == "f(*)". + +test_30 :- writeq_term_to_chars(a*(b+c), T), + T == "a*(b+c)". + +test_31 :- writeq_term_to_chars(f(;,'|',';;'), T), + T == "f(;,'|',';;')". + +test_32 :- read_from_chars("[.,.(.,.,.)].", T), + writeq_term_to_chars(T, Chars), + Chars == "['.','.'('.','.','.')]". + +test_33 :- writeq_term_to_chars((a :- b,c), Chars), + Chars == "a:-b,c". + +test_34 :- write_canonical_term_to_chars([a], T), + T == "'.'(a,[])". + +test_35 :- writeq_term_to_chars('/*', Chars), + Chars == "'/*'". + +test_203 :- writeq_term_to_chars(//*, Chars), + Chars == "//*". + +test_282 :- writeq_term_to_chars(//*.*/, Chars), + Chars == "//*.*/". + +test_36 :- writeq_term_to_chars('/**', Chars), + Chars == "'/**'". + +test_37 :- writeq_term_to_chars('*/', Chars), + Chars == "*/". + +test_38 :- "\'\`\"" = "'`""". + +test_179 :- "\'\"" = "'""". + +test_178 :- "\`" = "`". + +test_39 :- '\'\`\"' = '''`"'. + +test_40 :- writeq_term_to_chars('\'\`\"\"', T), + T == "'\\'`\"\"'". + +test_41 :- ('\\') = (\). + +test_42 :- setup_call_cleanup(op(1,xf,xf1), + ( read_from_chars("1xf1 = xf1(1).", T), + call(T) + ), + op(0,xf,xf1)). + +test_43 :- test_syntax_error("X = 0X1.", syntax_error(incomplete_reduction)). + +test_44 :- test_syntax_error("float(.0).", syntax_error(incomplete_reduction)). + +test_45 :- setup_call_cleanup(op(100,xfx,.), + ( read_from_chars("functor(3 .2,F,A).", T), + call(T), + T == functor('.'(3,2),'.',2) + ), + op(0,xfx,.)). + +test_46 :- test_syntax_error("float(- .0).", syntax_error(incomplete_reduction)). + +test_47 :- test_syntax_error("float(1E9).", syntax_error(incomplete_reduction)). + +test_48 :- test_syntax_error("integer(1e).", syntax_error(incomplete_reduction)). + +test_49 :- setup_call_cleanup(op(9,xf,e9), + ( read_from_chars("1e9 = e9(1).", T), + call(T) + ), + op(0,xf,e9)). + +test_50_51_204_220 :- + setup_call_cleanup(op(9,xf,e), + ( read_from_chars("1e-9 = -(e(1),9).", T0), + call(T0), + read_from_chars("1.0e- 9 = -(e(1.0),9).", T1), + call(T1), + read_from_chars("1e.", T2), + writeq_term_to_chars(T2, T3), + T3 == "1 e", + read_from_chars("1.0e.", T4), + writeq_term_to_chars(T4, T5), + T5 == "1.0 e" + ), + op(0,xf,e)). + +test_52 :- setup_call_cleanup(op(9,xfy,e), + ( read_from_chars("1.2e 3 = e(X,Y).", T0), + call(T0) + ), + op(0,xfy,e)). + +test_53 :- writeq_term_to_chars(1.0e100, Chars), + Chars == "1.0e100". + +test_54 :- test_syntax_error("float(1.0ee9).", syntax_error(incomplete_reduction)). + +test_286 :- (- (1)) = -(1). + +test_287 :- (- -1) = -(-1). + +test_288 :- (- 1^2) = ^(-1,2). + +test_56 :- integer(- 1). + +test_57 :- integer('-'1). + +test_58 :- integer('-' 1). + +test_59 :- integer(- /*.*/1). + +test_60 :- test_syntax_error("integer(-/*.*/1).", syntax_error(incomplete_reduction)). + +test_61 :- integer('-'/*.*/1). + +test_62 :- atom(-/*.*/-). + +test_63_180_64 :- setup_call_cleanup(( current_op(P,fy,-), + op(0,fy,-) + ), + ( integer(-1), + integer(- 1) + ), + op(P,fy,-)). + +test_135 :- writeq_term_to_chars(-(1), Chars), + Chars == "- (1)". + +test_136 :- setup_call_cleanup(( current_op(P,fy,-), + op(0,fy,-) + ), + ( writeq_term_to_chars(-(1), Chars), + Chars == "-(1)" + ), + op(P,fy,-)). + +test_182 :- writeq_term_to_chars(-(-1), Chars), + Chars == "- -1". + +test_183 :- writeq_term_to_chars(-(1^2), Chars), + Chars == "- (1^2)". + +test_260 :- writeq_term_to_chars(-(a^2), Chars), + Chars == "- (a^2)". + +test_139 :- writeq_term_to_chars(-((a,b)), Chars), + Chars == "- (a,b)". + +test_218 :- writeq_term_to_chars(-(1*2), Chars), + Chars == "- (1*2)". + +test_140 :- writeq_term_to_chars(-a, Chars), + Chars == "- a". + +test_184 :- writeq_term_to_chars(-(-), Chars), + Chars == "- (-)". + +test_185 :- writeq_term_to_chars(-[-], Chars), + Chars == "- \"-\"". + +test_188 :- writeq_term_to_chars(-p(c), Chars), + Chars == "- p(c)". + +test_189 :- writeq_term_to_chars(-{}, Chars), + Chars == "- {}". + +test_190 :- writeq_term_to_chars(-{a}, Chars), + Chars == "- {a}". + +test_191 :- writeq_term_to_chars(-(-a), Chars), + Chars == "- - a". + +test_192 :- writeq_term_to_chars(-(-(-a)), Chars), + Chars == "- - - a". + +test_216 :- writeq_term_to_chars(-(-1), Chars), + Chars == "- -1". + +test_215_248_249 :- + setup_call_cleanup(op(100,yfx,~), + ( read_from_chars("-(1~2~3).", T0), + writeq_term_to_chars(T0, Chars0), + Chars0 == "- (1~2~3)", + read_from_chars("- (1~2).", T1), + writeq_term_to_chars(T1, Chars1), + Chars1 == "- (1~2)", + read_from_chars("1~2.", T2), + writeq_term_to_chars(T2, Chars2), + Chars2 == "1~2" + ), + op(0,yfx,~)). + +test_278 :- setup_call_cleanup(op(9,xfy,.), + ( writeq_term_to_chars(-[1], Chars), + Chars == "- [1]" + ), + op(0,xfy,.)). + +test_279_296 :- + setup_call_cleanup(op(9,xf,'$VAR'), + ( writeq_term_to_chars(-'$VAR'(0), Chars0), + Chars0 == "- A", + writeq_term_to_chars('$VAR'(0), Chars1), + Chars1 == "A" + ), + op(0,xf,'$VAR')). + +test_55 :- setup_call_cleanup(op(1,yf,yf1), + ( read_from_chars("{-1 yf1}={yf1(X)}.", T), + call(T), + T = (_ = { yf1(-1) }) + ), + op(0,yf,yf1)). + +test_65 :- compound(+1). + +test_66 :- compound(+ 1). + +test_277 :- writeq_term_to_chars(+ 1^2, _). + +test_67 :- setup_call_cleanup(( current_op(P,fy,+), + op(0,fy,+) + ), + compound(+1), + op(P,fy,+)). + +test_257 :- writeq_term_to_chars([+{a},+[]], Chars), + Chars == "[+{a},+[]]". + +test_68 :- [(:-)|(:-)]=[:-|:-]. + +test_69 :- test_syntax_error("X=[a|b,c].", syntax_error(incomplete_reduction)). + +test_70 :- catch((op(1000,xfy,','), + false), + error(permission_error(modify, operator, ','), op/3), + true). + +test_71 :- catch((op(1001,xfy,','), + false), + error(permission_error(modify, operator, ','), op/3), + true). + +test_72 :- catch((op(999,xfy,'|'), + false), + error(permission_error(create, operator, '|'), op/3), + true). + +test_73 :- _ = [a|b]. + +test_285 :- test_syntax_error("X = [(a|b)].", syntax_error(_)). + +test_219 :- [a|[]] = [a]. + +test_74 :- test_syntax_error("X = [a|b|c].", syntax_error(incomplete_reduction)). + +test_75 :- test_syntax_error("var(a:-b).", syntax_error(incomplete_reduction)). + +test_76 :- test_syntax_error(":- = :- .", syntax_error(incomplete_reduction)). + +test_77 :- test_syntax_error("- = - .", syntax_error(incomplete_reduction)). + +test_78 :- test_syntax_error("* = * .", syntax_error(incomplete_reduction)). + +test_79 :- current_op(200,fy,-), !. + +test_80 :- current_op(200,fy,+), !. + +test_81 :- {- - c}={-(-(c))}. + +test_82 :- test_syntax_error("(- -) = -(-). ", syntax_error(incomplete_reduction)). + +test_83 :- test_syntax_error("(- - -) = -(-(-)). ", syntax_error(incomplete_reduction)). + +test_84 :- test_syntax_error("(- - - -) = -(-(-(-))). ", syntax_error(incomplete_reduction)). + +test_85 :- test_syntax_error("{:- :- c} = {:-(:-,c)}.", syntax_error(incomplete_reduction)). + +test_86 :- test_syntax_error("{- = - 1}={(-(=)) - 1}. ", syntax_error(incomplete_reduction)). + +test_87 :- test_syntax_error("write_canonical((- = - 1)). ", syntax_error(incomplete_reduction)). + +test_88 :- test_syntax_error("write_canonical((- = -1)). ", syntax_error(incomplete_reduction)). + +test_89 :- test_syntax_error("write_canonical((-;)). ", syntax_error(incomplete_reduction)). + +test_90 :- test_syntax_error("write_canonical((-;-)). ", syntax_error(incomplete_reduction)). + +test_91 :- test_syntax_error("write_canonical((;-;-)). ", syntax_error(incomplete_reduction)). + +test_92 :- test_syntax_error("[:- -c] = [(:- -c)].", syntax_error(incomplete_reduction)). + +test_93 :- test_syntax_error("writeq([a,b|,]).", syntax_error(incomplete_reduction)). + +test_94 :- test_syntax_error("X = {,}.", syntax_error(incomplete_reduction)). + +test_95 :- {1} = {}(1). + +test_96 :- write_canonical_term_to_chars({1}, Chars), + Chars == "{}(1)". + +test_97 :- '[]'(1) = [ ](X), + X == 1. + +test_98 :- test_syntax_error("X = [] (1).", syntax_error(incomplete_reduction)). + +test_99 :- catch((op(100,yfy,op), + false), + error(domain_error(operator_specifier, yfy), op/3), + true). + +test_100 :- '''' = '\''. + +test_101 :- a = '\141\'. + +test_102 :- test_syntax_error("a = '\\141'.", syntax_error(incomplete_reduction)). + +test_103 :- X = '\141\141', + X == a141. + +test_104 :- test_syntax_error("X = '\\9'.", syntax_error(invalid_single_quoted_character)). + +test_105 :- test_syntax_error("X = '\\N'.", syntax_error(invalid_single_quoted_character)). + +test_106 :- test_syntax_error("X = '\\\\'.", syntax_error(incomplete_reduction)). + +test_107 :- test_syntax_error("X = '\\77777777777\\'.", syntax_error(cannot_parse_big_int)). + +test_108 :- a = '\x61\'. + +test_109 :- test_syntax_error("atom_codes('\\xG\\',Cs).", syntax_error(incomplete_reduction)). + +test_110 :- test_syntax_error("atom_codes('\\xG1\\',Cs).", syntax_error(incomplete_reduction)). + +test_111 :- test_syntax_error("atom(`).", syntax_error(incomplete_reduction)). + +test_112 :- test_syntax_error("atom(`+).", syntax_error(incomplete_reduction)). + +test_297 :- test_syntax_error("atom(`\n`).", syntax_error(missing_quote)). + +test_113 :- test_syntax_error("X =`a`.", syntax_error(back_quoted_string)). + +test_114 :- integer(0'\'). + +test_115 :- integer(0'''). + +test_116 :- 0''' = 0'\'. + +test_117 :- test_syntax_error("integer(0'').", syntax_error(incomplete_reduction)). + +test_195_205_196_197 :- + setup_call_cleanup(op(100,xf,''), + ( read_from_chars("(0 '') = ''(X).", T0), + call(T0), + T0 = (_ = ('')(0)), + read_from_chars("0 ''.", T1), + writeq_term_to_chars(T1, C0), + C0 == "0 ''", + read_from_chars("0''.", T2), + writeq_term_to_chars(T2, C1), + C1 == "0 ''" ), + op(0,xf,'')). + +test_118_119_120 :- + setup_call_cleanup(op(100,xfx,''), + ( read_from_chars("functor(0 ''1, F, A).", T0), + call(T0), + T0 = functor(_, (''), 2), + read_from_chars("functor(0''1, F, A).", T1), + call(T1), + T1 = functor(_, (''), 2) + ), + op(0,xfx,'')). + +test_206_207_209_256 :- + setup_call_cleanup(op(100,xf,f), + ( test_syntax_error("0'f'.", syntax_error(incomplete_reduction)), + read_from_chars("0'f'f'.", T0), + writeq_term_to_chars(T0, C0), + C0 == "102 f", + read_from_chars("0'ff.", T1), + writeq_term_to_chars(T1, C1), + C1 == "102 f", + read_from_chars("0f.", T2), + writeq_term_to_chars(T2, C2), + C2 == "0 f" + ), + op(0,xf,f)). + +test_208 :- setup_call_cleanup(op(100,xf,'f '), + ( read_from_chars("0 'f '.", T0), + writeq_term_to_chars(T0, C0), + C0 == "0 'f '"), + op(0,xf,'f ')). + +test_121 :- test_syntax_error("X = 2'1.", syntax_error(incomplete_reduction)). + +test_122_262 :- + setup_call_cleanup(op(100,xfx,'1 '), + ( read_from_chars("functor(2'1 'y, F, A).", T0), + call(T0), + T0 = functor(_, ('1 '), 2), + read_from_chars("functor(2 '1 'y, F, A).", T1), + call(T1), + T1 = functor(_, ('1 '), 2) + ), + op(0,xfx,'1 ')). + +test_123 :- read_from_chars("X = 0'\\x41\\ .", T), + T = (_ = A), + A == 65. + +test_124 :- X =0'\x41\, + X == 65. + +test_125 :- X =0'\x1\, + X == 1. + +test_127 :- X is 16'mod'2, + X == 0. + +test_128 :- X is 37'mod'2, + X == 1. + +test_129 :- test_syntax_error("X is 0'mod'1.", syntax_error(incomplete_reduction)). + +test_130 :- X is 1'+'1, + X == 2. + +test_212 :- read_from_chars("X is 1'\\\n+'1.", T), + T = (_ is 1+1), + call(T). + +test_213 :- read_from_chars("X is 0'\\\n+'1.", T), + T = (_ is 0+1), + call(T). + +test_259 :- read_from_chars("X is 0'\\\n+'/*'. % */1.", T), + T = (_ is 0+1), + call(T). + +test_303 :- test_syntax_error("X = 0'\\\na.", syntax_error(incomplete_reduction)). + +test_214 :- test_syntax_error("X is 0'\\", syntax_error(incomplete_reduction)). + +test_126 :- test_syntax_error("X = 0'\\\n.\\", syntax_error(incomplete_reduction)). + +test_131_132_133 :- + setup_call_cleanup(op(100,fx,' op'), + ( read_from_chars("' op' '1 '.", T0), + writeq_term_to_chars(T0, C0), + C0 == "' op' '1 '", + read_from_chars("' op'[].", T1), + writeq_term_to_chars(T1, C1), + C1 == "' op'[]" + ), + op(0, fx, ' op') + ). + +test_134 :- + setup_call_cleanup(op(1,xf,xf1), + test_syntax_error("{- =xf1}.", syntax_error(incomplete_reduction)), + op(0,xf,xf1)). + +test_137 :- writeq_term_to_chars(- (a*b), Chars), + Chars == "- (a*b)". + +test_138 :- writeq_term_to_chars(\ (a*b), Chars), + Chars == "\\ (a*b)". + +test_141 :- \+ current_op(_,xfy,.). + +test_142_143_144_221_258 :- + setup_call_cleanup(op(100,xfy,.), + ( read_from_chars("1 .2.", T0), + writeq_term_to_chars(T0, C0), + C0 == "[1|2]", + read_from_chars("[1].", T1), + writeq_term_to_chars(T1, C1), + C1 == "[1]", + read_from_chars("-[1].", T2), + writeq_term_to_chars(T2, C2), + C2 == "- [1]", + read_from_chars("X = 1.e.", T3), + writeq_term_to_chars(T3, C3), + C3 == "A=[1|e]", + read_from_chars("writeq(ok).%\n1=X.", T4), + T4 = writeq(ok) + ), + op(0,xfy,.)). + +test_145 :- write_canonical_term_to_chars('$VAR'(0), Cs), + Cs == "'$VAR'(0)". + +test_146 :- write_term_to_chars('$VAR'(0), [], Cs), + Cs == "$VAR(0)". + +test_244 :- writeq_term_to_chars('$VAR'(0), Cs), + Cs == "A". + +test_245 :- writeq_term_to_chars('$VAR'(-1), Cs), + Cs == "'$VAR'(-1)". + +test_246 :- writeq_term_to_chars('$VAR'(-2), Cs), + Cs == "'$VAR'(-2)". + +test_247 :- writeq_term_to_chars('$VAR'(x), Cs), + Cs == "'$VAR'(x)". + +test_289 :- writeq_term_to_chars('$VAR'('A'), Cs), + Cs == "'$VAR'('A')". + +test_147_148_149_150 :- + setup_call_cleanup(( op(9,fy,fy), + op(9,yf,yf)), + ( read_from_chars("fy 1 yf.", T0), + write_canonical_term_to_chars(T0, C0), + C0 == "fy(yf(1))", + test_syntax_error("fy yf.", syntax_error(incomplete_reduction)), + read_from_chars("fy(yf(1)).", T1), + writeq_term_to_chars(T1, C1), + C1 == "fy 1 yf", + read_from_chars("yf(fy(1)).", T2), + writeq_term_to_chars(T2, C2), + C2 == "(fy 1)yf" + ), + ( op(0,fy,fy), + op(0,yf,yf))). + +test_151_152_153 :- + setup_call_cleanup(( op(9,fy,fy), + op(9,yfx,yfx)), + ( read_from_chars("fy 1 yfx 2.", T0), + write_canonical_term_to_chars(T0, C0), + C0 == "fy(yfx(1,2))", + read_from_chars("fy(yfx(1,2)).", T1), + writeq_term_to_chars(T1, C1), + C1 == "fy 1 yfx 2", + read_from_chars("yfx(fy(1),2).", T2), + writeq_term_to_chars(T2, C2), + C2 == "(fy 1)yfx 2" + ), + ( op(0,fy,fy), + op(0,yfx,yfx))). + +test_154_155_156 :- + setup_call_cleanup(( op(9,yf,yf), + op(9,xfy,xfy)), + ( read_from_chars("1 xfy 2 yf.", T0), + write_canonical_term_to_chars(T0, C0), + C0 == "xfy(1,yf(2))", + read_from_chars("xfy(1,yf(2)).", T1), + writeq_term_to_chars(T1, C1), + C1 == "1 xfy 2 yf", + read_from_chars("yf(xfy(1,2)).", T2), + writeq_term_to_chars(T2, C2), + C2 == "(1 xfy 2)yf" + ), + ( op(0,yf,yf), + op(0,xfy,xfy)) + ). + +test_157 :- setup_call_cleanup((( current_op(P,xfy,:-) -> + true + ; P = 0 + ), + op(0,xfy,:-) + ), + \+ current_op(_,xfx,:-), + ( op(P,xfy,:-), + op(1200,xfx,:-) ) + ). + +test_158 :- catch((op(0,xfy,','), + false), + error(permission_error(modify, operator, (',')), op/3), + true). + +test_159_201_202_160_161 :- + setup_call_cleanup(( op(9,fy,f), + op(9,yf,f)), + ( read_from_chars("f f 0.", T0), + write_canonical_term_to_chars(T0, C0), + C0 == "f(f(0))", + read_from_chars("f(f(0)).", T1), + writeq_term_to_chars(T1, C1), + C1 == "f f 0", + read_from_chars("f 0 f.", T2), + write_canonical_term_to_chars(T2, C2), + C2 == "f(f(0))", + read_from_chars("0 f f.", T3), + write_canonical_term_to_chars(T3, C3), + C3 == "f(f(0))", + test_syntax_error("f f.", syntax_error(incomplete_reduction)) + ), + ( op(0,fy,f), + op(0,yf,f))). + +test_162 :- setup_call_cleanup((op(9,fy,p),op(9,yfx,p)), + test_syntax_error("1 p p p 2.", syntax_error(incomplete_reduction)), + (op(0,fy,p),op(0,yfx,p))). + +test_163 :- setup_call_cleanup((op(9,fy,p),op(9,xfy,p)), + ( read_from_chars("1 p p p 2.", T), + write_canonical_term_to_chars(T, C), + C == "p(1,p(p(2)))" + ), + (op(0,fy,p),op(0,xfy,p))). + +test_164 :- setup_call_cleanup((op(7,fy,p),op(9,yfx,p)), + ( read_from_chars("1 p p p 2.", T), + write_canonical_term_to_chars(T, C), + C == "p(1,p(p(2)))" + ), + (op(0,fy,p),op(0,yfx,p))). + +test_165 :- atom('.''-''.'). + +test_166_167 :- setup_call_cleanup(current_op(P,xfy,'|'), + ( op(0,xfy,'|'), + test_syntax_error("(a|b).", syntax_error(incomplete_reduction))), + op(P,xfy,'|')). + +test_168_169 :- call_cleanup(( op(0,xfy,.), + op(9,yf,.), + read_from_chars(".(.).", T), + writeq_term_to_chars(T, C), + C == "('.')'.'" ), + op(0,yf,.)). + +test_194 :- op(0,xfy,.), + writeq_term_to_chars((.)+(.), C), + C == "'.'+'.'". + +test_170 :- set_prolog_flag(double_quotes,chars). + +test_171 :- writeq_term_to_chars("a", C), + C == "\"a\"". + +test_229 :- test_syntax_error("\"\\z.\"", syntax_error(missing_quote)). + +test_300 :- writeq_term_to_chars("\0\", C), + C == "\"\\x0\\\"". + +test_172 :- X is 10.0** -323, + writeq_term_to_chars(X, C), + C == "1.0e-323". + +test_173 :- 1.0e-323=:=10.0** -323. + +test_174 :- -1 = -0x1. + +test_175 :- T = t(0b1,0o1,0x1), + T = t(1,1,1). + +test_176 :- X is 0b1mod 2, + X == 1. + +test_217_181_290 :- + setup_call_cleanup(( current_op(P, xfy, '|') -> + true + ; P = 0 + ), + ( op(1105,xfy,'|'), + read_from_chars("(a-->b,c|d).", T0), + writeq_term_to_chars(T0, C0), + C0 == "a-->b,c | d", + read_from_chars("[(a|b)].", T1), + writeq_term_to_chars(T1, C1), + C1 == "[(a | b)]" + ), + op(P, xfy, '|')). + +test_186 :- X/* /*/=7, + X == 7. + +test_187 :- X/*/*/=7, + X == 7. + +test_198 :- atom($-). + +test_199 :- atom(-$). + +test_200 :- setup_call_cleanup(op(900, fy, [$]), + ( read_from_chars("$a+b.", T), + write_canonical_term_to_chars(T, C), + C == "$(+(a,b))" + ), + op(0,fy,[$])). + +test_224 :- catch((read_from_chars("\\ .", T), + call(T), + false), + error(existence_error(procedure,(\)/0), _), + true). + +test_225 :- char_code(C,0), + writeq_term_to_chars(C, Cs), + Cs == "'\\x0\\'". + +test_250 :- writeq_term_to_chars('\0\', C), + C == "'\\x0\\'". + +test_226 :- write_canonical_term_to_chars(_+_, Cs), + Cs == "+(A,B)". % note that no variable names are supplied by write_canonical_term_to_chars/2. + +test_227 :- write_canonical_term_to_chars(A+A, Cs), + Cs == "+(A,A)". + +test_228 :- test_syntax_error("writeq(0'\\z).", syntax_error(unexpected_char)). + +test_230 :- test_syntax_error("char_code('\\^',X).", syntax_error(invalid_single_quoted_character)). + +test_231 :- test_syntax_error("writeq(0'\\c).", syntax_error(unexpected_char)). + +test_232 :- test_syntax_error("writeq(0'\\ ).", syntax_error(unexpected_char)). + +test_233 :- test_syntax_error("writeq(nop (1)).", syntax_error(incomplete_reduction)). + +test_234_235 :- setup_call_cleanup(op(400,fx,f), + ( read_from_chars("f/*.*/(1,2).", T), + writeq_term_to_chars(T, C), + C == "f (1,2)", + test_syntax_error("1 = f.", syntax_error(incomplete_reduction)) + ), + op(0,fx,f)). + +test_236 :- write_canonical_term_to_chars(a- - -b, Cs), + Cs == "-(a,-(-(b)))". + +test_237 :- catch((op(699,xf,>), + false), + error(permission_error(create,operator,>),op/3), + true). + +test_238 :- writeq_term_to_chars(>(>(a),b), Cs), + Cs == ">(a)>b". + +test_239 :- test_syntax_error("a> >b.", syntax_error(incomplete_reduction)). + +test_242 :- test_syntax_error("a> =b.", syntax_error(incomplete_reduction)). + +test_243 :- test_syntax_error("a>,b.", syntax_error(incomplete_reduction)). + +test_240 :- test_syntax_error("a>.", syntax_error(incomplete_reduction)). + +test_251_263_252_253_254_255 :- + setup_call_cleanup(op(9,yfx,[bop,bo,b,op,xor]), + ( read_from_chars("0 bop 2.", T0), + writeq_term_to_chars(T0, C0), + C0 == "0 bop 2", + read_from_chars("0bo 2.", T1), + writeq_term_to_chars(T1, C1), + C1 == "0 bo 2", + read_from_chars("0b 2.", T2), + writeq_term_to_chars(T2, C2), + C2 == "0 b 2", + read_from_chars("0op 2.", T3), + writeq_term_to_chars(T3, C3), + C3 == "0 op 2", + read_from_chars("0xor 2.", T4), + writeq_term_to_chars(T4, C4), + C4 == "0 xor 2" + ), + op(0,yfx,[bop,bo,b,op,xor])). + +test_264 :- writeq_term_to_chars('^`', C), + C == "'^`'". + +test_265_266_267 :- + setup_call_cleanup(op(9,yf,[b2,o8]), + ( read_from_chars("0b2.", T0), + writeq_term_to_chars(T0, C0), + C0 == "0 b2", + read_from_chars("0o8.", T1), + writeq_term_to_chars(T1, C1), + C1 == "0 o8" + ), + op(0,yf,[b2,o8])). + +test_268 :- catch((op(500,xfy,{}), + false), + error(permission_error(create, operator, {}), op/3), + true). + +test_269 :- writeq_term_to_chars('\b\r\f\t\n', C), + C == "'\\b\\r\\f\\t\\n'". + +test_270 :- + setup_call_cleanup((open("test_270.txt", write, WriteFile), + format(WriteFile, "get_char(Stream, C). %\n", []), + close(WriteFile), + open("test_270.txt", read, ReadFile)), + (read_term(ReadFile, T, []), + T = get_char(ReadFile, C), + call(T), + C == ' '), + (close(ReadFile), + delete_file("test_270.txt"))). + +test_271 :- + setup_call_cleanup((open("test_271.txt", write, WriteFile), + format(WriteFile, "get_char(Stream, C).%\n", []), + close(WriteFile), + open("test_271.txt", read, ReadFile)), + (read_term(ReadFile, T, []), + T = get_char(ReadFile, C), + call(T), + C == '%'), + (close(ReadFile), + delete_file("test_271.txt"))). + +test_272 :- test_syntax_error("writeq(0B1).", syntax_error(incomplete_reduction)). + +test_274_275 :- + setup_call_cleanup(op(20,fx,--), + ( read_from_chars("--(a).", T0), + writeq_term_to_chars(T0, C0), + C0 == "--a", + op(0,fx,--), + read_from_chars("--(a).", T1), + writeq_term_to_chars(T1, C1), + C1 == "--(a)" + ), + op(0,fx,--)). + +test_276 :- writeq_term_to_chars(0xamod 2, C), + C == "10 mod 2". + +test_280 :- writeq_term_to_chars(00'+'1, C), + C == "0+1". + +test_281 :- test_syntax_error("00'a.", syntax_error(incomplete_reduction)). + +test_284 :- test_syntax_error("'\\^J'.", syntax_error(invalid_single_quoted_character)). + +test_291 :- writeq_term_to_chars([(a,b)], C), + C == "[(a,b)]". + +test_292 :- writeq_term_to_chars(1 = \\, C), + C == "1= \\\\". + +test_293 :- test_syntax_error("writeq((,)).", syntax_error(incomplete_reduction)). + +test_294 :- test_syntax_error("writeq({[}).", syntax_error(incomplete_reduction)). + +test_295 :- test_syntax_error("writeq({(}).", syntax_error(incomplete_reduction)). + +test_298 :- writeq_term_to_chars([a,b|c], C), + C == "[a,b|c]". + +test_299 :- (\+ (a,b)) = \+(T), + T == (a,b). + +test_302 :- [] = '[]'. + +test_304 :- setup_call_cleanup(op(300,fy,~), + ( read_from_chars("~ (a = b).", T), + writeq_term_to_chars(T, C), + C == "~(a=b)" + ), + op(0,fy,~)). + +test_305 :- writeq_term_to_chars(\ (a = b), C), + C == "\\ (a=b)". + +test_306 :- writeq_term_to_chars(+ (a = b), C), + C == "+(a=b)". + +test_307 :- writeq_term_to_chars([/**/], C), + C == "[]". + +test_308 :- writeq_term_to_chars(.+, C), + C == ".+". + +test_309 :- writeq_term_to_chars({a,b}, C), + C == "{a,b}". + +test_310 :- test_syntax_error("writeq({\\+ (}).", syntax_error(incomplete_reduction)). + +test_311 :- test_syntax_error("Finis ().", syntax_error(incomplete_reduction)). + +run_tests([Test|Tests]) --> + ( { call(Test) } -> + [] + ; { format("~a failed!~n", [Test]) }, + [Test] + ), + run_tests(Tests). +run_tests([]) --> []. + +run_tests :- + findall(Test, + ( current_predicate(iso_conformity_tests:Test/0), + once(sub_atom(Test, 0, 5, _, test_)) + ), + Tests), + phrase(run_tests(Tests), FailedTests), + ( FailedTests == [] -> + write('All tests passed'), + nl + ; format("Failed ISO conformity tests: ~w~n", [FailedTests]), + false + ). + +% FIXME: enable once all tests pass. +% :- initialization_goals(run_tests). From 3cbe78cb9b77d4daa53f6cb8bdbbdae49144f19e Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 29 Jun 2023 14:57:29 -0600 Subject: [PATCH 02/11] correct tests 259 and 304 of tests-pl/iso-conformity-tests.pl --- tests-pl/iso-conformity-tests.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index e263fa9f..87c6d066 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -551,8 +551,8 @@ test_213 :- read_from_chars("X is 0'\\\n+'1.", T), T = (_ is 0+1), call(T). -test_259 :- read_from_chars("X is 0'\\\n+'/*'. % */1.", T), - T = (_ is 0+1), +test_259 :- read_from_chars("X = 0'\\\n+'/*'. %*/1.", T), + T = (_ = 0+1), call(T). test_303 :- test_syntax_error("X = 0'\\\na.", syntax_error(incomplete_reduction)). @@ -973,7 +973,7 @@ test_302 :- [] = '[]'. test_304 :- setup_call_cleanup(op(300,fy,~), ( read_from_chars("~ (a = b).", T), writeq_term_to_chars(T, C), - C == "~(a=b)" + C == "~ (a=b)" ), op(0,fy,~)). From 8140ff9154b60665e0c0232e3ce2395bbf64ffc6 Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 29 Jun 2023 17:35:27 -0600 Subject: [PATCH 03/11] always print a space between prefix operator and its operand --- src/heap_print.rs | 46 +++++++------------------------- tests-pl/iso-conformity-tests.pl | 8 +++--- 2 files changed, 14 insertions(+), 40 deletions(-) diff --git a/src/heap_print.rs b/src/heap_print.rs index f846dea1..3f48aed7 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -590,31 +590,21 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { right_directed_op, )); } else if is_prefix!(spec.get_spec()) { - match name { - atom!("-") | atom!("\\") => { - self.format_prefix_op_with_space(max_depth, name, spec); - return; - } - _ => {} - }; - if self.check_max_depth(&mut max_depth) { self.iter.pop_stack(); self.state_stack.push(TokenOrRedirect::Atom(atom!("..."))); - self.state_stack.push(TokenOrRedirect::Op(name, spec)); + self.state_stack.push(TokenOrRedirect::Space); + self.state_stack.push(TokenOrRedirect::Atom(name)); return; } - let left_directed_op = DirectedOp::Left(name, spec); + let op = DirectedOp::Left(name, spec); - self.state_stack.push(TokenOrRedirect::CompositeRedirect( - max_depth, - left_directed_op, - )); - - self.state_stack.push(TokenOrRedirect::Op(name, spec)); + self.state_stack.push(TokenOrRedirect::CompositeRedirect(max_depth, op)); + self.state_stack.push(TokenOrRedirect::Space); + self.state_stack.push(TokenOrRedirect::Atom(name)); } else { match name.as_str() { "|" => { @@ -687,24 +677,6 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { true } - fn format_prefix_op_with_space(&mut self, mut max_depth: usize, name: Atom, spec: OpDesc) { - if self.check_max_depth(&mut max_depth) { - self.iter.pop_stack(); - - self.state_stack.push(TokenOrRedirect::Atom(atom!("..."))); - self.state_stack.push(TokenOrRedirect::Space); - self.state_stack.push(TokenOrRedirect::Atom(name)); - - return; - } - - let op = DirectedOp::Left(name, spec); - - self.state_stack.push(TokenOrRedirect::CompositeRedirect(max_depth, op)); - self.state_stack.push(TokenOrRedirect::Space); - self.state_stack.push(TokenOrRedirect::Atom(name)); - } - fn format_bar_separator_op(&mut self, mut max_depth: usize, name: Atom, spec: OpDesc) { if self.check_max_depth(&mut max_depth) { self.iter.pop_stack(); @@ -1348,8 +1320,10 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { self.state_stack.push(TokenOrRedirect::Open); if let Some(ref op) = &op { - if op.is_left() && requires_space(op.as_atom().as_str(), "(") { - self.state_stack.push(TokenOrRedirect::Space); + if !self.outputter.ends_with(" ") { + if op.is_left() && requires_space(op.as_atom().as_str(), "(") { + self.state_stack.push(TokenOrRedirect::Space); + } } } } diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index 87c6d066..39626808 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -341,7 +341,7 @@ test_67 :- setup_call_cleanup(( current_op(P,fy,+), op(P,fy,+)). test_257 :- writeq_term_to_chars([+{a},+[]], Chars), - Chars == "[+{a},+[]]". + Chars == "[+ {a},+ []]". test_68 :- [(:-)|(:-)]=[:-|:-]. @@ -568,7 +568,7 @@ test_131_132_133 :- C0 == "' op' '1 '", read_from_chars("' op'[].", T1), writeq_term_to_chars(T1, C1), - C1 == "' op'[]" + C1 == "' op' []" ), op(0, fx, ' op') ). @@ -932,7 +932,7 @@ test_274_275 :- setup_call_cleanup(op(20,fx,--), ( read_from_chars("--(a).", T0), writeq_term_to_chars(T0, C0), - C0 == "--a", + C0 == "-- a", op(0,fx,--), read_from_chars("--(a).", T1), writeq_term_to_chars(T1, C1), @@ -981,7 +981,7 @@ test_305 :- writeq_term_to_chars(\ (a = b), C), C == "\\ (a=b)". test_306 :- writeq_term_to_chars(+ (a = b), C), - C == "+(a=b)". + C == "+ (a=b)". test_307 :- writeq_term_to_chars([/**/], C), C == "[]". From a09306c58524fb9f378d6df6cbe60a1b9922e08e Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 29 Jun 2023 17:59:25 -0600 Subject: [PATCH 04/11] check ambiguity of "'" against tail if atom token is about to be quoted --- src/heap_print.rs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/heap_print.rs b/src/heap_print.rs index 3f48aed7..4025339c 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -568,7 +568,12 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { #[inline] fn ambiguity_check(&self, atom: &str) -> bool { let tail = self.outputter.range_from(self.last_item_idx..); - requires_space(tail, atom) + + if !self.quoted || non_quoted_token(atom.chars()) { + requires_space(tail, atom) + } else { + requires_space(tail, "'") + } } fn enqueue_op(&mut self, mut max_depth: usize, name: Atom, spec: OpDesc) { From 521118265a94ea504cdbdd137c0fc30a5d462b5c Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 29 Jun 2023 18:01:09 -0600 Subject: [PATCH 05/11] make setup of test_166_167 pass --- tests-pl/iso-conformity-tests.pl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index 39626808..31ddc4d3 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -732,7 +732,10 @@ test_164 :- setup_call_cleanup((op(7,fy,p),op(9,yfx,p)), test_165 :- atom('.''-''.'). -test_166_167 :- setup_call_cleanup(current_op(P,xfy,'|'), +test_166_167 :- setup_call_cleanup(( current_op(P,xfy,'|') -> + true + ; P = 0 + ), ( op(0,xfy,'|'), test_syntax_error("(a|b).", syntax_error(incomplete_reduction))), op(P,xfy,'|')). From 38a9d231746395b5725af47233bca9523cb2de67 Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 29 Jun 2023 18:03:43 -0600 Subject: [PATCH 06/11] correct initialization_goals misnomer in iso-conformity-tests.pl --- tests-pl/iso-conformity-tests.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index 31ddc4d3..e78305a2 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -1023,4 +1023,4 @@ run_tests :- ). % FIXME: enable once all tests pass. -% :- initialization_goals(run_tests). +% :- initialization(run_tests). From cb25a9025018643f5e2da32f4474dbc23ca299c3 Mon Sep 17 00:00:00 2001 From: Mark Date: Sat, 1 Jul 2023 15:38:05 -0600 Subject: [PATCH 07/11] add iso-conformity-tests.pl to test suite --- src/machine/mock_wam.rs | 2 +- tests-pl/iso-conformity-tests.pl | 9 +++------ tests/scryer/src_tests.rs | 9 +++++++++ 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/machine/mock_wam.rs b/src/machine/mock_wam.rs index f71f32e3..70264ac9 100644 --- a/src/machine/mock_wam.rs +++ b/src/machine/mock_wam.rs @@ -239,7 +239,7 @@ impl Machine { user_error, load_contexts: vec![], runtime, - foreign_function_table: Default::default(), + foreign_function_table: Default::default(), }; let mut lib_path = current_dir(); diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index e78305a2..d72fbf38 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -5,7 +5,6 @@ :- use_module(library(files)). :- use_module(library(format)). :- use_module(library(iso_ext)). -:- use_module(library(lists), [append/3]). writeq_term_to_chars(Term, Chars) :- Options = [ignore_ops(false), numbervars(true), quoted(true), variable_names([])], @@ -1016,11 +1015,9 @@ run_tests :- Tests), phrase(run_tests(Tests), FailedTests), ( FailedTests == [] -> - write('All tests passed'), - nl - ; format("Failed ISO conformity tests: ~w~n", [FailedTests]), + write('All tests passed') + ; format("Failed ISO conformity tests: ~w", [FailedTests]), false ). -% FIXME: enable once all tests pass. -% :- initialization(run_tests). +:- initialization(run_tests). diff --git a/tests/scryer/src_tests.rs b/tests/scryer/src_tests.rs index c7f7c80a..38043098 100644 --- a/tests/scryer/src_tests.rs +++ b/tests/scryer/src_tests.rs @@ -69,3 +69,12 @@ fn setup_call_cleanup_process() { fn clpz_load() { load_module_test("src/tests/clpz/test_clpz.pl", ""); } + +#[serial] +#[test] +fn iso_conformity_tests() { + load_module_test( + "tests-pl/iso-conformity-tests.pl", + "All tests passed", + ); +} From e36f96fd475ff06173d5f1de8c6726f6303d4d53 Mon Sep 17 00:00:00 2001 From: Mark Date: Mon, 3 Jul 2023 11:34:41 -0600 Subject: [PATCH 08/11] correct ISO conformity test #185 --- tests-pl/iso-conformity-tests.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index d72fbf38..40242fca 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -271,7 +271,7 @@ test_184 :- writeq_term_to_chars(-(-), Chars), Chars == "- (-)". test_185 :- writeq_term_to_chars(-[-], Chars), - Chars == "- \"-\"". + Chars == "- [-]". test_188 :- writeq_term_to_chars(-p(c), Chars), Chars == "- p(c)". From 9cdad087ef2b064073faf650fa65912ade038e03 Mon Sep 17 00:00:00 2001 From: Mark Date: Mon, 3 Jul 2023 11:35:07 -0600 Subject: [PATCH 09/11] add double_quotes write option for printing to strings, enable it at toplevel --- build/instructions_template.rs | 4 ++-- src/heap_print.rs | 13 ++++++++--- src/lib/builtins.pl | 40 +++++++++++++++++++--------------- src/lib/charsio.pl | 7 +++--- src/machine/machine_state.rs | 23 ++++++++++++++++++- src/machine/mock_wam.rs | 1 + src/parser/ast.rs | 2 +- src/toplevel.pl | 12 +++++----- 8 files changed, 68 insertions(+), 34 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 7f559b8e..dc88a827 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -472,9 +472,9 @@ enum SystemClauseType { WAMInstructions, #[strum_discriminants(strum(props(Arity = "2", Name = "$inlined_instructions")))] InlinedInstructions, - #[strum_discriminants(strum(props(Arity = "7", Name = "$write_term")))] + #[strum_discriminants(strum(props(Arity = "8", Name = "$write_term")))] WriteTerm, - #[strum_discriminants(strum(props(Arity = "7", Name = "$write_term_to_chars")))] + #[strum_discriminants(strum(props(Arity = "8", Name = "$write_term_to_chars")))] WriteTermToChars, #[strum_discriminants(strum(props(Arity = "1", Name = "$scryer_prolog_version")))] ScryerPrologVersion, diff --git a/src/heap_print.rs b/src/heap_print.rs index 4025339c..4aef1ab1 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -478,6 +478,7 @@ pub struct HCPrinter<'a, Outputter> { iter: StackfulPreOrderHeapIter<'a>, atom_tbl: &'a mut AtomTable, op_dir: &'a OpDir, + flags: MachineFlags, state_stack: Vec, toplevel_spec: Option, last_item_idx: usize, @@ -488,6 +489,7 @@ pub struct HCPrinter<'a, Outputter> { pub ignore_ops: bool, pub print_strings_as_strs: bool, pub max_depth: usize, + pub double_quotes: bool, } macro_rules! push_space_if_amb { @@ -544,6 +546,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { atom_tbl: &'a mut AtomTable, stack: &'a mut Stack, op_dir: &'a OpDir, + flags: MachineFlags, output: Outputter, cell: HeapCellValue, ) -> Self { @@ -552,6 +555,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { iter: stackful_preorder_iter(heap, stack, cell), atom_tbl, op_dir, + flags, state_stack: vec![], toplevel_spec: None, last_item_idx: 0, @@ -562,6 +566,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { var_names: IndexMap::new(), print_strings_as_strs: false, max_depth: 0, + double_quotes: false, } } @@ -1164,9 +1169,11 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { let at_cdr = self.outputter.ends_with("|"); - if !at_cdr && !self.ignore_ops && end_cell.is_string_terminator(&self.iter.heap) { - self.remove_list_children(focus.value() as usize); - return self.print_proper_string(focus.value() as usize, max_depth); + if self.double_quotes && self.flags.double_quotes == DoubleQuotes::Chars { + if !at_cdr && !self.ignore_ops && end_cell.is_string_terminator(&self.iter.heap) { + self.remove_list_children(focus.value() as usize); + return self.print_proper_string(focus.value() as usize, max_depth); + } } if self.ignore_ops { diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 904d2f69..4794c603 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -528,30 +528,34 @@ parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :- parse_write_options(Options, OptionValues, Stub) :- - DefaultOptions = [ignore_ops-false, max_depth-0, numbervars-false, + DefaultOptions = [double_quotes-false, ignore_ops-false, max_depth-0, numbervars-false, quoted-false, variable_names-[]], parse_options_list(Options, builtins:parse_write_options_, DefaultOptions, OptionValues, Stub). + +parse_write_options_(double_quotes(DoubleQuotes), double_quotes-DoubleQuotes) :- + ( nonvar(DoubleQuotes), + lists:member(DoubleQuotes, [true, false]), + ! + ; throw(error(domain_error(write_option, double_quotes(DoubleQuotes)), _)) + ). parse_write_options_(ignore_ops(IgnoreOps), ignore_ops-IgnoreOps) :- ( nonvar(IgnoreOps), lists:member(IgnoreOps, [true, false]), ! - ; - throw(error(domain_error(write_option, ignore_ops(IgnoreOps)), _)) + ; throw(error(domain_error(write_option, ignore_ops(IgnoreOps)), _)) ). parse_write_options_(quoted(Quoted), quoted-Quoted) :- ( nonvar(Quoted), lists:member(Quoted, [true, false]), ! - ; - throw(error(domain_error(write_option, quoted(Quoted)), _)) + ; throw(error(domain_error(write_option, quoted(Quoted)), _)) ). parse_write_options_(numbervars(NumberVars), numbervars-NumberVars) :- ( nonvar(NumberVars), lists:member(NumberVars, [true, false]), ! - ; - throw(error(domain_error(write_option, numbervars(NumberVars)), _)) + ; throw(error(domain_error(write_option, numbervars(NumberVars)), _)) ). parse_write_options_(variable_names(VNNames), variable_names-VNNames) :- must_be_var_names_list(VNNames), @@ -560,8 +564,7 @@ parse_write_options_(max_depth(MaxDepth), max_depth-MaxDepth) :- ( integer(MaxDepth), MaxDepth >= 0, ! - ; - throw(error(domain_error(write_option, max_depth(MaxDepth)), _)) + ; throw(error(domain_error(write_option, max_depth(MaxDepth)), _)) ). parse_write_options_(E, _) :- throw(error(domain_error(write_option, E), _)). @@ -607,11 +610,12 @@ write_term(Term, Options) :- % * `max_depth(+N)` if the term is nested deeper than N, print the reminder as ellipses. % If N = 0 (default), there's no limit. % * `numbervars(+Boolean)` if true, replaces `$VAR(N)` variables with letters, in order. Default is false. -% * `quoted(+Boolean)` if true, strings and atoms that need quotes to be valid Prolog synytax, are quoted. Default is false. +% * `quoted(+Boolean)` if true, strings and atoms that need quotes to be valid Prolog syntax, are quoted. Default is false. % * `variable_names(+List)` assign names to variables in term. List should be a list of terms of format `Name=Var`. +% * `double_quotes(+Boolean)` if true, strings are printed in double quotes rather than with list notation. Default is false. write_term(Stream, Term, Options) :- - parse_write_options(Options, [IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames], write_term/3), - '$write_term'(Stream, Term, IgnoreOps, NumberVars, Quoted, VNNames, MaxDepth). + parse_write_options(Options, [DoubleQuotes, IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames], write_term/3), + '$write_term'(Stream, Term, IgnoreOps, NumberVars, Quoted, VNNames, MaxDepth, DoubleQuotes). %% write(+Term). @@ -619,26 +623,26 @@ write_term(Stream, Term, Options) :- % Write Term to the current output stream using a syntax similar to Prolog write(Term) :- current_output(Stream), - '$write_term'(Stream, Term, false, true, false, [], 0). + '$write_term'(Stream, Term, false, true, false, [], 0, false). %% write(+Stream, +Term). % % Write Term to the stream Stream using a syntax similar to Prolog write(Stream, Term) :- - '$write_term'(Stream, Term, false, true, false, [], 0). + '$write_term'(Stream, Term, false, true, false, [], 0, false). %% write_canonical(+Term). % % Write Term to the current output stream using canonical Prolog syntax. Can be read back as Prolog terms. write_canonical(Term) :- current_output(Stream), - '$write_term'(Stream, Term, true, false, true, [], 0). + '$write_term'(Stream, Term, true, false, true, [], 0, false). %% write_canonical(+Stream, +Term). % % Write Term to the stream Stream using canonical Prolog syntax. Can be read back as Prolog terms. write_canonical(Stream, Term) :- - '$write_term'(Stream, Term, true, false, true, [], 0). + '$write_term'(Stream, Term, true, false, true, [], 0, false). %% writeq(+Term). % @@ -646,14 +650,14 @@ write_canonical(Stream, Term) :- % quoted according to Prolog syntax. writeq(Term) :- current_output(Stream), - '$write_term'(Stream, Term, false, true, true, [], 0). + '$write_term'(Stream, Term, false, true, true, [], 0, false). %% writeq(+Stream, +Term). % % Write Term to the stream Stream using a syntax similar to `write/1` but quoting the atoms that need to be % quoted according to Prolog syntax. writeq(Stream, Term) :- - '$write_term'(Stream, Term, false, true, true, [], 0). + '$write_term'(Stream, Term, false, true, true, [], 0, false). select_rightmost_options([Option-Value | OptionPairs], OptionValues) :- ( pairs:same_key(Option, OptionPairs, OtherValues, _), diff --git a/src/lib/charsio.pl b/src/lib/charsio.pl index 99b5c281..128a6c50 100644 --- a/src/lib/charsio.pl +++ b/src/lib/charsio.pl @@ -206,13 +206,14 @@ read_from_chars(Chars, Term) :- % * `max_depth(+N)` if the term is nested deeper than N, print the reminder as ellipses. % If N = 0 (default), there's no limit. % * `numbervars(+Boolean)` if true, replaces `$VAR(N)` variables with letters, in order. Default is false. -% * `quoted(+Boolean)` if true, strings and atoms that need quotes to be valid Prolog synytax, are quoted. Default is false. +% * `quoted(+Boolean)` if true, strings and atoms that need quotes to be valid Prolog syntax, are quoted. Default is false. % * `variable_names(+List)` assign names to variables in term. List should be a list of terms of format `Name=Var`. +% * `double_quotes(+Boolean)` if true, strings are printed in double quotes rather than with list notation. Default is false. write_term_to_chars(_, Options, _) :- var(Options), instantiation_error(write_term_to_chars/3). write_term_to_chars(Term, Options, Chars) :- builtins:parse_write_options(Options, - [IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames], + [DoubleQuotes, IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames], write_term_to_chars/3), ( nonvar(Chars) -> throw(error(uninstantiation_error(Chars), write_term_to_chars/3)) @@ -221,7 +222,7 @@ write_term_to_chars(Term, Options, Chars) :- ), term_variables(Term, Vars), extend_var_list(Vars, VNNames, NewVarNames, numbervars), - '$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth). + '$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth, DoubleQuotes). % Encodes Ch character to list of Bytes. char_utf8bytes(Ch, Bytes) :- diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs index 29702c4a..78b1a7f5 100644 --- a/src/machine/machine_state.rs +++ b/src/machine/machine_state.rs @@ -666,6 +666,7 @@ impl MachineState { let numbervars = self.store(self.deref(self.registers[4])); let quoted = self.store(self.deref(self.registers[5])); let max_depth = self.store(self.deref(self.registers[7])); + let double_quotes = self.store(self.deref(self.registers[8])); let term_to_be_printed = self.store(self.deref(self.registers[2])); let stub_gen = || functor_stub(atom!("write_term"), 2); @@ -747,7 +748,25 @@ impl MachineState { ); let quoted = read_heap_cell!(quoted, - (HeapCellValueTag::Atom, (name, _arity)) => { + (HeapCellValueTag::Atom, (name, arity)) => { + debug_assert_eq!(arity, 0); + name == atom!("true") + } + (HeapCellValueTag::Str, s) => { + let (name, arity) = cell_as_atom_cell!(self.heap[s]) + .get_name_and_arity(); + + debug_assert_eq!(arity, 0); + name == atom!("true") + } + _ => { + unreachable!() + } + ); + + let double_quotes = read_heap_cell!(double_quotes, + (HeapCellValueTag::Atom, (name, arity)) => { + debug_assert_eq!(arity, 0); name == atom!("true") } (HeapCellValueTag::Str, s) => { @@ -767,6 +786,7 @@ impl MachineState { &mut self.atom_tbl, &mut self.stack, op_dir, + self.flags, PrinterOutputter::new(), term_to_be_printed, ); @@ -774,6 +794,7 @@ impl MachineState { printer.ignore_ops = ignore_ops; printer.numbervars = numbervars; printer.quoted = quoted; + printer.double_quotes = double_quotes; match Number::try_from(max_depth) { Ok(Number::Fixnum(n)) => { diff --git a/src/machine/mock_wam.rs b/src/machine/mock_wam.rs index 70264ac9..a4aad74c 100644 --- a/src/machine/mock_wam.rs +++ b/src/machine/mock_wam.rs @@ -64,6 +64,7 @@ impl MockWAM { &mut self.machine_st.atom_tbl, &mut self.machine_st.stack, &self.op_dir, + self.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(term_write_result.heap_loc), ); diff --git a/src/parser/ast.rs b/src/parser/ast.rs index 31f1a702..272d5b7e 100644 --- a/src/parser/ast.rs +++ b/src/parser/ast.rs @@ -313,7 +313,7 @@ impl Default for MachineFlags { } } -#[derive(Debug, Clone, Copy)] +#[derive(Debug, Clone, Copy, PartialEq)] pub enum DoubleQuotes { Atom, Chars, diff --git a/src/toplevel.pl b/src/toplevel.pl index 30de5227..2df6d360 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -231,13 +231,13 @@ write_goal(G, VarList, MaxDepth) :- write(' = '), ( needs_bracketing(Value, =) -> write('('), - write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]), + write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(true)]), write(')') - ; write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]) + ; write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(true)]) ) ; G == [] -> write('true') - ; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]) + ; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth), double_quotes(true)]) ). write_last_goal(G, VarList, MaxDepth) :- @@ -250,9 +250,9 @@ write_last_goal(G, VarList, MaxDepth) :- write(' = '), ( needs_bracketing(Value, =) -> write('('), - write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]), + write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(true)]), write(')') - ; write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]), + ; write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(true)]), ( trailing_period_is_ambiguous(Value) -> write(' ') ; true @@ -260,7 +260,7 @@ write_last_goal(G, VarList, MaxDepth) :- ) ; G == [] -> write('true') - ; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]) + ; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth), double_quotes(true)]) ). write_eq((G1, G2), VarList, MaxDepth) :- From f5e7573bd6078b56a7533f198a8a666c28fa6608 Mon Sep 17 00:00:00 2001 From: Mark Date: Mon, 3 Jul 2023 12:09:26 -0600 Subject: [PATCH 10/11] correct tests #171 and #300 --- tests-pl/iso-conformity-tests.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests-pl/iso-conformity-tests.pl b/tests-pl/iso-conformity-tests.pl index 40242fca..630b2baa 100644 --- a/tests-pl/iso-conformity-tests.pl +++ b/tests-pl/iso-conformity-tests.pl @@ -753,12 +753,12 @@ test_194 :- op(0,xfy,.), test_170 :- set_prolog_flag(double_quotes,chars). test_171 :- writeq_term_to_chars("a", C), - C == "\"a\"". + C == "[a]". test_229 :- test_syntax_error("\"\\z.\"", syntax_error(missing_quote)). test_300 :- writeq_term_to_chars("\0\", C), - C == "\"\\x0\\\"". + C == "['\\x0\\']". test_172 :- X is 10.0** -323, writeq_term_to_chars(X, C), From ab893be41848f108f11721dd13d9d6cad0d6412a Mon Sep 17 00:00:00 2001 From: Mark Date: Mon, 3 Jul 2023 13:18:53 -0600 Subject: [PATCH 11/11] update tests --- src/heap_print.rs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/heap_print.rs b/src/heap_print.rs index 4aef1ab1..4e7781b7 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -1657,6 +1657,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0) ); @@ -1686,6 +1687,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0) ); @@ -1710,6 +1712,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0) ); @@ -1723,6 +1726,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0) ); @@ -1754,6 +1758,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0), ); @@ -1773,6 +1778,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0), ); @@ -1790,6 +1796,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0) ); @@ -1820,6 +1827,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0) ); @@ -1843,6 +1851,7 @@ mod tests { &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), pstr_loc_as_cell!(0) ); @@ -1866,15 +1875,18 @@ mod tests { wam.machine_st.heap.push(empty_list_as_cell!()); { - let printer = HCPrinter::new( + let mut printer = HCPrinter::new( &mut wam.machine_st.heap, &mut wam.machine_st.atom_tbl, &mut wam.machine_st.stack, &wam.op_dir, + wam.machine_st.flags, PrinterOutputter::new(), heap_loc_as_cell!(0), ); + printer.double_quotes = true; + let output = printer.print(); assert_eq!(output.result(), "\"abcabc\""); @@ -1893,7 +1905,7 @@ mod tests { assert_eq!( &wam.parse_and_print_term("[a,b,\"a\",[a,b,c]].").unwrap(), - "[a,b,\"a\",\"abc\"]" + "[a,b,[a],[a,b,c]]" ); all_cells_unmarked(&wam.machine_st.heap); @@ -1901,7 +1913,7 @@ mod tests { assert_eq!( &wam.parse_and_print_term("[\"abc\",e,f,[g,e,h,Y,v|[X,Y]]].") .unwrap(), - "[\"abc\",e,f,[g,e,h,Y,v,X,Y]]" + "[[a,b,c],e,f,[g,e,h,Y,v,X,Y]]" ); all_cells_unmarked(&wam.machine_st.heap);