From 3f445c76be882e12ccf56b616f23ba385f22b60d Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 18 Feb 2023 02:15:24 -0700 Subject: [PATCH] add '$delete_all_attributes', use copy_term/3 as defined in #1272 --- build/instructions_template.rs | 4 +++ src/lib/freeze.pl | 2 +- src/loader.pl | 8 +++-- src/machine/dispatch.rs | 8 +++++ src/machine/project_attributes.pl | 56 +++++++++++++++++++------------ src/machine/system_calls.rs | 21 ++++++++++++ 6 files changed, 74 insertions(+), 25 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 98295308..6e21c165 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -566,6 +566,8 @@ enum SystemClauseType { PutToAttributedVarList, #[strum_discriminants(strum(props(Arity = "3", Name = "$del_from_attr_list")))] DeleteFromAttributedVarList, + #[strum_discriminants(strum(props(Arity = "1", Name = "$delete_all_attributes")))] + DeleteAllAttributes, REPL(REPLCodePtr), } @@ -1627,6 +1629,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallGetFromAttributedVarList(_) | &Instruction::CallPutToAttributedVarList(_) | &Instruction::CallDeleteFromAttributedVarList(_) | + &Instruction::CallDeleteAllAttributes(_) | &Instruction::CallFetchGlobalVar(_) | &Instruction::CallFirstStream(_) | &Instruction::CallFlushOutput(_) | @@ -1842,6 +1845,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteGetFromAttributedVarList(_) | &Instruction::ExecutePutToAttributedVarList(_) | &Instruction::ExecuteDeleteFromAttributedVarList(_) | + &Instruction::ExecuteDeleteAllAttributes(_) | &Instruction::ExecuteFetchGlobalVar(_) | &Instruction::ExecuteFirstStream(_) | &Instruction::ExecuteFlushOutput(_) | 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 1faba9e3..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]. diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 1cb1a8fa..e15e8048 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -5207,6 +5207,14 @@ impl Machine { self.delete_from_attributed_variable_list(); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallDeleteAllAttributes(_) => { + self.delete_all_attributes(); + self.machine_st.p += 1; + } + &Instruction::ExecuteDeleteAllAttributes(_) => { + self.delete_all_attributes(); + self.machine_st.p = self.machine_st.cp; + } } } diff --git a/src/machine/project_attributes.pl b/src/machine/project_attributes.pl index 66d6adb5..968859cd 100644 --- a/src/machine/project_attributes.pl +++ b/src/machine/project_attributes.pl @@ -1,7 +1,11 @@ :- module('$project_atts', [copy_term/3]). +:- use_module(library(dcgs)). +:- use_module(library(lambda)). +:- use_module(library(lists), [foldl/4]). + 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,9 +21,9 @@ 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 ), @@ -72,25 +76,33 @@ 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([]) --> []. +gather_residual_goals([V|Vs]) --> + { '$get_attr_list'(V, Attrs), + phrase(copy_attribute_modules(Attrs), Modules0), + sort(Modules0, Modules) }, + foldl(V+\M^phrase(M:attribute_goals(V)), Modules), + gather_residual_goals(Vs). +delete_all_attributes(Term) :- '$delete_all_attributes'(Term). -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]). +copy_term(Term, Copy, Gs) :- + '$term_attributed_variables'(Term, Vs), + findall(Term-Gs, + ( phrase(gather_residual_goals(Vs), Gs), + delete_all_attributes(Term) + ), + [Copy-Gs]). diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 0854a9f8..402bcac7 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -1036,6 +1036,27 @@ impl MachineState { } impl Machine { + #[inline(always)] + pub(crate) fn delete_all_attributes(&mut self) { + let h = self.machine_st.heap.len(); + + self.machine_st.heap.push(heap_loc_as_cell!(h)); + self.machine_st.registers[2] = heap_loc_as_cell!(h); + + self.term_attributed_variables(); + + let mut list_of_attr_vars = self.deref_register(2); + + while let HeapCellValueTag::Lis = list_of_attr_vars.get_tag() { + let attr_var_loc = list_of_attr_vars.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))); + + list_of_attr_vars = self.machine_st.heap[attr_var_loc + 1]; + } + } + #[inline(always)] pub(crate) fn get_clause_p(&self, module_name: Atom) -> (usize, usize) { use crate::machine::loader::CompilationTarget; -- 2.54.0