add '$delete_all_attributes', use copy_term/3 as defined in #1272

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index 982953088f22c22d615d2fa8964b4405cce4c95f..6e21c1659d3c9a713ab7004cef33897a573cc9d0 100644 (file)
--- 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 c6554fa4c7e714baf8bc35378786f979d10c6784..218a2532ecebe7e14fbdb9910446142f5c7fae05 100644 (file)
--- 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 1faba9e3edb2e6bcf581d4c2941cd7c857f1c503..896d6bff5a97115116ffefacf0f6aa5564788900 100644 (file)
--- 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 1cb1a8fa9a6d9d015636177a47c92158222c6f9b..e15e804810d352e0fbdc7244a718e13a6f3fb51b 100644 (file)
--- 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 66d6adb5f32ed3b6559fc637117e0b18ed2aae74..968859cda8fdf070166f8206ccec4420d1598e34 100644 (file)
--- 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 0854a9f87b0d31f34702d8db03edcc46b35f66c9..402bcac73511b93e653e28df8d2cc7c0c3bee27a 100644 (file)
--- 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;