diff options
Diffstat (limited to 'csc/cps.csc')
| -rw-r--r-- | csc/cps.csc | 38 |
1 files changed, 26 insertions, 12 deletions
diff --git a/csc/cps.csc b/csc/cps.csc index 1f58287..230a1c4 100644 --- a/csc/cps.csc +++ b/csc/cps.csc @@ -23,6 +23,7 @@ %lexical-ref %lexical-set %library-define + %library-ref %sequence call? constant? @@ -54,6 +55,8 @@ %branch %fix %primitive + *globals* + branch-atom closure-arguments closure-body closure-name @@ -205,9 +208,14 @@ (define (to-cps expr continuation) (match expr (_ when (or (constant? expr) - (lexical-ref? expr) - (library-ref? expr)) + (lexical-ref? expr)) (continuation expr)) + ((% %library-ref . _) + (unless (library-ref? expr) + (error "wtf")) + (define temp (new-ref)) + (make-primitive 'peek (list *globals* expr) (list temp) + (continuation temp))) ((% %lexical-set ref arg) (to-cps arg @@ -343,10 +351,9 @@ (define (box-conversion expr) (define boxed-refs (get-boxed expr)) (define (boxed? ref) - (or (library-ref? ref) ; globals are always boxed - (and (lexical-ref? ref) - (guard (e ((key-not-found-error? e) #f)) - (lookup boxed-refs ref))))) + (and (lexical-ref? ref) + (guard (e ((key-not-found-error? e) #f)) + (lookup boxed-refs ref)))) (define (convert-arg-list args) (define boxed-args (loop for arg in args if (boxed? arg) @@ -363,7 +370,10 @@ (values new-args boxed-args vars)) (let convert ((expr expr)) (match expr - ((% %update ref atom continuation) + ((% %update ref atom continuation) when (library-ref? ref) + (make-primitive 'poke (list atom *globals* ref) '() + (convert continuation))) + ((% %update ref atom continuation) when (lexical-ref? ref) (make-primitive 'poke (list atom ref (make-constant 0)) '() (convert continuation))) ((% %primitive op args res continuation) ; Note that no reference in res can be boxed. @@ -374,12 +384,16 @@ do (set! new-expr (make-primitive 'peek (list arg (make-constant 0)) (list var) new-expr)) finally (return new-expr))) + ((% %branch atom true false) when (boxed? atom) + (define temp (new-ref)) + (make-primitive 'peek (list atom (make-constant 0)) (list temp) + (make-branch temp + (convert true) + (convert false)))) ((% %branch atom true false) - (if (boxed? atom) - (let ((var (new-ref))) - (make-primitive 'peek (list atom (make-constant 0)) (list var) - (make-branch var (convert true) (convert false)))) - (make-branch atom (convert true) (convert false)))) + (make-branch atom + (convert true) + (convert false))) ((% %apply proc args) (define-values (new-params boxed-params vars) (convert-arg-list (cons proc args))) (define new-expr (make-apply (car new-params) (cdr new-params))) |