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

Fixes for lambda AST

Browse source 
- When creating a lambda ast, wrap the body in a list, just like the previous code
- Modified wrap-mutables to handle and unpack lambda AST's
- Reverted changes to closure conversion, as that code will now receive regular lambda's instead of AST lambda's
This commit is contained in:
Justin Ethier 2016-05-07 00:51:10 -04:00
parent 9b72e8dcd7
commit f440d45dd0
1 changed files with 33 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
scheme/cyclone/transforms.sld
View file

@ -1203,6 +1203,11 @@
(cond (cond
; Core forms: ; Core forms:
((ast:lambda? exp)
`(lambda ,(ast:lambda-args exp)
,(wrap-mutable-formals
(ast:lambda-formals->list exp)
(wrap-mutables (car (ast:lambda-body exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase
((const? exp) exp) ((const? exp) exp)
((ref? exp) (if (and (not (member exp globals)) ((ref? exp) (if (and (not (member exp globals))
(is-mutable? exp)) (is-mutable? exp))
@ -1447,7 +1452,7 @@
(let ((k (gensym 'k))) (let ((k (gensym 'k)))
(list (ast:make-lambda (list (ast:make-lambda
(list k) (list k)
(xform k)) (list (xform k)))
cont-ast))))) cont-ast)))))
((prim-call? ast) ((prim-call? ast)
@ -1467,7 +1472,7 @@
(if (equal? ltype 'args:varargs) (if (equal? ltype 'args:varargs)
'args:fixed-with-varargs ;; OK? promote due to k 'args:fixed-with-varargs ;; OK? promote due to k
ltype)) ltype))
(cps-seq (cddr ast) k))))) (list (cps-seq (cddr ast) k))))))
; ;
; TODO: begin is expanded already by desugar code... better to do it here? ; TODO: begin is expanded already by desugar code... better to do it here?
@ -1482,8 +1487,8 @@
(lambda (vals) (lambda (vals)
(cons (ast:make-lambda (cons (ast:make-lambda
(lambda->formals fn) (lambda->formals fn)
(cps-seq (cddr fn) ;(ast-subx fn) (list (cps-seq (cddr fn) ;(ast-subx fn)
cont-ast)) cont-ast)))
vals)))) vals))))
(else (else
(cps-list ast ;(ast-subx ast) (cps-list ast ;(ast-subx ast)
@ -1509,7 +1514,7 @@
(else (else
(let ((r (gensym 'r))) ;(new-var 'r))) (let ((r (gensym 'r))) ;(new-var 'r)))
(cps (car asts) (cps (car asts)
(ast:make-lambda (list r) (body r))))))) (ast:make-lambda (list r) (list (body r))))))))
(define (cps-seq asts cont-ast) (define (cps-seq asts cont-ast)
(cond ((null? asts) (cond ((null? asts)
@ -1521,7 +1526,7 @@
(cps (car asts) (cps (car asts)
(ast:make-lambda (ast:make-lambda
(list r) (list r)
(cps-seq (cdr asts) cont-ast))))))) (list (cps-seq (cdr asts) cont-ast))))))))
;; Remove dummy symbol inserted into define forms converted to CPS ;; Remove dummy symbol inserted into define forms converted to CPS
(define (remove-unused ast) (define (remove-unused ast)
@ -1617,23 +1622,6 @@
(define (convert exp self-var free-var-lst) (define (convert exp self-var free-var-lst)
(define (cc exp) (define (cc exp)
(cond (cond
((ast:lambda? exp)
(let* ((new-self-var (gensym 'self))
(body (ast:lambda-body exp))
(new-free-vars
(difference
(difference (free-vars body) (ast:lambda-formals->list exp))
globals)))
`(%closure
(lambda
,(list->lambda-formals
(cons new-self-var (ast:lambda-formals->list exp))
(ast:lambda-formals-type exp))
,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc.
;,(convert body new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc.
,@(map (lambda (v) ;; TODO: splice here?
(cc v))
new-free-vars))))
((const? exp) exp) ((const? exp) exp)
((quote? exp) exp) ((quote? exp) exp)
((ref? exp) ((ref? exp)
@ -1651,6 +1639,22 @@
,@(map cc (cdr exp)))) ;; TODO: need to splice? ,@(map cc (cdr exp)))) ;; TODO: need to splice?
((set!? exp) `(set! ,(set!->var exp) ((set!? exp) `(set! ,(set!->var exp)
,(cc (set!->exp exp)))) ,(cc (set!->exp exp))))
((lambda? exp)
(let* ((new-self-var (gensym 'self))
(body (lambda->exp exp))
(new-free-vars
(difference
(difference (free-vars body) (lambda-formals->list exp))
globals)))
`(%closure
(lambda
,(list->lambda-formals
(cons new-self-var (lambda-formals->list exp))
(lambda-formals-type exp))
,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc.
,@(map (lambda (v) ;; TODO: splice here?
(cc v))
new-free-vars))))
((if? exp) `(if ,@(map cc (cdr exp)))) ((if? exp) `(if ,@(map cc (cdr exp))))
((cell? exp) `(cell ,(cc (cell->value exp)))) ((cell? exp) `(cell ,(cc (cell->value exp))))
((cell-get? exp) `(cell-get ,(cc (cell-get->cell exp)))) ((cell-get? exp) `(cell-get ,(cc (cell-get->cell exp))))
@ -1659,11 +1663,11 @@
((app? exp) ((app? exp)
(let ((fn (car exp)) (let ((fn (car exp))
(args (map cc (cdr exp)))) (args (map cc (cdr exp))))
(if (ast:lambda? fn) (if (lambda? fn)
(let* ((body (ast:lambda-body fn)) (let* ((body (lambda->exp fn))
(new-free-vars (new-free-vars
(difference (difference
(difference (free-vars body) (ast:lambda-formals->list fn)) (difference (free-vars body) (lambda-formals->list fn))
globals)) globals))
(new-free-vars? (> (length new-free-vars) 0))) (new-free-vars? (> (length new-free-vars) 0)))
(if new-free-vars? (if new-free-vars?
@ -1672,14 +1676,14 @@
`((%closure `((%closure
(lambda (lambda
,(list->lambda-formals ,(list->lambda-formals
(cons new-self-var (ast:lambda-formals->list fn)) (cons new-self-var (lambda-formals->list fn))
(ast:lambda-formals-type fn)) (lambda-formals-type fn))
,(convert (car body) new-self-var new-free-vars)) ,(convert (car body) new-self-var new-free-vars))
,@(map (lambda (v) (cc v)) ,@(map (lambda (v) (cc v))
new-free-vars)) new-free-vars))
,@args)) ,@args))
; No free vars, just create simple lambda ; No free vars, just create simple lambda
`((lambda ,(ast:lambda-args fn) `((lambda ,(lambda->formals fn)
,@(map cc body)) ,@(map cc body))
,@args))) ,@args)))
(let ((f (cc fn))) (let ((f (cc fn)))