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

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

Browse Source
This commit is contained in:
Mark Thom
2019-02-22 23:22:25 -07:00
parent 0f01d37618
commit 1d331757e2
6 changed files with 216 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
README.md
View File

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

8
src/prolog/heap.rs
View File

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

6
src/prolog/instructions.rs
View File

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

84
src/prolog/lib/builtins.pl
View File

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

73
src/prolog/machine/system_calls.rs
View File

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

58
src/tests.rs
View File

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