conjunction work

parent 98b9d274
...@@ -122,7 +122,8 @@ caller(cc,Args,label(G,N),V,[L,LL]) :- !, ...@@ -122,7 +122,8 @@ caller(cc,Args,label(G,N),V,[L,LL]) :- !,
get_S(V,S), get_S(V,S),
set_S(V,0), set_S(V,0),
push_v(2,V), push_v(2,V),
L2=[[push-3]|L4], get_P(V,P0).
L2=[[push-3,P0,_]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_), push_args_args(#f,Args,V,L4,LL2,_,_),
LL2 = [['goto-inst',G]|LL]. LL2 = [['goto-inst',G]|LL].
......
...@@ -21,6 +21,7 @@ collect_conj((X,Y),L,LL) :- !, ...@@ -21,6 +21,7 @@ collect_conj((X,Y),L,LL) :- !,
collect_conj(Y,L1,LL). collect_conj(Y,L1,LL).
collect_conj(X,[X|LL],LL). collect_conj(X,[X|LL],LL).
-trace.
-extended. -extended.
compile_conj0([],Tail,V,L) :- throw(#t). compile_conj0([],Tail,V,L) :- throw(#t).
...@@ -31,18 +32,25 @@ compile_conj0([X|Gs],Tail,V,L) :- var(X),!, ...@@ -31,18 +32,25 @@ compile_conj0([X|Gs],Tail,V,L) :- var(X),!,
compile_conj0([call(X)|Gs],Tail,V,L). compile_conj0([call(X)|Gs],Tail,V,L).
compile_conj0([!|Gs],Tail,V,[L,LL]) :- !, compile_conj0([!|Gs],Tail,V,[L,LL]) :- !,
get_C(V,[[_,#t]|_]), get_C(V,C),
(C=[[[P0,TagC2],_]|_];(get_P(V,P0),TagC2=false)),!,
write(aa(C)),nl,
set_P(V,P0),
C=[[_,#t]|_],
ifc(compile_conj0(Gs,Tail,V,[L1,LL]),E, ifc(compile_conj0(Gs,Tail,V,[L1,LL]),E,
( (
tfc(E), tfc(E),
( (
E==#t -> E==#t ->
(Tail==#t -> L=[[cut],[cc]|LL] ; L=[[cut]|LL]); (
Cut=[cut,P0,TagC2],
(Tail==#t -> L=[Cut,[cc,TagC2]|LL] ; L=[Cut|LL])
);
throw(c) throw(c)
) )
), ),
( (
L=[[cut]|L1] L=[[cut,P0,TagC2]|L1]
)). )).
compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !, compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !,
...@@ -55,8 +63,11 @@ compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !, ...@@ -55,8 +63,11 @@ compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !,
( (
push_Q(3,V,Q), push_Q(3,V,Q),
( (
Tail==#t -> Tail==#t ->
L=[[softie,A],[cc]|LL] ; (
get_P(V,P0),
L=[[softie,A],[cc,P0]|LL]
);
L=[[softie,A]|LL] L=[[softie,A]|LL]
) )
); );
...@@ -71,7 +82,8 @@ compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !, ...@@ -71,7 +82,8 @@ compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !,
)). )).
compile_conj0([(fail;false)|Gs],Tail,V,[L,LL]) :- !, compile_conj0([(fail;false)|Gs],Tail,V,[L,LL]) :- !,
L=[[fail]|LL]. get_P(V,P0),
L=[[fail,P0]|LL].
compile_conj0([G|Gs],Tail,V,L) :- !, compile_conj0([G|Gs],Tail,V,L) :- !,
link_l(L,L1,L2), link_l(L,L1,L2),
...@@ -81,7 +93,7 @@ compile_conj0([G|Gs],Tail,V,L) :- !, ...@@ -81,7 +93,7 @@ compile_conj0([G|Gs],Tail,V,L) :- !,
( (
E==#t -> E==#t ->
compile_conj0(Gs,Tail,V,L) ; compile_conj0(Gs,Tail,V,L) ;
throw(E) throw(E)
) )
), ),
( (
...@@ -90,11 +102,25 @@ compile_conj0([G|Gs],Tail,V,L) :- !, ...@@ -90,11 +102,25 @@ compile_conj0([G|Gs],Tail,V,L) :- !,
tfc(E2), tfc(E2),
( (
E2==#t -> E2==#t ->
(Tail==#t -> L2=[[[cc]|U],U] ; L2=[U,U]); (
Tail==#t ->
(
get_P(V,P0),
L2=[[[cc,P0]|U],U]
);
L2=[U,U]
);
E2==c -> E2==c ->
L2=[[[cut],[fail]|U],U] ; (
get_C(V,[[[P0,TagC2],_]|_]),
set_P(V,P0),
L2=[[[cut,P0,TagC2],[fail,TagC2]|U],U]
);
E2=softie(A) -> E2=softie(A) ->
L2=[[[softie,A],[fail]|U],U] ; (
get_P(V,P0),
L2=[[[softie,A],[fail,P0]|U],U]
);
throw(E2) throw(E2)
) )
)) ))
......
...@@ -86,7 +86,7 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,B2,LLX,P0,PP0,Q,QQ) ...@@ -86,7 +86,7 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,B2,LLX,P0,PP0,Q,QQ)
( (
(nonvar(X),X=(G1->G2)) -> (nonvar(X),X=(G1->G2)) ->
(W=#t,XX=(call(G1),softie(A),collect_F(FF),G2)) ; (W=#t,XX=(call(G1),softie(A),collect_F(FF),G2)) ;
(W=#f,,XX=(X,newtag_F(FF),set_p(Q))) (W=#f,XX=(X,newtag_F(FF),set_p(Q)))
), ),
set_P(V,ground(Lab)), set_P(V,ground(Lab)),
push_Q(3,V,Q), push_Q(3,V,Q),
...@@ -123,9 +123,15 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,B2,LLX,P0,PP0,Q,QQ) ...@@ -123,9 +123,15 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,B2,LLX,P0,PP0,Q,QQ)
%pop_Q(1,V,_), %pop_Q(1,V,_),
head_at_true(Qit,First,#f,A,C,Lab,Lab2,L,LX), head_at_true(Qit,First,#f,A,C,Lab,Lab2,L,LX),
UU=[[0,_]], UU=[[0,_]],
Err==c -> get_C(V,[[[P0,TagC2],_]|_]),
LLX=[[cut],[fail]|LL]; (
LLX=LL Err==c ->
(
set_P(V,P0),
LLX=[[cut,P0,TagC2],[fail,TagC2]|LL]
);
LLX=LL
)
) )
) )
), ),
......
...@@ -32,14 +32,26 @@ zero(V) :- get_A(V,A),A=[[0|_]]. ...@@ -32,14 +32,26 @@ zero(V) :- get_A(V,A),A=[[0|_]].
print([]). print([]).
print([X|L]) :- write(X),nl,print(L). print([X|L]) :- write(X),nl,print(L).
wrap(Code,[L,LL]) :- wrap(Code,V,[L,LL]) :-
catch(Code,E, catch(Code,E,
( (
tfc(E), tfc(E),
( (
E==#t -> L=[[[cc]|LL],LL]; E==#t ->
E==c -> L=[[[cut],[fail]|LL],LL]; (
L=[[[fail]|LL],LL] get_P(P0),
L=[[[cc,P0]|LL],LL]
);
E==c ->
(
get_C(V,[[[P0,TagC2],_]|_]),
set_P(V,P0),
L=[[[cut,P0,TagC2],[fail,TagC2]|LL],LL]
);
(
get_P(V,P0),
L=[[[fail,P0]|LL],LL]
)
) )
)). )).
...@@ -60,7 +72,7 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !, ...@@ -60,7 +72,7 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
(var(Constants) -> init_const ; true), (var(Constants) -> init_const ; true),
b_setval(pretty,#t), b_setval(pretty,#t),
make_state(0,[[0,_,_]],[],[[0,_]],0,0,0,0,0,[HC,HV],[],V), make_state(0,[[0,_,_]],[],[[0,_]],0,0,0,0,0,[HC,HV],[],V),
wrap(compile_goal(Code,#t,V,[L,[]]),[L,[]]),!, wrap(compile_goal(Code,#t,V,[L,[]]),V,[L,[]]),!,
print(L),nl,!, print(L),nl,!,
get_M(V,StackSize), get_M(V,StackSize),
handle_all(L,LL), handle_all(L,LL),
...@@ -80,9 +92,11 @@ compile_goal(set_p(Q),Tail,V,[L,LL]) :- !, ...@@ -80,9 +92,11 @@ compile_goal(set_p(Q),Tail,V,[L,LL]) :- !,
L=[[set_p,Q,P]|LL]. L=[[set_p,Q,P]|LL].
compile_goal(!,Tail,V,[L,LL]) :- !, compile_goal(!,Tail,V,[L,LL]) :- !,
check_tail(Tail), check_tail(Tail),
(Tail==#t -> L=[[cut],[cc]|LL] ; L=[[cut]|LL]). get_C(V,[[[P0,TagC2],_]|_]),
set_P(V,P0),
(Tail==#t -> L=[[cut,P0,TagC2],[cc,TagC2]|LL] ; L=[[cut,P0,TagC2]|LL])
.
compile_goal(softie(A),Tail,V,[L,LLL]) :- !, compile_goal(softie(A),Tail,V,[L,LLL]) :- !,
check_tail(Tail), check_tail(Tail),
tail(Tail,V,LL,LLL), tail(Tail,V,LL,LLL),
...@@ -169,12 +183,12 @@ compile_goal((F(|ASrgs) :- Goal),Tail,V,L) :- !, ...@@ -169,12 +183,12 @@ compile_goal((F(|ASrgs) :- Goal),Tail,V,L) :- !,
push_v(N,V), push_v(N,V),
get_A(V,[[0|_]|_]) -> get_A(V,[[0|_]|_]) ->
wrap(compile_goal((move_args(0,N),begin_att,Impr,end_att,Goal), wrap(compile_goal((move_args(0,N),begin_att,Impr,end_att,Goal),
Tail,V,L),L); Tail,V,L),V,L);
wrap(compile_goal((move_args(0,N),begin_att,Impr,Goal),Tail,V,L),L). wrap(compile_goal((move_args(0,N),begin_att,Impr,Goal),Tail,V,L),V,L).
compile_goal((F :- Goal),Tail,V,L) :- !, compile_goal((F :- Goal),Tail,V,L) :- !,
push_v(4,V), push_v(4,V),
wrap(compile_goal((pop(4),Goal),Tail,V,L),L). wrap(compile_goal((pop(4),Goal),Tail,V,L),V,L).
compile_goal(newtag_F(F),Tail,V,[L,LL]) :- !, compile_goal(newtag_F(F),Tail,V,[L,LL]) :- !,
check_tail(Tail), check_tail(Tail),
...@@ -332,7 +346,7 @@ compile_goal(call_(X,A0,Al,C0,Pre,Post,LP),Tail,V,[L,LL]) :- !, ...@@ -332,7 +346,7 @@ compile_goal(call_(X,A0,Al,C0,Pre,Post,LP),Tail,V,[L,LL]) :- !,
set_AA(V,A), set_AA(V,A),
LLX = Post, LLX = Post,
set_C(V,C), set_C(V,C),
(Tail=#t -> LP=[[cc]|LL] ; LP=LL). LP=LL.
compile_goal((X =.. Y),Tail,V, L, LL) :- !, compile_goal((X =.. Y),Tail,V, L, LL) :- !,
(var_p(X);constant(X)) -> (var_p(X);constant(X)) ->
...@@ -368,7 +382,7 @@ compile_goal(once(G),Tail,V,[L,LL]) :- !, ...@@ -368,7 +382,7 @@ compile_goal(once(G),Tail,V,[L,LL]) :- !,
new_var(VP,V,TagP2), new_var(VP,V,TagP2),
new_var(VS,V,TagS2), new_var(VS,V,TagS2),
get_C(V,C), get_C(V,C),
Al=[A0,Cut_p], Al=[A0,Cut_p],
( (
A==#t -> A==#t ->
( (
...@@ -410,45 +424,42 @@ compile_goal(\\+\\+\\+X,Tail,V,[L,LL]) :- !, ...@@ -410,45 +424,42 @@ compile_goal(\\+\\+\\+X,Tail,V,[L,LL]) :- !,
compile_goal(\\+X,Tail,V,[L,LL]). compile_goal(\\+X,Tail,V,[L,LL]).
compile_goal(\\+\\+X,Tail,V,[L,LLL]) :- !, compile_goal(\\+\\+X,Tail,V,[L,LLL]) :- !,
get_P(V,P0),
(P0=ground(_) -> PP=1 ; PP=0),
A0 = [P0,TagC2],
tail(Tail,V,LL,LLL), tail(Tail,V,LL,LLL),
L=LX, L=LX,
get_QAESBB2(V,Q,AA,E,S,B,B2), get_QAESBB2(V,Q,AA,E,S,B,B2),
set_QAE(V,[],[[0|_]],0), set_QAE(V,[],[[0|_]],0),
var_p(VP), var_p(VP),
var_p(VS), var_p(VS),
var_p(VT), (PP=0 -> var_p(VP) ; true),
get_F(V,F), get_F(V,F),
add_var_f(VP,V,F,TagP1), add_var_f(VP,V,F,TagP1),
add_var_f(VS,V,F,TagS1), add_var_f(VS,V,F,TagS1),
add_var_f(VT,V,F,TagT1), (PP=0 -> add_var_f(VP,V,F,TagC1) ; true),
compile_goal(call_(X,A,Ad,[C0|_],Pre,Post,LP),#f,V,[LX,LLX]), compile_goal(call_(X,A,Ad,[C0|_],Pre,Post,LP),#f,V,[LX,LLX]),
set_P(V,P0),
add_var_f(VP,V,F,TagP2), add_var_f(VP,V,F,TagP2),
add_var_f(VS,V,F,TagS2), add_var_f(VS,V,F,TagS2),
add_var_f(VT,V,F,TagT2), (PP=0 -> add_var_f(VP,V,F,TagC2) ; true),
set_QAESBB2(V,Q,AA,E,S,B,B2), set_QAESBB2(V,Q,AA,E,S,B,B2),
(A=[[0|_]|_] -> Tp is 0 ; Tp is 1), (A=[[0|_]|_] -> Tp is 0 ; Tp is 1),
Ad=[A0,Cut_p], Ad=[A0,Cut_p],
( (
A==#t -> A==#t ->
( (
Cut_p == #t -> Cut_p == #t ->
( (
Tp == 0 -> PP == 0 ->
( (
Pre = ['newframe-ps', A0, TagP1, TagS1], Pre = ['newframe-ps', TagP1, TagS1],
Post = [['goto-inst' , Out], Post = [['unwind-ps', TagP2, TagS2]|LP]
[label , A0],
['fail-psc' , TagP2, TagS2, C0],
[label , Out],
['unwind-psc', TagP2, TagS2, C0]|LP]
) ; ) ;
( (
Pre = ['newframe-pst', A0, TagP1, TagS1, TagT1], Pre = ['newframe-psc', TagP1, TagS1, TagC1],
Post = [['goto-inst' , Out], Post = [['unwind-ps', TagP2, TagS2]|LP]
[label , A0],
['fail-psc' , TagP2, TagS2, C0],
[label , Out],
['unwind-psct', TagP2, TagS2, TagT2, C0]|LP]
) )
) ; ) ;
( (
...@@ -458,20 +469,23 @@ compile_goal(\\+\\+X,Tail,V,[L,LLL]) :- !, ...@@ -458,20 +469,23 @@ compile_goal(\\+\\+X,Tail,V,[L,LLL]) :- !,
Post = [['unwind-ps' , TagP2, TagS2]|LP] Post = [['unwind-ps' , TagP2, TagS2]|LP]
) ; ) ;
( (
Pre = ['newframe-pst', A0, TagP1, TagS1, TagT1], Pre = ['newframe-ps', TagP1, TagS1],
Post = [['unwind-pst' , A0, TagP2, TagS2, TagT2]|LP] Post = [['unwind-ps' , TagP2, TagS2]|LP]
) )
) )
); );
( (
Cut_p == #t -> Cut_p == #t ->
( (
Pre = ['store-p' , A0, TagP1], PP=0 ->
Post = [['goto-inst', Out ], (
[label , A0 ], Pre = ['newframe-pc', TagP1, TagC1],
['fail-pc' , TagP2, C ], Post = ['unwind-p', TagP1]
[label , Out ], );
['restore-c', C0 ]|LP] (
Pre = ['newframe-p', TagP1],
Post = ['unwind-p', TagP1]
)
) ; ) ;
( (
Pre = [true], Pre = [true],
......
...@@ -32,6 +32,26 @@ chech_push(F) :- ...@@ -32,6 +32,26 @@ chech_push(F) :-
-extended. -extended.
handle([true],I,I,L,L) :- !. handle([true],I,I,L,L) :- !.
handle([cut,P,[[S1,V1,Q1],N1,F1|_]],I,II,L,LL) :- !,
(
P=ground(_) ->
true;
(
new_var(V1,Q1,S),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
cut(P,E1,I,II,L,LL)
)
).
handle([cut,P,false],I,II,L,LL) :- !,
(
P=ground(_) ->
true;
(
cut(P,false,I,II,L,LL)
)
).
handle(['cc',P],I,II,L,LL) :- !, handle(['cc',P],I,II,L,LL) :- !,
'cc-call'(P,I,II,L,LL). 'cc-call'(P,I,II,L,LL).
...@@ -175,13 +195,45 @@ handle(['unwind-light-tail',(U,[[[S,V,Q],N,F|_],_]),QQ],I,II,L,LL) :- !, ...@@ -175,13 +195,45 @@ handle(['unwind-light-tail',(U,[[[S,V,Q],N,F|_],_]),QQ],I,II,L,LL) :- !,
handle([(X,('goto-inst';'store-state';'post-q')),N],I,II,L,LL) :- !, handle([(X,('goto-inst';'store-state';'post-q')),N],I,II,L,LL) :- !,
X(N,I,II,L,LL). X(N,I,II,L,LL).
handle([(X,('unwind-tail')),[[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]]],I,II,L,LL) :- !, handle([(X,('unwind-tail')),
[[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_]]],I,II,L,LL) :- !,
new_var(V1,Q1,S1), new_var(V1,Q1,S1),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)), (V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
new_var(V2,Q2,S2), new_var(V2,Q2,S2),
(V2=[VC2|_] -> E2=var(VC2) ; E2=svar(V2)), (V2=[VC2|_] -> E2=var(VC2) ; E2=svar(V2)),
X(E1,E2,I,II,L,LL). X(E1,E2,I,II,L,LL).
handle([(X,('unwind-p')),
[[S1,V1,Q1],N1,F1|_]] ,I,II,L,LL) :- !,
new_var(V1,Q1,S1),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
X(E1,I,II,L,LL).
handle([(X,('newframe-ps';'newframe-pc';
'unwind-ps';'unwind-pc')),
[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_]] ,I,II,L,LL) :- !,
new_var(V1,Q1,S1),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
new_var(V2,Q2,S2),
(V2=[VC2|_] -> E2=var(VC2) ; E2=svar(V2)),
X(E1,E2,I,II,L,LL).
handle([(X,('newframe-psc')),
[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_],
[[S3,V3,Q3],N3,F3|_]] ,I,II,L,LL) :- !,
new_var(V1,Q1,S1),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
new_var(V2,Q2,S2),
(V2=[VC2|_] -> E2=var(VC2) ; E2=svar(V2)),
new_var(V3,Q3,S3),
(V3=[VC3|_] -> E3=var(VC3) ; E3=svar(V3)),
X(E1,E2,E3,I,II,L,LL).
handle([(F,(newframe ; 'newframe-negation' ; 'post-negation' handle([(F,(newframe ; 'newframe-negation' ; 'post-negation'
; 'unwind' ; 'unwind-negation' ; 'unwind' ; 'unwind-negation'
...@@ -195,27 +247,14 @@ handle([(F,(newframe ; 'newframe-negation' ; 'post-negation' ...@@ -195,27 +247,14 @@ handle([(F,(newframe ; 'newframe-negation' ; 'post-negation'
F(E1,E2,B,I,II,L,LL). F(E1,E2,B,I,II,L,LL).
handle([(F,('newframe-ps';'unwind-ps';'unwind-psc';'store-ps';'fail-psc')) handle([(F,('store-ps';'fail-psc')),
,A0,[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :- A,[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :-
!,
new_var(V1,Q1,S1),
new_var(V2,Q2,S2),
(V1=[V1C|_] -> E1=var(V1C) ; E1=svar(V1)),
(V2=[V2C|_] -> E2=var(V2C) ; E2=svar(V2)),
F(A0,E1,E2,I,II,L,LL).
handle([(F,('newframe-pst';'unwind-psct';'unwind-pst'))
,A0,[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_],
[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :-
!, !,
new_var(V1,Q1,S1), new_var(V1,Q1,S1),
new_var(V2,Q2,S2), new_var(V2,Q2,S2),
new_var(V3,Q3,S3),
(V1=[V1C|_] -> E1=var(V1C) ; E1=svar(V1)), (V1=[V1C|_] -> E1=var(V1C) ; E1=svar(V1)),
(V2=[V2C|_] -> E2=var(V2C) ; E2=svar(V2)), (V2=[V2C|_] -> E2=var(V2C) ; E2=svar(V2)),
(V3=[V3C|_] -> E3=var(V3C) ; E3=svar(V3)), F(E1,E2,I,II,L,LL).
F(A0,E1,E2,E3,I,II,L,LL).
handle(['store-p',A0,[[S1,V1,Q1],N1,F1|_]],I,II,L,LL) :- handle(['store-p',A0,[[S1,V1,Q1],N1,F1|_]],I,II,L,LL) :-
!, !,
......
...@@ -63,7 +63,7 @@ ...@@ -63,7 +63,7 @@
<cc>)))) <cc>))))
(<define> (touch_Q e v) (<define> (touch_Q e v)
(<pp> `(touch ,e)) ; (<pp> `(touch ,e))
(<recur> lp ((l (<lookup> (vector-ref (<lookup> v) nq)))) (<recur> lp ((l (<lookup> (vector-ref (<lookup> v) nq))))
(if (pk 'touch (pair? l)) (if (pk 'touch (pair? l))
(<and> (<and>
......
...@@ -15,20 +15,24 @@ ...@@ -15,20 +15,24 @@
#:use-module (logic guile-log vm utils) #:use-module (logic guile-log vm utils)
#:use-module (logic guile-log vm fkn) #:use-module (logic guile-log vm fkn)
#:export (in-call cc-call in-tailcall in-post-call post-unicall #:export (in-call cc-call in-tailcall in-post-call post-unicall
push-3 pushtail-3 handle-spcc)) push-3 pushtail-3 handle-spcc cut))
(compile-prolog-string (compile-prolog-string
" "
'handle-spcc'(C,I,I,L,LL) :- 'handle-spcc'(C,I,I,L,LL) :-
NCC is C, NCUT is C,
NP is C + 1, NCC is C + 1,
NS is C + 2, NP is C + 2,
NVEC is C + 3, NS is C + 3,
gset(vec,svar(NVEC),I,L,L2), NVEC is C + 4,
gset(cc,svar(NCC),I,L2,L3), id(cut,var(ICUT)),
gset(p,svar(NP),I,L3,L4), id(cc,var(cc)),
gset(s,svar(NS),I,L4,LL). generate('scm-ref/immediate'(NVEC,ICUT,NCUT),L,L1),
generate('scm-ref/immediate'(NVEC,ICC,NCC),L1,L2),
gset(p,svar(NP),I,L2,L3),
gset(s,svar(NS),I,L3,L4),
gset(vec,svar(NVEC),I,L4,L5),
gset(const,vconst,I,L5,LL).
'push-3'(P,C,I,II,L,LL) :- 'push-3'(P,C,I,II,L,LL) :-
args([cc(C),pp(P),s],I,II,L,LL). args([cc(C),pp(P),s],I,II,L,LL).
...@@ -65,11 +69,18 @@ ...@@ -65,11 +69,18 @@
tailstub(NN,L2,LL). tailstub(NN,L2,LL).
'in-post-call'(I,II,L,LL) :- 'in-post-call'(I,II,L,LL) :-
generate('assert-narg-ee/locals'(3,nvec),L,LL), generate('assert-narg-ee/locals'(3,nvec),L,L1),
gset(const,vconst,I,L1,LL),
II = 0. II = 0.
'post-unicall'(I,II,L,LL) :- 'post-unicall'(I,II,L,LL) :-
'goto-stackstart'(II), 'goto-stackstart'(II),
'install-stack'(I1,II,L,LL). 'install-stack'(I1,II,L,LL).
cut(ground(_),V,I,I,L,L) :- !.
cut(_,false,I,I,L,L) :- !,
gset(p,cut,I,L,LL).
cut(_,V,I,I,L,LL) :-
gset(p,V,I,L,LL).
") ")
...@@ -8,8 +8,8 @@ ...@@ -8,8 +8,8 @@
((eq? s 'reset) 'pl-reset) ((eq? s 'reset) 'pl-reset)
(else s)))) (else s))))
#:export (newframe-ps newframe-pst newframe-light newframe #:export (newframe-ps newframe-psc newframe-light newframe
newframe-negation newframe-negation newframe-pc
store-state store-ps store-p)) store-state store-ps store-p))
(compile-prolog-string (compile-prolog-string
...@@ -46,18 +46,23 @@ ...@@ -46,18 +46,23 @@
gset(cstack,sp(I),L3,L4), gset(cstack,sp(I),L3,L4),
reset(I,L4,LL). reset(I,L4,LL).
'newframe-ps'(A,P,S,I,L,LL) :- 'newframe-ps'(P,S,I,I,L,LL) :-
scmcall('gp-newframe',[s],I,I1,L,L1), write(1),
gset(P,p,I1,L1,L2), generate(newframe,L,L1),
gset(S,s,I1,L2,L3), write(2),
gset(p,l(A),I1,L3,L4), gset(S,s,I,L1,L2),
gset(s,sp(I1-1),I1,L4,L5), gset(P,p,I,L2,LL).
reset(I,L5,LL).
'newframe-pc'(P,C,I,I,L,LL) :-
gset(P,p,I,L,L1),
gset(C,p,I,L1,L2).
'newframe-pst'(A,P,S,T,I,I,L,LL) :- 'newframe-psc'(P,S,C,I,I,L,LL) :-
generate(newframe,L,L1), generate(newframe,L,L1),
gset(P,p,I,L1,L2), gset(S,s,I,L1,L2),
gset(S,s,I,L2,LL). gset(P,p,I,L2,L3),
gset(C,p,I,L3,LL).
-trace. -trace.
'newframe-light'(P,NP,I,I,L,LL) :- 'newframe-light'(P,NP,I,I,L,LL) :-
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
#:use-module (logic guile-log vm utils) #:use-module (logic guile-log vm utils)
#:use-module (logic guile-log iso-prolog) #:use-module (logic guile-log iso-prolog)
#:export (unwind-light-tail unwind-light unwind unwind-negation #:export (unwind-light-tail unwind-light unwind unwind-negation
unwind-tail unwind-ps unwind-psc unwind-psct unwind-pst unwind-tail unwind-ps unwind-p
post-negation post-s post-q post-c post-sc restore-c restore-pc post-negation post-s post-q post-c post-sc restore-c restore-pc
softie softie-light softie-ps softie-pc softie-psc softie softie-light softie-ps softie-pc softie-psc
fail-psc fail-pc)) fail-psc fail-pc))
...@@ -39,17 +39,14 @@ ...@@ -39,17 +39,14 @@
'unwind-light-tail'(Tag,I,I,L,LL) :- 'unwind-light-tail'(Tag,I,I,L,LL) :-
gset(p,Tag,I,L,LL). gset(p,Tag,I,L,LL).
'unwind-ps'(P,S,I,L,LL) :- 'unwind-ps'(P,S,I,I,L,LL) :-
scmcall('gp-unwind',[S],I,I1,L,L1), gset(s,S,I,L,L1),
gset(s,sp(I1-1),I,L1,L2). generate('unwind-tail',L1,L2),
gset(p,P,I,2,L3), gset(p,P,I,L2,LL).
'unwind-psc'(P,S,C,I,L,LL) :- 'unwind-p'(P,I,I,L,LL) :-
scmcall('gp-unwind',[S],I,I1,L,L1), gset(p,P,I,L,LL).
gset(s,sp(I1-1),I,L1,L2),
gset(p,P,I,L2,L3),
gset(cut,C,I,L3,LL).
'unwind-psct'(P,S,C,T,I,L,LL) :- 'unwind-psct'(P,S,C,T,I,L,LL) :-
scmcall('gp-unwind',[S],I,I1,L,L1), scmcall('gp-unwind',[S],I,I1,L,L1),
gset(s,sp(I1-1),I,L1,L2), gset(s,sp(I1-1),I,L1,L2),
......
...@@ -5,9 +5,11 @@ ...@@ -5,9 +5,11 @@
#:export (reset gset gref move movex scmcall make_p make_cc j je jne #:export (reset gset gref move movex scmcall make_p make_cc j je jne
scmtailcall scmtailcall2 scmcall1 generate scmtailcall scmtailcall2 scmcall1 generate
label gfalse gtrue isTrue pltest lookup2 svar args label gfalse gtrue isTrue pltest lookup2 svar args
test sp cc p s c l vec lvec cut stack call? scut pp pltest_s test sp cc p s c l vec lvec stack call? scut pp pltest_s
base init-proc base init-proc id vconst
tailstub stub inlabel)) tailstub stub inlabel)
#:replace (const))
(define il 0) (define il 0)
...@@ -24,7 +26,6 @@ ...@@ -24,7 +26,6 @@
(set! i 0) (set! i 0)
(set! constants (make-hash-table)))) (set! constants (make-hash-table))))