refactorisation

parent 8a15c84d
(define-module (logic guile-log vm call)
#:use-module ((logic guile-log iso-prolog)
#:renamer
(lambda (x) (if (eq? x 'reset)
'reset_iso
x)))
#:use-module (logic guile-log vm utils)
#:use-module (logic guile-log vm fkn)
#:export ())
(compile-prolog-string
"
store_stack(I,0,L,LL) :-
(
I > 0 ->
do_n_cons(I,I,_,L,L1);
gset(sp(0),c([]),L,L1)
).
gset('stack',sp(0),1,L1,L2).
cc(A,I,0,L,LL) :-
scm_tailcall(cc,[s,pp|A],0,_,L,LL).
call(F,A,P,CC,I,0,L,LL) :-
store_stack(I,II,L,l1),
scm_tailcall(F,[s,pp,CC|A],0,_,L1,LL).
pp(I,II,L,LL) :-
gset(sp(I),p,L,L1),
II is I + 1,
isProcedure(sp(I),Lab,II,L,L1),
scmcall1('gp-make-p',[self],I,I1,L,L1),
move(I1-1,I,L1,LL),
label(Lab,L3,L4).
cc(C,I,II,L,LL) :-
scmcall('gp-make-cc',[self,stack,l(C),cut],I,I1,L,L1),
move(I1-1,I,L1,LL),
II is I + 1.
")
(define (gp-make-p p self)
(make-closure self self.vec p.ip p.stack p.cut p.scut))
(define (gp-make-cc self stack next-ip cut scut)
(make-closure self.proc self.vec ip stack cut scut))
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
#:use-module (logic guile-log vm utils) #:use-module (logic guile-log vm utils)
#:export (icons! ifkn! icurly! #:export (icons! ifkn! icurly!
mk-cons mk-fkn mk-curly mk-cons mk-fkn mk-curly
icons ifkn icurly)) icons ifkn icurly do_n_cons))
(compile-prolog-string (compile-prolog-string
" "
......
(define-module (logic guile-log vm push)
#:use-module ((logic guile-log iso-prolog)
#:renamer
(lambda (x) (if (eq? x 'reset)
'reset_iso
x)))
#:use-module (logic guile-log vm utils)
#:export (cutter goto-inst sp-move equal-instruction
push-instruction pushv push-variable
pop-variable pop seek dup clear-sp))
(compile-prolog-string
"
'clear-sp'(I,0,L,LL) :-
reset(0,L,LL).
cutter(V,VC,I,L,LL) :-
gset(cut,V,I,L,L1),
gset(scut,VC,I,L1,L2),
reset(I,L2,LL).
'goto-inst'(Inst,I,L,LL) :-
gref(I,c(Inst),I,L,L1),
generate(goto(I),L1,LL).
cut(I,L,LL) :-
isZero(cut,I,L,L2),
jne(Lab,L2,L3),
gset(p,vcut,I,L3,L4),
j(Lab2,L4,L5),
gset(p,cut,I,L6,L7).
scmcall('gp-prune',[scut],I,_,L7,L8),
reset(I,L8,LL).
'sp-move'(V,I,II,L,LL) :-
II is I - 1,
gset(V,svar(II),I,L,LL),
reset(II,L1,LL).
'equal-instruction'(C,I,II,L,LL) :-
pltest('equal?',[sp(I-1),c(C)],I,L,L2),
II is I - 1,
reset(II,L2,LL).
'push-instruction'(C,I,II,L,LL) :-
gset(sp(I),c(C),I,L,L1),
II is I + 1,
reset(II,L1,LL).
pushv(X,I,II,L,LL) :-
scmcall('gp-var!',[s],I,I2,L,L1),
gset(sp[I],svar(I2-1),I2,L1,L2),
II is I + 1,
reset(II,L2,LL).
'push-variable'(V,I,II,L,LL) :-
gset(sp(I),V,I,L,L1),
II is I + 1,
reset(II,L1,LL).
'pop-variable'(V,I,II,L,LL) :-
gset(V,sp(I-1),L,L1),
II is I - 1,
reset(II,L1,LL).
pop(N,I,II,L,LL) :-
II is I - N,
reset(II,L,LL).
seek(N,I,II,L,LL) :-
II is I + N,
reset(II,L,LL).
dup(I,II,L,LL) :-
move(I,I-1,L,L1),
II is I + 1,
reset(II,L1,LL).
")
...@@ -2,16 +2,23 @@ ...@@ -2,16 +2,23 @@
#:use-module (logic guile-log iso-prolog) #:use-module (logic guile-log iso-prolog)
#:export (reset gset gref move scmcall make_p make_cc j je jne #:export (reset gset gref move scmcall make_p make_cc j je jne
label gfalse isTrue pltest lookup2 label gfalse isTrue pltest lookup2
test)) test sp cc vec cut scut pp))
(compile-prolog-string (compile-prolog-string
" "
generate(Tok,[Tok|LL],LL). generate(Tok,[Tok|LL],LL).
id(s , sp(0)). id(s ,sp(0)).
id(p , sp(1)). id(p ,sp(1)).
id(cc , sp(2)). id(cut ,sp(2)).
id(vec, sp(3)). id(scut ,sp(3))
id(vec ,sp(4)).
id(stack,sp(5)),
id(cc ,var(0)).
sp(6).
e(cc(C),I,II,L,LL) :- cc(C,I,II,L,LL).
e(pp,I,II,L,LL) :- pp(I,II,L,LL).
reset(I,L,LL) :- reset(I,L,LL) :-
call(II is I), call(II is I),
...@@ -38,6 +45,9 @@ ...@@ -38,6 +45,9 @@
gref(var(X),I,L,LL) :- gref(var(X),I,L,LL) :-
var_ref(X,I,L,LL). var_ref(X,I,L,LL).
gref(l(X),I,L,LL) :- !,
generate('label-ref'(I,X),L,LL).
gref(sp(X),I,L,LL) :- gref(sp(X),I,L,LL) :-
move(X,I,L,LL). move(X,I,L,LL).
...@@ -110,14 +120,6 @@ ...@@ -110,14 +120,6 @@
II is I2 + 1, II is I2 + 1,
reset(II,L4,LL). reset(II,L4,LL).
make_p(I,L,LL) :-
scmcall('gp-make-p',[self,p],I,L,L1),
move(I+3,I,L1,L2).
make_cc(I,L,LL) :-
scmcall('gp-make-cc',[self,cc],I,L,L1),
move(I+3,I,L1,L2).
j(Label,L,LL) :- j(Label,L,LL) :-
generate(j(Label),L,LL). generate(j(Label),L,LL).
......
This diff is collapsed.
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