rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix bug in DeleteAttribute

Browse Source
This commit is contained in:
Mark Thom
2019-02-02 19:25:12 -07:00
parent a28c8934f3
commit f51405bc04
5 changed files with 90 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/prolog/instructions.rs
View File

@@ -276,7 +276,7 @@ impl SystemClauseType {
pub fn name(&self) -> ClauseName { pub fn name(&self) -> ClauseName {
match self { match self {
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), &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::DeleteHeadAttribute => clause_name!("$del_attr_head"),
&SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"), &SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"),
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"), &SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
@@ -317,7 +317,7 @@ impl SystemClauseType {
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> { pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
match (name, arity) { match (name, arity) {
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$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), ("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution), ("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution),
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm), ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),

68
src/prolog/lib/atts.pl
View File

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

2
src/prolog/machine/mod.rs
View File

@@ -314,6 +314,7 @@ static QUEUES: &str = include_str!("../lib/queues.pl");
static ERROR: &str = include_str!("../lib/error.pl"); static ERROR: &str = include_str!("../lib/error.pl");
static TERMS: &str = include_str!("../lib/terms.pl"); static TERMS: &str = include_str!("../lib/terms.pl");
static DCGS: &str = include_str!("../lib/dcgs.pl"); static DCGS: &str = include_str!("../lib/dcgs.pl");
static ATTS: &str = include_str!("../lib/atts.pl");
impl Machine { impl Machine {
pub fn new() -> Self { pub fn new() -> Self {
@@ -335,6 +336,7 @@ impl Machine {
compile_user_module(&mut wam, ERROR.as_bytes()); compile_user_module(&mut wam, ERROR.as_bytes());
compile_user_module(&mut wam, TERMS.as_bytes()); compile_user_module(&mut wam, TERMS.as_bytes());
compile_user_module(&mut wam, DCGS.as_bytes()); compile_user_module(&mut wam, DCGS.as_bytes());
compile_user_module(&mut wam, ATTS.as_bytes());
wam wam
} }

2
src/prolog/machine/system_calls.rs
View File

@@ -210,7 +210,7 @@ impl MachineState {
if let Addr::Lis(l2) = self.store(self.deref(Addr::HeapCell(l1 + 1))) { if let Addr::Lis(l2) = self.store(self.deref(Addr::HeapCell(l1 + 1))) {
let addr = self.heap[l1 + 1].as_addr(l1 + 1); let addr = self.heap[l1 + 1].as_addr(l1 + 1);
self.heap[l1 + 1] = HeapCellValue::Addr(Addr::HeapCell(l2 + 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));
} }
} }
}, },

51
src/tests.rs
View File

@@ -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\".", assert_prolog_success!(&mut wam, "?- partial_string(\"abc\", X), partial_string(\"abcdef\", X), X = \"abcdef\".",
[["X = [a, b, c, d, e, f]"]]); [["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"]]);
}