disjunction start to work

parent abfdc542
......@@ -34,12 +34,12 @@ collect_disjunction(X,[X|UU],UU).
head_at_true(Q,#t,_,A,C,Lab,Lab2,L1,LLX) :- L1=LLX, Lab2=Lab.
head_at_true(Q,#f,#f,A,C,Lab,Lab2,L1,LLX) :-
(var(Q) -> tr('unwind-light',Unwind) ; tr(unwind,Unwind)),
(varx(Q) -> tr('unwind-light',Unwind) ; tr(unwind,Unwind)),
(var(Lab) -> true ; throw(error_head)),
L1=[[label,Lab,U],[Unwind,A,Lab2,Q]|LLX].
head_at_true(Q,#f,#t,A,C,Lab,Lab2,L1,LLX) :-
(var(Q) -> tr('unwind-light-tail',Unwind) ; tr('unwind-tail',Unwind)),
(varx(Q) -> tr('unwind-light-tail',Unwind) ; tr('unwind-tail',Unwind)),
(var(Lab) -> true ; throw(error_head)),
L1=[[label,Lab,U],[Unwind,A,Q]|LLX].
......@@ -80,13 +80,14 @@ combine_pp(P1,PP0,PP1) :-
-trace.
goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,B2,LLX,P0,PP0,Q,QQ)
:-
Q=Qit,
Qit=Q,
get_CES(V,[C|_],E,S),
set_AB2ES(V,Aq,B2,0,S0),
((nonvar(X),X=(G1->G2)) ->
(W=#t,XX=(call(G1),softie(A),collect_F(FF),G2)) ;
(W=#f,,XX=(X,newtag_F(FF)))),
(
(nonvar(X),X=(G1->G2)) ->
(W=#t,XX=(call(G1),softie(A),collect_F(FF),G2)) ;
(W=#f,,XX=(X,newtag_F(FF),set_p(Q)))
),
set_P(V,ground(Lab)),
push_Q(3,V,Q),
compile_goal(XX,Tail,V,[LX,LG]),
......@@ -137,7 +138,7 @@ compile_disjunction0
set_P(V,P0),
(First=#t -> compile_goaler(X,Tail,V,[L,LL],PP0) ;
catch((
Q=Qit,
Qit=Q,
get_CES(V,[C|_],E,S),
set_AB2ES(V,Aq,B2,0,S0),
(
......
......@@ -19,7 +19,6 @@ reverse_op(@>=,@=<).
reverse_op(=:=,=:=).
reverse_op(=\\=,=\\=).
rev(X,Y) :-
rev(X,[],Y).
......@@ -44,7 +43,7 @@ wrap(Code,[L,LL]) :-
)
)).
-trace.
-extended(',',m_and,;,m_or,\\+,m_not).
compile_goal(Code,Iout):- !,
compile_goal(Code,Iout,StackSize,Narg,Consts,#t).
......@@ -76,12 +75,17 @@ compile_goal(X,Tail,V,L) :- var_p(X),!,
compile_goal(pr(X),Tail,V,[L,L]) :- !,
write(pr(X)),nl.
compile_goal(set_p(Q),Tail,V,[L,LL]) :- !,
get_P(V,P),
L=[[set_p,Q,P]|LL].
compile_goal(!,Tail,V,[L,LL]) :- !,
check_tail(Tail),
(Tail==#t -> L=[[cut],[cc]|LL] ; L=[[cut]|LL]).
compile_goal(softie(A),Tail,V,[LL,L]) :- !,
compile_goal(softie(A),Tail,V,[L,LLL]) :- !,
check_tail(Tail),
tail(Tail,V,LL,LLL),
get_P(V,P),
(Tail==#t -> L=[[softie,A],[cc,P]|LL] ; L=[[softie,A]|LL]).
......@@ -98,7 +102,8 @@ compile_goal(begin_att,Tail,V,[L,LLL]) :- !,
var_p(AAx),
add_var(AAx,V,Tagx),
tr('pre-unify',Pre),
L = [[Pre,AAt,Tagx]|LL]
get_P(V,P),
L = [[Pre,AAt,Tagx,P]|LL]
)
).
......@@ -228,11 +233,12 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
(
get_AB2ESM(V,Aq,B2,E,S,M),
get_F(V,F),
Q=[_,_],
compile_disjunction(XX,#t,Aq,Ae,Out,Lab,LabA,Tail,S,U,B2,V,LM,Q,QQ),!,
(zero(V) -> Tp is 0 ; Tp is 1),
pushl_Q(V,QQ),
(
var(Q) ->
varx(Q) ->
(
var_p(Var1),
var_p(Var2),
......@@ -403,17 +409,22 @@ compile_goal((X->Y),Tail,V,L) :- !,
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]) :- !,
tail(Tail,V,LL,LLL),
L=LX,
get_QAESBB2(V,Q,AA,E,S,B,B2),
set_QAE(V,[],[[0|_]],0),
new_var(VP,V,TagP1),
new_var(VS,V,TagS1),
new_var(VT,V,TagT1),
var_p(VP),
var_p(VS),
var_p(VT),
get_F(V,F),
add_var_f(VP,V,F,TagP1),
add_var_f(VS,V,F,TagS1),
add_var_f(VT,V,F,TagT1),
compile_goal(call_(X,A,Ad,[C0|_],Pre,Post,LP),#f,V,[LX,LLX]),
new_var(VP,V,TagP2),
new_var(VS,V,TagS2),
new_var(VT,V,TagT2),
add_var_f(VP,V,F,TagP2),
add_var_f(VS,V,F,TagS2),
add_var_f(VT,V,F,TagT2),
set_QAESBB2(V,Q,AA,E,S,B,B2),
(A=[[0|_]|_] -> Tp is 0 ; Tp is 1),
Ad=[A0,Cut_p],
......@@ -447,8 +458,8 @@ compile_goal(\\+\\+X,Tail,V,[L,LL]) :- !,
Post = [['unwind-ps' , TagP2, TagS2]|LP]
) ;
(
Pre = ['newframe-pst', TagP1, TagS1, TagT1],
Post = [['unwind-pst' , TagP2, TagS2, TagT2]|LP]
Pre = ['newframe-pst', A0, TagP1, TagS1, TagT1],
Post = [['unwind-pst' , A0, TagP2, TagS2, TagT2]|LP]
)
)
);
......@@ -590,7 +601,7 @@ compile_goal(X is Y,Tail,V,L) :- !,
compile_goal(iss(X,Y),Tail,V,[L,LLL]) :- !,
check_tail(Tail),
tail(Tail,LL,LLL),
tail(Tail,V,LL,LLL),
(
instruction(Y) ->
(
......@@ -602,9 +613,9 @@ compile_goal(iss(X,Y),Tail,V,[L,LLL]) :- !,
tr('unify-instruction-2',Unify),
var_p(X),
add_var(X,V,Tag),
L=[[Unify,Tag,Y,#t]|LLL]
L=[[Unify,Tag,Y,#t]|LL]
)
);
);
ifc(compile_scm(Y,V,L,LX),EY,compile_goal(X is EY, Tail, V, [L,LL]),
(
var_p(X) ->
......@@ -613,7 +624,7 @@ compile_goal(iss(X,Y),Tail,V,[L,LLL]) :- !,
(isFirst(Tag) -> true ; touch_Q(12,V)),
push_v(-1,V),
tr(unify,Unify),
LX=[[unify,Tag,#t]|LLL]
LX=[[unify,Tag,#t]|LL]
);
(
(
......@@ -622,7 +633,7 @@ compile_goal(iss(X,Y),Tail,V,[L,LLL]) :- !,
tr('equal-instruction',Equal)
),
push_v(-1,V),
LX=[[Equal,X]|LLL]
LX=[[Equal,X]|LL]
)
))).
......
(compile-prolog-string "
%newvars needs to be variables
ttt('newframe-light', newframe).
ttt('unwind-light' , unwind).
newv([]).
newv([[newvar,[[V,S],N,F]]|L]) :- !,
......@@ -27,8 +30,7 @@ chech_push(F) :-
-trace.
-extended.
handle(['cc'],I,II,L,LL) :- !,
'cc-call'(\"complex\",I,II,L,LL).
handle([true],I,I,L,L) :- !.
handle(['cc',P],I,II,L,LL) :- !,
'cc-call'(P,I,II,L,LL).
......@@ -124,41 +126,74 @@ handle([softie,A],I,II,L,LL) :- !,
(var(A) ; number(A)) ->
softie(A,I,II,L,LL) ;
(
A=[[S,V,Q],N,F|_],
A=[_,[[S,V,Q],N,F|_]],
new_var(V,Q,S),
V=[VC|_],
'softie-light'(VC,I,II,L,LL)
(V=[VC|_] -> E=var(VC) ; E=svar(V)),
'softie-light'(E,I,II,L,LL)
)
).
handle(push_at(K),I,II,L,LL) :- !,
push_at(K,I,II,L,LL).
handle([(FF,('newframe-light';'unwind-light')),
[[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],A,QQ],I,II,L,LL) :- !,
new_var(V1,Q1,S1),
new_var(V2,Q2,S2),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
(V2=[VC2|_] -> E2=var(VC2) ; E2=svar(V2)),
FF(E1,A,I,II,L,LL).
handle([set_p,Q,P],I,II,L,LL) :- !,
(
varx(Q) ->
(
I=II,L=LL
);
(
set_p(P,I,II,L,LL)
)
).
handle(['unwind-light-tail',[[[S,V,Q],N,F|_],_],QQ],I,II,L,LL) :- !,
handle([(F,('newframe-light';'unwind-light')),
(U,[[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]]),A,QQ],I,II,L,LL) :- !,
(
varx(QQ) ->
(
new_var(V1,Q1,S),
(V1=[VC1|_] -> E1=var(VC1) ; E1=svar(V1)),
F(E1,A,I,II,L,LL)
);
(
ttt(F,FF),
handle([FF,U,A],I,II,L,LL)
)
).
handle(['unwind-light-tail',(U,[[[S,V,Q],N,F|_],_]),QQ],I,II,L,LL) :- !,
new_var(V,Q,S),
(V=[VC|_] -> E=var(VC) ; E=svar(V)),
'unwind-light-tail'(E,I,II,L,LL).
(
varx(QQ) ->
'unwind-light-tail'(E,I,II,L,LL);
handle(['unwind-tail',U],I,II,L,LL)
).
handle([(X,('goto-inst';'store-state';'unwind-tail';
'post-q')),N],I,II,L,LL) :- !,
X(N,I,II,L,LL).
handle([(X,('goto-inst';'store-state';'post-q')),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) :- !,
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 ; 'newframe-negation' ; 'post-negation'
handle([(F,(newframe ; 'newframe-negation' ; 'post-negation'
; 'unwind' ; 'unwind-negation'
; 'post-s'),A,B]),
I,II,L,LL) :- !,
X=[F|_],
F(A,B,I,II,L,LL).
; 'post-s')),
[[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],B],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)),
F(E1,E2,B,I,II,L,LL).
handle([(F,('newframe-ps';'unwind-ps';'unwind-psc';'store-ps';'fail-psc'))
,A0,[[S1,V1,Q1],N1,F1|_],[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :-
......@@ -231,7 +266,7 @@ handle((X,['post-unicall',A,P]),I,II,L,LL) :- !,
handle(['newvar', _],L,L) :- !.
handle(['pre-unify',At,Vx],I,II,L,LL) :- !,
handle(['pre-unify',At,Vx,P],I,II,L,LL) :- !,
Vx=[[S,V,Q],N,F|_],
(
N==1 ->
......@@ -240,7 +275,8 @@ handle(['pre-unify',At,Vx],I,II,L,LL) :- !,
(
new_var(V,Q,S),
(V=[VC|_] -> E=var(VC) ; E=svar(V)),
'pre-unify'(E,I,II,L,LL)
set_p(P,I,I1,L,L1),
'pre-unify'(E,I1,II,L1,LL)
) ;
(L=LL,I=II)
).
......
(compile-prolog-string
"
-trace.
-extended.
compile_scm(X,V,L,LL) :-
var_p(X) ->
......@@ -10,14 +11,16 @@ compile_scm(X,V,L,LL) :-
);
constant(X) -> (!,tr('push-constant',Atom), L=[[Atom ,XX]|LL],
E=X,regconst(X,XX), push_v(1,V));
instruction(X) -> (!,tr('push-instruction',Atomic), L=[[Atomic,X]|LL],
E=X,push_v(1,V)).
instruction(X) -> (!,throw(X)).
%(!,tr('push-instruction',Atomic), L=[[Atomic,X]|LL],
% E=X,push_v(1,V)).
compile_scm((Op, ';'(max,min,+,-,*,/,<<,>>,\\/,/\\,mod))
(X,Y),V,L,LL) :- !,
ifc(compile_scm(X,V,L,LX),EX,
(
(number(EX) -> true ; throw(EY)),
(number(EX) -> true ; throw(EX)),
ifc(compile_scm(Y,V,L,LY),EY,
(
(number(EY) -> true ; throw(EY)),
......
......@@ -47,7 +47,7 @@
(let lp ((l (<lookup> (vector-ref v nq))) (r '()))
(if (pair? l)
(let ((y (car l)))
(if (eq? y x)
(if (pk 'popl (eq? (gp-car y S) (gp-car x S)))
(<and>
(<set> (vector-ref v nq) (cdr l))
(let lp ((xx (<lookup> xx)))
......@@ -63,11 +63,11 @@
<cc>))))
(<define> (touch_Q e v)
;(<pp> `(touch ,e))
(<pp> `(touch ,e))
(<recur> lp ((l (<lookup> (vector-ref (<lookup> v) nq))))
(if (pair? l)
(if (pk 'touch (pair? l))
(<and>
(<=> #t ,(car l))
(<=> (_ #t) ,(car l))
(lp (cdr l)))
<cc>)))
......@@ -544,6 +544,7 @@ compile_goal.
collect_F.
newtag_F.
varx([_,X]) :- var(X).
")
(all-defined-out)
(define-module (logic guile-log guile-prolog vm vm-var)
#:use-module (logic guile-log)
#:use-module ((logic guile-log umatch) :select (gp-car))
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
......
......@@ -450,7 +450,7 @@ SCM get_index_set(SCM s, SCM f, SCM e, SCM db)
}
*/
static inline int MAX(int i, int j)
static inline int MAXI(int i, int j)
{
if(i < j)
return j;
......@@ -458,7 +458,7 @@ static inline int MAX(int i, int j)
return i;
}
static inline int MIN(int i, int j)
static inline int MINI(int i, int j)
{
if(i > j)
return j;
......@@ -573,7 +573,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
// printf("MPZ v\n");fflush(stdout);
if(*n)
{
n2 = MIN(n3,*n);
n2 = MINI(n3,*n);
for(i = 0; i < n2; i++)
data2[i] = data[i] & data3[i];
}
......@@ -613,7 +613,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
// printf("finish v\n");fflush(stdout);
{
int N = *n;
*n = MAX(*n, n2);
*n = MAXI(*n, n2);
for(i = 0; i < n2; i++)
if(i < N)
data[i] = data[i] | data2[i];
......@@ -663,7 +663,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
if(*n)
{
*n = MIN(n3,*n);
*n = MINI(n3,*n);
for(i = 0; i < *n; i++)
data[i] = data[i] & data3[i];
}
......@@ -819,7 +819,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
else if (vha)
*vh = intersection_x(vha,*vh);
}
//printf("ATOM\n");fflush(stdout);
if(SCM_I_INUMP (v))
{
......@@ -833,8 +833,8 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
mpz_t *mpv = &(SCM_I_BIG_MPZ(v));
int n3 = (*mpv)->_mp_size;
ulong *data3 = (*mpv)->_mp_d;
int i,n2 = *n ? MIN(n3, *n) : n3;
int i;
n2 = *n ? (MINI(n3, *n)) : n3;
if(*n)
{
for(i = 0; i < n2; i++)
......@@ -853,7 +853,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
ulong na = my_scm_to_ulong(a);
int i;
data[0] = data2[0] | (*n ? (data[0] & na) : na);
*n = MAX(n2,1);
*n = MAXI(n2,1);
for(i = 1; i < *n; i++)
data[i] = data2[i];
//printf("na = %p, data[0]= %p\n", na, data[0]);
......@@ -864,12 +864,12 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
int n4 = (*mpa)->_mp_size;
ulong *data4 = (*mpa)->_mp_d;
n4 = *n ? MIN(n4,*n) : n4;
n4 = *n ? MINI(n4,*n) : n4;
if(*n)
{
int i;
*n = MAX(n2, n4);
*n = MAXI(n2, n4);
for(i = 0; i < n4; i++)
data[i] = data[i] & data4[i];
for(i = 0; i < n2; i++)
......@@ -881,8 +881,8 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
else
{
int i;
*n = MAX(n2, n4);
int nk = MIN(n4,n2);
*n = MAXI(n2, n4);
int nk = MINI(n4,n2);
for(i = 0; i < nk; i++)
data[i] = data[2] | data4[i];
if(n2 < n4)
......@@ -1039,7 +1039,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
{
ulong nv = my_scm_to_ulong(v);
data2[0] = (n2 == 0 ? nv : nv & data2[0]);
n2 = MAX(1, n2);
n2 = MAXI(1, n2);
}
else
{
......@@ -1050,7 +1050,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
if(n2)
{
n2 = MIN(n3,n2);
n2 = MINI(n3,n2);
for(i = 0; i < n2; i++)
data2[i] = data2[i] & data3[i];
}
......@@ -1097,7 +1097,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
{
ulong nv = my_scm_to_ulong(v);
data2[0] = (n2 == 0 ? nv : nv & data2[0]);
n2 = MAX(1, n2);
n2 = MAXI(1, n2);
}
else
{
......@@ -1108,7 +1108,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM
if(*n)
{
n2 = MIN(n3,n2);
n2 = MINI(n3,n2);
for(i = 0; i < n2; i++)
data2[i] = data2[i] & data3[i];
}
......
......@@ -54,26 +54,19 @@
gset(s,sp(I1-1),I1,L4,L5),
reset(I,L5,LL).
'newframe-pst'(A,P,S,T,I,L,LL) :-
scmcall('gp-newframe',[s],I,I1,L,L1),
gset(P,p,I1,L1,L2),
gset(S,s,I1,L2,L3).
gset(T,delayers,I1,L3,L4),
gset(p,l(A),I1,L4,L5).
gset(s,sp(I1-1),I1,L5,L6),
reset(I,L6,LL).
'newframe-pst'(A,P,S,T,I,I,L,LL) :-
generate(newframe,L,L1),
gset(P,p,I,L1,L2),
gset(S,s,I,L2,LL).
-trace.
'newframe-light'(P,NP,I,I,L,LL) :-
gset(P,p,I,L,LL).
newframe(NP,TP,I,L,LL) :-
gset(sp(I),l(NP),I,L,L1),
II is I + 1,
'store-state'([sp(I),s,newframe,p],II,L1,L2),
gset(p,sp(I),II,L2,L3),
gset(s,newframe,I,L3,L4),
reset(I,L4,LL).
newframe(S,P,A,I,I,L,LL) :-
gset(P,p,I,L,L1),
generate(newframe,L1,L2),
gset(S,s,I,L2,LL).
'newframe-negation'(NP,TP,I,L,LL) :-
I1 is I + 1,
......
......@@ -6,7 +6,7 @@
x)))
#:use-module (logic guile-log vm utils)
#:replace (cutter goto-inst sp-move equal-instruction
push-instruction pushv push-variable
push-instruction pushv push-variable set_p
pop-variable pop seek dup clear-sp push_at))
(compile-prolog-string
......@@ -75,6 +75,10 @@
movex(I,I-1,L,L),
II is I + 1.
set_p(P,I,I,L,LL) :-
P=ground(X) ->
gset(p,l(X),I,L,LL);
L=LL.
")
......@@ -108,26 +108,30 @@
'unify-instruction-2'(M,C,V,K,I,II,L,LL) :- 'unify-constant-2'(M,C,V,K,I,II,L,LL).
-trace.
'unify-constant-2'(M,C,V,K,I,I,L,LL) :-
I1 is I + 1,
I2 is I + 2,
(
K == #f ->
gset(V,c(C),I,L,LL);
(
M == #f ->
(
gset(sp(I),V,L,L1),
gset(sp(I+1),c(C),L,L1),
generate('gp-m-unify',L1,L2),
reset(I,L2,LL)
reset(I2,L,L1),
gset(sp(I),V,I1,L1,L2),
gset(sp(I1),c(C),I2,L2,L3),
generate('gp-m-unify'(base+I+1),L3,L4),
reset(I,L4,LL)
);
(
gset(sp(I),V,L,L1),
gset(sp(I+1),c(C),L,L1),
reset(I2,L,L1),
gset(sp(I),V,I1,L1,L2),
gset(sp(I1),c(C),I2,L2,L3),
(
(M=#t;K=#t) ->
generate('gp-unify-raw',L1,L2);
generate('gp-unify',L1,L2)
generate('gp-unify-raw'(base+I1),L3,L4);
generate('gp-unify'(base+I1),L3,L4)
),
reset(I,L2,LL)
reset(I,L4,LL)
)
)
).
......
......@@ -29,8 +29,11 @@
gset(s,S,I,L,L1),
gset(cut,C,I,L1,LL).
'unwind-tail'(Tag,I,L,LL) :-
scmcall('restore-state-tail',[vec,c(Tag)],I,L,LL).
-trace.
'unwind-tail'(S,P,I,I,L,LL) :-
gset(s,S,I,L,L1),
gset(p,P,I,L1,L2),
generate('unwind-tail',L2,LL).
-trace.
'unwind-light-tail'(Tag,I,I,L,LL) :-
......@@ -53,13 +56,11 @@
gset(p,P,I,L2,L3),
gset(cut,C,I,L3,L4),
gset(delayers,T,I,L4,LL).
'unwind-pst'(P,S,T,I,L,LL) :-
scmcall('gp-unwind',[S],I,I1,L,L1),
gset(s,sp(I1-1),I,L1,L2),
gset(p,P,I,L2,L3),
gset(s,S,I,L3,L4),
gset(delayers,T,I,L4,LL).
'unwind-pst'(_,P,S,T,I,I,L,LL) :-
gset(s,S,I,L,L1),
generate('unwind-tail',L1,L2),
gset(p,P,I,L2,LL).
'restore-c'(C,I,L,LL) :-
gset(cut,C,I,L,LL).
......@@ -68,11 +69,11 @@
gset(p,P,I,L,L1),
gset(cut,C,I,L1,LL).
softie(Tag,I,L,LL) :-
scmcall('restore-state-tail-p',[vec,c[Tag]],I,L,LL).
softie(P,I,I,L,LL) :-
gset(p,P,L,LL).
'softie-light'(Tag,I,L,LL) :-
gset(p,svar(Tag),I,L,LL).
'softie-light'(Tag,I,I,L,LL) :-
gset(p,Tag,I,L,LL).
'softie-ps'(P,S,I,L,LL) :-
get(p,P,I,L,L1),
......@@ -87,8 +88,11 @@
get(s,S,I,L1,LL),
get(cut,C,I,L1,L2).
unwind(Tag,P,I,L,LL) :-
scmcall('gp-unwind-it',[vec,c(Tag),c(P)],I,L,LL).
unwind(S,P,A,I,I,L,LL) :-
gset(p,P,I,L,L1),
gset(s,S,I,L1,L2),
generate(unwind,L2,LL).
-trace.
'unwind-light'(P,A,I,I,L,LL) :-
......
......@@ -31,6 +31,7 @@
cutter goto-inst sp-move equal-instruction
push-instruction pushv push-variable
pop-variable pop seek dup clear-sp push_at
set_p
;; unify
ggset unify unify-2 unify-constant-2
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment