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

add call_residue_vars/2

Browse Source
This commit is contained in:
Mark Thom
2019-02-18 21:13:56 -07:00
parent a460e84c57
commit 2467f6c711
9 changed files with 122 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,7 +1,8 @@
:- module(atts, [attribute/1, '$absent_attr'/2, '$copy_attr_list'/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]).
:- module(atts, [attribute/1, call_residue_vars/2, '$absent_attr'/2,
'$copy_attr_list'/2, '$get_attr'/2, '$put_attr'/2,
'$absent_from_list'/2, '$get_from_list'/3,
'$add_to_list'/3, '$del_attr'/3, '$del_attr_step'/3,
'$del_attr_buried'/4]).
:- use_module(library(control)).
:- use_module(library(dcgs)).
@@ -19,21 +20,21 @@
( 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_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
'$get_from_list'([L|Ls], Attr) :-
'$get_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, Attr)
; L = Attr
; '$get_from_list'(Ls, Attr)
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr, '$enqueue_attr_var'(V)
; '$get_from_list'(Ls, 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, V, Attr).
'$add_to_list'(Ls, Attr) :-
( var(Ls) -> Ls = [Attr | _]
; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, Attr)
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V)
; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
@@ -41,25 +42,26 @@
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, Attr)
; '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, Attr) :-
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, Attr)
'$del_attr_step'(Ls1, V, Attr) :-
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
; true ).
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, Attr) :-
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
Ls0 = [_, Att | _],
nonvar(Att),
!,
( 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)
( Att \= Attr -> '$del_attr_step'(Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
'$del_attr_step'(Ls1, V, Attr)
).
'$del_attr_buried'(_, _, _).
'$del_attr_buried'(_, _, _, _).
'$copy_attr_list'(L, []) :- var(L), !.
'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
@@ -123,3 +125,8 @@ user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
user:goal_expansion(Term, M:get_atts(Var, Attr)) :-
nonvar(Term),
Term = get_atts(Var, M, Attr).
call_residue_vars(Goal, Vars) :-
'$get_attr_var_queue_delim'(B),
call(Goal),
'$get_attr_var_queue_beyond'(B, Vars).