small steps of improvements

parent 32aee427
......@@ -155,6 +155,15 @@ PSSOURCES = \
language/prolog/modules/library/oset.plb \
language/prolog/modules/library/rbtrees.plb \
language/prolog/modules/library/forward_chaining.plb \
logic/guile-log/vm/utils.scm \
logic/guile-log/vm/call.scm \
logic/guile-log/vm/fkn.scm \
logic/guile-log/vm/push.scm \
logic/guile-log/vm/unify.scm \
logic/guile-log/vm/newframe.scm \
logic/guile-log/vm/unwind.scm \
logic/guile-log/vm/op.scm \
logic/guile-log/vm/vm.scm \
logic/guile-log/guile-prolog/vm/vm-pre.scm \
logic/guile-log/guile-prolog/vm/vm-var.scm \
logic/guile-log/guile-prolog/vm/vm-scm.scm \
......
......@@ -138,7 +138,8 @@ handle(['pre-unify',At,Vx],I,II,L,LL) :- !,
isCplx(At) ->
(
new_var(V,Q,S),
'pre-unify'(V,I,II,L,LL)
(V=[VC|_] -> E=var(VC) ; E=sp(V)),
'pre-unify'(E,I,II,L,LL)
) ;
(L=LL,I=II)
).
......@@ -149,7 +150,8 @@ handle(['post-unify-tail',[[S,V,Q],N,F|_]],I,II,L,LL) :-
F==#t -> throw(end_with_no_begin) ;
(
new_var(V,Q,S),
'post-unify-tail'(V,I,II,L,LL)
(V=[VC|_] -> E=var(VC) ; E=sp(V)),
'post-unify-tail'(E,I,II,L,LL)
)
).
......
......@@ -26,8 +26,8 @@
).
gset('stack',sp(0),1,L1,L2).
'cc-call'(A,I,0,L,LL) :-
scm_tailcall(cc,[s,pp|A],0,_,L,LL).
'cc-call'(I,0,L,LL) :-
scmtailcall(cc,[s,pp],0,_,L,LL).
'in-call'(F,A,P,CC,I,II,L,LL) :-
store_stack(I,I1,L,L1),
......@@ -35,20 +35,7 @@
'in-tailcall'(F,A,P,CC,I,II,L,LL) :-
scm_tailcall(F,[s,pp,CC|A],I,II,L,LL).
pp(I,II,L,LL) :-
gset(sp(I),p,L,L1),
II is I + 1,
isProcedure(p,Lab,II,L1,L2),
scmcall1('gp-make-p',[self],I,I1,L2,L3),
move(I1-1,I,L1,LL),
label(Lab,L3,L4).
'cc-call'(C,I,II,L,LL) :-
scmcall('gp-make-cc',[self,l(C)],I,I1,L,L1),
move(I1-1,I,L1,LL),
II is I + 1.
'post-call'(NARG,I,II,L,LL) :-
I0 is NARG + 2,
'goto-stackstart'(I0,I1),
......
(define-module (logic guile-log vm unify)
#:use-module (logic guile-log vm utils)
#:use-module (logic guile-log vm call)
#:use-module ((logic guile-log iso-prolog)
#:renamer
(lambda (s)
......@@ -21,33 +22,31 @@
scmcall('gp-set',[V,sp(-1),s],I,I1,L,L1),
reset(I,L1,LL).
'pre-unify'(V,I,L,LL) :-
vset('call?',c(0),I,L,L1),
'pre-unify'(V,I,I,L,LL) :-
gset('call?',c(0),I,L,L1),
gset(V,c(delayers),I,L1,LL).
'post-unify'(V,Nsloc,I,L,LL) :-
gref(V,I,L,L1),
II is I + 1,
gset(V,c(#f),II,L2,L3),
gref(delayers,II,L3,L4),
gref(c(delayers),II,L3,L4),
generate(eq(I,II),L4,L5),
generate(je(E),L5,L6),
generate('delay-call'(Nsloc),L6,LL),
label(E,LL).
'post-unify-tail'(V,Nsloc,I,L,LL) :-
'post-unify-tail'(V,I,0,L,LL) :-
gref(V,I,L,L1),
II is I + 1,
gset(V,c(#f),II,L2,L3),
gref(delayers,II,L3,L4),
gref(c(delayers),II,L3,L4),
generate(eq(I,II),L4,L5),
generate(je(E),L5,L6),
generate('delay-call'(Nsloc),L6,L7),
label(E,LL),
cc(L7,LL).
III is II + 1,
scmtailcall2('delay-call',[cc],III,_,L6,L7),
label(E,L8,L9),
'cc-call'(I,_,L9,LL).
-trace.
unify(Code,V,I,II,L,LL) :-
M is (Code /\\ 3),
A is (Code /\\ 4) >> 2,
......@@ -112,7 +111,6 @@
'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) :-
(
K == #f ->
......
(define-module (logic guile-log vm utils)
#:use-module (logic guile-log iso-prolog)
#:export (reset gset gref move scmcall make_p make_cc j je jne
scmtailcall scmtailcall2 scmcall1 generate
label gfalse gtrue isTrue pltest lookup2
test sp cc s c vec cut stack call? scut pp pltest_s))
......@@ -16,17 +17,25 @@
id(stack ,var(3)).
id(cc ,var(4)).
id('call?' ,var(5)).
id(self ,var(6)).
sp(6).
pp(I,II,L,LL) :-
II is I + 1,
gset(sp(I),p,II,L,L1),
isProcedure(sp(I),Lab,II,L1,L2),
scmcall1('gp-make-p',[self],I,I1,L2,L3),
move(I1-1,I,L3,L4),
label(Lab,L4,LL).
e(cc(C),I,II,L,LL) :- cc(C,I,II,L,LL).
e(pp,I,II,L,LL) :- pp(I,II,L,LL).
-trace.
reset(I,L,LL) :-
call(II is I),
generate(reset(II),L,LL).
vareref(Pos,I,II,L,LL) :-
varref(Pos,I,II,L,LL) :-
generate('vector-ref'(I,0,Pos),L,LL),
II is I + 1.
......@@ -39,14 +48,13 @@
move(I,J,L,LL) :-
call(II is I),
call(JJ is J),
generate(move(II,JJ),L,LL).
generate(move(JJ,II),L,LL).
-trace.
gref(c(X),I,L,LL) :- !,
constant(X,I,L,LL).
gref(var(X),I,L,LL) :- !,
var_ref(X,I,L,LL).
varref(X,I,_,L,LL).
gref(sp(X),I,L,LL) :- !,
move(X,I,L,LL).
......@@ -55,35 +63,42 @@
generate('label-ref'(I,X),L,LL).
gref(A,I,L,LL) :-
id(A,X),
id(A,X),!,
gref(X,I,L,LL).
gref(A,I,L,LL) :-
e(A,I,_,L,LL).
vset(I,sp(J),I,L,LL) :- !,
call(JJ is J),
varset(I,JJ,L2,LL).
varset(I,JJ,L,LL).
vset(J,var(X),I,L,LL) :- !,
gref(var(X),I,L,L1),
gref(var(X),I,L,L2),
varset(J,I,L2,LL).
vset(J,c(X),I,L,LL) :- !,
gref(c(X),I,L,L1),
gref(c(X),I,L,L2),
varset(J,I,L2,LL).
vset(J,X,I,L,LL) :-
id(X,XX),
vset(J,XX,I,L,LL).
sset(I,sp(J),I,L,LL) :- !,
move(J,I,L,LL).
sset(K,sp(J),I,L,LL) :- !,
move(J,K,L,LL).
sset(J,var(X),I,L,LL) :- !,
gref(var(X),I,L,L1),
move(I,J,L1,LL).
gref(var(X),I,L,L2),
move(I,J,L2,LL).
sset(J,c(X),I,L,LL) :- !,
gref(c(X),I,L,L1),
move(I,J,L1,LL).
gref(c(X),I,L,L2),
move(I,J,L2,LL).
sset(J,X,I,L,LL) :-
id(X,XX),
sset(J,XX,I,L,LL).
gset(var(V),Val,I,L,LL) :- !,
vset(V,Val,I,L,LL).
......@@ -103,7 +118,6 @@
I = N,
generate('pl-setup-frame',L4,LL).
-trace.
args([],I,I,L,L).
args([X|A],I,II,L,LL) :-
......@@ -111,7 +125,6 @@
I1 is I + 1,
args(A,I1,II,L1,LL).
-trace.
scmcall(F,Args,I,II,L,LL) :-
length(Args,N),
NN is N + 1,
......@@ -125,6 +138,41 @@
II is I2 + 1,
reset(II,L5,LL).
scmcall1(F,Args,I,II,L,LL) :-
length(Args,N),
NN is N + 2,
NNN is I + NN - 1,
reset(NNN,L,L1),
args(Args,I,I1,L1,L2),
gref(c(F),I1,L2,L3),
I2 is I1 + 1,
generate(handle_interupts,L3,L4),
generate(call(I2,NN),L4,L5),
II is I2 + 1,
reset(II,L5,LL).
scmtailcall(F,Args,I,II,L,LL) :-
length(Args,N),
NN is N + 1,
NNN is I + NN,
reset(NNN,L,L1),
args(Args,I,I1,L1,L2),
gref(c(F),I1,L2,L3),
I2 is I1 + 1,
generate(handle_interupts,L3,L4),
generate(tailcall(I2,NN),L4,L5).
scmtailcall2(F,Args,I,II,L,LL) :-
length(Args,N),
NN is N + 1 + 2,
NNN is I + NN - 2,
reset(NNN,L,L1),
args(Args,I,I1,L1,L2),
gref(c(F),I1,L2,L3),
I2 is I1 + 1,
generate(handle_interupts,L3,L4),
generate(tailcall(I2,NN),L4,L5).
j(Label,L,LL) :-
generate(j(Label),L,LL).
......@@ -137,31 +185,33 @@
label(Label,L,LL) :-
generate(label(Label),L,LL).
gfalse(I,I,L,LL) :-
gref(p,I,L,L1),
gfalse(P,I,L,LL) :-
gref(p,I,L,L2),
generate('immediate-tag?='(I,7,0),L2,L3),
generate(je(A),L3,L4),
generate(je(Lab),L3,L4),
generate(goto(I),L4,L5),
label(A,L5,L6),
II is I + 1.
label(Lab,L5,L6),
generate(tailcall(I,0),L6,LL).
gtrue(I,L,L).
isTrue(sp(I),Label,I,L,LL) :-
isTrue(sp(I),I,Label,L,LL) :-
call(II is I),
generate(test1(true,II,Label),L,LL).
isProcedure(sp(J),Label,I,L,LL) :-
call(JJ is J),
generate(test1(isProcedure,JJ,Label),L,LL).
-trace.
pltest(F,A,I,II,L,LL) :-
scmcall(F,A,I,II,L,L1),
isTrue(sp(II-1),II,Label,L1,L2),
gfalse(II,_,L2,L3),
label(Label,L3,LL).
-trace.
pltest_s(F,A,I,L,LL) :-
pltest(F,A,I,II,L,L1),
gset(s,sp(II-1),II,L1,LL).
pltest(F,A,I,II,L,L2),
gset(s,sp(II-1),II,L2,LL).
lookup2(I,L,LL) :-
scmcall('gp-lookup',[sp(I-2),s],I,L,L1),
......
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