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

WIP - AST lambda integration

Browse source
This commit is contained in:
Justin Ethier 2018-09-06 18:55:43 -04:00
parent 8359f7a6f9
commit 941930af35
1 changed files with 36 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
scheme/cyclone/cgen.sld
View file

@ -717,6 +717,28 @@
(let* ((args (app->args exp)) (let* ((args (app->args exp))
(fun (app->fun exp))) (fun (app->fun exp)))
(cond (cond
((ast:lambda? fun)
(let* ((lid (allocate-lambda (c-compile-lambda fun trace #t))) ;; TODO: pass in free vars? may be needed to track closures
;; properly, wait until this comes up in an example
(this-cont (string-append "__lambda_" (number->string lid)))
(cgen
(c-compile-args
args
append-preamble
""
this-cont
trace
cps?))
(num-cargs (c:num-args cgen)))
(set-c-call-arity! num-cargs)
(c-code
(string-append
(c:allocs->str (c:allocs cgen))
"return_direct" (number->string num-cargs)
"(data," this-cont
(if (> num-cargs 0) "," "") ; TODO: how to propagate continuation - cont " "
(c:body cgen) ");"))))
;; Direct recursive call of top-level function ;; Direct recursive call of top-level function
((and (pair? trace) ((and (pair? trace)
(not (null? (cdr trace))) (not (null? (cdr trace)))
@ -770,28 +792,6 @@
"goto loop;"))) "goto loop;")))
) )
((lambda? fun)
(let* ((lid (allocate-lambda (c-compile-lambda fun trace #t))) ;; TODO: pass in free vars? may be needed to track closures
;; properly, wait until this comes up in an example
(this-cont (string-append "__lambda_" (number->string lid)))
(cgen
(c-compile-args
args
append-preamble
""
this-cont
trace
cps?))
(num-cargs (c:num-args cgen)))
(set-c-call-arity! num-cargs)
(c-code
(string-append
(c:allocs->str (c:allocs cgen))
"return_direct" (number->string num-cargs)
"(data," this-cont
(if (> num-cargs 0) "," "") ; TODO: how to propagate continuation - cont " "
(c:body cgen) ");"))))
((prim? fun) ((prim? fun)
(let* ((c-fun (let* ((c-fun
(c-compile-prim fun cont)) (c-compile-prim fun cont))
@ -1076,6 +1076,7 @@
(define inline-lambdas '()) (define inline-lambdas '())
; allocate-lambda : (string -> string) -> lambda-id ; allocate-lambda : (string -> string) -> lambda-id
TODO: check everything calling this function and/or using lambdas
(define (allocate-lambda lam . cps?) (define (allocate-lambda lam . cps?)
(let ((id num-lambdas)) (let ((id num-lambdas))
(set! num-lambdas (+ 1 num-lambdas)) (set! num-lambdas (+ 1 num-lambdas))
@ -1089,7 +1090,7 @@
; (cdr (assv id lambdas))) ; (cdr (assv id lambdas)))
(define (lambda->env exp) (define (lambda->env exp)
(let ((formals (lambda-formals->list exp))) (let ((formals (ast:lambda-formals->list exp)))
(if (pair? formals) (if (pair? formals)
(car formals) (car formals)
'unused))) 'unused)))
@ -1254,13 +1255,13 @@
(let* ((formals (c-compile-formals (let* ((formals (c-compile-formals
(if (not cps?) (if (not cps?)
;; Ignore continuation (k) arg for non-CPS funcs ;; Ignore continuation (k) arg for non-CPS funcs
(cdr (lambda->formals exp)) (cdr (ast:lambda-args exp))
(lambda->formals exp)) (ast:lambda-args exp))
(lambda-formals-type exp))) (ast:lambda-formals-type exp)))
(tmp-ident (if (> (length (lambda-formals->list exp)) 0) (tmp-ident (if (> (length (ast:lambda-formals->list exp)) 0)
(mangle (if (pair? (lambda->formals exp)) (mangle (if (pair? (ast:lambda-args exp))
(car (lambda->formals exp)) (car (ast:lambda-args exp))
(lambda->formals exp))) (ast:lambda-args exp)))
"")) ""))
(return-type (return-type
(if cps? "void" "object")) (if cps? "void" "object"))
@ -1288,7 +1289,7 @@
formals)) formals))
(env-closure (lambda->env exp)) (env-closure (lambda->env exp))
(body (c-compile-exp (body (c-compile-exp
(car (lambda->exp exp)) ;; car ==> assume single expr in lambda body after CPS (car (ast:lambda-body exp)) ;; car ==> assume single expr in lambda body after CPS
append-preamble append-preamble
(mangle env-closure) (mangle env-closure)
trace trace
@ -1300,18 +1301,20 @@
formals* formals*
") {\n" ") {\n"
preamble preamble
TODO: this and the rest of the "exp" instances in this function:
(if (lambda-varargs? exp) (if (lambda-varargs? exp)
;; Load varargs from C stack into Scheme list ;; Load varargs from C stack into Scheme list
(string-append (string-append
; DEBUGGING: ; DEBUGGING:
;"printf(\"%d %d\\n\", argc, " ;"printf(\"%d %d\\n\", argc, "
; (number->string (length (lambda-formals->list exp))) ");" ; (number->string (length (ast:lambda-formals->list exp))) ");"
"load_varargs(" "load_varargs("
TODO: ast equivalents for these next two:
(mangle (lambda-varargs-var exp)) (mangle (lambda-varargs-var exp))
", " ", "
(mangle (lambda-varargs-var exp)) (mangle (lambda-varargs-var exp))
"_raw, argc - " (number->string "_raw, argc - " (number->string
(- (length (lambda-formals->list exp)) (- (length (ast:lambda-formals->list exp))
1 1
(if has-closure? 1 0))) (if has-closure? 1 0)))
");\n"); ");\n");