Merge pull request #1850 from mthom/iso-conformity-tests

Automate ISO syntax conformity tests

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,

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<TokenOrRedirect>,
     toplevel_spec: Option<DirectedOp>,
     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,13 +566,19 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
             var_names: IndexMap::new(),
             print_strings_as_strs: false,
             max_depth: 0,
+            double_quotes: false,
         }
     }
 
     #[inline]
     fn ambiguity_check(&self, atom: &str) -> bool {
         let tail = self.outputter.range_from(self.last_item_idx..);
+
+        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) {
@@ -590,31 +600,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(
+            self.state_stack.push(TokenOrRedirect::CompositeRedirect(max_depth, op));
-                max_depth,
+            self.state_stack.push(TokenOrRedirect::Space);
-                left_directed_op,
+            self.state_stack.push(TokenOrRedirect::Atom(name));
-            ));
-
-            self.state_stack.push(TokenOrRedirect::Op(name, spec));
         } else {
             match name.as_str() {
                 "|" => {
@@ -687,24 +687,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();
@@ -1187,10 +1169,12 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
 
         let at_cdr = self.outputter.ends_with("|");
 
+        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 {
             self.at_cdr(",");
@@ -1348,12 +1332,14 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
             self.state_stack.push(TokenOrRedirect::Open);
 
             if let Some(ref op) = &op {
+                if !self.outputter.ends_with(" ") {
                     if op.is_left() && requires_space(op.as_atom().as_str(), "(") {
                         self.state_stack.push(TokenOrRedirect::Space);
                     }
                 }
             }
         }
+    }
 
     #[allow(dead_code)]
     fn print_tcp_listener(&mut self, tcp_listener: &TcpListener, max_depth: usize) {
@@ -1671,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)
             );
@@ -1700,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)
             );
@@ -1724,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)
             );
@@ -1737,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)
             );
@@ -1768,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),
             );
@@ -1787,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),
             );
@@ -1804,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)
             );
@@ -1834,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)
             );
@@ -1857,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)
             );
@@ -1880,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\"");
@@ -1907,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);
@@ -1915,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);

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),
+    parse_write_options(Options, [DoubleQuotes, IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames], write_term/3),
-    '$write_term'(Stream, Term, IgnoreOps, NumberVars, Quoted, VNNames, MaxDepth).
+    '$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, _),

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) :-

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)) => {

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),
         );

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,

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) :-

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",
+    );
+}