From: Mark Thom Date: Sun, 3 Feb 2019 02:25:12 +0000 (-0700) Subject: fix bug in DeleteAttribute X-Git-Tag: v0.8.110~279 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=f51405bc047d1833fbb160bf1408bc51ea08d893;p=scryer-prolog.git fix bug in DeleteAttribute --- diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index 05a14576..f1f12d93 100644 --- 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 { 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 e0ba29b9..036b2318 100644 --- 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 c4ada3f1..3e31e48e 100644 --- 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 46dede29..b7e5d15e 100644 --- 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 df2904a3..89c8f1b8 100644 --- 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"]]); +}