* 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."
* `arg/3`
* `atom/1`
* `atomic/1`
+* `bagof/3`
* `between/3`
* `call/1..62`
* `call_cleanup/2`
* `expand_goal/2`
* `expand_term/2`
* `false/0`
+* `findall/{3,4}`
* `float/1`
* `freeze/2`
* `functor/3`
* `repeat/0`
* `reverse/2`
* `select/3`
+* `setof/3`
* `setup_call_cleanup/3`
* `sort/2`
* `string/1`
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()
}
EnqueueAttributedVar,
ExpandGoal,
ExpandTerm,
+ TruncateIfNoLiftedHeapGrowthDiff,
TruncateIfNoLiftedHeapGrowth,
GetAttributedVariableList,
GetAttrVarQueueDelimiter,
GetAttrVarQueueBeyond,
GetBValue,
GetLiftedHeapFromOffset,
+ GetLiftedHeapFromOffsetDiff,
GetSCCCleaner,
InstallSCCCleaner,
InstallInferenceCounter,
&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"),
("$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),
(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]).
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).
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,
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 {
_ => 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)) =>
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) =>
}
self.lifted_heap.truncate(lh_offset);
-
+
let solutions = self[temp_v!(2)].clone();
self.unify(Addr::HeapCell(h), solutions);
},
[["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]
projects / scryer-prolog.git / commitdiff