aboutsummaryrefslogtreecommitdiffstats
path: root/csc/cps.csc
diff options
context:
space:
mode:
Diffstat (limited to 'csc/cps.csc')
-rw-r--r--csc/cps.csc42
1 files changed, 28 insertions, 14 deletions
diff --git a/csc/cps.csc b/csc/cps.csc
index a5b7d3b..d8cd8bd 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -15,6 +15,7 @@
merge)
(only (csc ir1)
%call
+ %call-builtin
%define-syntax
%if
%lambda
@@ -161,20 +162,33 @@
(lambda (f)
; Technically the order of evaluation is unspecified.
; We evaluate expressions left to right.
- ;
- ; I would use the loop macro, but it mutates the loop
- ; variables which plays badly with building a lambda.
- (let loop ((args* (reverse args))
- (exprs (lambda (vals)
- (make-apply f (cons return-address (reverse vals))))))
- (if (null? args*)
- (exprs '())
- (loop (cdr args*)
- (lambda (vals)
- (to-cps
- (car args*)
- (lambda (val)
- (exprs (cons val vals))))))))))))
+ (loop for arg in (reverse args)
+ with expr = (lambda (vals)
+ (make-apply f (cons return-address (reverse vals))))
+ do (set! expr (let ((e* expr)
+ (arg* arg)) ; make copies to avoid modifying the expr in the closure.
+ (lambda (vals)
+ (to-cps arg*
+ (lambda (val)
+ (e* (cons val vals)))))))
+ finally (return (expr '())))))))
+ ((% %call-builtin op args)
+ (define returns-value? (not (symbol=? op 'poke)))
+ (loop for arg in (reverse args)
+ with expr = (lambda (vals)
+ (if returns-value?
+ (let ((result (new-ref)))
+ (make-primitive op (reverse vals) (list result)
+ (continuation result)))
+ (make-primitive op (reverse vals) '()
+ (continuation (make-constant #f)))))
+ do (set! expr (let ((e* expr)
+ (arg* arg))
+ (lambda (vals)
+ (to-cps arg*
+ (lambda (val)
+ (e* (cons val vals)))))))
+ finally (return (expr '()))))
((% %sequence head tail)
(to-cps
head