Add cps param

This commit is contained in:
Justin Ethier 2017-04-20 17:57:59 -04:00
parent f50aafffe4
commit 021113ced4

View file

@ -286,7 +286,7 @@
(let* ((preamble "")
(append-preamble (lambda (s)
(set! preamble (string-append preamble " " s "\n"))))
(body (c-compile-exp exp append-preamble "cont" (list src-file))))
(body (c-compile-exp exp append-preamble "cont" (list src-file) #t)))
;(write `(DEBUG ,body))
(string-append
preamble
@ -334,7 +334,7 @@
((tagged-list? 'lambda exp)
(c-compile-exp
`(%closure ,exp)
append-preamble cont trace))
append-preamble cont trace #t))
; Application:
((app? exp) (c-compile-app exp append-preamble cont trace cps?))
@ -660,7 +660,7 @@
(mangle exp))))
; c-compile-args : list[exp] (string -> void) -> string
(define (c-compile-args args append-preamble prefix cont trace)
(define (c-compile-args args append-preamble prefix cont trace cps?)
(letrec ((num-args 0)
(_c-compile-args
(lambda (args append-preamble prefix cont)
@ -673,7 +673,7 @@
(c:append/prefix
prefix
(c-compile-exp (car args)
append-preamble cont trace)
append-preamble cont trace cps?)
(_c-compile-args (cdr args)
append-preamble ", " cont)))))))
(c:tuple/args
@ -698,7 +698,8 @@
append-preamble
""
this-cont
trace))
trace
cps?))
(num-cargs (c:num-args cgen)))
(set-c-call-arity! num-cargs)
(c-code
@ -713,7 +714,7 @@
(let* ((c-fun
(c-compile-prim fun cont))
(c-args
(c-compile-args args append-preamble "" "" trace))
(c-compile-args args append-preamble "" "" trace cps?))
(num-args (length args))
(num-args-str
(string-append
@ -761,9 +762,9 @@
;; TODO: may not be good enough, closure app could be from an element
((tagged-list? '%closure-ref fun)
(let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace))
(let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace cps?))
(this-cont (c:body cfun))
(cargs (c-compile-args (cdr args) append-preamble " " this-cont trace)))
(cargs (c-compile-args (cdr args) append-preamble " " this-cont trace cps?)))
(set-c-call-arity! (c:num-args cargs))
(c-code
(string-append
@ -781,7 +782,7 @@
fun append-preamble cont trace))
(this-cont (string-append "(closure)" (c:body cfun)))
(cargs (c-compile-args
args append-preamble " " this-cont trace))
args append-preamble " " this-cont trace cps?))
(num-cargs (c:num-args cargs)))
(set-c-call-arity! num-cargs)
(c-code
@ -801,7 +802,7 @@
; c-compile-if : if-exp -> string
(define (c-compile-if exp append-preamble cont trace cps?)
(let* ((compile (lambda (exp)
(c-compile-exp exp append-preamble cont trace)))
(c-compile-exp exp append-preamble cont trace cps?)))
(test (compile (if->condition exp)))
(then (compile (if->then exp)))
(els (compile (if->else exp))))
@ -847,7 +848,7 @@
(lambda? body)
(c-compile-exp
body append-preamble cont
(st:add-function! trace var)))
(st:add-function! trace var) #t))
;; Add inline global definition also, if applicable
; (trace:error `(JAE DEBUG ,var
@ -1148,7 +1149,8 @@
(car (lambda->exp exp)) ;; car ==> assume single expr in lambda body after CPS
append-preamble
(mangle env-closure)
trace)))
trace
#t)))
(cons
(lambda (name)
(string-append "static void " name