rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
Automate ISO syntax conformity tests
This commit is contained in:
Mark Thom
2023-07-03 13:53:41 -06:00
committed by GitHub
parent d079a18459 ab893be418
commit 42274ef3ae
10 changed files with 1132 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
build/instructions_template.rs
View File

@@ -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,

84
src/heap_print.rs
View File

@@ -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..);
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) {
@@ -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(
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 +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,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 {
@@ -1348,8 +1332,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);
}
}
}
}
@@ -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);

40
src/lib/builtins.pl
View File

@@ -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, _),

7
src/lib/charsio.pl
View File

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

23
src/machine/machine_state.rs
View File

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

3
src/machine/mock_wam.rs
View File

@@ -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),
);
@@ -239,7 +240,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();

2
src/parser/ast.rs
View File

@@ -313,7 +313,7 @@ impl Default for MachineFlags {
}
}
#[derive(Debug, Clone, Copy)]
#[derive(Debug, Clone, Copy, PartialEq)]
pub enum DoubleQuotes {
Atom,
Chars,

12
src/toplevel.pl
View File

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

1023
tests-pl/iso-conformity-tests.pl Normal file
View File

File diff suppressed because it is too large Load Diff

9
tests/scryer/src_tests.rs
View File

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