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

preliminary cont work

Browse Source
This commit is contained in:
Mark Thom
2019-12-19 20:02:10 -04:00
parent 3d2c4f0801 5ccd334555
commit 837ae4cb17
15 changed files with 359 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -28,26 +28,26 @@
'$get_attr_list'(V, Ls),
'$absent_from_list'(Ls, Attr).
'$absent_from_list'(X, _) :-
var(X), !.
'$absent_from_list'([L|Ls], Attr) :-
( L \= Attr -> '$absent_from_list'(Ls, Attr) ).
'$absent_from_list'(X, Attr) :-
( var(X) -> true
; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr)
).
'$get_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
'$get_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr -> '$enqueue_attr_var'(V)
; '$get_from_list'(Ls, V, Attr)
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr, '$enqueue_attr_var'(V)
).
'$put_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr).
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V)
( var(Ls) ->
Ls = [Attr | _], '$enqueue_attr_var'(V)
; Ls = [_ | Ls0], '$add_to_list'(Ls0, V, Attr)
).
@@ -57,7 +57,8 @@
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, V, Attr) :-
@@ -67,15 +68,14 @@
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
Ls0 = [_, Att | _],
nonvar(Att),
!,
( 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)
( var(Ls1) -> true
; Ls1 = [Att | Ls2] ->
( Att \= Attr -> '$del_attr_buried'(Ls1, Ls2, 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'(_, _, _, _).
'$copy_attr_list'(L, []) :- var(L), !.
'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
@@ -124,11 +124,19 @@ put_attr(Name, Arity) -->
{ functor(Attr, Name, Arity),
numbervars(Attr, 0, Arity),
V = '$VAR'(Arity) },
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$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, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
'$del_attr'(Ls, V, AttrForm),
'$put_attr'(V, Attr)),
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
'$del_attr'(Ls, V, AttrForm),
'$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),
@@ -149,3 +157,4 @@ call_residue_vars(Goal, Vars) :-
'$get_attr_var_queue_delim'(B),
call(Goal),
'$get_attr_var_queue_beyond'(B, Vars).

29
src/prolog/lib/cont.pl Normal file
View File

@@ -0,0 +1,29 @@
:- module(cont, [reset/3, shift/1]).
reset(Goal, Cont, Term) :-
call(Goal),
'$reset_cont_marker',
'$bind_from_register'(Cont, 3),
'$bind_from_register'(Term, 4).
shift(Term) :-
'$nextEP'(first, E, P),
get_chunks(E, P, L),
Cont = cont(call_continuation(L)),
'$write_cont_and_term'(_, _, Cont, Term),
'$unwind_environments'.
get_chunks(E, P, L) :-
( '$points_to_cont_reset_marker'(P) ->
L = []
; '$get_chunk'(E,P,TB),
L = [TB|Rest],
'$nextEP'(E, NextE, NextP),
get_chunks(NextE, NextP, Rest)
).
call_continuation(L) :- '$call_continuation'(L).
'$write_cont_and_term'(_, _, _, _).

16
src/prolog/lib/freeze.pl
View File

@@ -21,16 +21,8 @@ freeze(X, Goal) :-
put_atts(Fresh, frozen(Goal)),
Fresh = X.
gather_freeze_goals(Attrs, _) -->
{ var(Attrs) },
!.
gather_freeze_goals([frozen(X) | _], Var) -->
[freeze(Var, X)],
{ put_atts(Var, -frozen(_)) },
!.
gather_freeze_goals([_ | Attrs], Var) -->
gather_freeze_goals(Attrs, Var).
attribute_goals(Var) -->
{ get_atts(Var, frozen(Goals)),
put_atts(Var, -frozen(_)) },
[freeze(Var, Goals)].
attribute_goals(X) -->
{ '$get_attr_list'(X, Attrs) },
gather_freeze_goals(Attrs, X).

46
src/prolog/lib/lists.pl
View File

@@ -1,7 +1,11 @@
:- module(lists, [member/2, select/3, append/3, memberchk/2,
reverse/2, length/2, maplist/2, maplist/3,
maplist/4, maplist/5, maplist/6, maplist/7,
maplist/8, maplist/9]).
:- module(lists, [member/2, select/3, append/3, foldl/4, foldl/5,
memberchk/2, reverse/2, length/2, maplist/2,
maplist/3, maplist/4, maplist/5, maplist/6,
maplist/7, maplist/8, maplist/9, same_length/2,
sumlist/2]).
:- use_module(library(error)).
length(Xs, N) :-
@@ -96,3 +100,37 @@ maplist(_, [], [], [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s], [E8|E8s]) :-
call(Cont, E1, E2, E3, E4, E5, E6, E7),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s).
sumlist_([], S, S).
sumlist_([N|Ns], S, S0) :-
S1 is S0 + N,
sumlist_(Ns, S, S1).
sumlist(Ns, S) :-
must_be(list, Ns),
sumlist_(Ns, S, 0).
same_length([], []).
same_length([_|As], [_|Bs]) :-
same_length(As, Bs).
foldl(Goal_3, Ls, A0, A) :-
foldl_(Ls, Goal_3, A0, A).
foldl_([], _, A, A).
foldl_([L|Ls], G_3, A0, A) :-
call(G_3, L, A0, A1),
foldl_(Ls, G_3, A1, A).
foldl(Goal_4, Xs, Ys, A0, A) :-
foldl_(Xs, Ys, Goal_4, A0, A).
foldl_([], [], _, A, A).
foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
call(G_4, X, Y, A0, A1),
foldl_(Xs, Ys, G_4, A1, A).