fix bug in DeleteAttribute

diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs
index 05a14576b2cc0891f1b92e95e3dcd8575b15dd73..f1f12d93425c78c67b2565069a318856dbcf17f2 100644 (file)
--- a/src/prolog/instructions.rs
+++ b/src/prolog/instructions.rs
@@ -276,7 +276,7 @@ impl SystemClauseType {
     pub fn name(&self) -> ClauseName {
         match self {
             &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
-            &SystemClauseType::DeleteAttribute => clause_name!("$del_attr"),
+            &SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
             &SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
             &SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"),
             &SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
@@ -317,7 +317,7 @@ impl SystemClauseType {
     pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
         match (name, arity) {
             ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
-            ("$del_attr", 1) => Some(SystemClauseType::DeleteAttribute),
+            ("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute),
             ("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
             ("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution),
             ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),

diff --git a/src/prolog/lib/atts.pl b/src/prolog/lib/atts.pl
index e0ba29b9b04c189585111c04651cf57612c8a519..036b23185ff7304ca70f9b9fe488fa632d4b355d 100644 (file)
--- a/src/prolog/lib/atts.pl
+++ b/src/prolog/lib/atts.pl
@@ -1,6 +1,6 @@
-:- module(atts, [attribute/1, absent_attr/2, get_attr/2, put_attr/2,
-                absent_from_list/2, get_from_list/2, add_to_list/2,
-                del_attr/3, del_attr_step/2, del_attr_non_head/3]).
+:- module(atts, [attribute/1, '$absent_attr'/2, '$get_attr'/2, '$put_attr'/2,
+                '$absent_from_list'/2, '$get_from_list'/2, '$add_to_list'/2,
+                '$del_attr'/3, '$del_attr_step'/2, '$del_attr_buried'/3]).
 
 :- use_module(library(control)).
 :- use_module(library(dcgs)).
@@ -8,57 +8,57 @@
 
 :- op(1199, fx, attribute).
 
-absent_attr(V, Attr) :-
+'$absent_attr'(V, Attr) :-
     '$get_attr_list'(V, Ls),
-    absent_from_list(Ls, Attr).
+    '$absent_from_list'(Ls, Attr).
 
-absent_from_list(X, _) :-
+'$absent_from_list'(X, _) :-
     var(X), !.
-absent_from_list([L|Ls], Attr) :-
-    ( L \= Attr -> absent_from_list(Ls, Attr) ).
+'$absent_from_list'([L|Ls], Attr) :-
+    ( L \= Attr -> '$absent_from_list'(Ls, Attr) ).
 
-get_attr(V, Attr) :-
-    '$get_attr_list'(V, Ls), nonvar(Ls), get_from_list(Ls, Attr).
+'$get_attr'(V, Attr) :-
+    '$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, Attr).
 
-get_from_list([L|Ls], Attr) :-
+'$get_from_list'([L|Ls], Attr) :-
     nonvar(L),
-    ( L \= Attr -> nonvar(Ls), get_from_list(Ls, Attr)
+    ( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, Attr)
     ; copy_term(L, L0), L0 = Attr
-    ; get_from_list(Ls, Attr)
+    ; '$get_from_list'(Ls, Attr)
     ).
 
-put_attr(V, Attr) :-
-    '$get_attr_list'(V, Ls), add_to_list(Ls, Attr).
+'$put_attr'(V, Attr) :-
+    '$get_attr_list'(V, Ls), '$add_to_list'(Ls, Attr).
 
-add_to_list(Ls, Attr) :-
+'$add_to_list'(Ls, Attr) :-
     ( var(Ls) -> Ls = [Attr | _]
-    ; Ls = [_ | Ls0] -> add_to_list(Ls0, Attr)
+    ; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, Attr)
     ).
 
-del_attr(Ls0, _, _) :-
+'$del_attr'(Ls0, _, _) :-
     var(Ls0), !.
-del_attr(Ls0, V, Attr) :-
+'$del_attr'(Ls0, V, Attr) :-
     Ls0 = [Att | Ls1],
     nonvar(Att),
-    ( Att \= Attr -> del_attr_non_head(Ls0, Ls1, Attr)
-    ; '$del_attr_head'(V), del_attr(Ls1, V, Attr)
+    ( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, Attr)
+    ; '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
     ).
 
-del_attr_step(Ls1, Attr) :-
-    ( nonvar(Ls1) -> Ls1 = [_ | Ls2], del_attr_non_head(Ls1, Ls2, Attr)
+'$del_attr_step'(Ls1, Attr) :-
+    ( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, Attr)
     ; true ).
 
 %% assumptions: Ls0 is a list, Ls1 is its tail;
 %%              the head of Ls0 can be ignored.
-del_attr_non_head(Ls0, Ls1, Attr) :-
+'$del_attr_buried'(Ls0, Ls1, Attr) :-
     Ls0 = [_, Att | _],
     nonvar(Att),
     !,
-    ( Att \= Attr -> del_attr_step(Ls1, Attr)
-    ; '$del_attr'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
-      del_attr_step(Ls1, Attr)
+    ( Att \= Attr -> '$del_attr_step'(Ls1, Attr)
+    ; '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
+      '$del_attr_step'(Ls1, Attr)
     ).
-del_attr_non_head(_, _, _).
+'$del_attr_buried'(_, _, _).
 
 user:term_expansion(Term0, Terms) :-
     nonvar(Term0),
@@ -99,17 +99,17 @@ put_attr(Name, Arity) -->
     { functor(Attr, Name, Arity),
       numbervars(Attr, 0, Arity),
       V = '$VAR'(Arity) },
-    [(put_atts(V, +Attr) :- !, functor(Attr, _, _), put_attr(V, Attr)),
-     (put_atts(V,  Attr) :- !, functor(Attr, _, _), put_attr(V, Attr)),
-     (put_atts(V, -Attr) :- !, functor(Attr, _, _), '$get_attr_list'(V, Ls), del_attr(Ls, V, Attr))].
+    [(put_atts(V, +Attr) :- !, functor(Attr, _, _), '$put_attr'(V, Attr)),
+     (put_atts(V,  Attr) :- !, functor(Attr, _, _), '$put_attr'(V, Attr)),
+     (put_atts(V, -Attr) :- !, functor(Attr, _, _), '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, Attr))].
 
 get_attr(Name, Arity) -->
     { functor(Attr, Name, Arity),
       numbervars(Attr, 0, Arity),
       V = '$VAR'(Arity) },
-    [(get_atts(V, +Attr) :- !, functor(Attr, _, _), get_attr(V, Attr)),
-     (get_atts(V,  Attr) :- !, functor(Attr, _, _), get_attr(V, Attr)),
-     (get_atts(V, -Attr) :- !, functor(Attr, _, _), absent_attr(V, Attr))].
+    [(get_atts(V, +Attr) :- !, functor(Attr, _, _), '$get_attr'(V, Attr)),
+     (get_atts(V,  Attr) :- !, functor(Attr, _, _), '$get_attr'(V, Attr)),
+     (get_atts(V, -Attr) :- !, functor(Attr, _, _), '$absent_attr'(V, Attr))].
 
 user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
     nonvar(Term),

diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs
index c4ada3f182ce910c0798abf9543d90b533358ef7..3e31e48e94249a690f0b7e36e4296426d614db8f 100644 (file)
--- a/src/prolog/machine/mod.rs
+++ b/src/prolog/machine/mod.rs
@@ -314,6 +314,7 @@ static QUEUES: &str  = include_str!("../lib/queues.pl");
 static ERROR: &str   = include_str!("../lib/error.pl");
 static TERMS: &str   = include_str!("../lib/terms.pl");
 static DCGS: &str    = include_str!("../lib/dcgs.pl");
+static ATTS: &str    = include_str!("../lib/atts.pl");
 
 impl Machine {
     pub fn new() -> Self {
@@ -335,6 +336,7 @@ impl Machine {
         compile_user_module(&mut wam, ERROR.as_bytes());
        compile_user_module(&mut wam, TERMS.as_bytes());
         compile_user_module(&mut wam, DCGS.as_bytes());
+        compile_user_module(&mut wam, ATTS.as_bytes());
 
         wam
     }

diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs
index 46dede2932d9dc66d4605cf33e44c108033df3ff..b7e5d15e53d5995794f7d423427c78816281d3c4 100644 (file)
--- a/src/prolog/machine/system_calls.rs
+++ b/src/prolog/machine/system_calls.rs
@@ -210,7 +210,7 @@ impl MachineState {
                     if let Addr::Lis(l2) = self.store(self.deref(Addr::HeapCell(l1 + 1))) {
                         let addr = self.heap[l1 + 1].as_addr(l1 + 1);                        
                         self.heap[l1 + 1] = HeapCellValue::Addr(Addr::HeapCell(l2 + 1));
-                        self.trail(TrailRef::AttrVarLink(l2 + 1, addr));
+                        self.trail(TrailRef::AttrVarLink(l1 + 1, addr));
                     }
                 }                
             },

diff --git a/src/tests.rs b/src/tests.rs
index df2904a3f8079e8337bf94c6eb2f3329d2fb6c17..89c8f1b8b33f8bd076a613be3f0b892c0519ce3b 100644 (file)
--- a/src/tests.rs
+++ b/src/tests.rs
@@ -2133,3 +2133,54 @@ fn test_queries_on_string_lists()
     assert_prolog_success!(&mut wam, "?- partial_string(\"abc\", X), partial_string(\"abcdef\", X), X = \"abcdef\".",
                            [["X = [a, b, c, d, e, f]"]]);
 }
+
+#[test]
+fn test_queries_on_attributed_variables()
+{
+    let mut wam = Machine::new();
+
+    submit(&mut wam, "
+:- module(my_mod, []).
+:- use_module(library(atts)).
+
+:- attribute dif/1, frozen/1.");
+
+    assert_prolog_success!(&mut wam, "?- ( put_atts(V, my_mod, dif(1)) ; put_atts(V, my_mod, dif(2)) ),
+                                         get_atts(V, my_mod, L).",
+                           [["L = [dif(1) | _17]", "V = _12"],
+                            ["L = [dif(2) | _17]", "V = _12"]]);
+
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, frozen(a)),
+                                      ( put_atts(V, my_mod, dif(1))
+                                      ; put_atts(V, my_mod, -frozen(a)), put_atts(V, my_mod, dif(2))
+                                      ; put_atts(V, my_mod, dif(different)) ),
+                                      get_atts(V, my_mod, Ls).",
+                           [["Ls = [frozen(a), dif(1) | _37]", "V = _12"],
+                            ["Ls = [dif(2) | _51]", "V = _12"],
+                            ["Ls = [frozen(a), dif(different) | _37]", "V = _12"]]);
+
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a)]),
+                                      ( put_atts(V, my_mod, -dif(2)) ; put_atts(V, my_mod, -frozen(A)) ),
+                                        get_atts(V, my_mod, L).",
+                           [["A = _70", "L = [dif(1), frozen(a) | _68]", "V = _27"],
+                            ["A = _70", "L = [dif(1), dif(2) | _68]", "V = _27"]]);
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]),
+                                      ( put_atts(V, my_mod, -dif(2)) ; put_atts(V, my_mod, -frozen(A)) ),
+                                        get_atts(V, my_mod, L).",
+                           [["A = _98", "L = [dif(1), frozen(a), frozen(b) | _96]", "V = _31"],
+                            ["A = _98", "L = [dif(1), dif(2) | _96]", "V = _31"]]);
+    assert_prolog_failure!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]),
+                                         get_atts(V, my_mod, -dif(1)).");
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]),
+                                         get_atts(V, my_mod, -dif(3)).");
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]),
+                                         get_atts(V, my_mod, dif(X)).",
+                           [["X = 1", "V = _31"],
+                            ["X = 2", "V = _31"]]);
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]),
+                                         put_atts(V, my_mod, -dif(A)), get_atts(V, my_mod, Ls).",
+                           [["A = _99", "Ls = [frozen(a), frozen(b) | _96]", "V = _31"]]);
+    assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), frozen(a), dif(2), frozen(b)]),
+                                         put_atts(V, my_mod, -dif(A)), get_atts(V, my_mod, Ls).",
+                           [["A = _99", "Ls = [frozen(a), frozen(b) | _96]", "V = _31"]]);
+}