Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 08:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-09-11 12:47:58 -04:00
parent c84a2ab356
commit f8af9833e1
1 changed files with 9 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
scheme/cyclone/cgen.sld
View file

@ -312,6 +312,11 @@
;; require CPS, so this flag is not applicable to them. ;; require CPS, so this flag is not applicable to them.
(define (c-compile-exp exp append-preamble cont trace cps?) (define (c-compile-exp exp append-preamble cont trace cps?)
(cond (cond
; Special case - global function w/out a closure. Create an empty closure
((ast:lambda? exp)
(c-compile-exp
`(%closure ,exp)
append-preamble cont trace cps?))
; Core forms: ; Core forms:
((const? exp) (c-compile-const exp)) ((const? exp) (c-compile-const exp))
((prim? exp) ((prim? exp)
@ -329,12 +334,6 @@
(c-compile-global exp append-preamble cont trace)) (c-compile-global exp append-preamble cont trace))
((define-c? exp) ((define-c? exp)
(c-compile-raw-global-lambda exp append-preamble cont trace)) (c-compile-raw-global-lambda exp append-preamble cont trace))
; Special case - global function w/out a closure. Create an empty closure
TODO: convert to ast lambda
((tagged-list? 'lambda exp)
(c-compile-exp
`(%closure ,exp)
append-preamble cont trace cps?))
; Application: ; Application:
((app? exp) (c-compile-app exp append-preamble cont trace cps?)) ((app? exp) (c-compile-app exp append-preamble cont trace cps?))
@ -962,14 +961,13 @@ TODO: convert to ast lambda
;(write `(add-global ,var-sym ,code)) ;(write `(add-global ,var-sym ,code))
(set! *globals* (cons (list var-sym lambda? code) *globals*))) (set! *globals* (cons (list var-sym lambda? code) *globals*)))
(define (c-compile-global exp append-preamble cont trace) (define (c-compile-global exp append-preamble cont trace)
TODO: assumes lambda's below:
(let ((var (define->var exp)) (let ((var (define->var exp))
(body (if (equal? 4 (length exp)) ; Simple var assignment contains superfluous %closure-ref (body (if (equal? 4 (length exp)) ; Simple var assignment contains superfluous %closure-ref
(cadddr exp) (cadddr exp)
(car (define->exp exp))))) (car (define->exp exp)))))
(add-global (add-global
var var
(lambda? body) (ast:lambda? body)
(c-compile-exp (c-compile-exp
body append-preamble cont body append-preamble cont
(st:add-function! trace var) #t)) (st:add-function! trace var) #t))
@ -980,7 +978,7 @@ TODO: assumes lambda's below:
; ,(define-c->inline-var exp) ; ,(define-c->inline-var exp)
; ,(prim:udf? (define-c->inline-var exp)) ; ,(prim:udf? (define-c->inline-var exp))
; )) ; ))
(when (and (lambda? body) (when (and (ast:lambda? body)
(prim:udf? (define-c->inline-var exp))) (prim:udf? (define-c->inline-var exp)))
(add-global-inline (add-global-inline
var var
@ -1114,10 +1112,12 @@ TODO: assumes lambda's below:
;; Note this must be the count before additional closure/CPS arguments ;; Note this must be the count before additional closure/CPS arguments
;; are added, so we need to detect those and not include them. ;; are added, so we need to detect those and not include them.
(define (compute-num-args lam) (define (compute-num-args lam)
AST TODO: lambda-num-args does not work for AST lambda's
(let ((count (lambda-num-args lam))) ;; Current arg count, may be too high (let ((count (lambda-num-args lam))) ;; Current arg count, may be too high
(cond (cond
((< count 0) -1) ;; Unlimited ((< count 0) -1) ;; Unlimited
(else (else
AST TODO:
(let ((formals (lambda-formals->list lam))) (let ((formals (lambda-formals->list lam)))
(- count (- count
(if (fl/closure? formals) 1 0) (if (fl/closure? formals) 1 0)