From: Mark Thom Date: Tue, 19 Feb 2019 04:13:56 +0000 (-0700) Subject: add call_residue_vars/2 X-Git-Tag: v0.8.110~242 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=2467f6c711b87738f3847c0f3c6b35cfee417771;p=scryer-prolog.git add call_residue_vars/2 --- diff --git a/README.md b/README.md index 81d91531..3be0960b 100644 --- a/README.md +++ b/README.md @@ -41,7 +41,7 @@ Extend rusty-wam to include the following, among other features: is straightforward with attributed variables (_in progress_). - [x] Support for `verify_attributes/3` - [x] Support for `attribute_goals/2` and `project_attributes/2` - - [ ] `call_residue/2` and `call_residue_vars/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`). @@ -140,6 +140,7 @@ The following predicates are built-in to rusty-wam. * `call/1..62` * `call_cleanup/2` * `call_with_inference_limit/3` +* `call_residue_vars/2` * `can_be/2` * `catch/3` * `compare/3` diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index 99a4832e..43462e87 100644 --- a/src/prolog/instructions.rs +++ b/src/prolog/instructions.rs @@ -242,9 +242,12 @@ pub enum SystemClauseType { DeleteHeadAttribute, DynamicModuleResolution, EnqueueAttributeGoal, + EnqueueAttributedVar, ExpandGoal, ExpandTerm, GetAttributedVariableList, + GetAttrVarQueueDelimiter, + GetAttrVarQueueBeyond, GetBValue, GetSCCCleaner, InstallSCCCleaner, @@ -285,9 +288,12 @@ impl SystemClauseType { &SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"), &SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"), &SystemClauseType::EnqueueAttributeGoal => clause_name!("$enqueue_attribute_goal"), + &SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"), &SystemClauseType::ExpandTerm => clause_name!("$expand_term"), &SystemClauseType::ExpandGoal => clause_name!("$expand_goal"), &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::GetBValue => clause_name!("$get_b_value"), &SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"), &SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"), @@ -325,9 +331,10 @@ impl SystemClauseType { match (name, arity) { ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute), - ("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute), + ("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute), ("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution), ("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal), + ("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar), ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm), ("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal), ("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList), @@ -346,6 +353,8 @@ impl SystemClauseType { ("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock), ("$erase_ball", 0) => Some(SystemClauseType::EraseBall), ("$fail", 0) => Some(SystemClauseType::Fail), + ("$get_attr_var_queue_beyond", 2) => Some(SystemClauseType::GetAttrVarQueueBeyond), + ("$get_attr_var_queue_delim", 1) => Some(SystemClauseType::GetAttrVarQueueDelimiter), ("$get_ball", 1) => Some(SystemClauseType::GetBall), ("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock), ("$get_cp", 1) => Some(SystemClauseType::GetCutPoint), diff --git a/src/prolog/lib/atts.pl b/src/prolog/lib/atts.pl index 59e80bec..528c5065 100644 --- a/src/prolog/lib/atts.pl +++ b/src/prolog/lib/atts.pl @@ -1,7 +1,8 @@ -:- module(atts, [attribute/1, '$absent_attr'/2, '$copy_attr_list'/2, - '$get_attr'/2, '$put_attr'/2, '$absent_from_list'/2, - '$get_from_list'/2, '$add_to_list'/2, '$del_attr'/3, - '$del_attr_step'/2, '$del_attr_buried'/3]). +:- module(atts, [attribute/1, call_residue_vars/2, '$absent_attr'/2, + '$copy_attr_list'/2, '$get_attr'/2, '$put_attr'/2, + '$absent_from_list'/2, '$get_from_list'/3, + '$add_to_list'/3, '$del_attr'/3, '$del_attr_step'/3, + '$del_attr_buried'/4]). :- use_module(library(control)). :- use_module(library(dcgs)). @@ -19,21 +20,21 @@ ( L \= Attr -> '$absent_from_list'(Ls, Attr) ). '$get_attr'(V, Attr) :- - '$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, Attr). + '$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr). -'$get_from_list'([L|Ls], Attr) :- +'$get_from_list'([L|Ls], V, Attr) :- nonvar(L), - ( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, Attr) - ; L = Attr - ; '$get_from_list'(Ls, Attr) + ( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr) + ; L = Attr, '$enqueue_attr_var'(V) + ; '$get_from_list'(Ls, V, Attr) ). '$put_attr'(V, Attr) :- - '$get_attr_list'(V, Ls), '$add_to_list'(Ls, Attr). + '$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr). -'$add_to_list'(Ls, Attr) :- - ( var(Ls) -> Ls = [Attr | _] - ; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, Attr) +'$add_to_list'(Ls, V, Attr) :- + ( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V) + ; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, V, Attr) ). '$del_attr'(Ls0, _, _) :- @@ -41,25 +42,26 @@ '$del_attr'(Ls0, V, Attr) :- Ls0 = [Att | Ls1], nonvar(Att), - ( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, Attr) - ; '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr) + ( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr) + ; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr) ). -'$del_attr_step'(Ls1, Attr) :- - ( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, Attr) +'$del_attr_step'(Ls1, V, Attr) :- + ( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr) ; true ). %% assumptions: Ls0 is a list, Ls1 is its tail; %% the head of Ls0 can be ignored. -'$del_attr_buried'(Ls0, Ls1, Attr) :- +'$del_attr_buried'(Ls0, Ls1, V, Attr) :- Ls0 = [_, Att | _], nonvar(Att), !, - ( Att \= Attr -> '$del_attr_step'(Ls1, Attr) - ; '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking. - '$del_attr_step'(Ls1, Attr) + ( Att \= Attr -> '$del_attr_step'(Ls1, V, Attr) + ; '$enqueue_attr_var'(V), + '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking. + '$del_attr_step'(Ls1, V, Attr) ). -'$del_attr_buried'(_, _, _). +'$del_attr_buried'(_, _, _, _). '$copy_attr_list'(L, []) :- var(L), !. '$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :- @@ -123,3 +125,8 @@ user:goal_expansion(Term, M:put_atts(Var, Attr)) :- user:goal_expansion(Term, M:get_atts(Var, Attr)) :- nonvar(Term), Term = get_atts(Var, M, Attr). + +call_residue_vars(Goal, Vars) :- + '$get_attr_var_queue_delim'(B), + call(Goal), + '$get_attr_var_queue_beyond'(B, Vars). diff --git a/src/prolog/lib/dif.pl b/src/prolog/lib/dif.pl index 90311138..e830a206 100644 --- a/src/prolog/lib/dif.pl +++ b/src/prolog/lib/dif.pl @@ -9,25 +9,27 @@ dif_set_variables([Var|Vars], X, Y) :- put_atts(Var, dif(X, Y)), dif_set_variables(Vars, X, Y). -verify_dif_attrs([dif(X, Y) | Attrs], Var, [X \== Y | Goals]) :- - ( get_atts(Var, +dif(X, Y)) -> true - ; put_atts(Var, +dif(X, Y)) +verify_dif_attrs([dif(X, Y) | Attrs], Value, [X \== Y | Goals]) :- + ( get_atts(Value, +dif(X, Y)) -> true + ; put_atts(Value, +dif(X, Y)) ), - verify_dif_attrs(Attrs, Var, Goals). -verify_dif_attrs([_ | Attrs], Var, Goals) :- - verify_dif_attrs(Attrs, Var, Goals). + verify_dif_attrs(Attrs, Value, Goals). +verify_dif_attrs([_ | Attrs], Value, Goals) :- + verify_dif_attrs(Attrs, Value, Goals). verify_dif_attrs([], _, []). -verify_dif_attrs_no_var([dif(X, Y) | Attrs], [X \== Y | Goals]) :- - verify_dif_attrs_no_var(Attrs, Goals). -verify_dif_attrs_no_var([_ | Attrs], Goals) :- - verify_dif_attrs_no_var(Attrs, Goals). -verify_dif_attrs_no_var([], []). +verify_dif_attrs_no_var([dif(X, Y) | Attrs], Value, [X \== Y | Goals]) :- + term_variables(Value, ValueVars), + dif_set_variables(ValueVars, X, Y), + verify_dif_attrs_no_var(Attrs, Value, Goals). +verify_dif_attrs_no_var([_ | Attrs], Value, Goals) :- + verify_dif_attrs_no_var(Attrs, Value, Goals). +verify_dif_attrs_no_var([], _, []). verify_attributes(Var, Value, Goals) :- ( get_atts(Var, Attrs) -> ( var(Value) -> verify_dif_attrs(Attrs, Value, Goals) - ; verify_dif_attrs_no_var(Attrs, Goals) + ; verify_dif_attrs_no_var(Attrs, Value, Goals) ) ). diff --git a/src/prolog/machine/attributed_variables.rs b/src/prolog/machine/attributed_variables.rs index 5686dd47..debf27be 100644 --- a/src/prolog/machine/attributed_variables.rs +++ b/src/prolog/machine/attributed_variables.rs @@ -11,6 +11,7 @@ pub(super) type Bindings = Vec<(usize, Addr)>; pub(super) struct AttrVarInitializer { pub(super) attribute_goals: Vec, + pub(super) attr_var_queue: Vec, pub(super) bindings: Bindings, pub(super) cp: LocalCodePtr, pub(super) verify_attrs_loc: usize, @@ -21,6 +22,7 @@ impl AttrVarInitializer { pub(super) fn new(verify_attrs_loc: usize, project_attrs_loc: usize) -> Self { AttrVarInitializer { attribute_goals: vec![], + attr_var_queue: vec![], bindings: vec![], cp: LocalCodePtr::default(), verify_attrs_loc, @@ -30,6 +32,7 @@ impl AttrVarInitializer { #[inline] pub(super) fn reset(&mut self) { + self.attr_var_queue.clear(); self.bindings.clear(); } } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 16838836..14f774fb 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -341,6 +341,9 @@ pub(crate) trait CallPolicy: Any { machine_st.heap.truncate(machine_st.or_stack[b].h); + let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b; + machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b); + machine_st.hb = machine_st.heap.h; machine_st.p += 1; @@ -379,6 +382,9 @@ pub(crate) trait CallPolicy: Any { machine_st.heap.truncate(machine_st.or_stack[b].h); + let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b; + machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b); + machine_st.hb = machine_st.heap.h; machine_st.p += offset; @@ -414,8 +420,11 @@ pub(crate) trait CallPolicy: Any { machine_st.pstr_trail.truncate(machine_st.pstr_tr); machine_st.heap.truncate(machine_st.or_stack[b].h); - machine_st.b = machine_st.or_stack[b].b; + let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b; + machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b); + + machine_st.b = machine_st.or_stack[b].b; machine_st.or_stack.truncate(machine_st.b); machine_st.hb = machine_st.heap.h; @@ -454,8 +463,10 @@ pub(crate) trait CallPolicy: Any { machine_st.heap.truncate(machine_st.or_stack[b].h); - machine_st.b = machine_st.or_stack[b].b; + let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b; + machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b); + machine_st.b = machine_st.or_stack[b].b; machine_st.or_stack.truncate(machine_st.b); machine_st.hb = machine_st.heap.h; diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 34d4a8d8..f7c1d286 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -2256,6 +2256,7 @@ impl MachineState { self.or_stack.push(gi, self.e, self.cp.clone(), + self.attr_var_init.attr_var_queue.len(), self.b, self.p.clone() + 1, self.tr, @@ -2288,10 +2289,11 @@ impl MachineState { &ChoiceInstruction::TryMeElse(offset) => { let n = self.num_of_args; let gi = self.next_global_index(); - + self.or_stack.push(gi, self.e, self.cp.clone(), + self.attr_var_init.attr_var_queue.len(), self.b, self.p.clone() + offset, self.tr, diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 12385931..075901c8 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -31,7 +31,7 @@ impl MachineState { // a step in Brent's algorithm. fn brents_alg_step(&self, brent_st: &mut BrentAlgState) -> Option { - match self.heap[brent_st.hare].clone() { + match self.heap[brent_st.hare].clone() { HeapCellValue::NamedStr(..) => Some(CycleSearchResult::NotList), HeapCellValue::Addr(addr) => @@ -43,14 +43,14 @@ impl MachineState { Addr::Lis(l) => { brent_st.hare = l + 1; brent_st.steps += 1; - + if brent_st.tortoise == brent_st.hare { return Some(CycleSearchResult::NotList); } else if brent_st.steps == brent_st.power { brent_st.tortoise = brent_st.hare; brent_st.power <<= 1; } - + None }, _ => @@ -204,7 +204,7 @@ impl MachineState { Addr::Con(Constant::Usize(old_b)) if self.b <= old_b + 2 => {}, _ => self.fail = true }; - }, + }, &SystemClauseType::DeleteAttribute => { let ls0 = self.store(self.deref(self[temp_v!(1)].clone())); @@ -265,6 +265,15 @@ impl MachineState { let addr = self[temp_v!(1)].clone(); self.attr_var_init.attribute_goals.push(addr); }, + &SystemClauseType::EnqueueAttributedVar => { + let addr = self[temp_v!(1)].clone(); + + match self.store(self.deref(addr)) { + Addr::AttrVar(h) => + self.attr_var_init.attr_var_queue.push(h), + _ => {} + } + }, &SystemClauseType::ExpandGoal => { self.p = CodePtr::Local(LocalCodePtr::UserGoalExpansion(0)); return Ok(()); @@ -296,6 +305,35 @@ impl MachineState { let list_addr = self[temp_v!(2)].clone(); self.unify(Addr::HeapCell(attr_var_list), list_addr); }, + &SystemClauseType::GetAttrVarQueueDelimiter => { + let addr = self[temp_v!(1)].clone(); + let value = Addr::Con(Constant::Usize(self.attr_var_init.attr_var_queue.len())); + + self.unify(addr, value); + }, + &SystemClauseType::GetAttrVarQueueBeyond => { + let addr = self[temp_v!(1)].clone(); + + match self.store(self.deref(addr)) { + Addr::Con(Constant::Usize(b)) => { + let mut attr_vars: Vec<_> = self.attr_var_init.attr_var_queue[b ..] + .iter().filter_map(|h| + match self.store(self.deref(Addr::HeapCell(*h))) { + Addr::AttrVar(h) => Some(Addr::AttrVar(h)), + _ => None + }).collect(); + + attr_vars.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2)); + + self.term_dedup(&mut attr_vars); + let var_list_addr = Addr::HeapCell(self.heap.to_list(attr_vars.into_iter())); + + let list_addr = self[temp_v!(2)].clone(); + self.unify(var_list_addr, list_addr); + }, + _ => self.fail = true + } + }, &SystemClauseType::GetDoubleQuotes => { let a1 = self[temp_v!(1)].clone(); @@ -410,7 +448,7 @@ impl MachineState { for (h, addr) in bindings { self.heap[h] = HeapCellValue::Addr(addr); } - }, + }, &SystemClauseType::RemoveCallPolicyCheck => { let restore_default = match call_policy.downcast_mut::().ok() { diff --git a/src/prolog/or_stack.rs b/src/prolog/or_stack.rs index dce84db0..d7e9f7f3 100644 --- a/src/prolog/or_stack.rs +++ b/src/prolog/or_stack.rs @@ -7,6 +7,7 @@ pub struct Frame { pub global_index: usize, pub e: usize, pub cp: LocalCodePtr, + pub attr_var_init_b: usize, pub b: usize, pub bp: CodePtr, pub tr: usize, @@ -20,6 +21,7 @@ impl Frame { fn new(global_index: usize, e: usize, cp: LocalCodePtr, + attr_var_init_b: usize, b: usize, bp: CodePtr, tr: usize, @@ -33,6 +35,7 @@ impl Frame { global_index, e, cp, + attr_var_init_b, b, bp, tr, @@ -59,6 +62,7 @@ impl OrStack { global_index: usize, e: usize, cp: LocalCodePtr, + attr_var_init_b: usize, b: usize, bp: CodePtr, tr: usize, @@ -67,7 +71,7 @@ impl OrStack { b0: usize, n: usize) { - self.0.push(Frame::new(global_index, e, cp, b, bp, tr, pstr_tr, h, b0, n)); + self.0.push(Frame::new(global_index, e, cp, attr_var_init_b, b, bp, tr, pstr_tr, h, b0, n)); } pub fn len(&self) -> usize {