add findall/4, bagof/3, setof/3

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_).
+  paper "Indexing `dif/2`" (_done_).
-* All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`).
+* 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`

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()
     }

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

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) :-
+check_for_compat_list(L) :-
-    '$skip_max_list'(_, -1, Solutions, R),
+    '$skip_max_list'(_, -1, L, R),
-    (  nonvar(R), R \== [], throw(error(type_error(list, Solutions), findall/3))
+    (  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).

src/prolog/machine/system_calls.rs

@@ -205,6 +205,23 @@ impl MachineState {
         threshold + lh_offset + 2
     }
 
+    fn truncate_if_no_lifted_heap_diff<AddrConstr>(&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())) {
+                self.truncate_if_no_lifted_heap_diff(|_| Addr::Con(Constant::EmptyList)),
-                    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
-                },
             &SystemClauseType::GetAttributedVariableList => {
                 let attr_var = self.store(self.deref(self[temp_v!(1)].clone()));
                 let mut attr_var_list = match attr_var {
@@ -381,6 +390,42 @@ 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();
 

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]