diff --git a/Cargo.lock b/Cargo.lock index b7c06dbc..1b504f1e 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -367,6 +367,17 @@ dependencies = [ "syn 1.0.103", ] +[[package]] +name = "derive_deref" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dcdbcee2d9941369faba772587a565f4f534e42cb8d17e5295871de730163b2b" +dependencies = [ + "proc-macro2 1.0.47", + "quote 1.0.21", + "syn 1.0.103", +] + [[package]] name = "difflib" version = "0.4.0" @@ -1850,6 +1861,7 @@ dependencies = [ "crossterm", "crrl", "ctrlc", + "derive_deref", "dirs-next", "divrem", "futures", diff --git a/Cargo.toml b/Cargo.toml index 206b7150..9e2ca883 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -65,6 +65,7 @@ tokio = { version = "1.24.2", features = ["full"] } futures = "0.3" libffi = "3.1.0" libloading = "0.7" +derive_deref = "1.1.1" [dev-dependencies] assert_cmd = "1.0.3" diff --git a/README.md b/README.md index d421bfa0..ed002d8d 100644 --- a/README.md +++ b/README.md @@ -6,14 +6,15 @@ source industrial strength production environment that is also a testbed for bleeding edge research in logic and constraint programming, which is itself written in a high-level language. +The homepage of the project is: [**https://www.scryer.pl**](https://www.scryer.pl) + ![Scryer Logo: Cryer](logo/scryer.png) ## Phase 1 Produce an implementation of the Warren Abstract Machine in Rust, done according to the progression of languages in [Warren's Abstract -Machine: A Tutorial -Reconstruction](https://github.com/mthom/scryer-prolog/blob/master/wambook/wambook.pdf). +Machine: A Tutorial Reconstruction](https://github.com/mthom/scryer-prolog/blob/master/wambook/wambook.pdf). Phase 1 has been completed in that Scryer Prolog implements in some form all of the WAM book, including lists, cuts, Debray allocation, first @@ -52,9 +53,9 @@ Extend Scryer Prolog to include the following, among other features: `bb_put/2` (non-backtrackable) and `bb_b_put/2` (backtrackable). - [x] Delimited continuations based on reset/3, shift/1 (documented in - "Delimited Continuations for Prolog"). + "[Delimited Continuations for Prolog](https://biblio.ugent.be/publication/5646080/file/5646081)"). - [x] Tabling library based on delimited continuations - (documented in "Tabling as a Library with Delimited Control"). + (documented in "[Tabling as a Library with Delimited Control](https://biblio.ugent.be/publication/6880648/file/6885145.pdf)"). - [x] A _redone_ representation of strings as difference lists of characters, using a packed internal representation. - [x] clp(B) and clp(ℤ) as builtin libraries. @@ -69,7 +70,7 @@ Extend Scryer Prolog to include the following, among other features: - [ ] Greatly reducing the number of instructions used to compile disjunctives. - [ ] Storing short atoms to heap cells without writing them to the atom table. - [ ] A compacting garbage collector satisfying the five properties of - "Precise Garbage Collection in Prolog." (_in progress_) + "[Precise Garbage Collection in Prolog](https://www.complang.tuwien.ac.at/ulrich/papers/PDF/2008-ciclops.pdf)." (_in progress_) - [ ] Mode declarations. ## Phase 3 @@ -88,12 +89,12 @@ nice to have in the future. They'd make a good project for anyone wanting to contribute code to Scryer Prolog. 1. Implement the global analysis techniques described in Peter van -Roy's thesis, "Can Logic Programming Execute as Fast as Imperative -Programming?" +Roy's thesis, "[Can Logic Programming Execute as Fast as Imperative +Programming?](https://www.info.ucl.ac.be/~pvr/Peter.thesis/Peter.thesis.html)" 2. Add unum representation and arithmetic, using either an existing unum implementation or an ad hoc one. Unums are described in -Gustafson's book "The End of Error." +Gustafson's book "[The End of Error](http://www.johngustafson.net/unums.html)." 3. Add concurrent tables to manage shared references to atoms and strings. diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 80614815..d2cee3bb 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -272,16 +272,10 @@ enum SystemClauseType { PathCanonical, #[strum_discriminants(strum(props(Arity = "3", Name = "$file_time")))] FileTime, - #[strum_discriminants(strum(props(Arity = "1", Name = "$del_attr_non_head")))] - DeleteAttribute, - #[strum_discriminants(strum(props(Arity = "1", Name = "$del_attr_head")))] - DeleteHeadAttribute, #[strum_discriminants(strum(props(Arity = "arity", Name = "$module_call")))] DynamicModuleResolution(usize), #[strum_discriminants(strum(props(Arity = "arity", Name = "$prepare_call_clause")))] PrepareCallClause(usize), - #[strum_discriminants(strum(props(Arity = "1", Name = "$enqueue_attr_var")))] - EnqueueAttributedVar, #[strum_discriminants(strum(props(Arity = "2", Name = "$fetch_global_var")))] FetchGlobalVar, #[strum_discriminants(strum(props(Arity = "1", Name = "$first_stream")))] @@ -572,6 +566,14 @@ enum SystemClauseType { GetClauseP, #[strum_discriminants(strum(props(Arity = "6", Name = "$invoke_clause_at_p")))] InvokeClauseAtP, + #[strum_discriminants(strum(props(Arity = "3", Name = "$get_from_attr_list")))] + GetFromAttributedVarList, + #[strum_discriminants(strum(props(Arity = "3", Name = "$put_to_attr_list")))] + PutToAttributedVarList, + #[strum_discriminants(strum(props(Arity = "3", Name = "$del_from_attr_list")))] + DeleteFromAttributedVarList, + #[strum_discriminants(strum(props(Arity = "1", Name = "$delete_all_attributes_from_var")))] + DeleteAllAttributesFromVar, REPL(REPLCodePtr), } @@ -1624,15 +1626,16 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallDeleteDirectory(_) | &Instruction::CallPathCanonical(_) | &Instruction::CallFileTime(_) | - &Instruction::CallDeleteAttribute(_) | - &Instruction::CallDeleteHeadAttribute(_) | &Instruction::CallDynamicModuleResolution(..) | &Instruction::CallPrepareCallClause(..) | &Instruction::CallCompileInlineOrExpandedGoal(..) | &Instruction::CallIsExpandedOrInlined(_) | &Instruction::CallGetClauseP(_) | &Instruction::CallInvokeClauseAtP(_) | - &Instruction::CallEnqueueAttributedVar(_) | + &Instruction::CallGetFromAttributedVarList(_) | + &Instruction::CallPutToAttributedVarList(_) | + &Instruction::CallDeleteFromAttributedVarList(_) | + &Instruction::CallDeleteAllAttributesFromVar(_) | &Instruction::CallFetchGlobalVar(_) | &Instruction::CallFirstStream(_) | &Instruction::CallFlushOutput(_) | @@ -1842,15 +1845,16 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteDeleteDirectory(_) | &Instruction::ExecutePathCanonical(_) | &Instruction::ExecuteFileTime(_) | - &Instruction::ExecuteDeleteAttribute(_) | - &Instruction::ExecuteDeleteHeadAttribute(_) | &Instruction::ExecuteDynamicModuleResolution(..) | &Instruction::ExecutePrepareCallClause(..) | &Instruction::ExecuteCompileInlineOrExpandedGoal(..) | &Instruction::ExecuteIsExpandedOrInlined(_) | &Instruction::ExecuteGetClauseP(_) | &Instruction::ExecuteInvokeClauseAtP(_) | - &Instruction::ExecuteEnqueueAttributedVar(_) | + &Instruction::ExecuteGetFromAttributedVarList(_) | + &Instruction::ExecutePutToAttributedVarList(_) | + &Instruction::ExecuteDeleteFromAttributedVarList(_) | + &Instruction::ExecuteDeleteAllAttributesFromVar(_) | &Instruction::ExecuteFetchGlobalVar(_) | &Instruction::ExecuteFirstStream(_) | &Instruction::ExecuteFlushOutput(_) | diff --git a/src/forms.rs b/src/forms.rs index 97864370..1c014587 100644 --- a/src/forms.rs +++ b/src/forms.rs @@ -812,8 +812,9 @@ impl PredicateInfo { } #[inline] - pub(crate) fn must_retract_local_clauses(&self) -> bool { - self.is_extensible && self.has_clauses && !self.is_discontiguous + pub(crate) fn must_retract_local_clauses(&self, is_cross_module_clause: bool) -> bool { + self.is_extensible && self.has_clauses && !self.is_discontiguous && + !(self.is_multifile && is_cross_module_clause) } } diff --git a/src/lib/atts.pl b/src/lib/atts.pl index 372a9bdd..d6ee47a3 100644 --- a/src/lib/atts.pl +++ b/src/lib/atts.pl @@ -19,74 +19,12 @@ '$default_attr_list'(PGs, Module, AttrVar). '$default_attr_list'([], _, _) --> []. -'$absent_attr'(V, Attr) :- - '$get_attr_list'(V, Ls), - '$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 - ). - -'$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) - ; Ls = [_ | Ls0], - '$add_to_list'(Ls0, V, Attr) - ). - -'$del_attr'(Ls0, _, _) :- - var(Ls0), - !. -'$del_attr'(Ls0, V, Attr) :- - Ls0 = [Att | Ls1], - nonvar(Att), - ( Att \= Attr -> - '$del_attr_buried'(Ls0, Ls1, V, Attr) - ; '$del_attr_head'(V), - '$del_attr'(Ls1, V, Attr) - ). - -'$del_attr_step'(Ls1, V, Attr) :- - ( nonvar(Ls1) -> - Ls1 = [_ | Ls2], - '$del_attr_buried'(Ls1, Ls2, V, Attr) +'$absent_attr'(V, Module, Attr) :- + ( '$get_from_attr_list'(V, Module, Attr) -> + false ; true ). -%% assumptions: Ls0 is a list, Ls1 is its tail; -%% the head of Ls0 can be ignored. -'$del_attr_buried'(Ls0, Ls1, V, Attr) :- - ( var(Ls1) -> true - ; Ls1 = [Att | Ls2] -> - ( Att \= Attr -> - '$del_attr_buried'(Ls1, Ls2, V, Attr) - ; '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking. - '$del_attr_step'(Ls1, V, Attr) - ) - ). - '$copy_attr_list'(L, _Module, []) :- var(L), !. '$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :- ( Module0 == Module -> @@ -142,38 +80,28 @@ put_attr(Name, Arity, Module) --> { functor(Attr, Name, Arity) }, [(put_atts(V, +Attr) :- !, - functor(Attr, Head, Arity), - functor(AttrForm, Head, Arity), - '$get_attr_list'(V, Ls), - atts:'$del_attr'(Ls, V, Module:AttrForm), - atts:'$put_attr'(V, Module:Attr)), - (put_atts(V, Attr) :- + '$put_to_attr_list'(V, Module, Attr)), + (put_atts(V, Attr) :- !, - functor(Attr, Head, Arity), - functor(AttrForm, Head, Arity), - '$get_attr_list'(V, Ls), - atts:'$del_attr'(Ls, V, Module:AttrForm), - atts:'$put_attr'(V, Module:Attr)), + '$put_to_attr_list'(V, Module, Attr)), (put_atts(V, -Attr) :- !, - functor(Attr, _, _), - '$get_attr_list'(V, Ls), - atts:'$del_attr'(Ls, V, Module:Attr))]. + '$del_from_attr_list'(V, Module, Attr))]. get_attr(Name, Arity, Module) --> { functor(Attr, Name, Arity) }, [(get_atts(V, +Attr) :- !, functor(Attr, _, _), - atts:'$get_attr'(V, Module:Attr)), + atts:'$get_from_attr_list'(V, Module, Attr)), (get_atts(V, Attr) :- !, functor(Attr, _, _), - atts:'$get_attr'(V, Module:Attr)), + atts:'$get_from_attr_list'(V, Module, Attr)), (get_atts(V, -Attr) :- !, functor(Attr, _, _), - atts:'$absent_attr'(V, Module:Attr))]. + atts:'$absent_attr'(V, Module, Attr))]. user:goal_expansion(Term, M:put_atts(Var, Attr)) :- nonvar(Term), diff --git a/src/lib/clpb.pl b/src/lib/clpb.pl index 546286ea..1bdbbefc 100644 --- a/src/lib/clpb.pl +++ b/src/lib/clpb.pl @@ -211,7 +211,7 @@ Here is an example session with a few queries and their answers: T = 1, clpb:sat(X=:=X*Y), clpb:sat(Y=:=Y*Z). ?- sat(1#X#a#b). - sat(X=:=a#b). + clpb:sat(X=:=a#b). ``` The pending residual goals constrain remaining variables to Boolean @@ -348,7 +348,7 @@ does compute =|XOR|= as intended: ``` ?- xor(x, y, Z). -sat(Z=:=x#y). + clpb:sat(Z=:=x#y). ``` ## Acknowledgments diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index 5823aa42..fd5d9d18 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -220,31 +220,23 @@ partition_([X|Xs], Pred, Ls0, Es0, Gs0) :- :- meta_predicate(include(1, ?, ?)). -include(Goal, Ls0, Ls) :- - include_(Ls0, Goal, Ls). - -include_([], _, []). -include_([L|Ls0], Goal, Ls) :- +include(_, [], []). +include(Goal, [L|Ls0], Ls) :- ( call(Goal, L) -> Ls = [L|Rest] ; Ls = Rest ), - include_(Ls0, Goal, Rest). - + include(Goal, Ls0, Rest). :- meta_predicate(exclude(1, ?, ?)). -exclude(Goal, Ls0, Ls) :- - exclude_(Ls0, Goal, Ls). - -exclude_([], _, []). -exclude_([L|Ls0], Goal, Ls) :- +exclude(_, [], []). +exclude(Goal, [L|Ls0], Ls) :- ( call(Goal, L) -> Ls = Rest ; Ls = [L|Rest] ), - exclude_(Ls0, Goal, Rest). - + exclude(Goal, Ls0, Rest). %:- discontiguous clpz:goal_expansion/5. @@ -7711,7 +7703,7 @@ attributes_goals([]) --> []. attributes_goals([propagator(P, State)|As]) --> ( { ground(State) } -> [] ; { phrase(attribute_goal_(P), Gs) } -> - { % del_attr(State, clpz_aux), State = processed, + { del_attr(State, clpz_aux), State = processed, ( monotonic -> maplist(unwrap_with(bare_integer), Gs, Gs1) ; maplist(unwrap_with(=), Gs, Gs1) @@ -7822,7 +7814,7 @@ conjunction(A, B, G, D) --> original_goal(original_goal(State, Goal)) --> ( { var(State) } -> -% { State = processed }, + { State = processed }, [Goal] ; [] ). diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl index 08870316..1767d2bb 100644 --- a/src/lib/dcgs.pl +++ b/src/lib/dcgs.pl @@ -75,13 +75,6 @@ phrase(GRBody, S0, S) :- ; call(M:GRBody1, S0, S) ). - -module_call_qualified(M, Call, Call1) :- - ( nonvar(M) -> Call1 = M:Call - ; Call = Call1 - ). - - % The same version of the below two dcg_rule clauses, but with module scoping. dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :- dcg_non_terminal(NonTerminal, S0, S, Head), @@ -127,7 +120,10 @@ dcg_body(NonTerminal, S0, S, Goal1) :- NonTerminal \= ( \+ _ ), loader:strip_module(NonTerminal, M, NonTerminal0), dcg_non_terminal(NonTerminal0, S0, S, Goal0), - module_call_qualified(M, Goal0, Goal1). + ( functor(NonTerminal, (:), 2) -> + Goal1 = M:Goal0 + ; Goal1 = Goal0 + ). % The following constructs in a grammar rule body % are defined in the corresponding subclauses. @@ -215,6 +211,9 @@ user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :- E, dcgs:error_goal(E, GRBody1) ), - module_call_qualified(M, GRBody1, GRBody2). + ( GRBody = (_:_) -> + GRBody2 = M:GRBody1 + ; GRBody2 = GRBody1 + ). user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])). diff --git a/src/lib/dif.pl b/src/lib/dif.pl index 33e3e44b..a59052ac 100644 --- a/src/lib/dif.pl +++ b/src/lib/dif.pl @@ -40,9 +40,6 @@ verify_attributes(Var, Value, Goals) :- ; Goals = [] ). -% Probably the world's worst dif/2 implementation. I'm open to -% suggestions for improvement. - %% dif(?X, ?Y). % % True iff X and Y are different terms. Unlike `\=/2`, `dif/2` is more declarative because if X and Y can @@ -69,12 +66,16 @@ dif(X, Y) :- ) ). -gather_dif_goals([]) --> []. -gather_dif_goals([(X \== Y) | Goals]) --> - [dif:dif(X, Y)], - gather_dif_goals(Goals). +gather_dif_goals(_, []) --> []. +gather_dif_goals(V, [(X \== Y) | Goals]) --> + ( { term_variables(X, [V0 | _]), + V == V0 } -> + [dif:dif(X, Y)] + ; [] + ), + gather_dif_goals(V, Goals). attribute_goals(X) --> { get_atts(X, +dif(Goals)) }, - gather_dif_goals(Goals), + gather_dif_goals(X, Goals), { put_atts(X, -dif(_)) }. diff --git a/src/lib/error.pl b/src/lib/error.pl index 7efb170e..38a93214 100644 --- a/src/lib/error.pl +++ b/src/lib/error.pl @@ -1,5 +1,5 @@ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Written 2018-2022 by Markus Triska (triska@metalevel.at) + Written 2018-2023 by Markus Triska (triska@metalevel.at) I place this code in the public domain. Use it in any way you want. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ @@ -85,11 +85,11 @@ must_be_(list, Term) :- check_(error:ilist, list, Term). must_be_(type, Term) :- check_(error:type, type, Term). must_be_(boolean, Term) :- check_(error:boolean, boolean, Term). must_be_(term, Term) :- - ( \+ ground(Term) -> - instantiation_error(must_be/2) - ; \+ acyclic_term(Term) -> - type_error(term, Term, must_be/2) - ; true + ( acyclic_term(Term) -> + ( ground(Term) -> true + ; instantiation_error(must_be/2) + ) + ; type_error(term, Term, must_be/2) ). % We cannot use maplist(must_be(character), Cs), because library(lists) diff --git a/src/lib/freeze.pl b/src/lib/freeze.pl index c6554fa4..218a2532 100644 --- a/src/lib/freeze.pl +++ b/src/lib/freeze.pl @@ -38,5 +38,5 @@ freeze(X, Goal) :- attribute_goals(Var) --> { get_atts(Var, frozen(Goals)), put_atts(Var, -frozen(_)) }, - [freeze(Var, Goals)]. + [freeze:freeze(Var, Goals)]. diff --git a/src/loader.pl b/src/loader.pl index fe3d6fe2..896d6bff 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -11,7 +11,6 @@ current_module/1 ]). - :- use_module(library(error)). :- use_module(library(lists)). :- use_module(library(pairs)). @@ -221,7 +220,12 @@ complete_partial_goal(N, HeadArg, InnerHeadArgs, SuppArgs, CompleteHeadArg) :- integer(N), N >= 0, HeadArg =.. [Functor | InnerHeadArgs], - length(SuppArgs, N), + % the next two lines are equivalent to length(SuppArgs, N) but + % avoid length/2 so that copy_term/3 (which is invoked by + % length/2) can be bootstrapped without self-reference. + functor(SuppArgsFunctor, '.', N), + SuppArgsFunctor =.. [_ | SuppArgs], + % length(SuppArgs, N), append(InnerHeadArgs, SuppArgs, InnerHeadArgs0), CompleteHeadArg =.. [Functor | InnerHeadArgs0]. @@ -620,7 +624,7 @@ strip_module(Goal, M, G) :- strip_subst_module(Goal, M1, M2, G) :- '$strip_module'(Goal, M2, G), - ( var(M2) -> + ( var(M2), \+ functor(Goal, (:), 2) -> M2 = M1 ; true ). diff --git a/src/machine/attributed_variables.rs b/src/machine/attributed_variables.rs index 2bab7451..57ea1c22 100644 --- a/src/machine/attributed_variables.rs +++ b/src/machine/attributed_variables.rs @@ -52,6 +52,7 @@ impl MachineState { self.cp = INSTALL_VERIFY_ATTR_INTERRUPT; } + debug_assert_eq!(self.heap[h].get_tag(), HeapCellValueTag::AttrVar); self.attr_var_init.bindings.push((h, addr)); } @@ -63,10 +64,9 @@ impl MachineState { .map(|(ref h, _)| attr_var_as_cell!(*h)); let var_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter)); - let iter = self.attr_var_init.bindings.drain(0..).map(|(_, ref v)| *v); - let value_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter)); + (var_list_addr, value_list_addr) } diff --git a/src/machine/compile.rs b/src/machine/compile.rs index db64293d..5f3d8e28 100644 --- a/src/machine/compile.rs +++ b/src/machine/compile.rs @@ -2280,14 +2280,17 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> { .ok_or(SessionError::NamelessEntry)?; let listing_src_file_name = self.listing_src_file_name(); - let payload_compilation_target = self.payload.compilation_target; - let mut predicate_info = self - .wam_prelude - .indices - .get_predicate_skeleton(&self.payload.predicates.compilation_target, &key) - .map(|skeleton| skeleton.predicate_info()) - .unwrap_or_default(); + // payload_compilation_target describes the compilation context, + // e.g. compiling + // + // table_wrapper:tabled(get_node(A), b). + // + // without a module declaration means self.payload.compilation_target + // is CompilationTarget::User while self.payload.predicates.compilation_target + // is CompilationTarget::Module(atom!("table_wrapper")). + + let payload_compilation_target = self.payload.compilation_target; let local_predicate_info = self .wam_prelude @@ -2301,34 +2304,37 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> { .map(|skeleton| skeleton.predicate_info()) .unwrap_or_default(); - if local_predicate_info.must_retract_local_clauses() { + let mut predicate_info = self + .wam_prelude + .indices + .get_predicate_skeleton(&self.payload.predicates.compilation_target, &key) + .map(|skeleton| skeleton.predicate_info()) + .unwrap_or_default(); + + let is_cross_module_clause = + payload_compilation_target != self.payload.predicates.compilation_target; + + if local_predicate_info.must_retract_local_clauses(is_cross_module_clause) { self.retract_local_clauses(&key, predicate_info.is_dynamic); } - let do_incremental_compile = - if payload_compilation_target == self.payload.predicates.compilation_target { - predicate_info.compile_incrementally() - } else { - local_predicate_info.is_multifile && predicate_info.compile_incrementally() - }; - let predicates_len = self.payload.predicates.len(); let non_counted_bt = self.payload.non_counted_bt_preds.contains(&key); - if do_incremental_compile { + if predicate_info.compile_incrementally() { let predicates = self.payload.predicates.take(); for term in predicates.predicates { self.incremental_compile_clause( key, term, - payload_compilation_target, + self.payload.predicates.compilation_target, non_counted_bt, AppendOrPrepend::Append, )?; } } else { - if payload_compilation_target != self.payload.predicates.compilation_target { + if is_cross_module_clause { if !local_predicate_info.is_extensible { if predicate_info.is_multifile { println!( @@ -2343,9 +2349,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> { .indices .remove_predicate_skeleton(&self.payload.predicates.compilation_target, &key) { + let compilation_target = self.payload.predicates.compilation_target; + if predicate_info.is_dynamic { let clause_clause_compilation_target = - match self.payload.predicates.compilation_target { + match compilation_target { CompilationTarget::User => { CompilationTarget::Module(atom!("builtins")) } @@ -2364,7 +2372,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> { self.payload.retraction_info.push_record( RetractionRecord::RemovedSkeleton( - payload_compilation_target, + compilation_target, key, skeleton, ), @@ -2415,9 +2423,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> { .clause_clauses.drain(0..std::cmp::min(predicates_len, clause_clauses_len)) .collect(); + let compilation_target = self.payload.predicates.compilation_target; + self.compile_clause_clauses( key, - payload_compilation_target, + compilation_target, clauses_vec.into_iter(), AppendOrPrepend::Append, )?; diff --git a/src/machine/copier.rs b/src/machine/copier.rs index 53325332..0d091468 100644 --- a/src/machine/copier.rs +++ b/src/machine/copier.rs @@ -28,7 +28,10 @@ pub(crate) fn copy_term( attr_var_policy: AttrVarPolicy, ) { let mut copy_term_state = CopyTermState::new(target, attr_var_policy); + copy_term_state.copy_term_impl(addr); + copy_term_state.copy_attr_var_lists(); + copy_term_state.unwind_trail(); } #[derive(Debug)] @@ -38,6 +41,7 @@ struct CopyTermState { old_h: usize, target: T, attr_var_policy: AttrVarPolicy, + attr_var_list_locs: Vec<(usize, HeapCellValue)>, } impl CopyTermState { @@ -48,6 +52,7 @@ impl CopyTermState { old_h: target.threshold(), target, attr_var_policy, + attr_var_list_locs: vec![], } } @@ -86,16 +91,12 @@ impl CopyTermState { self.target.push(hcv); } - let cdr = self - .target - .store(self.target.deref(heap_loc_as_cell!(addr + 1))); + let cdr = self.target.store(self.target.deref(heap_loc_as_cell!(addr + 1))); if !cdr.is_var() { self.trail_list_cell(addr + 1, threshold); } else { - let car = self - .target - .store(self.target.deref(heap_loc_as_cell!(addr))); + let car = self.target.store(self.target.deref(heap_loc_as_cell!(addr))); if !car.is_var() { self.trail_list_cell(addr, threshold); @@ -167,6 +168,51 @@ impl CopyTermState { self.trail.push((Ref::heap_cell(pstr_loc), trail_item)); } + fn copy_attr_var_lists(&mut self) { + while !self.attr_var_list_locs.is_empty() { + let iter = mem::replace(&mut self.attr_var_list_locs, vec![]); + + for (threshold, list_loc) in iter { + self.target[threshold] = list_loc_as_cell!(self.target.threshold()); + self.copy_attr_var_list(list_loc); + } + } + } + + /* + * Attributed variable attribute lists adhere to a particular + * structure which is ensured by this function and not at all by + * the vanilla copier. + */ + fn copy_attr_var_list(&mut self, mut list_addr: HeapCellValue) { + while let HeapCellValueTag::Lis = list_addr.get_tag() { + let threshold = self.target.threshold(); + let heap_loc = list_addr.get_value(); + let str_loc = self.target[heap_loc].get_value(); + + self.target.push(heap_loc_as_cell!(threshold+2)); + self.target.push(heap_loc_as_cell!(threshold+1)); + + read_heap_cell!(self.target[str_loc], + (HeapCellValueTag::Atom) => { + self.target.push(self.target[str_loc]); + } + (HeapCellValueTag::Str) => { + self.copy_term_impl(self.target[str_loc]); + } + _ => { + unreachable!(); + } + ); + + list_addr = self.target[heap_loc + 1]; + + if HeapCellValueTag::Lis == list_addr.get_tag() { + self.target[threshold + 1] = list_loc_as_cell!(self.target.threshold()); + } + } + } + fn reinstantiate_var(&mut self, addr: HeapCellValue, frontier: usize) { read_heap_cell!(addr, (HeapCellValueTag::Var, h) => { @@ -195,9 +241,15 @@ impl CopyTermState { if let AttrVarPolicy::DeepCopy = self.attr_var_policy { self.target.push(attr_var_as_cell!(threshold)); + self.target.push(heap_loc_as_cell!(threshold + 1)); - let list_val = self.target[h + 1]; - self.target.push(list_val); + let old_list_link = self.target[h + 1]; + self.trail.push((Ref::heap_cell(h + 1), old_list_link)); + self.target[h + 1] = heap_loc_as_cell!(threshold + 1); + + if old_list_link.get_tag() == HeapCellValueTag::Lis { + self.attr_var_list_locs.push((threshold + 1, old_list_link)); + } } } _ => { @@ -298,8 +350,6 @@ impl CopyTermState { } ); } - - self.unwind_trail(); } fn unwind_trail(&mut self) { diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index d8ace62d..e2e144c5 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -3570,22 +3570,6 @@ impl Machine { self.file_time(); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } - &Instruction::CallDeleteAttribute(_) => { - self.delete_attribute(); - self.machine_st.p += 1; - } - &Instruction::ExecuteDeleteAttribute(_) => { - self.delete_attribute(); - self.machine_st.p = self.machine_st.cp; - } - &Instruction::CallDeleteHeadAttribute(_) => { - self.delete_head_attribute(); - self.machine_st.p += 1; - } - &Instruction::ExecuteDeleteHeadAttribute(_) => { - self.delete_head_attribute(); - self.machine_st.p = self.machine_st.cp; - } &Instruction::CallDynamicModuleResolution(arity, _) => { let (module_name, key) = try_or_throw!( self.machine_st, @@ -3616,14 +3600,6 @@ impl Machine { self.machine_st.backtrack(); } } - &Instruction::CallEnqueueAttributedVar(_) => { - self.enqueue_attributed_var(); - self.machine_st.p += 1; - } - &Instruction::ExecuteEnqueueAttributedVar(_) => { - self.enqueue_attributed_var(); - self.machine_st.p = self.machine_st.cp; - } &Instruction::CallFetchGlobalVar(_) => { self.fetch_global_var(); step_or_fail!(self, self.machine_st.p += 1); @@ -5231,6 +5207,38 @@ impl Machine { self.machine_st.execute_at_index(2, p); } + &Instruction::CallGetFromAttributedVarList(_) => { + self.get_from_attributed_variable_list(); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteGetFromAttributedVarList(_) => { + self.get_from_attributed_variable_list(); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } + &Instruction::CallPutToAttributedVarList(_) => { + self.put_to_attributed_variable_list(); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecutePutToAttributedVarList(_) => { + self.put_to_attributed_variable_list(); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } + &Instruction::CallDeleteFromAttributedVarList(_) => { + self.delete_from_attributed_variable_list(); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteDeleteFromAttributedVarList(_) => { + self.delete_from_attributed_variable_list(); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } + &Instruction::CallDeleteAllAttributesFromVar(_) => { + self.delete_all_attributes_from_var(); + self.machine_st.p += 1; + } + &Instruction::ExecuteDeleteAllAttributesFromVar(_) => { + self.delete_all_attributes_from_var(); + self.machine_st.p = self.machine_st.cp; + } } } diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs index 9b69c86b..b457ecae 100644 --- a/src/machine/machine_state_impl.rs +++ b/src/machine/machine_state_impl.rs @@ -11,10 +11,10 @@ use crate::machine::machine_indices::*; use crate::machine::machine_state::*; use crate::machine::partial_string::*; use crate::machine::stack::*; +use crate::machine::unify::*; use crate::parser::ast::*; use crate::parser::rug::{Integer, Rational}; -use fxhash::FxBuildHasher; use indexmap::IndexSet; use std::cmp::Ordering; @@ -130,16 +130,6 @@ impl MachineState { } } } - TrailRef::AttrVarHeapLink(h) => { - if h < self.hb { - self.trail.push(TrailEntry::build_with( - TrailEntryTag::TrailedAttrVarHeapLink, - h as u64, - )); - - self.tr += 1; - } - } TrailRef::AttrVarListLink(h, l) => { if h < self.hb { self.trail.push(TrailEntry::build_with( @@ -245,634 +235,96 @@ impl MachineState { ) } - fn unify_structure(&mut self, s1: usize, value: HeapCellValue) { - // s1 is the value of a STR cell. - let (n1, a1) = cell_as_atom_cell!(self.heap[s1]).get_name_and_arity(); - - read_heap_cell!(value, - (HeapCellValueTag::Str, s2) => { - let (n2, a2) = cell_as_atom_cell!(self.heap[s2]) - .get_name_and_arity(); - - if n1 == n2 && a1 == a2 { - for idx in (0..a1).rev() { - self.pdl.push(heap_loc_as_cell!(s2+1+idx)); - self.pdl.push(heap_loc_as_cell!(s1+1+idx)); - } - } else { - self.fail = true; - } - } - (HeapCellValueTag::Lis, l2) => { - if a1 == 2 && n1 == atom!(".") { - for idx in (0..2).rev() { - self.pdl.push(heap_loc_as_cell!(l2+1+idx)); - self.pdl.push(heap_loc_as_cell!(s1+1+idx)); - } - } else { - self.fail = true; - } - } - (HeapCellValueTag::Atom, (n2, a2)) => { - if !(a1 == 0 && a2 == 0 && n1 == n2) { - self.fail = true; - } - } - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), str_loc_as_cell!(s1)); - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), str_loc_as_cell!(s1)); - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), str_loc_as_cell!(s1)); - } - _ => { - self.fail = true; - } - ) + #[inline] + pub(super) fn bind_with_occurs_check_wrapper(&mut self, r: Ref, value: HeapCellValue) { + let mut unifier = CompositeUnifierForOccursCheck::from(DefaultUnifier::from(self)); + unifier.bind(r, value); } - fn unify_list(&mut self, l1: usize, d2: HeapCellValue) { - read_heap_cell!(d2, - (HeapCellValueTag::Lis, l2) => { - for idx in (0..2).rev() { - self.pdl.push(heap_loc_as_cell!(l2 + idx)); - self.pdl.push(heap_loc_as_cell!(l1 + idx)); - } - } - (HeapCellValueTag::Str, s2) => { - let (n2, a2) = cell_as_atom_cell!(self.heap[s2]) - .get_name_and_arity(); - - if a2 == 2 && n2 == atom!(".") { - for idx in (0..2).rev() { - self.pdl.push(heap_loc_as_cell!(s2+1+idx)); - self.pdl.push(heap_loc_as_cell!(l1+idx)); - } - } else { - self.fail = true; - } - } - (HeapCellValueTag::PStrLoc | HeapCellValueTag::CStr | HeapCellValueTag::PStr) => { - self.unify_partial_string(list_loc_as_cell!(l1), d2) - } - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), list_loc_as_cell!(l1)); - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), list_loc_as_cell!(l1)); - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), list_loc_as_cell!(l1)); - } - _ => { - self.fail = true; - } - ) - } - - pub fn unify_complete_string(&mut self, atom: Atom, value: HeapCellValue) { - if let Some(r) = value.as_var() { - if atom == atom!("") { - self.bind(r, atom_as_cell!(atom!("[]"))); - } else { - self.bind(r, atom_as_cstr_cell!(atom)); - } - - return; - } - - read_heap_cell!(value, - (HeapCellValueTag::Atom, (cstr_atom, arity)) if atom == atom!("") => { - debug_assert_eq!(arity, 0); - self.fail = cstr_atom != atom!("[]"); - } - (HeapCellValueTag::Str, s) => { - let (name, arity) = cell_as_atom_cell!(self.heap[s]) - .get_name_and_arity(); - - if arity == 0 { - self.fail = atom == atom!("") && name != atom!("[]"); - } else { - // this is intentionally the same policy for - // value.tag() == Lis and PStrLoc. they're not - // grouped together to allow for arity == 0. - self.unify_partial_string(atom_as_cstr_cell!(atom), value); - - if !self.pdl.is_empty() { - self.unify(); - } - } - } - (HeapCellValueTag::CStr, cstr_atom) => { - self.fail = atom != cstr_atom; - } - (HeapCellValueTag::Lis | HeapCellValueTag::PStrLoc) => { - self.unify_partial_string(atom_as_cstr_cell!(atom), value); - - if !self.pdl.is_empty() { - self.unify(); - } - } - _ => { - self.fail = true; - } + #[inline] + pub(super) fn bind_with_occurs_check_with_error_wrapper( + &mut self, + r: Ref, + value: HeapCellValue, + ) { + let mut unifier = CompositeUnifierForOccursCheckWithError::from( + DefaultUnifier::from(self), ); - } - // d1's tag is LIS, STR or PSTRLOC. - pub fn unify_partial_string(&mut self, d1: HeapCellValue, d2: HeapCellValue) { - if let Some(r) = d2.as_var() { - self.bind(r, d1); - return; - } - - let s1 = self.heap.len(); - - self.heap.push(d1); - self.heap.push(d2); - - let mut pstr_iter1 = HeapPStrIter::new(&self.heap, s1); - let mut pstr_iter2 = HeapPStrIter::new(&self.heap, s1 + 1); - - match compare_pstr_prefixes(&mut pstr_iter1, &mut pstr_iter2) { - PStrCmpResult::Ordered(Ordering::Equal) => {} - PStrCmpResult::Ordered(Ordering::Less) => { - if pstr_iter2.focus.as_var().is_none() { - self.fail = true; - } else { - self.pdl.push(empty_list_as_cell!()); - self.pdl.push(pstr_iter2.focus); - } - } - PStrCmpResult::Ordered(Ordering::Greater) => { - if pstr_iter1.focus.as_var().is_none() { - self.fail = true; - } else { - self.pdl.push(empty_list_as_cell!()); - self.pdl.push(pstr_iter1.focus); - } - } - continuable @ PStrCmpResult::FirstIterContinuable(iteratee) | - continuable @ PStrCmpResult::SecondIterContinuable(iteratee) => { - if continuable.is_second_iter() { - std::mem::swap(&mut pstr_iter1, &mut pstr_iter2); - } - - let mut chars_iter = PStrCharsIter { - iter: pstr_iter1, - item: Some(iteratee), - }; - - let mut focus = pstr_iter2.focus; - - 'outer: loop { - while let Some(c) = chars_iter.peek() { - read_heap_cell!(focus, - (HeapCellValueTag::Lis, l) => { - let val = pstr_iter2.heap[l]; - - self.pdl.push(val); - self.pdl.push(char_as_cell!(c)); - - focus = pstr_iter2.heap[l+1]; - } - (HeapCellValueTag::Str, s) => { - let (name, arity) = cell_as_atom_cell!(pstr_iter2.heap[s]) - .get_name_and_arity(); - - if name == atom!(".") && arity == 2 { - self.pdl.push(pstr_iter2.heap[s+1]); - self.pdl.push(char_as_cell!(c)); - - focus = pstr_iter2.heap[s+2]; - } else { - self.fail = true; - break 'outer; - } - } - (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => { - match chars_iter.item.unwrap() { - PStrIteratee::Char(focus, _) => { - self.pdl.push(self.heap[focus]); - self.pdl.push(heap_loc_as_cell!(h)); - } - PStrIteratee::PStrSegment(focus, _, n) => { - read_heap_cell!(self.heap[focus], - (HeapCellValueTag::CStr | HeapCellValueTag::PStr, pstr_atom) => { - if focus < self.heap.len() - 2 { - self.heap.pop(); - self.heap.pop(); - } - - if n == 0 { - let target_cell = match self.heap[focus].get_tag() { - HeapCellValueTag::CStr => { - atom_as_cstr_cell!(pstr_atom) - } - HeapCellValueTag::PStr => { - pstr_loc_as_cell!(focus) - } - _ => { - unreachable!() - } - }; - - self.pdl.push(target_cell); - self.pdl.push(heap_loc_as_cell!(h)); - } else { - let h_len = self.heap.len(); - - self.heap.push(pstr_offset_as_cell!(focus)); - self.heap.push(fixnum_as_cell!( - Fixnum::build_with(n as i64) - )); - - self.pdl.push(pstr_loc_as_cell!(h_len)); - self.pdl.push(heap_loc_as_cell!(h)); - } - - return; - } - (HeapCellValueTag::PStrOffset, pstr_loc) => { - let n0 = cell_as_fixnum!(self.heap[focus+1]) - .get_num() as usize; - - if pstr_loc < self.heap.len() - 2 { - self.heap.pop(); - self.heap.pop(); - } - - if n == n0 { - self.pdl.push(pstr_loc_as_cell!(focus)); - self.pdl.push(heap_loc_as_cell!(h)); - } else { - let h_len = self.heap.len(); - - self.heap.push(pstr_offset_as_cell!(pstr_loc)); - self.heap.push(fixnum_as_cell!( - Fixnum::build_with(n as i64) - )); - - self.pdl.push(pstr_loc_as_cell!(h_len)); - self.pdl.push(heap_loc_as_cell!(h)); - } - - return; - } - _ => { - } - ); - - if focus < self.heap.len() - 2 { - self.heap.pop(); - self.heap.pop(); - } - - self.pdl.push(self.heap[focus]); - self.pdl.push(heap_loc_as_cell!(h)); - - return; - } - } - - break 'outer; - } - _ => { - self.fail = true; - break 'outer; - } - ); - - chars_iter.next(); - } - - chars_iter.iter.next(); - - self.pdl.push(focus); - self.pdl.push(chars_iter.iter.focus); - - break; - } - } - PStrCmpResult::Unordered => { - self.pdl.push(pstr_iter1.focus); - self.pdl.push(pstr_iter2.focus); - } - } - - self.heap.pop(); - self.heap.pop(); - } - - pub fn unify_atom(&mut self, atom: Atom, value: HeapCellValue) { - read_heap_cell!(value, - (HeapCellValueTag::Atom, (name, arity)) => { - self.fail = !(arity == 0 && name == atom); - } - (HeapCellValueTag::Str, s) => { - let (name, arity) = cell_as_atom_cell!(self.heap[s]) - .get_name_and_arity(); - - self.fail = !(arity == 0 && name == atom); - } - (HeapCellValueTag::CStr, cstr_atom) if atom == atom!("[]") => { - self.fail = cstr_atom != atom!(""); - } - (HeapCellValueTag::Char, c1) => { - if let Some(c2) = atom.as_char() { - self.fail = c1 != c2; - } else { - self.fail = true; - } - } - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), atom_as_cell!(atom)); - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), atom_as_cell!(atom)); - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), atom_as_cell!(atom)); - } - _ => { - self.fail = true; - } - ); - } - - pub fn unify_char(&mut self, c: char, value: HeapCellValue) { - read_heap_cell!(value, - (HeapCellValueTag::Atom, (name, arity)) => { - if let Some(c2) = name.as_char() { - self.fail = !(c == c2 && arity == 0); - } else { - self.fail = true; - } - } - (HeapCellValueTag::Str, s) => { - let (name, arity) = cell_as_atom_cell!(self.heap[s]) - .get_name_and_arity(); - - if let Some(c2) = name.as_char() { - self.fail = !(c == c2 && arity == 0); - } else { - self.fail = true; - } - } - (HeapCellValueTag::Char, c2) => { - if c != c2 { - self.fail = true; - } - } - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), char_as_cell!(c)); - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), char_as_cell!(c)); - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), char_as_cell!(c)); - } - _ => { - self.fail = true; - } - ); - } - - pub fn unify_fixnum(&mut self, n1: Fixnum, value: HeapCellValue) { - if let Some(r) = value.as_var() { - self.bind(r, fixnum_as_cell!(n1)); - return; - } - - match Number::try_from(value) { - Ok(n2) => match n2 { - Number::Fixnum(n2) if n1.get_num() == n2.get_num() => {} - Number::Integer(n2) if n1.get_num() == *n2 => {} - Number::Rational(n2) if n1.get_num() == *n2 => {} - _ => { - self.fail = true; - } - }, - Err(_) => { - self.fail = true; - } - } - } - - pub fn unify_big_int(&mut self, n1: TypedArenaPtr, value: HeapCellValue) { - if let Some(r) = value.as_var() { - self.bind(r, typed_arena_ptr_as_cell!(n1)); - return; - } - - match Number::try_from(value) { - Ok(n2) => match n2 { - Number::Fixnum(n2) if *n1 == n2.get_num() => {} - Number::Integer(n2) if *n1 == *n2 => {} - Number::Rational(n2) if *n1 == *n2 => {} - _ => { - self.fail = true; - } - }, - Err(_) => { - self.fail = true; - } - } - } - - pub fn unify_rational(&mut self, n1: TypedArenaPtr, value: HeapCellValue) { - if let Some(r) = value.as_var() { - self.bind(r, typed_arena_ptr_as_cell!(n1)); - return; - } - - match Number::try_from(value) { - Ok(n2) => match n2 { - Number::Fixnum(n2) if *n1 == n2.get_num() => {} - Number::Integer(n2) if *n1 == *n2 => {} - Number::Rational(n2) if *n1 == *n2 => {} - _ => { - self.fail = true; - } - }, - Err(_) => { - self.fail = true; - } - } - } - - pub fn unify_f64(&mut self, f1: F64Ptr, value: HeapCellValue) { - if let Some(r) = value.as_var() { - self.bind(r, HeapCellValue::from(f1)); - return; - } - - read_heap_cell!(value, - (HeapCellValueTag::F64, f2) => { - self.fail = **f1 != **f2; - } - _ => { - self.fail = true; - } - ); - } - - pub fn unify_constant(&mut self, ptr: UntypedArenaPtr, value: HeapCellValue) { - if let Some(ptr2) = value.to_untyped_arena_ptr() { - if ptr.get_ptr() == ptr2.get_ptr() { - return; - } - } - - match_untyped_arena_ptr!(ptr, - (ArenaHeaderTag::Integer, int_ptr) => { - self.unify_big_int(int_ptr, value); - } - (ArenaHeaderTag::Rational, rat_ptr) => { - self.unify_rational(rat_ptr, value); - } - _ => { - if let Some(r) = value.as_var() { - self.bind(r, untyped_arena_ptr_as_cell!(ptr)); - } else { - self.fail = true; - } - } - ); + unifier.bind(r, value); } pub fn unify(&mut self) { - let mut tabu_list = IndexSet::with_hasher(FxBuildHasher::default()); + let mut unifier = DefaultUnifier::from(self); + unifier.unify_internal(); + } - while !(self.pdl.is_empty() || self.fail) { - let s1 = self.pdl.pop().unwrap(); - let s1 = self.deref(s1); + pub fn unify_structure(&mut self, s1: usize, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_structure(s1, value); + } - let s2 = self.pdl.pop().unwrap(); - let s2 = self.deref(s2); + pub fn unify_atom(&mut self, atom: Atom, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_atom(atom, value); + } - if s1 != s2 { - let d1 = self.store(s1); - let d2 = self.store(s2); + pub fn unify_list(&mut self, l1: usize, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_list(l1, value); + } - read_heap_cell!(d1, - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), d2); - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), d2); - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), d2); - } - (HeapCellValueTag::Atom, (name, arity)) => { - debug_assert!(arity == 0); - self.unify_atom(name, d2); - } - (HeapCellValueTag::Str, s1) => { - if tabu_list.contains(&(d1, d2)) { - continue; - } + pub fn unify_complete_string(&mut self, atom: Atom, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_complete_string(atom, value); + } - self.unify_structure(s1, d2); + pub fn unify_partial_string(&mut self, value_1: HeapCellValue, value_2: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_partial_string(value_1, value_2); + } - if !self.fail { - let d2 = self.store(d2); - tabu_list.insert((d1, d2)); - } - } - (HeapCellValueTag::Lis, l1) => { - if d2.is_ref() { - if tabu_list.contains(&(d1, d2)) { - continue; - } - } + pub fn unify_char(&mut self, c: char, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_char(c, value); + } - self.unify_list(l1, d2); + pub fn unify_fixnum(&mut self, n1: Fixnum, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_fixnum(n1, value); + } - if !self.fail { - let d2 = self.store(d2); - tabu_list.insert((d1, d2)); - } - } - (HeapCellValueTag::PStrLoc) => { - read_heap_cell!(d2, - (HeapCellValueTag::PStrLoc | - HeapCellValueTag::Lis | - HeapCellValueTag::Str) => { - if tabu_list.contains(&(d1, d2)) { - continue; - } - } - (HeapCellValueTag::CStr | - HeapCellValueTag::AttrVar | - HeapCellValueTag::Var | - HeapCellValueTag::StackVar) => { - } - _ => { - self.fail = true; - break; - } - ); + pub fn unify_big_int(&mut self, n1: TypedArenaPtr, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_big_num(n1, value); + } - self.unify_partial_string(d1, d2); + pub fn unify_rational(&mut self, n1: TypedArenaPtr, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_big_num(n1, value); + } - if !self.fail && !d2.is_constant() { - let d2 = self.store(d2); - tabu_list.insert((d1, d2)); - } - } - (HeapCellValueTag::CStr) => { - read_heap_cell!(d2, - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), d1); - continue; - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), d1); - continue; - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), d1); - continue; - } - (HeapCellValueTag::Str | - HeapCellValueTag::Lis | - HeapCellValueTag::PStrLoc) => { - } - (HeapCellValueTag::CStr) => { - self.fail = d1 != d2; - continue; - } - _ => { - self.fail = true; - return; - } - ); + pub fn unify_f64(&mut self, f1: F64Ptr, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_f64(f1, value); + } - self.unify_partial_string(d2, d1); - } - (HeapCellValueTag::F64, f1) => { - self.unify_f64(f1, d2); - } - (HeapCellValueTag::Fixnum, n1) => { - self.unify_fixnum(n1, d2); - } - (HeapCellValueTag::Char, c1) => { - self.unify_char(c1, d2); - } - (HeapCellValueTag::Cons, ptr_1) => { - self.unify_constant(ptr_1, d2); - } - _ => { - unreachable!(); - } - ); - } - } + pub fn unify_constant(&mut self, ptr: UntypedArenaPtr, value: HeapCellValue) { + let mut unifier = DefaultUnifier::from(self); + unifier.unify_constant(ptr, value); + } + + pub(super) fn unify_with_occurs_check_with_error(&mut self) { + let mut unifier = CompositeUnifierForOccursCheckWithError::from( + DefaultUnifier::from(self), + ); + + unifier.unify_internal(); + } + + pub(super) fn unify_with_occurs_check(&mut self) { + let mut unifier = CompositeUnifierForOccursCheck::from(DefaultUnifier::from(self)); + unifier.unify_internal(); } pub(super) fn set_ball(&mut self) { @@ -893,527 +345,6 @@ impl MachineState { self.fail = true; } - #[inline] - pub fn bind_with_occurs_check(&mut self, r: Ref, value: HeapCellValue) -> bool { - if let RefTag::StackCell = r.get_tag() { - // local variable optimization -- r cannot occur in the - // heap structure bound to value, so don't bother - // traversing value. - self.bind(r, value); - return false; - } - - let mut occurs_triggered = false; - - if !value.is_constant() { - for addr in stackful_preorder_iter(&mut self.heap, value) { - let addr = unmark_cell_bits!(addr); - - if let Some(inner_r) = addr.as_var() { - if r == inner_r { - occurs_triggered = true; - break; - } - } - } - } - - if occurs_triggered { - self.fail = true; - } else { - self.bind(r, value); - } - - return occurs_triggered; - } - - #[inline] - pub(super) fn bind_with_occurs_check_wrapper(&mut self, r: Ref, value: HeapCellValue) { - self.bind_with_occurs_check(r, value); - } - - #[inline] - pub(super) fn bind_with_occurs_check_with_error_wrapper( - &mut self, - r: Ref, - value: HeapCellValue, - ) { - if self.bind_with_occurs_check(r, value) { - let err = self.representation_error(RepFlag::Term); - let stub = functor_stub(atom!("unify_with_occurs_check"), 2); - let err = self.error_form(err, stub); - - self.throw_exception(err); - } - } - - pub(super) fn unify_with_occurs_check_with_error(&mut self) { - let mut throw_error = false; - self.unify_with_occurs_check_loop(|| throw_error = true); - - if throw_error { - let err = self.representation_error(RepFlag::Term); - let stub = functor_stub(atom!("unify_with_occurs_check"), 2); - let err = self.error_form(err, stub); - - self.throw_exception(err); - } - } - - pub(super) fn unify_with_occurs_check(&mut self) { - self.unify_with_occurs_check_loop(|| {}) - } - - fn unify_structure_with_occurs_check( - &mut self, - s1: usize, - value: HeapCellValue, - mut occurs_trigger: impl FnMut(), - ) { - // s1 is the value of a STR cell. - let (n1, a1) = cell_as_atom_cell!(self.heap[s1]).get_name_and_arity(); - - read_heap_cell!(value, - (HeapCellValueTag::Str, s2) => { - let (n2, a2) = cell_as_atom_cell!(self.heap[s2]) - .get_name_and_arity(); - - if n1 == n2 && a1 == a2 { - for idx in (0..a1).rev() { - self.pdl.push(heap_loc_as_cell!(s2+1+idx)); - self.pdl.push(heap_loc_as_cell!(s1+1+idx)); - } - } else { - self.fail = true; - } - } - (HeapCellValueTag::Lis, l2) => { - if a1 == 2 && n1 == atom!(".") { - for idx in (0..2).rev() { - self.pdl.push(heap_loc_as_cell!(l2+idx)); - self.pdl.push(heap_loc_as_cell!(s1+1+idx)); - } - } else { - self.fail = true; - } - } - (HeapCellValueTag::Atom, (n2, a2)) => { - self.fail = !(a1 == 0 && a2 == 0 && n1 == n2); - } - (HeapCellValueTag::AttrVar, h) => { - if self.bind_with_occurs_check(Ref::attr_var(h), str_loc_as_cell!(s1)) { - occurs_trigger(); - } - } - (HeapCellValueTag::Var, h) => { - if self.bind_with_occurs_check(Ref::heap_cell(h), str_loc_as_cell!(s1)) { - occurs_trigger(); - } - } - (HeapCellValueTag::StackVar, s) => { - if self.bind_with_occurs_check(Ref::stack_cell(s), str_loc_as_cell!(s1)) { - occurs_trigger(); - } - } - _ => { - self.fail = true; - } - ) - } - - // the return value of unify_partial_string_with_occurs_check is - // interpreted as follows: - // - // Some(None) -- the strings are equal, nothing to unify - // Some(Some(f2,f1)) -- prefixes equal, try to unify focus values f2, f1 - // None -- prefixes not equal, unification fails - // - // d1's tag is assumed to be one of LIS, STR or PSTRLOC. - pub fn unify_partial_string_with_occurs_check( - &mut self, - d1: HeapCellValue, - d2: HeapCellValue, - mut occurs_trigger: impl FnMut(), - ) { - if let Some(r) = d2.as_var() { - if self.bind_with_occurs_check(r, d1) { - occurs_trigger(); - } - - return; - } - - let s1 = self.heap.len(); - - self.heap.push(d1); - self.heap.push(d2); - - let mut pstr_iter1 = HeapPStrIter::new(&self.heap, s1); - let mut pstr_iter2 = HeapPStrIter::new(&self.heap, s1 + 1); - - match compare_pstr_prefixes(&mut pstr_iter1, &mut pstr_iter2) { - PStrCmpResult::Ordered(Ordering::Equal) => {} - PStrCmpResult::Ordered(Ordering::Less) => { - if pstr_iter2.focus.as_var().is_none() { - self.fail = true; - } else { - self.pdl.push(empty_list_as_cell!()); - self.pdl.push(pstr_iter2.focus); - } - } - PStrCmpResult::Ordered(Ordering::Greater) => { - if pstr_iter1.focus.as_var().is_none() { - self.fail = true; - } else { - self.pdl.push(empty_list_as_cell!()); - self.pdl.push(pstr_iter1.focus); - } - } - continuable @ PStrCmpResult::FirstIterContinuable(iteratee) | - continuable @ PStrCmpResult::SecondIterContinuable(iteratee) => { - if continuable.is_second_iter() { - std::mem::swap(&mut pstr_iter1, &mut pstr_iter2); - } - - let mut chars_iter = PStrCharsIter { - iter: pstr_iter1, - item: Some(iteratee), - }; - - let mut focus = pstr_iter2.focus; - - 'outer: loop { - while let Some(c) = chars_iter.peek() { - read_heap_cell!(focus, - (HeapCellValueTag::Lis, l) => { - let val = pstr_iter2.heap[l]; - - self.pdl.push(val); - self.pdl.push(char_as_cell!(c)); - - focus = pstr_iter2.heap[l+1]; - } - (HeapCellValueTag::Str, s) => { - let (name, arity) = cell_as_atom_cell!(pstr_iter2.heap[s]) - .get_name_and_arity(); - - if name == atom!(".") && arity == 2 { - self.pdl.push(pstr_iter2.heap[s+1]); - self.pdl.push(char_as_cell!(c)); - - focus = pstr_iter2.heap[s+2]; - } else { - self.fail = true; - break 'outer; - } - } - (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => { - match chars_iter.item.unwrap() { - PStrIteratee::Char(focus, _) => { - self.pdl.push(self.heap[focus]); - self.pdl.push(heap_loc_as_cell!(h)); - } - PStrIteratee::PStrSegment(focus, _, n) => { - read_heap_cell!(self.heap[focus], - (HeapCellValueTag::CStr | HeapCellValueTag::PStr, pstr_atom) => { - if focus < self.heap.len() - 2 { - self.heap.pop(); - self.heap.pop(); - } - - if n == 0 { - let target_cell = match self.heap[focus].get_tag() { - HeapCellValueTag::CStr => { - atom_as_cstr_cell!(pstr_atom) - } - HeapCellValueTag::PStr => { - pstr_loc_as_cell!(focus) - } - _ => { - unreachable!() - } - }; - - self.pdl.push(target_cell); - self.pdl.push(heap_loc_as_cell!(h)); - } else { - let h_len = self.heap.len(); - - self.heap.push(pstr_offset_as_cell!(focus)); - self.heap.push(fixnum_as_cell!( - Fixnum::build_with(n as i64) - )); - - self.pdl.push(pstr_loc_as_cell!(h_len)); - self.pdl.push(heap_loc_as_cell!(h)); - } - - return; - } - (HeapCellValueTag::PStrOffset, pstr_loc) => { - let n0 = cell_as_fixnum!(self.heap[focus+1]) - .get_num() as usize; - - if pstr_loc < self.heap.len() - 2 { - self.heap.pop(); - self.heap.pop(); - } - - if n == n0 { - self.pdl.push(pstr_loc_as_cell!(focus)); - self.pdl.push(heap_loc_as_cell!(h)); - } else { - let h_len = self.heap.len(); - - self.heap.push(pstr_offset_as_cell!(pstr_loc)); - self.heap.push(fixnum_as_cell!( - Fixnum::build_with(n as i64) - )); - - self.pdl.push(pstr_loc_as_cell!(h_len)); - self.pdl.push(heap_loc_as_cell!(h)); - } - - return; - } - _ => { - } - ); - - if focus < self.heap.len() - 2 { - self.heap.pop(); - self.heap.pop(); - } - - self.pdl.push(self.heap[focus]); - self.pdl.push(heap_loc_as_cell!(h)); - - return; - } - } - - break 'outer; - } - _ => { - self.fail = true; - break 'outer; - } - ); - - chars_iter.next(); - } - - chars_iter.iter.next(); - - self.pdl.push(chars_iter.iter.focus); - self.pdl.push(focus); - - break; - } - } - PStrCmpResult::Unordered => { - self.pdl.push(pstr_iter1.focus); - self.pdl.push(pstr_iter2.focus); - } - } - - self.heap.pop(); - self.heap.pop(); - } - - fn unify_list_with_occurs_trigger( - &mut self, - l1: usize, - d2: HeapCellValue, - mut occurs_trigger: impl FnMut(), - ) { - read_heap_cell!(d2, - (HeapCellValueTag::Lis, l2) => { - for idx in (0..2).rev() { - self.pdl.push(heap_loc_as_cell!(l2+idx)); - self.pdl.push(heap_loc_as_cell!(l1+idx)); - } - } - (HeapCellValueTag::Str, s2) => { - let (n2, a2) = cell_as_atom_cell!(self.heap[s2]) - .get_name_and_arity(); - - if a2 == 2 && n2 == atom!(".") { - for idx in (0..2).rev() { - self.pdl.push(heap_loc_as_cell!(s2+1+idx)); - self.pdl.push(heap_loc_as_cell!(l1+idx)); - } - } else { - self.fail = true; - } - } - (HeapCellValueTag::PStrLoc | HeapCellValueTag::CStr | HeapCellValueTag::PStr) => { - self.unify_partial_string_with_occurs_check( - list_loc_as_cell!(l1), - d2, - &mut occurs_trigger, - ) - } - (HeapCellValueTag::AttrVar, h) => { - if self.bind_with_occurs_check(Ref::attr_var(h), list_loc_as_cell!(l1)) { - occurs_trigger(); - } - } - (HeapCellValueTag::Var, h) => { - if self.bind_with_occurs_check(Ref::heap_cell(h), list_loc_as_cell!(l1)) { - occurs_trigger(); - } - } - (HeapCellValueTag::StackVar, s) => { - if self.bind_with_occurs_check(Ref::stack_cell(s), list_loc_as_cell!(l1)) { - occurs_trigger(); - } - } - _ => { - self.fail = true; - } - ) - } - - pub(super) fn unify_with_occurs_check_loop(&mut self, mut occurs_trigger: impl FnMut()) { - let mut tabu_list = IndexSet::with_hasher(FxBuildHasher::default()); - - // self.fail = false; - - while !(self.pdl.is_empty() || self.fail) { - let s1 = self.pdl.pop().unwrap(); - let s1 = self.deref(s1); - - let s2 = self.pdl.pop().unwrap(); - let s2 = self.deref(s2); - - if s1 != s2 { - let d1 = self.store(s1); - let d2 = self.store(s2); - - read_heap_cell!(d1, - (HeapCellValueTag::AttrVar, h) => { - if self.bind_with_occurs_check(Ref::attr_var(h), d2) { - occurs_trigger(); - } - } - (HeapCellValueTag::Var, h) => { - if self.bind_with_occurs_check(Ref::heap_cell(h), d2) { - occurs_trigger(); - } - } - (HeapCellValueTag::StackVar, s) => { - if self.bind_with_occurs_check(Ref::stack_cell(s), d2) { - occurs_trigger(); - } - } - (HeapCellValueTag::Atom, (name, arity)) => { - debug_assert!(arity == 0); - self.unify_atom(name, d2); - } - (HeapCellValueTag::Str, s1) => { - if tabu_list.contains(&(d1, d2)) { - continue; - } - - self.unify_structure_with_occurs_check(s1, d2, &mut occurs_trigger); - - if !self.fail { - let d2 = self.store(d2); - tabu_list.insert((d1, d2)); - } - } - (HeapCellValueTag::Lis, l1) => { - if d2.is_ref() { - if tabu_list.contains(&(d1, d2)) { - continue; - } - } - - self.unify_list_with_occurs_trigger(l1, d2, &mut occurs_trigger); - - if !self.fail { - let d2 = self.store(d2); - tabu_list.insert((d1, d2)); - } - } - (HeapCellValueTag::PStrLoc) => { - read_heap_cell!(d2, - (HeapCellValueTag::PStrLoc | - HeapCellValueTag::Lis | - HeapCellValueTag::Str) => { - if tabu_list.contains(&(d1, d2)) { - continue; - } - } - (HeapCellValueTag::CStr | - HeapCellValueTag::AttrVar | - HeapCellValueTag::Var | - HeapCellValueTag::StackVar) => { - } - _ => { - self.fail = true; - break; - } - ); - - self.unify_partial_string_with_occurs_check( - d1, - d2, - &mut occurs_trigger, - ); - - if !self.fail && !d2.is_constant() { - let d2 = self.store(d2); - tabu_list.insert((d1, d2)); - } - } - (HeapCellValueTag::CStr) => { - read_heap_cell!(d2, - (HeapCellValueTag::AttrVar, h) => { - self.bind(Ref::attr_var(h), d1); - continue; - } - (HeapCellValueTag::Var, h) => { - self.bind(Ref::heap_cell(h), d1); - continue; - } - (HeapCellValueTag::StackVar, s) => { - self.bind(Ref::stack_cell(s), d1); - continue; - } - (HeapCellValueTag::Str | - HeapCellValueTag::Lis | - HeapCellValueTag::PStrLoc) => { - } - _ => { - self.fail = true; - return; - } - ); - - self.unify_partial_string(d2, d1); - } - (HeapCellValueTag::F64, f1) => { - self.unify_f64(f1, d2); - } - (HeapCellValueTag::Fixnum, n1) => { - self.unify_fixnum(n1, d2); - } - (HeapCellValueTag::Char, c1) => { - self.unify_char(c1, d2); - } - (HeapCellValueTag::Cons, ptr_1) => { - self.unify_constant(ptr_1, d2); - } - _ => { - unreachable!(); - } - ); - } - } - } - pub(crate) fn read_s(&mut self) -> HeapCellValue { match &mut self.s { &mut HeapPtr::HeapCell(h) => self.deref(self.heap[h + self.s_offset]), diff --git a/src/machine/mod.rs b/src/machine/mod.rs index 77eb9c8b..5193eb66 100644 --- a/src/machine/mod.rs +++ b/src/machine/mod.rs @@ -21,6 +21,7 @@ pub mod stack; pub mod streams; pub mod system_calls; pub mod term_stream; +pub mod unify; use crate::arena::*; use crate::arithmetic::*; @@ -257,31 +258,22 @@ impl Machine { let mut path_buf = current_dir(); path_buf.push("machine/attributed_variables.pl"); - bootstrapping_compile( - Stream::from_static_string( - include_str!("attributed_variables.pl"), - &mut self.machine_st.arena, - ), - self, - ListingSource::from_file_and_path( - atom!("attributed_variables"), - path_buf, - ), - ) - .unwrap(); + let stream = Stream::from_static_string( + include_str!("attributed_variables.pl"), + &mut self.machine_st.arena, + ); + + self.load_file(path_buf.to_str().unwrap(), stream); let mut path_buf = current_dir(); path_buf.push("machine/project_attributes.pl"); - bootstrapping_compile( - Stream::from_static_string( - include_str!("project_attributes.pl"), - &mut self.machine_st.arena, - ), - self, - ListingSource::from_file_and_path(atom!("project_attributes"), path_buf), - ) - .unwrap(); + let stream = Stream::from_static_string( + include_str!("project_attributes.pl"), + &mut self.machine_st.arena, + ); + + self.load_file(path_buf.to_str().unwrap(), stream); if let Some(module) = self.indices.modules.get(&atom!("$atts")) { if let Some(code_index) = module.code_dir.get(&(atom!("driver"), 2)) { @@ -866,14 +858,22 @@ impl Machine { TrailEntryTag::TrailedAttrVar => { self.machine_st.heap[h] = attr_var_as_cell!(h); } - TrailEntryTag::TrailedAttrVarHeapLink => { - self.machine_st.heap[h] = heap_loc_as_cell!(h); - } TrailEntryTag::TrailedAttrVarListLink => { let l = self.machine_st.trail[i + 1].get_value() as usize; if l < self.machine_st.hb { - self.machine_st.heap[h] = list_loc_as_cell!(l); + if h == l { + self.machine_st.heap[h] = heap_loc_as_cell!(h); + } else { + read_heap_cell!(self.machine_st.heap[l], + (HeapCellValueTag::Var) => { + self.machine_st.heap[h] = list_loc_as_cell!(l); + } + _ => { + self.machine_st.heap[h] = heap_loc_as_cell!(l); + } + ); + } } else { self.machine_st.heap[h] = heap_loc_as_cell!(h); } diff --git a/src/machine/project_attributes.pl b/src/machine/project_attributes.pl index b2f75007..f54797c8 100644 --- a/src/machine/project_attributes.pl +++ b/src/machine/project_attributes.pl @@ -1,7 +1,12 @@ :- module('$project_atts', [copy_term/3]). +:- use_module(library(dcgs)). +:- use_module(library(error), [can_be/2]). +:- use_module(library(lambda)). +:- use_module(library(lists), [foldl/4, maplist/2]). + project_attributes(QueryVars, AttrVars) :- - gather_attr_modules(AttrVars, Modules0), + phrase(gather_attr_modules(AttrVars), Modules0), sort(Modules0, Modules), call_project_attributes(Modules, QueryVars, AttrVars). @@ -17,19 +22,14 @@ project_attributes(QueryVars, AttrVars) :- call_project_attributes([], _, _). call_project_attributes([Module|Modules], QueryVars, AttrVars) :- ( catch(Module:project_attributes(QueryVars, AttrVars), - E, - '$project_atts':'$print_project_attributes_exception'(Module, E) - ) + E, + '$project_atts':'$print_project_attributes_exception'(Module, E) + ) -> true ; true ), call_project_attributes(Modules, QueryVars, AttrVars). -call_attribute_goals([], _, _). -call_attribute_goals([Module|Modules], GoalCaller, AttrVars) :- - call(GoalCaller, AttrVars, Module, Goals), - call_attribute_goals(Modules, GoalCaller, AttrVars). - '$print_attribute_goals_exception'(Module, E) :- ( E = error(evaluation_error((Module:attribute_goals)/3), attribute_goals/3) ; E = error(existence_error(procedure, attribute_goals/3), attribute_goals/3) @@ -38,20 +38,6 @@ call_attribute_goals([Module|Modules], GoalCaller, AttrVars) :- nl ). -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) - ), - E, - ( '$project_atts':'$print_attribute_goals_exception'(Module, E), - atts:'$default_attr_list'(Module, AttrVar, Goals, RGoals) - )) - -> true - ; atts:'$default_attr_list'(Module, AttrVar, Goals, RGoals) - ), - call_query_var_goals(AttrVars, Module, RGoals). - call_attr_var_goals([], _, []). call_attr_var_goals([AttrVar|AttrVars], Module, Goals) :- ( catch(Module:attribute_goals(AttrVar, Goals, RGoals), @@ -77,25 +63,52 @@ call_attribute_goals_with_module_prefix([Module | Modules], GoalCaller, AttrVars module_prefixed_goals(Goals0, Module, Goals, Gs), call_attribute_goals_with_module_prefix(Modules, GoalCaller, AttrVars, Gs). +gather_attr_modules([]) --> []. +gather_attr_modules([AttrVar|AttrVars]) --> + { '$get_attr_list'(AttrVar, Attrs) }, + copy_attribute_modules(Attrs), + gather_attr_modules(AttrVars). -gather_attr_modules([], []). -gather_attr_modules([AttrVar|AttrVars], Modules) :- - '$get_attr_list'(AttrVar, Attrs), - copy_attribute_modules(Attrs, Modules, Modules0), - gather_attr_modules(AttrVars, Modules0). +copy_attribute_modules(Attrs) --> + { var(Attrs) }, + !. +copy_attribute_modules([Module:_|Attrs]) --> + [Module], + copy_attribute_modules(Attrs). -copy_attribute_modules(Attrs, Ls, Ls) :- - var(Attrs), !. -copy_attribute_modules([Module:_|Attrs], [Module|Modules0], Modules1) :- - copy_attribute_modules(Attrs, Modules0, Modules1). +gather_residual_goals_(M, V, V0, V1) :- + ( catch(M:attribute_goals(V, V0, V1), + E, + ('$project_atts':'$print_attribute_goals_exception'(M, E), + V0 = V1) + ) -> + true + ; V0 = V1 + ). +gather_residual_goals(M, V) --> + gather_residual_goals_(M, V), + atts:'$default_attr_list'(M, V). -copy_term(Source, Dest, Goals) :- - '$term_attributed_variables'(Source, AttrVars), - gather_attr_modules(AttrVars, Modules0), - sort(Modules0, Modules), - call_attribute_goals_with_module_prefix(Modules, '$project_atts':call_query_var_goals, - AttrVars, Goals0), - sort(Goals0, Goals1), - !, - '$copy_term_without_attr_vars'([Source | Goals1], [Dest | Goals]). +gather_residual_goals([]) --> []. +gather_residual_goals([V|Vs]) --> + { '$get_attr_list'(V, Attrs), + phrase(copy_attribute_modules(Attrs), Modules0), + sort(Modules0, Modules) }, + foldl(V+\M^gather_residual_goals(M, V), Modules), + gather_residual_goals(Vs). + +delete_all_attributes_from_var(V) :- '$delete_all_attributes_from_var'(V). + +copy_term(Term, Copy, Gs) :- + can_be(list, Gs), + findall(Term-Rs, term_residual_goals(Term,Rs), [Copy-Gs]), + ( var(Gs) -> + Gs = [] + ; true + ). + +term_residual_goals(Term,Rs) :- + '$term_attributed_variables'(Term, Vs), + phrase(gather_residual_goals(Vs), Rs), + maplist(delete_all_attributes_from_var, Vs). diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 288b457b..1c367a80 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -458,7 +458,41 @@ impl BrentAlgState { } } +#[derive(Debug)] +enum MatchSite { + NoMatchVarTail(usize), // no match, we refer to the location of the uninstantiated tail instead. + Match(usize), // a match +} + +#[derive(Debug)] +struct AttrListMatch { + match_site: MatchSite, + prev_tail: Option, +} + impl MachineState { + pub(crate) fn get_attr_var_list(&mut self, attr_var: HeapCellValue) -> Option { + read_heap_cell!(attr_var, + (HeapCellValueTag::AttrVar, h) => { + Some(h + 1) + } + (HeapCellValueTag::Var | HeapCellValueTag::StackVar) => { + // create an AttrVar in the heap. + let h = self.heap.len(); + + self.heap.push(attr_var_as_cell!(h)); + self.heap.push(heap_loc_as_cell!(h+1)); + + self.bind(Ref::attr_var(h), attr_var); + + Some(h + 1) + } + _ => { + None + } + ) + } + pub(crate) fn name_and_arity_from_heap(&self, cell: HeapCellValue) -> Option { read_heap_cell!(self.store(self.deref(cell)), (HeapCellValueTag::Str, s) => { @@ -1004,6 +1038,17 @@ impl MachineState { } impl Machine { + #[inline(always)] + pub(crate) fn delete_all_attributes_from_var(&mut self) { + let attr_var = self.deref_register(1); + + if let HeapCellValueTag::AttrVar = attr_var.get_tag() { + let attr_var_loc = attr_var.get_value(); + self.machine_st.heap[attr_var_loc] = heap_loc_as_cell!(attr_var_loc); + self.machine_st.trail(TrailRef::Ref(Ref::attr_var(attr_var_loc))); + } + } + #[inline(always)] pub(crate) fn get_clause_p(&self, module_name: Atom) -> (usize, usize) { use crate::machine::loader::CompilationTarget; @@ -4467,17 +4512,10 @@ impl Machine { let attr_var = self.deref_register(1); let attr_var_list = read_heap_cell!(attr_var, (HeapCellValueTag::AttrVar, h) => { - h + 1 + h+1 } - (HeapCellValueTag::Var | HeapCellValueTag::StackVar) => { - // create an AttrVar in the heap. - let h = self.machine_st.heap.len(); - - self.machine_st.heap.push(attr_var_as_cell!(h)); - self.machine_st.heap.push(heap_loc_as_cell!(h+1)); - - self.machine_st.bind(Ref::attr_var(h), attr_var); - h + 1 + (HeapCellValueTag::Var, h) => { + h } _ => { self.machine_st.fail = true; @@ -4489,6 +4527,44 @@ impl Machine { self.machine_st.bind(Ref::heap_cell(attr_var_list), list_addr); } + #[inline(always)] + pub(crate) fn get_from_attributed_variable_list(&mut self) { + let attr_var = self.deref_register(1); + let attr = self.deref_register(3); + let attr_var_list = read_heap_cell!(attr_var, + (HeapCellValueTag::AttrVar, h) => { + self.machine_st.heap[h+1] + } + _ => { + self.machine_st.fail = true; + return; + } + ); + + let module = self.deref_register(2); + + match self.match_attribute(attr_var_list, module, attr) { + Some(AttrListMatch { match_site: MatchSite::Match(match_site), .. }) => { + let list_head = self.machine_st.heap[match_site]; + + if list_head.get_value() == match_site { + // at the end of the list, no match found in this case. + self.machine_st.fail = true; + } else { + let (_, qualified_goal) = self.machine_st.strip_module( + list_head, + empty_list_as_cell!(), + ); + + unify!(self.machine_st, qualified_goal, attr); + } + } + _ => { + self.machine_st.fail = true; + } + } + } + #[inline(always)] pub(crate) fn get_attr_var_queue_delimiter(&mut self) { let addr = self.deref_register(1); @@ -4523,81 +4599,202 @@ impl Machine { } #[inline(always)] - pub(crate) fn enqueue_attributed_var(&mut self) { - let addr = self.deref_register(1); - - read_heap_cell!(addr, + pub(crate) fn delete_from_attributed_variable_list(&mut self) { + let attr_var = self.deref_register(1); + let attr = self.deref_register(3); + let attr_var_list = read_heap_cell!(attr_var, (HeapCellValueTag::AttrVar, h) => { - self.machine_st.attr_var_init.attr_var_queue.push(h); + h + 1 } _ => { + return; } ); - } - #[inline(always)] - pub(crate) fn delete_attribute(&mut self) { - let ls0 = self.deref_register(1); + let module = self.deref_register(2); - if let HeapCellValueTag::Lis = ls0.get_tag() { - let l1 = ls0.get_value(); - let ls1 = self.machine_st.store(self.machine_st.deref(heap_loc_as_cell!(l1 + 1))); - - if let HeapCellValueTag::Lis = ls1.get_tag() { - let l2 = ls1.get_value(); - - let old_addr = self.machine_st.store(self.machine_st.deref(self.machine_st.heap[l1+1])); - let tail = self.machine_st.store(self.machine_st.deref(heap_loc_as_cell!(l2 + 1))); - - let tail = if tail.is_var() { - heap_loc_as_cell!(l1 + 1) + match self.match_attribute(self.machine_st.heap[attr_var_list], module, attr) { + Some(AttrListMatch { prev_tail, match_site: MatchSite::Match(match_site) }) => { + let prev_tail = if let Some(prev_tail) = prev_tail { + // not at the head. + prev_tail } else { - tail + if self.machine_st.heap[match_site + 1].is_var() { + let h = attr_var.get_value(); + + self.machine_st.heap[h] = heap_loc_as_cell!(h); + self.machine_st.trail(TrailRef::Ref(Ref::attr_var(h))); + } + + // at the head. + attr_var_list }; - let trail_ref = read_heap_cell!(old_addr, - (HeapCellValueTag::Var, h) => { - TrailRef::AttrVarHeapLink(h) - } - (HeapCellValueTag::Lis, l) => { - TrailRef::AttrVarListLink(l1 + 1, l) - } - _ => { - unreachable!() - } - ); + if self.machine_st.heap[match_site + 1].get_tag() == HeapCellValueTag::Lis { + let prev_tail_value = self.machine_st.heap[match_site + 1].get_value(); + self.machine_st.heap[prev_tail].set_value(prev_tail_value); + } else { + self.machine_st.heap[prev_tail] = heap_loc_as_cell!(prev_tail); + } - self.machine_st.heap[l1 + 1] = tail; - self.machine_st.trail(trail_ref); + self.machine_st.trail(TrailRef::AttrVarListLink(prev_tail, match_site)); + } + _ => { } } } #[inline(always)] - pub(crate) fn delete_head_attribute(&mut self) { - let addr = self.deref_register(1); - - debug_assert_eq!(addr.get_tag(), HeapCellValueTag::AttrVar); - - let h = addr.get_value(); - let addr = self.machine_st.store(self.machine_st.deref(self.machine_st.heap[h + 1])); - - debug_assert_eq!(addr.get_tag(), HeapCellValueTag::Lis); - - let l = addr.get_value(); - let tail = self.machine_st.store(self.machine_st.deref(self.machine_st.heap[l + 1])); - - let tail = if tail.is_var() { - self.machine_st.heap[h] = heap_loc_as_cell!(h); - self.machine_st.trail(TrailRef::Ref(Ref::attr_var(h))); - - heap_loc_as_cell!(h + 1) - } else { - tail + pub(crate) fn put_to_attributed_variable_list(&mut self) { + let attr_var = self.deref_register(1); + let attr = self.deref_register(3); + let attr_var_list = match self.machine_st.get_attr_var_list(attr_var) { + Some(h) => h, + None => { + self.machine_st.fail = true; + return; + } }; - self.machine_st.heap[h + 1] = tail; - self.machine_st.trail(TrailRef::AttrVarListLink(h + 1, l)); + let module = self.deref_register(2); + + /* + * How to handle attribute trailing using just AttrVarListLink (which + * should be re-named to something more general) in unwind_trail: + * + * Given AttrVarListLink(h, l): + * + * 1. Check cell at offset l. + * 2. If h == l, set heap[h] = heap_loc_as_cell!(h). + * 3. If cell is a Var, set heap[h] = list_loc_as_cell!(l). + * 4. Otherwise, cell points to an element of the list which is therefore + * an atom or str. Set heap[h] accordingly. + * + * For this to work, all elements of attributed variable lists must be + * heap cell locs pointing to later elements in the heap, either atoms (0-arity) + * or str cells (> 0-arity). + */ + + let h = self.machine_st.heap.len(); + + self.machine_st.heap.push(str_loc_as_cell!(h+1)); + self.machine_st.heap.extend(functor!(atom!(":"), [cell(module), cell(attr)])); + + match self.match_attribute(self.machine_st.heap[attr_var_list], module, attr) { + Some(AttrListMatch { match_site, .. }) => { + let (match_site, l) = match match_site { + MatchSite::NoMatchVarTail(match_site) => { + let l = self.machine_st.heap[match_site].get_value(); + + // at the end of the (non-empty) list here. + self.machine_st.heap[match_site] = list_loc_as_cell!(h+4); + self.machine_st.heap.push(heap_loc_as_cell!(h)); + self.machine_st.heap.push(heap_loc_as_cell!(h+5)); + + (match_site, l) + } + MatchSite::Match(match_site) => { + let l = self.machine_st.heap[match_site].get_value(); + self.machine_st.heap[match_site].set_value(h); + + (match_site, l) + } + }; + + self.machine_st.trail(TrailRef::AttrVarListLink(match_site, l)); + } + None => { + // the list is empty. + self.machine_st.heap[attr_var_list] = list_loc_as_cell!(h+4); + self.machine_st.heap.push(heap_loc_as_cell!(h)); + self.machine_st.heap.push(heap_loc_as_cell!(h+5)); + + self.machine_st.attr_var_init.attr_var_queue.push(attr_var_list - 1); + self.machine_st.trail(TrailRef::AttrVarListLink(attr_var_list, attr_var_list)); + } + } + } + + fn match_attribute( + &self, + mut attrs_list: HeapCellValue, + module: HeapCellValue, + attr: HeapCellValue, + ) -> Option { + let (name, arity) = match self.machine_st.name_and_arity_from_heap(attr) { + Some(key) => key, + None => { + return None; + } + }; + + let mut prev_tail = None; + + while let HeapCellValueTag::Lis = attrs_list.get_tag() { + let mut list_head = self.machine_st.heap[attrs_list.get_value()]; + + loop { + read_heap_cell!(list_head, + (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => { + debug_assert!(list_head != self.machine_st.heap[h]); + list_head = self.machine_st.heap[h]; + } + (HeapCellValueTag::Str | HeapCellValueTag::Atom) => { + let (module_loc, qualified_goal) = self.machine_st.strip_module( + list_head, + empty_list_as_cell!(), + ); + + let (t_name, t_arity) = self.machine_st + .name_and_arity_from_heap(qualified_goal) + .unwrap(); + + if module == module_loc && name == t_name && arity == t_arity { + return Some(AttrListMatch { + match_site: MatchSite::Match(attrs_list.get_value()), + prev_tail, + }); + } + + break; + } + _ => { + break; + } + ); + } + + let tail_loc = attrs_list.get_value() + 1; + prev_tail = Some(tail_loc); + + // do the work of self.store(self.deref(...)) but inline it + // for speed and simplify it. + let mut list_tail = self.machine_st.heap[tail_loc]; + + loop { + read_heap_cell!(list_tail, + (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => { + if list_tail != self.machine_st.heap[h] { + list_tail = self.machine_st.heap[h]; + } else { + return Some(AttrListMatch { + match_site: MatchSite::NoMatchVarTail(h), + prev_tail, + }); + } + } + (HeapCellValueTag::Lis) => { + attrs_list = list_tail; + break; + } + _ => { + unreachable!() + } + ); + } + } + + None } #[inline(always)] @@ -7177,4 +7374,3 @@ impl hkdf::KeyType for MyKey { self.0 } } - diff --git a/src/machine/unify.rs b/src/machine/unify.rs new file mode 100644 index 00000000..19445fe4 --- /dev/null +++ b/src/machine/unify.rs @@ -0,0 +1,763 @@ +use crate::arena::*; +use crate::forms::*; +use crate::heap_iter::stackful_preorder_iter; +use crate::machine::*; +use crate::machine::machine_state::*; +use crate::machine::partial_string::*; +use crate::types::*; + +use std::cmp::Ordering; +use std::ops::{Deref, DerefMut}; + +use derive_deref::*; +use fxhash::FxBuildHasher; +use indexmap::IndexSet; + +pub(crate) trait Unifier: DerefMut { + fn unify_structure(&mut self, s1: usize, value: HeapCellValue) { + // s1 is the value of a STR cell. + let (n1, a1) = cell_as_atom_cell!(self.heap[s1]).get_name_and_arity(); + + read_heap_cell!(value, + (HeapCellValueTag::Str, s2) => { + let (n2, a2) = cell_as_atom_cell!(self.heap[s2]) + .get_name_and_arity(); + + if n1 == n2 && a1 == a2 { + for idx in (0..a1).rev() { + self.pdl.push(heap_loc_as_cell!(s2+1+idx)); + self.pdl.push(heap_loc_as_cell!(s1+1+idx)); + } + } else { + self.fail = true; + } + } + (HeapCellValueTag::Lis, l2) => { + if a1 == 2 && n1 == atom!(".") { + for idx in (0..2).rev() { + self.pdl.push(heap_loc_as_cell!(l2+1+idx)); + self.pdl.push(heap_loc_as_cell!(s1+1+idx)); + } + } else { + self.fail = true; + } + } + (HeapCellValueTag::Atom, (n2, a2)) => { + self.fail = !(a1 == 0 && a2 == 0 && n1 == n2); + } + (HeapCellValueTag::AttrVar, h) => { + Self::bind(self, Ref::attr_var(h), str_loc_as_cell!(s1)); + } + (HeapCellValueTag::Var, h) => { + Self::bind(self, Ref::heap_cell(h), str_loc_as_cell!(s1)); + } + (HeapCellValueTag::StackVar, s) => { + Self::bind(self, Ref::stack_cell(s), str_loc_as_cell!(s1)); + } + _ => { + self.fail = true; + } + ); + } + + fn unify_list(&mut self, l1: usize, value: HeapCellValue) { + read_heap_cell!(value, + (HeapCellValueTag::Lis, l2) => { + for idx in (0..2).rev() { + self.pdl.push(heap_loc_as_cell!(l2 + idx)); + self.pdl.push(heap_loc_as_cell!(l1 + idx)); + } + } + (HeapCellValueTag::Str, s2) => { + let (n2, a2) = cell_as_atom_cell!(self.heap[s2]) + .get_name_and_arity(); + + if a2 == 2 && n2 == atom!(".") { + for idx in (0..2).rev() { + self.pdl.push(heap_loc_as_cell!(s2+1+idx)); + self.pdl.push(heap_loc_as_cell!(l1+idx)); + } + } else { + self.fail = true; + } + } + (HeapCellValueTag::PStrLoc | HeapCellValueTag::CStr | HeapCellValueTag::PStr) => { + Self::unify_partial_string(self, list_loc_as_cell!(l1), value) + } + (HeapCellValueTag::AttrVar, h) => { + Self::bind(self, Ref::attr_var(h), list_loc_as_cell!(l1)); + } + (HeapCellValueTag::Var, h) => { + Self::bind(self, Ref::heap_cell(h), list_loc_as_cell!(l1)); + } + (HeapCellValueTag::StackVar, s) => { + Self::bind(self, Ref::stack_cell(s), list_loc_as_cell!(l1)); + } + _ => { + self.fail = true; + } + ); + } + + fn unify_complete_string(&mut self, atom: Atom, value: HeapCellValue) { + if let Some(r) = value.as_var() { + if atom == atom!("") { + Self::bind(self, r, atom_as_cell!(atom!("[]"))); + } else { + Self::bind(self, r, atom_as_cstr_cell!(atom)); + } + + return; + } + + read_heap_cell!(value, + (HeapCellValueTag::Atom, (cstr_atom, arity)) if atom == atom!("") => { + debug_assert_eq!(arity, 0); + self.fail = cstr_atom != atom!("[]"); + } + (HeapCellValueTag::Str, s) => { + let (name, arity) = cell_as_atom_cell!(self.heap[s]) + .get_name_and_arity(); + + if arity == 0 { + self.fail = atom == atom!("") && name != atom!("[]"); + } else { + // this is intentionally the same policy for + // value.tag() == Lis and PStrLoc. they're not + // grouped together to allow for arity == 0. + Self::unify_partial_string(self, atom_as_cstr_cell!(atom), value); + + if !self.pdl.is_empty() { + Self::unify_internal(self); + } + } + } + (HeapCellValueTag::CStr, cstr_atom) => { + self.fail = atom != cstr_atom; + } + (HeapCellValueTag::Lis | HeapCellValueTag::PStrLoc) => { + Self::unify_partial_string(self, atom_as_cstr_cell!(atom), value); + + if !self.pdl.is_empty() { + Self::unify_internal(self); + } + } + _ => { + self.fail = true; + } + ); + } + + // the return value of unify_partial_string is interpreted as + // follows: + // + // Some(None) -- the strings are equal, nothing to unify + // Some(Some(f2,f1)) -- prefixes equal, try to unify focus values f2, f1 + // None -- prefixes not equal, unification fails + // + // d1's tag is assumed to be one of LIS, STR or PSTRLOC. + fn unify_partial_string(&mut self, value_1: HeapCellValue, value_2: HeapCellValue) { + if let Some(r) = value_2.as_var() { + Self::bind(self, r, value_1); + return; + } + + let machine_st = self.deref_mut(); + + let s1 = machine_st.heap.len(); + + machine_st.heap.push(value_1); + machine_st.heap.push(value_2); + + let mut pstr_iter1 = HeapPStrIter::new(&machine_st.heap, s1); + let mut pstr_iter2 = HeapPStrIter::new(&machine_st.heap, s1 + 1); + + match compare_pstr_prefixes(&mut pstr_iter1, &mut pstr_iter2) { + PStrCmpResult::Ordered(Ordering::Equal) => {} + PStrCmpResult::Ordered(Ordering::Less) => { + if pstr_iter2.focus.as_var().is_none() { + machine_st.fail = true; + } else { + machine_st.pdl.push(empty_list_as_cell!()); + machine_st.pdl.push(pstr_iter2.focus); + } + } + PStrCmpResult::Ordered(Ordering::Greater) => { + if pstr_iter1.focus.as_var().is_none() { + machine_st.fail = true; + } else { + machine_st.pdl.push(empty_list_as_cell!()); + machine_st.pdl.push(pstr_iter1.focus); + } + } + continuable @ PStrCmpResult::FirstIterContinuable(iteratee) | + continuable @ PStrCmpResult::SecondIterContinuable(iteratee) => { + if continuable.is_second_iter() { + std::mem::swap(&mut pstr_iter1, &mut pstr_iter2); + } + + let mut chars_iter = PStrCharsIter { + iter: pstr_iter1, + item: Some(iteratee), + }; + + let mut focus = pstr_iter2.focus; + + 'outer: loop { + while let Some(c) = chars_iter.peek() { + read_heap_cell!(focus, + (HeapCellValueTag::Lis, l) => { + let val = pstr_iter2.heap[l]; + + machine_st.pdl.push(val); + machine_st.pdl.push(char_as_cell!(c)); + + focus = pstr_iter2.heap[l+1]; + } + (HeapCellValueTag::Str, s) => { + let (name, arity) = cell_as_atom_cell!(pstr_iter2.heap[s]) + .get_name_and_arity(); + + if name == atom!(".") && arity == 2 { + machine_st.pdl.push(pstr_iter2.heap[s+1]); + machine_st.pdl.push(char_as_cell!(c)); + + focus = pstr_iter2.heap[s+2]; + } else { + machine_st.fail = true; + break 'outer; + } + } + (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => { + match chars_iter.item.unwrap() { + PStrIteratee::Char(focus, _) => { + machine_st.pdl.push(machine_st.heap[focus]); + machine_st.pdl.push(heap_loc_as_cell!(h)); + } + PStrIteratee::PStrSegment(focus, _, n) => { + read_heap_cell!(machine_st.heap[focus], + (HeapCellValueTag::CStr | HeapCellValueTag::PStr, pstr_atom) => { + if focus < machine_st.heap.len() - 2 { + machine_st.heap.pop(); + machine_st.heap.pop(); + } + + if n == 0 { + let target_cell = match machine_st.heap[focus].get_tag() { + HeapCellValueTag::CStr => { + atom_as_cstr_cell!(pstr_atom) + } + HeapCellValueTag::PStr => { + pstr_loc_as_cell!(focus) + } + _ => { + unreachable!() + } + }; + + machine_st.pdl.push(target_cell); + machine_st.pdl.push(heap_loc_as_cell!(h)); + } else { + let h_len = machine_st.heap.len(); + + machine_st.heap.push(pstr_offset_as_cell!(focus)); + machine_st.heap.push(fixnum_as_cell!( + Fixnum::build_with(n as i64) + )); + + machine_st.pdl.push(pstr_loc_as_cell!(h_len)); + machine_st.pdl.push(heap_loc_as_cell!(h)); + } + + return; + } + (HeapCellValueTag::PStrOffset, pstr_loc) => { + let n0 = cell_as_fixnum!(machine_st.heap[focus+1]) + .get_num() as usize; + + if pstr_loc < machine_st.heap.len() - 2 { + machine_st.heap.pop(); + machine_st.heap.pop(); + } + + if n == n0 { + machine_st.pdl.push(pstr_loc_as_cell!(focus)); + machine_st.pdl.push(heap_loc_as_cell!(h)); + } else { + let h_len = machine_st.heap.len(); + + machine_st.heap.push(pstr_offset_as_cell!(pstr_loc)); + machine_st.heap.push(fixnum_as_cell!( + Fixnum::build_with(n as i64) + )); + + machine_st.pdl.push(pstr_loc_as_cell!(h_len)); + machine_st.pdl.push(heap_loc_as_cell!(h)); + } + + return; + } + _ => { + } + ); + + if focus < machine_st.heap.len() - 2 { + machine_st.heap.pop(); + machine_st.heap.pop(); + } + + machine_st.pdl.push(machine_st.heap[focus]); + machine_st.pdl.push(heap_loc_as_cell!(h)); + + return; + } + } + + break 'outer; + } + _ => { + machine_st.fail = true; + break 'outer; + } + ); + + chars_iter.next(); + } + + chars_iter.iter.next(); + + machine_st.pdl.push(focus); + machine_st.pdl.push(chars_iter.iter.focus); + + break; + } + } + PStrCmpResult::Unordered => { + machine_st.pdl.push(pstr_iter1.focus); + machine_st.pdl.push(pstr_iter2.focus); + } + } + + machine_st.heap.pop(); + machine_st.heap.pop(); + } + + fn unify_atom(&mut self, atom: Atom, value: HeapCellValue) { + read_heap_cell!(value, + (HeapCellValueTag::Atom, (name, arity)) => { + self.fail = !(arity == 0 && name == atom); + } + (HeapCellValueTag::Str, s) => { + let (name, arity) = cell_as_atom_cell!(self.heap[s]) + .get_name_and_arity(); + + self.fail = !(arity == 0 && name == atom); + } + (HeapCellValueTag::CStr, cstr_atom) if atom == atom!("[]") => { + self.fail = cstr_atom != atom!(""); + } + (HeapCellValueTag::Char, c1) => { + if let Some(c2) = atom.as_char() { + self.fail = c1 != c2; + } else { + self.fail = true; + } + } + (HeapCellValueTag::AttrVar, h) => { + Self::bind(self, Ref::attr_var(h), atom_as_cell!(atom)); + } + (HeapCellValueTag::Var, h) => { + Self::bind(self, Ref::heap_cell(h), atom_as_cell!(atom)); + } + (HeapCellValueTag::StackVar, s) => { + Self::bind(self, Ref::stack_cell(s), atom_as_cell!(atom)); + } + _ => { + self.fail = true; + } + ); + } + + fn unify_char(&mut self, c: char, value: HeapCellValue) { + read_heap_cell!(value, + (HeapCellValueTag::Atom, (name, arity)) => { + if let Some(c2) = name.as_char() { + self.fail = !(c == c2 && arity == 0); + } else { + self.fail = true; + } + } + (HeapCellValueTag::Str, s) => { + let (name, arity) = cell_as_atom_cell!(self.heap[s]) + .get_name_and_arity(); + + if let Some(c2) = name.as_char() { + self.fail = !(c == c2 && arity == 0); + } else { + self.fail = true; + } + } + (HeapCellValueTag::Char, c2) => { + if c != c2 { + self.fail = true; + } + } + (HeapCellValueTag::AttrVar, h) => { + Self::bind(self, Ref::attr_var(h), char_as_cell!(c)); + } + (HeapCellValueTag::Var, h) => { + Self::bind(self, Ref::heap_cell(h), char_as_cell!(c)); + } + (HeapCellValueTag::StackVar, s) => { + Self::bind(self, Ref::stack_cell(s), char_as_cell!(c)); + } + _ => { + self.fail = true; + } + ); + } + + fn unify_fixnum(&mut self, n1: Fixnum, value: HeapCellValue) { + if let Some(r) = value.as_var() { + Self::bind(self, r, fixnum_as_cell!(n1)); + return; + } + + match Number::try_from(value) { + Ok(n2) => match n2 { + Number::Fixnum(n2) if n1.get_num() == n2.get_num() => {} + Number::Integer(n2) if n1.get_num() == *n2 => {} + Number::Rational(n2) if n1.get_num() == *n2 => {} + _ => { + self.fail = true; + } + }, + Err(_) => { + self.fail = true; + } + } + } + + fn unify_big_num(&mut self, n1: TypedArenaPtr, value: HeapCellValue) + where N: PartialEq + + PartialEq + + PartialEq + + ArenaAllocated + { + if let Some(r) = value.as_var() { + Self::bind(self, r, typed_arena_ptr_as_cell!(n1)); + return; + } + + match Number::try_from(value) { + Ok(n2) => match n2 { + Number::Fixnum(n2) if *n1 == n2.get_num() => {} + Number::Integer(n2) if *n1 == *n2 => {} + Number::Rational(n2) if *n1 == *n2 => {} + _ => { + self.fail = true; + } + }, + Err(_) => { + self.fail = true; + } + } + } + + fn unify_f64(&mut self, f1: F64Ptr, value: HeapCellValue) { + if let Some(r) = value.as_var() { + Self::bind(self, r, HeapCellValue::from(f1)); + return; + } + + read_heap_cell!(value, + (HeapCellValueTag::F64, f2) => { + self.fail = **f1 != **f2; + } + _ => { + self.fail = true; + } + ); + } + + fn unify_constant(&mut self, ptr: UntypedArenaPtr, value: HeapCellValue) { + if let Some(ptr2) = value.to_untyped_arena_ptr() { + if ptr.get_ptr() == ptr2.get_ptr() { + return; + } + } + + match_untyped_arena_ptr!(ptr, + (ArenaHeaderTag::Integer, int_ptr) => { + Self::unify_big_num(self, int_ptr, value); + } + (ArenaHeaderTag::Rational, rat_ptr) => { + Self::unify_big_num(self, rat_ptr, value); + } + _ => { + if let Some(r) = value.as_var() { + Self::bind(self, r, untyped_arena_ptr_as_cell!(ptr)); + } else { + self.fail = true; + } + } + ); + } + + fn unify_internal(&mut self) { + let mut tabu_list = IndexSet::with_hasher(FxBuildHasher::default()); + + while !(self.pdl.is_empty() || self.fail) { + let s1 = self.pdl.pop().unwrap(); + let s1 = (self.deref() as &MachineState).deref(s1); + + let s2 = self.pdl.pop().unwrap(); + let s2 = (self.deref() as &MachineState).deref(s2); + + if s1 != s2 { + let d1 = self.store(s1); + let d2 = self.store(s2); + + read_heap_cell!(d1, + (HeapCellValueTag::AttrVar, h) => { + Self::bind(self, Ref::attr_var(h), d2); + } + (HeapCellValueTag::Var, h) => { + Self::bind(self, Ref::heap_cell(h), d2); + } + (HeapCellValueTag::StackVar, s) => { + Self::bind(self, Ref::stack_cell(s), d2); + } + (HeapCellValueTag::Atom, (name, arity)) => { + debug_assert_eq!(arity, 0); + Self::unify_atom(self, name, d2); + } + (HeapCellValueTag::Str, s1) => { + if tabu_list.contains(&(d1, d2)) { + continue; + } + + Self::unify_structure(self, s1, d2); + + if !self.fail { + let d2 = self.store(d2); + tabu_list.insert((d1, d2)); + } + } + (HeapCellValueTag::Lis, l1) => { + if d2.is_ref() { + if tabu_list.contains(&(d1, d2)) { + continue; + } + } + + Self::unify_list(self, l1, d2); + + if !self.fail { + let d2 = self.store(d2); + tabu_list.insert((d1, d2)); + } + } + (HeapCellValueTag::PStrLoc) => { + read_heap_cell!(d2, + (HeapCellValueTag::PStrLoc | + HeapCellValueTag::Lis | + HeapCellValueTag::Str) => { + if tabu_list.contains(&(d1, d2)) { + continue; + } + } + (HeapCellValueTag::CStr | + HeapCellValueTag::AttrVar | + HeapCellValueTag::Var | + HeapCellValueTag::StackVar) => { + } + _ => { + self.fail = true; + break; + } + ); + + Self::unify_partial_string(self, d1, d2); + + if !self.fail && !d2.is_constant() { + let d2 = self.store(d2); + tabu_list.insert((d1, d2)); + } + } + (HeapCellValueTag::CStr) => { + read_heap_cell!(d2, + (HeapCellValueTag::AttrVar, h) => { + Self::bind(self, Ref::attr_var(h), d1); + continue; + } + (HeapCellValueTag::Var, h) => { + Self::bind(self, Ref::heap_cell(h), d1); + continue; + } + (HeapCellValueTag::StackVar, s) => { + Self::bind(self, Ref::stack_cell(s), d1); + continue; + } + (HeapCellValueTag::Str | + HeapCellValueTag::Lis | + HeapCellValueTag::PStrLoc) => { + } + (HeapCellValueTag::CStr) => { + self.fail = d1 != d2; + continue; + } + _ => { + self.fail = true; + return; + } + ); + + Self::unify_partial_string(self, d2, d1); + } + (HeapCellValueTag::F64, f1) => { + Self::unify_f64(self, f1, d2); + } + (HeapCellValueTag::Fixnum, n1) => { + Self::unify_fixnum(self, n1, d2); + } + (HeapCellValueTag::Char, c1) => { + Self::unify_char(self, c1, d2); + } + (HeapCellValueTag::Cons, ptr_1) => { + Self::unify_constant(self, ptr_1, d2); + } + _ => { + unreachable!(); + } + ); + } + } + } + + fn bind(&mut self, r: Ref, value: HeapCellValue); +} + +#[inline] +fn bind_with_occurs_check(unifier: &mut U, r: Ref, value: HeapCellValue) -> bool { + if let RefTag::StackCell = r.get_tag() { + // local variable optimization -- r cannot occur in the + // heap structure bound to value, so don't bother + // traversing value. + U::bind(unifier, r, value); + return false; + } + + let mut occurs_triggered = false; + + if !value.is_constant() { + for addr in stackful_preorder_iter(&mut unifier.heap, value) { + let addr = unmark_cell_bits!(addr); + + if let Some(inner_r) = addr.as_var() { + if r == inner_r { + occurs_triggered = true; + break; + } + } + } + } + + if occurs_triggered { + unifier.fail = true; + } else { + U::bind(unifier, r, value); + } + + return occurs_triggered; +} + +#[derive(Deref, DerefMut)] +pub(crate) struct DefaultUnifier<'a> { + machine_st: &'a mut MachineState, +} + +impl<'a> From<&'a mut MachineState> for DefaultUnifier<'a> { + #[inline(always)] + fn from(machine_st: &'a mut MachineState) -> Self { + Self { machine_st } + } +} + +impl<'a> Unifier for DefaultUnifier<'a> { + fn bind(&mut self, r: Ref, value: HeapCellValue) { + self.machine_st.bind(r, value); + } +} + +pub(crate) struct CompositeUnifierForOccursCheck { + unifier: U, +} + +impl Deref for CompositeUnifierForOccursCheck { + type Target = MachineState; + + #[inline(always)] + fn deref(&self) -> &Self::Target { + self.unifier.deref() + } +} + +impl DerefMut for CompositeUnifierForOccursCheck { + #[inline(always)] + fn deref_mut(&mut self) -> &mut Self::Target { + self.unifier.deref_mut() + } +} + +impl From for CompositeUnifierForOccursCheck { + #[inline(always)] + fn from(unifier: U) -> Self { + Self { unifier } + } +} + +impl Unifier for CompositeUnifierForOccursCheck { + fn bind(&mut self, r: Ref, value: HeapCellValue) { + bind_with_occurs_check(&mut self.unifier, r, value); + } +} + +pub(crate) struct CompositeUnifierForOccursCheckWithError { + unifier: U, +} + +impl Deref for CompositeUnifierForOccursCheckWithError { + type Target = MachineState; + + #[inline(always)] + fn deref(&self) -> &Self::Target { + self.unifier.deref() + } +} + +impl DerefMut for CompositeUnifierForOccursCheckWithError { + #[inline(always)] + fn deref_mut(&mut self) -> &mut Self::Target { + self.unifier.deref_mut() + } +} + +impl From for CompositeUnifierForOccursCheckWithError { + #[inline(always)] + fn from(unifier: U) -> Self { + Self { unifier } + } +} + +impl Unifier for CompositeUnifierForOccursCheckWithError { + fn bind(&mut self, r: Ref, value: HeapCellValue) { + if bind_with_occurs_check(&mut self.unifier, r, value) { + let err = self.representation_error(RepFlag::Term); + let stub = functor_stub(atom!("unify_with_occurs_check"), 2); + let err = self.error_form(err, stub); + + self.throw_exception(err); + } + } +} diff --git a/src/types.rs b/src/types.rs index 168f0e84..a8b66b35 100644 --- a/src/types.rs +++ b/src/types.rs @@ -53,7 +53,6 @@ pub enum HeapCellValueView { // trail elements. TrailedHeapVar = 0b011101, TrailedStackVar = 0b011111, - TrailedAttrVarHeapLink = 0b100001, TrailedAttrVarListLink = 0b100011, TrailedAttachedValue = 0b100101, TrailedBlackboardEntry = 0b100111, @@ -182,7 +181,6 @@ impl Ref { #[derive(Debug, Clone, Copy)] pub enum TrailRef { Ref(Ref), - AttrVarHeapLink(usize), AttrVarListLink(usize, usize), BlackboardEntry(Atom), BlackboardOffset(Atom, HeapCellValue), // key atom, key value @@ -194,7 +192,6 @@ pub(crate) enum TrailEntryTag { TrailedHeapVar = 0b011110, TrailedStackVar = 0b011111, TrailedAttrVar = 0b101110, - TrailedAttrVarHeapLink = 0b100010, TrailedAttrVarListLink = 0b100011, TrailedAttachedValue = 0b101010, TrailedBlackboardEntry = 0b100110,