diff --git a/README.md b/README.md index d6c31433..2d060807 100644 --- a/README.md +++ b/README.md @@ -175,7 +175,7 @@ The following predicates are built-in to Scryer. * `clause/2` * `compare/3` * `compound/1` -* `copy_term/2` +* `copy_term/{2,3}` * `current_predicate/1` * `current_op/3` * `cyclic_term/1` @@ -186,6 +186,7 @@ The following predicates are built-in to Scryer. * `false/0` * `findall/{3,4}` * `float/1` +* `foldl/{4,5}` * `forall/2` * `freeze/2` * `functor/3` @@ -219,6 +220,7 @@ The following predicates are built-in to Scryer. * `repeat/{0,1}` * `retract/1` * `reverse/2` +* `same_length/2` * `select/3` * `setof/3` * `setup_call_cleanup/3` @@ -226,6 +228,7 @@ The following predicates are built-in to Scryer. * `string/1` * `sub_atom/5` * `subsumes_term/2` +* `sumlist/2` * `term_expansion/2` * `term_variables/2` * `throw/1` diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index 82bd8cde..10a0ebfd 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -162,10 +162,15 @@ pub enum SystemClauseType { AtomChars, AtomCodes, AtomLength, + BindFromRegister, CallAttributeGoals, CharCode, CharsToNumber, + ClearAttrVarBindings, + ClearAttributeGoals, + CloneAttributeGoals, CodesToNumber, + CopyTermWithoutAttrVars, CheckCutPoint, CopyToLiftedHeap, DeleteAttribute, @@ -212,9 +217,10 @@ pub enum SystemClauseType { REPL(REPLCodePtr), ReadQueryTerm, ReadTerm, - RedoAttrVarBindings, + RedoAttrVarBinding, RemoveCallPolicyCheck, RemoveInferenceCounter, + ResetContinuationMarker, ResetGlobalVarAtKey, ResetGlobalVarAtOffset, RetractClause, @@ -260,10 +266,14 @@ impl SystemClauseType { &SystemClauseType::AtomChars => clause_name!("$atom_chars"), &SystemClauseType::AtomCodes => clause_name!("$atom_codes"), &SystemClauseType::AtomLength => clause_name!("$atom_length"), + &SystemClauseType::BindFromRegister => clause_name!("$bind_from_register"), &SystemClauseType::CallAttributeGoals => clause_name!("$call_attribute_goals"), &SystemClauseType::CharCode => clause_name!("$char_code"), &SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"), + &SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"), + &SystemClauseType::CloneAttributeGoals => clause_name!("$clone_attribute_goals"), &SystemClauseType::CodesToNumber => clause_name!("$codes_to_number"), + &SystemClauseType::CopyTermWithoutAttrVars => clause_name!("$copy_term_without_attr_vars"), &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), &SystemClauseType::REPL(REPLCodePtr::CompileBatch) => clause_name!("$compile_batch"), &SystemClauseType::REPL(REPLCodePtr::UseModule) => clause_name!("$use_module"), @@ -276,6 +286,7 @@ impl SystemClauseType { &SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile) => { clause_name!("$use_qualified_module_from_file") } + &SystemClauseType::ClearAttrVarBindings => clause_name!("$clear_attr_var_bindings"), &SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"), &SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"), &SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"), @@ -336,7 +347,7 @@ impl SystemClauseType { &SystemClauseType::NumberToChars => clause_name!("$number_to_chars"), &SystemClauseType::NumberToCodes => clause_name!("$number_to_codes"), &SystemClauseType::RawInputReadChar => clause_name!("$raw_input_read_char"), - &SystemClauseType::RedoAttrVarBindings => clause_name!("$redo_attr_var_bindings"), + &SystemClauseType::RedoAttrVarBinding => clause_name!("$redo_attr_var_binding"), &SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"), &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), @@ -361,6 +372,7 @@ impl SystemClauseType { &SystemClauseType::ResetGlobalVarAtOffset => clause_name!("$reset_global_var_at_offset"), &SystemClauseType::RetractClause => clause_name!("$retract_clause"), &SystemClauseType::ResetBlock => clause_name!("$reset_block"), + &SystemClauseType::ResetContinuationMarker => clause_name!("$reset_cont_marker"), &SystemClauseType::ReturnFromVerifyAttr => clause_name!("$return_from_verify_attr"), &SystemClauseType::SetBall => clause_name!("$set_ball"), &SystemClauseType::SetCutPointByDefault(_) => clause_name!("$set_cp_by_default"), @@ -384,6 +396,7 @@ impl SystemClauseType { ("$atom_codes", 2) => Some(SystemClauseType::AtomCodes), ("$atom_length", 2) => Some(SystemClauseType::AtomLength), ("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause), + ("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister), ("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront), ("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack), ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront), @@ -391,7 +404,11 @@ impl SystemClauseType { ("$call_attribute_goals", 2) => Some(SystemClauseType::CallAttributeGoals), ("$char_code", 2) => Some(SystemClauseType::CharCode), ("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber), + ("$clear_attr_var_bindings", 0) => Some(SystemClauseType::ClearAttrVarBindings), + ("$clear_attribute_goals", 0) => Some(SystemClauseType::ClearAttributeGoals), + ("$clone_attribute_goals", 1) => Some(SystemClauseType::CloneAttributeGoals), ("$codes_to_number", 2) => Some(SystemClauseType::CodesToNumber), + ("$copy_term_without_attr_vars", 2) => Some(SystemClauseType::CopyTermWithoutAttrVars), ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)), ("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap), @@ -438,7 +455,7 @@ impl SystemClauseType { ("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars), ("$number_to_codes", 2) => Some(SystemClauseType::NumberToCodes), ("$op", 3) => Some(SystemClauseType::OpDeclaration), - ("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings), + ("$redo_attr_var_binding", 2) => Some(SystemClauseType::RedoAttrVarBinding), ("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck), ("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter), ("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy), @@ -457,6 +474,7 @@ impl SystemClauseType { ("$read_query_term", 2) => Some(SystemClauseType::ReadQueryTerm), ("$read_term", 2) => Some(SystemClauseType::ReadTerm), ("$reset_block", 1) => Some(SystemClauseType::ResetBlock), + ("$reset_cont_marker", 0) => Some(SystemClauseType::ResetContinuationMarker), ("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey), ("$reset_global_var_at_offset", 3) => Some(SystemClauseType::ResetGlobalVarAtOffset), ("$retract_clause", 4) => Some(SystemClauseType::RetractClause), diff --git a/src/prolog/heap_print.rs b/src/prolog/heap_print.rs index 9011827a..8db9ff43 100644 --- a/src/prolog/heap_print.rs +++ b/src/prolog/heap_print.rs @@ -614,7 +614,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { } match addr { - Addr::AttrVar(h) => Some(format!("_{}", h + 1)), + Addr::AttrVar(h) => Some(format!("_{}", h)), Addr::HeapCell(h) | Addr::Lis(h) | Addr::Str(h) => Some(format!("_{}", h)), Addr::StackCell(fr, sc) => Some(format!("_s_{}_{}", fr, sc)), _ => None, diff --git a/src/prolog/lib/atts.pl b/src/prolog/lib/atts.pl index 3fc36974..71115639 100644 --- a/src/prolog/lib/atts.pl +++ b/src/prolog/lib/atts.pl @@ -28,26 +28,26 @@ '$get_attr_list'(V, Ls), '$absent_from_list'(Ls, Attr). -'$absent_from_list'(X, _) :- - var(X), !. -'$absent_from_list'([L|Ls], Attr) :- - ( L \= Attr -> '$absent_from_list'(Ls, Attr) ). +'$absent_from_list'(X, Attr) :- + ( var(X) -> true + ; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr) + ). '$get_attr'(V, Attr) :- '$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr). '$get_from_list'([L|Ls], V, Attr) :- nonvar(L), - ( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr) - ; L = Attr -> '$enqueue_attr_var'(V) - ; '$get_from_list'(Ls, V, Attr) + ( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr) + ; L = Attr, '$enqueue_attr_var'(V) ). '$put_attr'(V, Attr) :- '$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr). '$add_to_list'(Ls, V, Attr) :- - ( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V) + ( var(Ls) -> + Ls = [Attr | _], '$enqueue_attr_var'(V) ; Ls = [_ | Ls0], '$add_to_list'(Ls0, V, Attr) ). @@ -57,7 +57,8 @@ Ls0 = [Att | Ls1], nonvar(Att), ( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr) - ; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr) + ; '$enqueue_attr_var'(V), + '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr) ). '$del_attr_step'(Ls1, V, Attr) :- @@ -67,15 +68,14 @@ %% assumptions: Ls0 is a list, Ls1 is its tail; %% the head of Ls0 can be ignored. '$del_attr_buried'(Ls0, Ls1, V, Attr) :- - Ls0 = [_, Att | _], - nonvar(Att), - !, - ( 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) + ( var(Ls1) -> true + ; Ls1 = [Att | Ls2] -> + ( Att \= Attr -> '$del_attr_buried'(Ls1, Ls2, 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'(_, _, _, _). '$copy_attr_list'(L, []) :- var(L), !. '$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :- @@ -124,11 +124,19 @@ put_attr(Name, Arity) --> { functor(Attr, Name, Arity), numbervars(Attr, 0, Arity), V = '$VAR'(Arity) }, - [(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity), - '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)), - (put_atts(V, Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity), - '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)), - (put_atts(V, -Attr) :- !, functor(Attr, _, _), '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, Attr))]. + [(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity), + functor(AttrForm, Head, Arity), + '$get_attr_list'(V, Ls), + '$del_attr'(Ls, V, AttrForm), + '$put_attr'(V, Attr)), + (put_atts(V, Attr) :- !, functor(Attr, Head, Arity), + functor(AttrForm, Head, Arity), + '$get_attr_list'(V, Ls), + '$del_attr'(Ls, V, AttrForm), + '$put_attr'(V, Attr)), + (put_atts(V, -Attr) :- !, functor(Attr, _, _), + '$get_attr_list'(V, Ls), + '$del_attr'(Ls, V, Attr))]. get_attr(Name, Arity) --> { functor(Attr, Name, Arity), @@ -149,3 +157,4 @@ 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/cont.pl b/src/prolog/lib/cont.pl new file mode 100644 index 00000000..6fc0118b --- /dev/null +++ b/src/prolog/lib/cont.pl @@ -0,0 +1,29 @@ + +:- module(cont, [reset/3, shift/1]). + +reset(Goal, Cont, Term) :- + call(Goal), + '$reset_cont_marker', + '$bind_from_register'(Cont, 3), + '$bind_from_register'(Term, 4). + +shift(Term) :- + '$nextEP'(first, E, P), + get_chunks(E, P, L), + Cont = cont(call_continuation(L)), + '$write_cont_and_term'(_, _, Cont, Term), + '$unwind_environments'. + +get_chunks(E, P, L) :- + ( '$points_to_cont_reset_marker'(P) -> + L = [] + ; '$get_chunk'(E,P,TB), + L = [TB|Rest], + '$nextEP'(E, NextE, NextP), + get_chunks(NextE, NextP, Rest) + ). + +call_continuation(L) :- '$call_continuation'(L). + +'$write_cont_and_term'(_, _, _, _). + diff --git a/src/prolog/lib/freeze.pl b/src/prolog/lib/freeze.pl index 049e024b..8ab1de9b 100644 --- a/src/prolog/lib/freeze.pl +++ b/src/prolog/lib/freeze.pl @@ -21,16 +21,8 @@ freeze(X, Goal) :- put_atts(Fresh, frozen(Goal)), Fresh = X. -gather_freeze_goals(Attrs, _) --> - { var(Attrs) }, - !. -gather_freeze_goals([frozen(X) | _], Var) --> - [freeze(Var, X)], - { put_atts(Var, -frozen(_)) }, - !. -gather_freeze_goals([_ | Attrs], Var) --> - gather_freeze_goals(Attrs, Var). +attribute_goals(Var) --> + { get_atts(Var, frozen(Goals)), + put_atts(Var, -frozen(_)) }, + [freeze(Var, Goals)]. -attribute_goals(X) --> - { '$get_attr_list'(X, Attrs) }, - gather_freeze_goals(Attrs, X). diff --git a/src/prolog/lib/lists.pl b/src/prolog/lib/lists.pl index 4fc5de96..153b90ff 100644 --- a/src/prolog/lib/lists.pl +++ b/src/prolog/lib/lists.pl @@ -1,7 +1,11 @@ -:- module(lists, [member/2, select/3, append/3, memberchk/2, - reverse/2, length/2, maplist/2, maplist/3, - maplist/4, maplist/5, maplist/6, maplist/7, - maplist/8, maplist/9]). +:- module(lists, [member/2, select/3, append/3, foldl/4, foldl/5, + memberchk/2, reverse/2, length/2, maplist/2, + maplist/3, maplist/4, maplist/5, maplist/6, + maplist/7, maplist/8, maplist/9, same_length/2, + sumlist/2]). + + +:- use_module(library(error)). length(Xs, N) :- @@ -96,3 +100,37 @@ maplist(_, [], [], [], [], [], [], [], []). maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s], [E8|E8s]) :- call(Cont, E1, E2, E3, E4, E5, E6, E7), maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s). + + +sumlist_([], S, S). +sumlist_([N|Ns], S, S0) :- + S1 is S0 + N, + sumlist_(Ns, S, S1). + +sumlist(Ns, S) :- + must_be(list, Ns), + sumlist_(Ns, S, 0). + + + +same_length([], []). +same_length([_|As], [_|Bs]) :- + same_length(As, Bs). + + +foldl(Goal_3, Ls, A0, A) :- + foldl_(Ls, Goal_3, A0, A). + +foldl_([], _, A, A). +foldl_([L|Ls], G_3, A0, A) :- + call(G_3, L, A0, A1), + foldl_(Ls, G_3, A1, A). + + +foldl(Goal_4, Xs, Ys, A0, A) :- + foldl_(Xs, Ys, Goal_4, A0, A). + +foldl_([], [], _, A, A). +foldl_([X|Xs], [Y|Ys], G_4, A0, A) :- + call(G_4, X, Y, A0, A1), + foldl_(Xs, Ys, G_4, A1, A). diff --git a/src/prolog/machine/attributed_variables.pl b/src/prolog/machine/attributed_variables.pl index 1323d2f5..01ea8b7d 100644 --- a/src/prolog/machine/attributed_variables.pl +++ b/src/prolog/machine/attributed_variables.pl @@ -1,6 +1,6 @@ driver(Vars, Values) :- iterate(Vars, Values, ListOfListsOfGoalLists), - '$redo_attr_var_bindings', % the bindings list is emptied here. + '$clear_attr_var_bindings', !, call_goals(ListOfListsOfGoalLists), '$return_from_verify_attr'. @@ -8,6 +8,7 @@ driver(Vars, Values) :- iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]) :- '$get_attr_list'(Var, Ls), call_verify_attributes(Ls, Var, Value, ListOfGoalLists), + '$redo_attr_var_binding'(Var, Value), iterate(VarBindings, ValueBindings, ListsCubed). iterate([], [], []). @@ -28,7 +29,7 @@ call_verify_attributes(Attrs, _, _, []) :- call_verify_attributes([], _, _, []). call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :- gather_modules([Attr|Attrs], Modules0), - sort(Modules0, Modules), + sort(Modules0, Modules), verify_attrs(Modules, Var, Value, ListOfGoalLists). call_goals([ListOfGoalLists | ListsCubed]) :- diff --git a/src/prolog/machine/compile.rs b/src/prolog/machine/compile.rs index 06f01de5..75b03d35 100644 --- a/src/prolog/machine/compile.rs +++ b/src/prolog/machine/compile.rs @@ -649,7 +649,8 @@ impl ListingCompiler { let idx = code_dir .entry((name.clone(), arity)) .or_insert(CodeIndex::default()); - set_code_index!(idx, IndexPtr::Index(p), self.get_module_name()); + + set_code_index!(idx, IndexPtr::Index(p), self.get_module_name()); self.localize_self_calls(name, arity, &mut decl_code, p); code.extend(decl_code.into_iter()); diff --git a/src/prolog/machine/copier.rs b/src/prolog/machine/copier.rs index e7cb9e6e..8fe11266 100644 --- a/src/prolog/machine/copier.rs +++ b/src/prolog/machine/copier.rs @@ -5,6 +5,12 @@ use std::ops::IndexMut; type Trail = Vec<(Ref, HeapCellValue)>; +#[derive(Clone, Copy)] +pub enum AttrVarPolicy { + DeepCopy, + StripAttributes +} + pub(crate) trait CopierTarget: IndexMut { fn threshold(&self) -> usize; fn push(&mut self, _: HeapCellValue); @@ -13,9 +19,10 @@ pub(crate) trait CopierTarget: IndexMut { fn stack(&mut self) -> &mut Stack; } -pub(crate) fn copy_term(target: T, addr: Addr) { - let mut copy_term_state = CopyTermState::new(target); - copy_term_state.copy_term_impl(addr); +pub(crate) +fn copy_term(target: T, addr: Addr, attr_var_policy: AttrVarPolicy) { + let mut copy_term_state = CopyTermState::new(target, attr_var_policy); + copy_term_state.copy_term_impl(addr); } struct CopyTermState { @@ -23,15 +30,17 @@ struct CopyTermState { scan: usize, old_h: usize, target: T, + attr_var_policy: AttrVarPolicy } impl CopyTermState { - fn new(target: T) -> Self { + fn new(target: T, attr_var_policy: AttrVarPolicy) -> Self { CopyTermState { trail: vec![], scan: 0, old_h: target.threshold(), target, + attr_var_policy } } @@ -41,40 +50,17 @@ impl CopyTermState { &mut self.target[scan] } - fn reinstantiate_var(&mut self, addr: Addr, threshold: usize) { - match addr { - Addr::HeapCell(h) => { - self.target[threshold] = HeapCellValue::Addr(Addr::HeapCell(threshold)); - self.target[h] = HeapCellValue::Addr(Addr::HeapCell(threshold)); - self.trail - .push((Ref::HeapCell(h), HeapCellValue::Addr(Addr::HeapCell(h)))); - } - Addr::StackCell(fr, sc) => { - self.target[threshold] = HeapCellValue::Addr(Addr::HeapCell(threshold)); - self.target.stack().index_and_frame_mut(fr)[sc] = Addr::HeapCell(threshold); - self.trail.push(( - Ref::StackCell(fr, sc), - HeapCellValue::Addr(Addr::StackCell(fr, sc)), - )); - } - Addr::AttrVar(h) => { - self.target[threshold] = HeapCellValue::Addr(Addr::AttrVar(threshold)); - self.target[h] = HeapCellValue::Addr(Addr::AttrVar(threshold)); - self.trail - .push((Ref::AttrVar(h), HeapCellValue::Addr(Addr::AttrVar(h)))); + fn copied_list(&mut self, addr: usize) -> bool { + match self.target[addr].clone() { + HeapCellValue::Addr(Addr::Lis(addr)) | HeapCellValue::Addr(Addr::HeapCell(addr)) => { + if addr >= self.old_h { + *self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(addr)); + self.scan += 1; + return true; + } } _ => {} - } - } - - fn copied_list(&mut self, addr: usize) -> bool { - if let HeapCellValue::Addr(Addr::Lis(addr)) = self.target[addr].clone() { - if addr >= self.old_h { - *self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(addr)); - self.scan += 1; - return true; - } - } + }; false } @@ -88,11 +74,15 @@ impl CopyTermState { *self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(threshold)); let hcv = self.target[addr].clone(); - self.target.push(hcv.clone()); let ra = hcv.as_addr(threshold); let rd = self.target.store(self.target.deref(ra)); + self.target.push(hcv); + + let hcv = self.target[addr + 1].clone(); + self.target.push(hcv); + match rd.clone() { Addr::AttrVar(h) | Addr::HeapCell(h) if h >= self.old_h => { self.target[threshold] = HeapCellValue::Addr(rd) @@ -100,23 +90,67 @@ impl CopyTermState { ra @ Addr::AttrVar(_) | ra @ Addr::HeapCell(..) | ra @ Addr::StackCell(..) => { if ra == rd { self.reinstantiate_var(ra, threshold); + + if let AttrVarPolicy::StripAttributes = self.attr_var_policy { + self.trail.push((Ref::HeapCell(addr), self.target[addr].clone())); + self.target[addr] = HeapCellValue::Addr(Addr::HeapCell(threshold)); + } } else { self.target[threshold] = HeapCellValue::Addr(ra); } } _ => { - self.trail - .push((Ref::HeapCell(addr), self.target[addr].clone())); + self.trail.push((Ref::HeapCell(addr), self.target[addr].clone())); self.target[addr] = HeapCellValue::Addr(Addr::Lis(threshold)) } }; - let hcv = self.target[addr + 1].clone(); - self.target.push(hcv); - self.scan += 1; } + fn reinstantiate_var(&mut self, addr: Addr, frontier: usize) { + match addr { + Addr::HeapCell(h) => { + self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier)); + self.target[h] = HeapCellValue::Addr(Addr::HeapCell(frontier)); + self.trail.push(( + Ref::HeapCell(h), + HeapCellValue::Addr(Addr::HeapCell(h)), + )); + } + Addr::StackCell(fr, sc) => { + self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier)); + self.target.stack().index_and_frame_mut(fr)[sc] = Addr::HeapCell(frontier); + self.trail.push(( + Ref::StackCell(fr, sc), + HeapCellValue::Addr(Addr::StackCell(fr, sc)), + )); + } + Addr::AttrVar(h) => { + let threshold = if let AttrVarPolicy::DeepCopy = self.attr_var_policy { + self.target.threshold() + } else { + frontier + }; + + self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(threshold)); + self.target[h] = HeapCellValue::Addr(Addr::HeapCell(threshold)); + self.trail.push(( + Ref::AttrVar(h), + HeapCellValue::Addr(Addr::AttrVar(h)), + )); + + if let AttrVarPolicy::DeepCopy = self.attr_var_policy { + self.target.push(HeapCellValue::Addr(Addr::AttrVar(threshold))); + + let list_val = self.target[h + 1].clone(); + self.target.push(list_val); + } + } + _ => unreachable!() + } + } + fn copy_var(&mut self, addr: Addr) { let rd = self.target.store(self.target.deref(addr.clone())); @@ -125,23 +159,13 @@ impl CopyTermState { *self.value_at_scan() = HeapCellValue::Addr(rd); self.scan += 1; } - Addr::AttrVar(h) if addr == rd => { - let threshold = self.target.threshold(); - self.target - .push(HeapCellValue::Addr(Addr::AttrVar(threshold))); - - let list_val = self.target[h + 1].clone(); - self.target.push(list_val); - - self.reinstantiate_var(addr, threshold); - *self.value_at_scan() = HeapCellValue::Addr(Addr::AttrVar(threshold)); - } _ if addr == rd => { - let scan = self.scan; - self.reinstantiate_var(addr, scan); + self.reinstantiate_var(addr, self.scan); self.scan += 1; } - _ => *self.value_at_scan() = HeapCellValue::Addr(rd), + _ => { + *self.value_at_scan() = HeapCellValue::Addr(rd); + } } } @@ -158,8 +182,7 @@ impl CopyTermState { HeapCellValue::NamedStr(arity, name.clone(), fixity.clone()), )); - self.target - .push(HeapCellValue::NamedStr(arity, name, fixity)); + self.target.push(HeapCellValue::NamedStr(arity, name, fixity)); for i in 0..arity { let hcv = self.target[addr + 1 + i].clone(); @@ -185,8 +208,8 @@ impl CopyTermState { HeapCellValue::Addr(addr) => match addr { Addr::Lis(addr) => self.copy_list(addr), addr @ Addr::AttrVar(_) - | addr @ Addr::HeapCell(_) - | addr @ Addr::StackCell(..) => self.copy_var(addr), + | addr @ Addr::HeapCell(_) + | addr @ Addr::StackCell(..) => self.copy_var(addr), Addr::Str(addr) => self.copy_structure(addr), Addr::Con(_) | Addr::DBRef(_) => self.scan += 1, }, diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 64c761cd..49feac7d 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -61,7 +61,7 @@ impl Ball { }); } - stub + stub } } @@ -444,7 +444,10 @@ pub(crate) trait CallPolicy: Any { let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b; let attr_var_init_bindings_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_bindings_b; - machine_st.attr_var_init.backtrack(attr_var_init_queue_b, attr_var_init_bindings_b); + machine_st.attr_var_init.backtrack( + attr_var_init_queue_b, + attr_var_init_bindings_b, + ); machine_st.hb = machine_st.heap.h; machine_st.p += 1; @@ -481,7 +484,6 @@ pub(crate) trait CallPolicy: Any { machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr; machine_st.pstr_trail.truncate(machine_st.pstr_tr); - machine_st.heap.truncate(machine_st.stack.index_or_frame(b).prelude.h); let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b; @@ -502,7 +504,7 @@ pub(crate) trait CallPolicy: Any { for i in 1 .. n + 1 { machine_st.registers[i] = machine_st.stack.index_or_frame(b)[i-1].clone(); } - + machine_st.num_of_args = n; machine_st.e = machine_st.stack.index_or_frame(b).prelude.e; machine_st.cp = machine_st.stack.index_or_frame(b).prelude.cp; @@ -522,13 +524,14 @@ pub(crate) trait CallPolicy: Any { machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr; machine_st.pstr_trail.truncate(machine_st.pstr_tr); - machine_st.heap.truncate(machine_st.stack.index_or_frame(b).prelude.h); let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b; let attr_var_init_bindings_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_bindings_b; - machine_st.attr_var_init.backtrack(attr_var_init_queue_b, attr_var_init_bindings_b); + machine_st.attr_var_init.backtrack( + attr_var_init_queue_b, + attr_var_init_bindings_b); machine_st.b = machine_st.stack.index_or_frame(b).prelude.b; machine_st.truncate_stack(); @@ -565,6 +568,7 @@ pub(crate) trait CallPolicy: Any { machine_st.unwind_pstr_trail(old_pstr_tr, curr_pstr_tr); machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr; + machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr; machine_st.pstr_trail.truncate(machine_st.pstr_tr); machine_st.heap.truncate(machine_st.stack.index_or_frame(b).prelude.h); @@ -572,7 +576,10 @@ pub(crate) trait CallPolicy: Any { let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b; let attr_var_init_bindings_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_bindings_b; - machine_st.attr_var_init.backtrack(attr_var_init_queue_b, attr_var_init_bindings_b); + machine_st.attr_var_init.backtrack( + attr_var_init_queue_b, + attr_var_init_bindings_b + ); machine_st.b = machine_st.stack.index_or_frame(b).prelude.b; machine_st.truncate_stack(); @@ -715,7 +722,7 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(machine_st.last_call, machine_st) } &BuiltInClauseType::CopyTerm => { - machine_st.copy_term(); + machine_st.copy_term(AttrVarPolicy::DeepCopy); return_from_clause!(machine_st.last_call, machine_st) } &BuiltInClauseType::Eq => { diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index a56da366..a23a4357 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -2005,11 +2005,15 @@ impl MachineState { } pub(super) fn set_ball(&mut self) { + self.ball.reset(); + let addr = self[temp_v!(1)].clone(); self.ball.boundary = self.heap.h; + copy_term( CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut self.ball.stub), addr, + AttrVarPolicy::DeepCopy, ); } @@ -2912,13 +2916,13 @@ impl MachineState { } } - pub(super) fn copy_term(&mut self) { + pub(super) fn copy_term(&mut self, attr_var_policy: AttrVarPolicy) { let old_h = self.heap.h; let a1 = self[temp_v!(1)].clone(); let a2 = self[temp_v!(2)].clone(); - copy_term(CopyTerm::new(self), a1); + copy_term(CopyTerm::new(self), a1, attr_var_policy); self.unify(Addr::HeapCell(old_h), a2); } diff --git a/src/prolog/machine/project_attributes.pl b/src/prolog/machine/project_attributes.pl index 7349bdf5..ac851b2b 100644 --- a/src/prolog/machine/project_attributes.pl +++ b/src/prolog/machine/project_attributes.pl @@ -49,8 +49,8 @@ call_attribute_goals([Module | Modules], GoalCaller, AttrVars) :- call_query_var_goals([], _, []). call_query_var_goals([AttrVar|AttrVars], Module, Goals) :- - ( catch(( Module:attribute_goals(AttrVar, Goals, RGoals0), - atts:'$default_attr_list'(Module, AttrVar, RGoals0, RGoals) + ( catch(( Module:attribute_goals(AttrVar, Goals, RGoals0) + , atts:'$default_attr_list'(Module, AttrVar, RGoals0, RGoals) ), E, ( '$print_attribute_goals_exception'(Module, E), @@ -63,7 +63,7 @@ call_query_var_goals([AttrVar|AttrVars], Module, Goals) :- call_attr_var_goals([], _, []). call_attr_var_goals([AttrVar|AttrVars], Module, Goals) :- - ( catch(Module:attribute_goals(AttrVar, Goals, RGoals), + ( catch(Module:attribute_goals(AttrVar, Goals, RGoals), E, '$print_attribute_goals_exception'(Module, E) ) @@ -83,3 +83,26 @@ gather_modules_for_attrs(Attrs, Modules, Modules) :- gather_modules_for_attrs([Attr|Attrs], [Module|Modules], Modules0) :- '$module_of'(Module, Attr), gather_modules_for_attrs(Attrs, Modules, Modules0). + +module_prefixed_goals([], _, Gs, Gs). +module_prefixed_goals([G|Gs], Module, [MG|MGs], TailGs) :- + ( G = _:_ -> MG = G + ; MG = Module:G + ), + module_prefixed_goals(Gs, Module, MGs, TailGs). + +call_attribute_goals_with_module_prefix([], _, _, []). +call_attribute_goals_with_module_prefix([Module | Modules], GoalCaller, AttrVars, Goals) :- + call(GoalCaller, AttrVars, Module, Goals0), + enqueue_goals(Goals0), + module_prefixed_goals(Goals0, Module, Goals, Gs), + call_attribute_goals_with_module_prefix(Modules, GoalCaller, AttrVars, Gs). + +copy_term(Source, Dest, Goals) :- + term_variables(Source, Vars), + gather_modules(Vars, Modules0, _), + sort(Modules0, Modules), + call_attribute_goals_with_module_prefix(Modules, call_query_var_goals, Vars, Goals0), + sort(Goals0, Goals1), + !, + '$copy_term_without_attr_vars'([Source | Goals1], [Dest | Goals]). diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 89fbde2d..7d32b500 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -353,7 +353,7 @@ impl MachineState { copy_ball_term.push(HeapCellValue::Addr(Addr::HeapCell(threshold + 3))); copy_ball_term.push(HeapCellValue::Addr(Addr::HeapCell(threshold + 2))); - copy_term(copy_ball_term, copy_target); + copy_term(copy_ball_term, copy_target, AttrVarPolicy::DeepCopy); threshold + lh_offset + 2 } @@ -527,6 +527,16 @@ impl MachineState { Ok(()) } + fn fetch_attribute_goals(&mut self, mut attr_goals: Vec) { + attr_goals.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2)); + self.term_dedup(&mut attr_goals); + + let attr_goals = Addr::HeapCell(self.heap.to_list(attr_goals.into_iter())); + let target = self[temp_v!(1)].clone(); + + self.unify(attr_goals, target); + } + fn create_instruction_functors(&mut self, code: &Code, first_idx: usize) -> Vec { let mut queue = VecDeque::new(); let mut functors = vec![]; @@ -594,6 +604,25 @@ impl MachineState { self.p = CodePtr::DynamicTransaction(trans_type, p); return Ok(()); } + &SystemClauseType::BindFromRegister => { + let reg = self.store(self.deref(self[temp_v!(2)].clone())); + let n = match reg { + Addr::Con(Constant::Integer(n)) => n.to_usize(), + _ => unreachable!() + }; + + if let Some(n) = n { + if n <= MAX_ARITY { + let target = self[temp_v!(n)].clone(); + let addr = self[temp_v!(1)].clone(); + + self.unify(addr, target); + return return_from_clause!(self.last_call, self); + } + } + + self.fail = true; + } &SystemClauseType::AssertDynamicPredicateToFront => { let p = self.cp; let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Front); @@ -874,6 +903,9 @@ impl MachineState { _ => self.fail = true, }; } + &SystemClauseType::CopyTermWithoutAttrVars => { + self.copy_term(AttrVarPolicy::StripAttributes); + } &SystemClauseType::FetchGlobalVar => { let key = self[temp_v!(1)].clone(); @@ -1109,7 +1141,7 @@ impl MachineState { for i in (arity + 1 .. arity + narity + 1).rev() { self.registers[i] = self.registers[i - arity].clone(); } - + for i in 1 .. arity + 1 { self.registers[i] = self.heap[a + i].as_addr(a + i); } @@ -1122,7 +1154,7 @@ impl MachineState { ); } } - Addr::Con(Constant::Atom(name, _)) => { + Addr::Con(Constant::Atom(name, _)) => { return self.module_lookup(indices, (name, narity), module_name, true) } addr => { @@ -1370,16 +1402,16 @@ impl MachineState { &SystemClauseType::TruncateIfNoLiftedHeapGrowth => { self.truncate_if_no_lifted_heap_diff(|_| Addr::Con(Constant::EmptyList)) } + &SystemClauseType::ClearAttributeGoals => { + self.attr_var_init.attribute_goals.clear(); + } + &SystemClauseType::CloneAttributeGoals => { + let attr_goals = self.attr_var_init.attribute_goals.clone(); + self.fetch_attribute_goals(attr_goals); + } &SystemClauseType::FetchAttributeGoals => { - let mut attr_goals = mem::replace(&mut self.attr_var_init.attribute_goals, vec![]); - - attr_goals.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2)); - self.term_dedup(&mut attr_goals); - - let attr_goals = Addr::HeapCell(self.heap.to_list(attr_goals.into_iter())); - let target = self[temp_v!(1)].clone(); - - self.unify(attr_goals, target); + let attr_goals = mem::replace(&mut self.attr_var_init.attribute_goals, vec![]); + self.fetch_attribute_goals(attr_goals); } &SystemClauseType::GetAttributedVariableList => { let attr_var = self.store(self.deref(self[temp_v!(1)].clone())); @@ -1643,11 +1675,32 @@ impl MachineState { } }; } - &SystemClauseType::RedoAttrVarBindings => { - let bindings = mem::replace(&mut self.attr_var_init.bindings, vec![]); + &SystemClauseType::ClearAttrVarBindings => { + self.attr_var_init.bindings.clear(); + } + &SystemClauseType::RedoAttrVarBinding => { + let var = self.store(self.deref(self[temp_v!(1)].clone())); + let value = self.store(self.deref(self[temp_v!(2)].clone())); - for (h, addr) in bindings { - self.heap[h] = HeapCellValue::Addr(addr); + match var { + Addr::AttrVar(h) => { + if let Addr::AttrVar(h1) = value { + self.heap[h] = HeapCellValue::Addr(Addr::AttrVar(h1)); + + // append h's attributes list to h1's. + let mut l = h1 + 1; + + while let Addr::Lis(l1) = self.store(self.deref(self.heap[l].as_addr(l))) { + l = l1 + 1; + } + + self.heap[l] = HeapCellValue::Addr(Addr::HeapCell(h + 1)); + self.trail(TrailRef::Ref(Ref::HeapCell(l))); + } else { + self.heap[h] = HeapCellValue::Addr(value); + } + } + _ => unreachable!() } } &SystemClauseType::ResetGlobalVarAtKey => { @@ -1676,6 +1729,7 @@ impl MachineState { copy_term( CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub), value, + AttrVarPolicy::DeepCopy, ); let offset = self[temp_v!(3)].clone(); @@ -1930,11 +1984,13 @@ impl MachineState { &SystemClauseType::ReadTerm => { readline::set_prompt(false); self.read_term(current_input_stream, indices)?; - }, + } &SystemClauseType::ResetBlock => { let addr = self.deref(self[temp_v!(1)].clone()); self.reset_block(addr); } + &SystemClauseType::ResetContinuationMarker => { + } &SystemClauseType::SetBall => self.set_ball(), &SystemClauseType::SetSeed => { @@ -1981,6 +2037,7 @@ impl MachineState { copy_term( CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub), value, + AttrVarPolicy::DeepCopy, ); indices.global_variables.insert(key, (ball, None)); @@ -2001,6 +2058,7 @@ impl MachineState { copy_term( CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub), value.clone(), + AttrVarPolicy::DeepCopy, ); let stub = ball.copy_and_align(h); diff --git a/src/prolog/toplevel.pl b/src/prolog/toplevel.pl index 51eb93fa..cf561645 100644 --- a/src/prolog/toplevel.pl +++ b/src/prolog/toplevel.pl @@ -32,7 +32,7 @@ ; !, catch(throw(error(type_error(atom, Item), repl/0)), E, - '$print_exception_with_check'(E)) + '$print_exception_with_check'(E)) ). '$instruction_match'(Term, VarList) :- '$submit_query_and_print_results'(Term, VarList), @@ -42,10 +42,12 @@ ( expand_goals(Term0, Term) -> true ; Term = Term0 ), - ( '$get_b_value'(B), call(Term), '$write_eqs_and_read_input'(B, VarList), ! - ; write('false.'), nl - ), - '$reset_attr_var_state'. + ( '$get_b_value'(B), call(Term), '$write_eqs_and_read_input'(B, VarList), + ! + % clear attribute goal lists, which may be populated by + % copy_term/3 prior to failure. + ; '$clear_attribute_goals', write('false.'), nl + ). '$needs_bracketing'(Value, Op) :- catch((functor(Value, F, _), @@ -80,7 +82,7 @@ ( '$needs_bracketing'(Value, (=)) -> write('('), write_term(Value, [quoted(true), variable_names(VarList)]), - write(')') + write(')') ; write_term(Value, [quoted(true), variable_names(VarList)]), ( '$trailing_period_is_ambiguous'(Value) -> write(' ') @@ -99,7 +101,7 @@ '$write_eq'(G2, VarList). '$write_eq'(G, VarList) :- '$write_last_goal'(G, VarList). - + '$graphic_token_char'(C) :- memberchk(C, ['#', '$', '&', '*', '+', '-', '.', ('/'), ':', '<', '=', '>', '?', '@', '^', '~', ('\\')]). @@ -144,13 +146,20 @@ ). '$gather_query_vars'([], []). +'$is_a_different_variable'([_ = Binding | Pairs], Value) :- + ( Value == Binding, ! + ; '$is_a_different_variable'(Pairs, Value) + ). + '$gather_goals'([], VarList, Goals) :- '$get_attr_var_queue_beyond'(0, AttrVars), '$gather_query_vars'(VarList, QueryVars), '$call_attribute_goals'(QueryVars, AttrVars), '$fetch_attribute_goals'(Goals). '$gather_goals'([Var = Value | Pairs], VarList, Goals) :- - ( nonvar(Value) -> + ( ( nonvar(Value) + ; '$is_a_different_variable'(Pairs, Value) + ) -> Goals = [Var = Value | Goals0], '$gather_goals'(Pairs, VarList, Goals0) ; '$gather_goals'(Pairs, VarList, Goals)