vm opt

parent e2a4c4c3
......@@ -87,6 +87,9 @@ handle([\"tail-call\",N],I,II,L,LL) :- !,
handle(['push-3',P,N],I,II,L,LL) :- !,
'push-3'(P,N,I,II,L,LL).
handle([\"push-s\"],I,II,L,LL) :- !,
'push-s'(I,II,L,LL).
handle(['pushtail-3',P],I,II,L,LL) :- !,
'pushtail-3'(P,I,II,L,LL).
......
;;Track Values in the stack
;;X->I source
;;I->II
;;II->Y (sink
;;[K,X]
(define-syntax-rule (aif it p . l) (let ((it p)) (if it . l)))
(define (opt l)
(let* ((v (list->vector l))
(n (length l)))
(let lp ((i 0) (clobs vlist-null) (sources vlist-null) (sinks vlist-null) (deletes '()))
(if (< i n)
(call-with-values (lambda () (clobber (vector-ref v i)))
(lambda (i1 i2)
(let ((sources
(cond
((and i1 i2)
(aif it (vhash-ref sources i1)
(aif it2 (vhash-ref clobs i2)
(if (< it2 it)
(begin
(set! deletes (cons i l))
(vhash-cons i2 it sources))
sources)
(vhash-cons it i2 sources))
(vhash-cons i2 i sources)))
(i1
sources)
(i2
(vhash-cons i2 i sources))
(else
sources)))
(sinks
(cond
((and i1 i2)
sinks)
(i1
(vhash-cons i1 i sinks))
(else
sinks)))
(clobs
(if i1
(vhash-cons i1 i clobs)
clobs)))
(lp (+ i 1) clobs sources sinks deletes))))
(begin
(let lp ((i 0))
(if (< i n)
(call-with-values (lambda () (clobber (vector-ref v i)))
(lambda (i1 i2)
(cond
((and i1 i2)
(if (member i deletes)
(begin
(vector-set! v i #f)
#t)
(aif it (vhash-ref i1 sources)
(call-with-values (lambda () (clobber (vector-ref v it)))
(lambda (j1 j2)
(if (= j2 i1)
#t
(vector-set! v i (modify-source i1 (vector-ref v i))))))
#t)))
(i1
(aif it (vhash-ref sources i2)
(call-with-values (lambda () (clobber (vector-ref v it)))
(lambda (j1 j2)
(if (and j1 j2)
(vector-set! v it (vector i j1)))))))
(else
#t))
(lp (+ i 1))))))
(let lp ((i 0) (l '()))
(if (< i n)
(let ((x (vector-ref v i)))
(if x
(begin
(if (vector? x)
(let ((j (vector-ref x 0))
(k (vector-ref x 1)))
(set! x (modify-sink (vector-ref v k) k))))
(lp (+ i 1) (cons x l)))
(lp (+ i 1) l)))
(reverse l))))))))
......@@ -8,11 +8,15 @@
#:replace (cutter goto-inst sp-move equal-instruction
push-instruction pushv push-variable set_p
pop-variable pop seek dup clear-sp push_at
push-variable-scm
push-variable-scm push-s
))
(compile-prolog-string
"
'push-s'(I,II,L,LL) :-
II is I + 1,
gset(sp(I),s,I,L,LL).
'clear-sp'(I,0,L,LL) :-
reset(0,L,LL).
......
......@@ -31,7 +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 push-variable-scm
set_p push-variable-scm push-s
;; 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