Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 04:55:04 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add cps param

Browse source
This commit is contained in:
Justin Ethier 2017-04-20 17:57:59 -04:00
parent f50aafffe4
commit 021113ced4
1 changed files with 14 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
scheme/cyclone/cgen.sld
View file

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