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

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,
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),