From 1d331757e22886520121655aa54d347cfe0530aa Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Fri, 22 Feb 2019 23:22:25 -0700 Subject: [PATCH] add findall/4, bagof/3, setof/3 --- README.md | 11 ++-- src/prolog/heap.rs | 8 +++ src/prolog/instructions.rs | 6 +++ src/prolog/lib/builtins.pl | 84 +++++++++++++++++++++++++++--- src/prolog/machine/system_calls.rs | 73 +++++++++++++++++++++----- src/tests.rs | 58 +++++++++++++++++++++ 6 files changed, 216 insertions(+), 24 deletions(-) diff --git a/README.md b/README.md index 3be0960b..5816829b 100644 --- a/README.md +++ b/README.md @@ -38,15 +38,15 @@ Extend rusty-wam to include the following, among other features: * Definite Clause Grammars (_done_). * Attributed variables using the SICStus Prolog interface and semantics. Adding coroutines like `dif/2`, `freeze/2`, etc. - is straightforward with attributed variables (_in progress_). + is straightforward with attributed variables (_done_). - [x] Support for `verify_attributes/3` - [x] Support for `attribute_goals/2` and `project_attributes/2` - [x] `call_residue_vars/2` * `if_` and related predicates, following the developments of the - paper "Indexing `dif/2`" (_in progress_). -* All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`). + paper "Indexing `dif/2`" (_done_). +* All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`) (_done_). * Clause creation and destruction (`asserta/1`, `assertz/1`, - `retract/1`, `abolish/1`) with logical update semantics. + `retract/1`, `abolish/1`) with logical update semantics (_in progress_). * Streams and predicates for stream control. * An incremental compacting garbage collector satisfying the five properties of "Precise Garbage Collection in Prolog." @@ -136,6 +136,7 @@ The following predicates are built-in to rusty-wam. * `arg/3` * `atom/1` * `atomic/1` +* `bagof/3` * `between/3` * `call/1..62` * `call_cleanup/2` @@ -151,6 +152,7 @@ The following predicates are built-in to rusty-wam. * `expand_goal/2` * `expand_term/2` * `false/0` +* `findall/{3,4}` * `float/1` * `freeze/2` * `functor/3` @@ -176,6 +178,7 @@ The following predicates are built-in to rusty-wam. * `repeat/0` * `reverse/2` * `select/3` +* `setof/3` * `setup_call_cleanup/3` * `sort/2` * `string/1` diff --git a/src/prolog/heap.rs b/src/prolog/heap.rs index d929e86a..115e4e3a 100644 --- a/src/prolog/heap.rs +++ b/src/prolog/heap.rs @@ -15,16 +15,24 @@ impl Heap { h: 0 } } + #[inline] pub fn push(&mut self, val: HeapCellValue) { self.heap.push(val); self.h += 1; } + #[inline] pub fn truncate(&mut self, h: usize) { self.h = h; self.heap.truncate(h); } + #[inline] + pub fn last(&self) -> Option<&HeapCellValue> { + self.heap.last() + } + + #[inline] pub fn len(&self) -> usize { self.heap.len() } diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index 779a51d5..1f992dcc 100644 --- a/src/prolog/instructions.rs +++ b/src/prolog/instructions.rs @@ -246,12 +246,14 @@ pub enum SystemClauseType { EnqueueAttributedVar, ExpandGoal, ExpandTerm, + TruncateIfNoLiftedHeapGrowthDiff, TruncateIfNoLiftedHeapGrowth, GetAttributedVariableList, GetAttrVarQueueDelimiter, GetAttrVarQueueBeyond, GetBValue, GetLiftedHeapFromOffset, + GetLiftedHeapFromOffsetDiff, GetSCCCleaner, InstallSCCCleaner, InstallInferenceCounter, @@ -298,10 +300,12 @@ impl SystemClauseType { &SystemClauseType::ExpandTerm => clause_name!("$expand_term"), &SystemClauseType::ExpandGoal => clause_name!("$expand_goal"), &SystemClauseType::TruncateIfNoLiftedHeapGrowth => clause_name!("$truncate_if_no_lh_growth"), + &SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => clause_name!("$truncate_if_no_lh_growth_diff"), &SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"), &SystemClauseType::GetAttrVarQueueDelimiter => clause_name!("$get_attr_var_queue_delim"), &SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"), &SystemClauseType::GetLiftedHeapFromOffset => clause_name!("$get_lh_from_offset"), + &SystemClauseType::GetLiftedHeapFromOffsetDiff => clause_name!("$get_lh_from_offset_diff"), &SystemClauseType::GetBValue => clause_name!("$get_b_value"), &SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"), &SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"), @@ -349,9 +353,11 @@ impl SystemClauseType { ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm), ("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal), ("$truncate_if_no_lh_growth", 1) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth), + ("$truncate_if_no_lh_growth_diff", 2) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff), ("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList), ("$get_b_value", 1) => Some(SystemClauseType::GetBValue), ("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset), + ("$get_lh_from_offset_diff", 3) => Some(SystemClauseType::GetLiftedHeapFromOffsetDiff), ("$get_double_quotes", 1) => Some(SystemClauseType::GetDoubleQuotes), ("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner), ("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner), diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 437ee42f..9af0a436 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -5,9 +5,9 @@ (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, - (=@=)/2, (\=@=)/2, (:)/2, call_with_inference_limit/3, + (=@=)/2, (\=@=)/2, (:)/2, bagof/3, call_with_inference_limit/3, catch/3, current_prolog_flag/2, expand_goal/2, expand_term/2, - findall/3, set_prolog_flag/2, setup_call_cleanup/3, + findall/3, findall/4, set_prolog_flag/2, setof/3, setup_call_cleanup/3, term_variables/2, throw/1, true/0, false/0, write/1, write_canonical/1, writeq/1, write_term/2]). @@ -363,12 +363,84 @@ throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. truncate_lh_to(LhLength) :- '$truncate_lh_to'(LhLength). -findall(Template, Goal, Solutions) :- - '$skip_max_list'(_, -1, Solutions, R), - ( nonvar(R), R \== [], throw(error(type_error(list, Solutions), findall/3)) +check_for_compat_list(L) :- + '$skip_max_list'(_, -1, L, R), + ( nonvar(R), R \== [], throw(error(type_error(list, L), findall/3)) ; true - ), + ). + +findall(Template, Goal, Solutions) :- + check_for_compat_list(Solutions), '$lh_length'(LhLength), '$call_with_default_policy'(catch('$iterate_find_all'(Template, Goal, Solutions, LhLength), Error, ( truncate_lh_to(LhLength), throw(Error) ))). + +:- non_counted_backtracking '$iterate_find_all_diff'/4. +'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :- + call(Goal), + '$copy_to_lh'(LhOffset, Template), + '$fail'. +'$iterate_find_all_diff'(_, _, Solutions0, Solutions1, LhOffset) :- + '$truncate_if_no_lh_growth_diff'(LhOffset, Solutions1), + '$get_lh_from_offset_diff'(LhOffset, Solutions0, Solutions1). + + +findall(Template, Goal, Solutions0, Solutions1) :- + check_for_compat_list(Solutions0), + check_for_compat_list(Solutions1), + '$lh_length'(LhLength), + '$call_with_default_policy'(catch('$iterate_find_all_diff'(Template, Goal, Solutions0, + Solutions1, LhLength), + Error, + ( truncate_lh_to(LhLength), throw(Error) ))). + +set_difference([X|Xs], [Y|Ys], Zs) :- + X == Y, !, set_difference(Xs, [Y|Ys], Zs). +set_difference([X|Xs], [Y|Ys], [X|Zs]) :- + X @< Y, !, set_difference(Xs, [Y|Ys], Zs). +set_difference([X|Xs], [Y|Ys], Zs) :- + X @> Y, !, set_difference([X|Xs], Ys, Zs). +set_difference([], _, []) :- !. +set_difference(Xs, [], Xs). + +group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :- + V1 =@= V2, !, V1 = V2, group_by_variant(Pairs, V2-S2, Solutions, Pairs0). +group_by_variant(Pairs, _, [], Pairs). + +group_by_variants([V-S|Pairs], [V-Solution|Solutions]) :- + group_by_variant([V-S|Pairs], V-S, Solution, Pairs0), + group_by_variants(Pairs0, Solutions). +group_by_variants([], []). + +iterate_variants([V-Solution|GroupSolutions], V, Solution). +iterate_variants([_|GroupSolutions], Ws, Solution) :- + iterate_variants(GroupSolutions, Ws, Solution). + +bagof(Template, Goal, Solution) :- + check_for_compat_list(Solution), + term_variables(Template, TemplateVars0), + term_variables(Goal, GoalVars0), + sort(TemplateVars0, TemplateVars), + sort(GoalVars0, GoalVars), + set_difference(GoalVars, TemplateVars, Witnesses), + findall(Witnesses-Template, Goal, PairedSolutions0), + keysort(PairedSolutions0, PairedSolutions), + group_by_variants(PairedSolutions, GroupedSolutions), + iterate_variants(GroupedSolutions, Witnesses, Solution). + +iterate_variants_and_sort([V-Solution0|GroupSolutions], V, Solution) :- + sort(Solution0, Solution). +iterate_variants_and_sort([_|GroupSolutions], Ws, Solution) :- + iterate_variants_and_sort(GroupSolutions, Ws, Solution). + +setof(Template, Goal, Solution) :- + term_variables(Template, TemplateVars0), + term_variables(Goal, GoalVars0), + sort(TemplateVars0, TemplateVars), + sort(GoalVars0, GoalVars), + set_difference(GoalVars, TemplateVars, Witnesses), + findall(Witnesses-Template, Goal, PairedSolutions0), + keysort(PairedSolutions0, PairedSolutions), + group_by_variants(PairedSolutions, GroupedSolutions), + iterate_variants_and_sort(GroupedSolutions, Witnesses, Solution). diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index a19227cd..3cee711e 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -205,6 +205,23 @@ impl MachineState { threshold + lh_offset + 2 } + fn truncate_if_no_lifted_heap_diff(&mut self, addr_constr: AddrConstr) + where AddrConstr: Fn(usize) -> Addr + { + match self.store(self.deref(self[temp_v!(1)].clone())) { + Addr::Con(Constant::Usize(lh_offset)) => { + if lh_offset >= self.lifted_heap.len() { + self.lifted_heap.truncate(lh_offset); + } else { + let threshold = self.lifted_heap.len() - lh_offset; + self.lifted_heap.push(HeapCellValue::Addr(addr_constr(threshold))); + } + }, + _ => + self.fail = true + } + } + pub(super) fn system_call(&mut self, ct: &SystemClauseType, indices: &IndexStore, @@ -325,18 +342,10 @@ impl MachineState { self.p = CodePtr::Local(LocalCodePtr::UserTermExpansion(0)); return Ok(()); }, + &SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => + self.truncate_if_no_lifted_heap_diff(|h| Addr::HeapCell(h)), &SystemClauseType::TruncateIfNoLiftedHeapGrowth => - match self.store(self.deref(self[temp_v!(1)].clone())) { - Addr::Con(Constant::Usize(lh_offset)) => { - if lh_offset >= self.lifted_heap.len() { - self.lifted_heap.truncate(lh_offset); - } else { - self.lifted_heap.push(HeapCellValue::Addr(Addr::Con(Constant::EmptyList))); - } - }, - _ => - self.fail = true - }, + self.truncate_if_no_lifted_heap_diff(|_| Addr::Con(Constant::EmptyList)), &SystemClauseType::GetAttributedVariableList => { let attr_var = self.store(self.deref(self[temp_v!(1)].clone())); let mut attr_var_list = match attr_var { @@ -381,8 +390,44 @@ impl MachineState { _ => self.fail = true } }, + &SystemClauseType::GetLiftedHeapFromOffsetDiff => { + let lh_offset = self[temp_v!(1)].clone(); + + match self.store(self.deref(lh_offset)) { + Addr::Con(Constant::Usize(lh_offset)) => + if lh_offset >= self.lifted_heap.len() { + let solutions = self[temp_v!(2)].clone(); + let diff = self[temp_v!(3)].clone(); + + self.unify(solutions, Addr::Con(Constant::EmptyList)); + self.unify(diff, Addr::Con(Constant::EmptyList)); + } else { + let h = self.heap.h; + + for index in lh_offset .. self.lifted_heap.len() { + match self.lifted_heap[index].clone() { + HeapCellValue::Addr(addr) => + self.heap.push(HeapCellValue::Addr(addr + h)), + value => + self.heap.push(value) + } + } + + if let Some(HeapCellValue::Addr(addr)) = self.heap.last().cloned() { + let diff = self[temp_v!(3)].clone(); + self.unify(diff, addr); + } + + self.lifted_heap.truncate(lh_offset); + + let solutions = self[temp_v!(2)].clone(); + self.unify(Addr::HeapCell(h), solutions); + }, + _ => self.fail = true + } + }, &SystemClauseType::GetLiftedHeapFromOffset => { - let lh_offset = self[temp_v!(1)].clone(); + let lh_offset = self[temp_v!(1)].clone(); match self.store(self.deref(lh_offset)) { Addr::Con(Constant::Usize(lh_offset)) => @@ -391,7 +436,7 @@ impl MachineState { self.unify(solutions, Addr::Con(Constant::EmptyList)); } else { let h = self.heap.h; - + for index in lh_offset .. self.lifted_heap.len() { match self.lifted_heap[index].clone() { HeapCellValue::Addr(addr) => @@ -402,7 +447,7 @@ impl MachineState { } self.lifted_heap.truncate(lh_offset); - + let solutions = self[temp_v!(2)].clone(); self.unify(Addr::HeapCell(h), solutions); }, diff --git a/src/tests.rs b/src/tests.rs index 0288eb53..2ed2ef22 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1725,6 +1725,64 @@ fn test_queries_on_builtins() [["X = 1", "Y = 2"]]); assert_prolog_success!(&mut wam, "?- catch(findall(X, 4, S), error(type_error(callable, 4), _), true).", [["S = _3", "X = _1"]]); + + assert_prolog_success!(&mut wam, "?- bagof(X, (X=Y; X=Z), S).", + [["S = [_3, _6]", "X = _0", "Y = _3", "Z = _6"]]); + assert_prolog_success!(&mut wam, "?- bagof(X, (X=1 ; X = 2), X).", + [["X = [1, 2]"]]); + assert_prolog_success!(&mut wam, "?- bagof(X, (X=1 ; X = 2), S).", + [["S = [1, 2]", "X = _0"]]); + assert_prolog_success!(&mut wam, "?- bagof(1, (Y=1 ; Y=2), L).", + [["L = [1]", "Y = 1"], + ["L = [1]", "Y = 2"]]); + + submit(&mut wam, "b(1, 1). b(1, 1). b(1, 2). b(2, 1). b(2, 2). b(2, 2)."); + + assert_prolog_success!(&mut wam, "?- bagof(X, b(X, Y), L).", + [["L = [1, Y, 2]", "X = _0", "Y = 1"], + ["L = [1, 2, Y]", "X = _0", "Y = 2"]]); + + assert_prolog_success!(&mut wam, "?- bagof(X, (X=Y; X=Z; Y=1), L).", + [["L = [_3, _6]", "X = _0", "Y = _3", "Z = _6"], + ["L = [_174]", "X = _0", "Y = 1", "Z = _6"]]); + + submit(&mut wam, "a(1, f(_)). a(2, f(_))."); + + assert_prolog_success!(&mut wam, "?- bagof(X, a(X, Y), L).", + [["L = [1, 2]", "X = _0", "Y = f(_140)"]]); + + assert_prolog_success!(&mut wam, "?- setof(X, (X = 1 ; X = 2), S).", + [["S = [1, 2]", "X = _0"]]); + assert_prolog_success!(&mut wam, "?- setof(X, (X=Y ; X=Z), S).", + [["S = [_3, _6]", "X = _0", "Y = _3", "Z = _6"]]); + assert_prolog_failure!(&mut wam, "?- setof(X, false, S)."); + assert_prolog_success!(&mut wam, "?- setof(1, (Y=1 ; Y=2), L).", + [["L = [1]", "Y = 1"], + ["L = [1]", "Y = 2"]]); + assert_prolog_success!(&mut wam, "?- setof(X, (X=Y; X=Z; Y=1), L).", + [["L = [_3, _6]", "X = _0", "Y = _3", "Z = _6"], + ["L = [_173]", "X = _0", "Y = 1", "Z = _6"]]); + assert_prolog_failure!(&mut wam, "?- setof(X, member(X, [f(U,b),f(V,c)]), [f(a,c),f(a,b)])."); + assert_prolog_success!(&mut wam, "?- setof(X, member(X, [f(U,b),f(V,c)]), [f(a,b),f(a,c)]).", + [["U = a", "V = a", "X = _0"]]); + assert_prolog_success!(&mut wam, "?- setof(X, member(X, [V,U,f(U),f(V)]), L).", + [["L = [_2, _4, f(U), f(V)]", "U = _2", "V = _4", "X = _0"]]); + assert_prolog_success!(&mut wam, "?- setof(X, member(X, [V,U,f(U),f(V)]), [a,b,f(a),f(b)]).", + [["U = a", "V = b", "X = _0"]]); + + assert_prolog_success!(&mut wam, "?- findall(X, (X = 1 ; X = 2), S0, S1).", + [["S0 = [1, 2 | _11]", "S1 = _11", "X = _0"]]); + assert_prolog_success!(&mut wam, "?- findall(X+Y, (X = 1), S0, S1).", + [["S0 = [1+_34 | _7]", "S1 = _7", "X = _1", "Y = _2"]]); + assert_prolog_success!(&mut wam, "?- findall(X, false, S, _).", + [["S = []", "X = _0"]]); + assert_prolog_success!(&mut wam, "?- findall(X, (X = 1 ; X = 1), S0, S1).", + [["S0 = [1, 1 | _11]", "S1 = _11", "X = _0"]]); + assert_prolog_failure!(&mut wam, "?- findall(X, (X = 2 ; X = 1), [1, 2 | S], S)."); + assert_prolog_success!(&mut wam, "?- findall(X, (X = 1 ; X = 2), [X, Y | S], S).", + [["S = _11", "X = 1", "Y = 2"]]); + assert_prolog_success!(&mut wam, "?- catch(findall(X, 4, S0, S1), error(type_error(callable, 4), _), true).", + [["S0 = _3", "S1 = _4", "X = _1"]]); } #[test] -- 2.54.0