From d18813441649665f42b524443c65d0b6bb4ac59a Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Tue, 12 Jul 2022 22:55:48 -0700 Subject: Add builtin operations to IR1. --- csc/cps.csc | 42 ++++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 14 deletions(-) (limited to 'csc/cps.csc') 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 -- cgit v1.3.1