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

WIP - use AST to store lambdas after CPS convert

Browse source
This commit is contained in:
Justin Ethier 2016-05-06 00:24:57 -04:00
parent b163010d21
commit a86a8262fa
2 changed files with 86 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
cyclone.scm
View file

@ -13,6 +13,7 @@
(scheme lazy) (scheme lazy)
(scheme read) (scheme read)
(scheme write) (scheme write)
(scheme cyclone ast)
(scheme cyclone common) (scheme cyclone common)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone cgen) (scheme cyclone cgen)
@ -205,8 +206,13 @@
;; call/cc must be written in CPS form, so it is added here ;; call/cc must be written in CPS form, so it is added here
;; TODO: prevents this from being optimized-out ;; TODO: prevents this from being optimized-out
;; TODO: will this cause issues if another var is assigned to call/cc? ;; TODO: will this cause issues if another var is assigned to call/cc?
'(define call/cc `(define call/cc
(lambda (k f) (f k (lambda (_ result) (k result))))) ,(ast:make-lambda
'(k f)
(list 'f 'k
(ast:make-lambda '(_ result)
'(k result)))))
;(lambda (k f) (f k (lambda (_ result) (k result)))))
cps)));) cps)));)
(else (else
;; No need for call/cc yet ;; No need for call/cc yet

161
scheme/cyclone/transforms.sld
View file

@ -348,6 +348,9 @@
(car (reverse (lambda-formals->list exp)))) ; Last arg is varargs (car (reverse (lambda-formals->list exp)))) ; Last arg is varargs
#f)) #f))
(define (ast:lambda-formals-type ast)
(lambda-formals-type `(#f ,(ast:lambda-args ast) #f)))
(define (lambda-formals-type exp) (define (lambda-formals-type exp)
(let ((args (lambda->formals exp))) (let ((args (lambda->formals exp)))
(cond (cond
@ -357,6 +360,9 @@
(else (else
(error `(Unexpected formals list in lambda-formals-type: ,args)))))) (error `(Unexpected formals list in lambda-formals-type: ,args))))))
(define (ast:lambda-formals->list ast)
(lambda-formals->list `(#f ,(ast:lambda-args ast) #f)))
(define (lambda-formals->list exp) (define (lambda-formals->list exp)
(if (lambda-varargs? exp) (if (lambda-varargs? exp)
(let ((args (lambda->formals exp))) (let ((args (lambda->formals exp)))
@ -1165,6 +1171,9 @@
((lambda? exp) ((lambda? exp)
(map analyze-mutable-variables (lambda->exp exp)) (map analyze-mutable-variables (lambda->exp exp))
(void)) (void))
((ast:lambda? exp)
(map analyze-mutable-variables (ast:lambda-body exp))
(void))
((set!? exp) ((set!? exp)
(mark-mutable (set!->var exp)) (mark-mutable (set!->var exp))
(analyze-mutable-variables (set!->exp exp))) (analyze-mutable-variables (set!->exp exp)))
@ -1172,20 +1181,6 @@
(analyze-mutable-variables (if->condition exp)) (analyze-mutable-variables (if->condition exp))
(analyze-mutable-variables (if->then exp)) (analyze-mutable-variables (if->then exp))
(analyze-mutable-variables (if->else exp))) (analyze-mutable-variables (if->else exp)))
; Sugar:
((let? exp)
(map analyze-mutable-variables (map cadr (let->bindings exp)))
(map analyze-mutable-variables (let->exp exp))
(void))
((letrec? exp)
(map analyze-mutable-variables (map cadr (letrec->bindings exp)))
(map analyze-mutable-variables (letrec->exp exp))
(void))
((begin? exp)
(map analyze-mutable-variables (begin->exps exp))
(void))
; Application: ; Application:
((app? exp) ((app? exp)
(map analyze-mutable-variables exp) (map analyze-mutable-variables exp)
@ -1450,7 +1445,7 @@
(if (ref? cont-ast) ; prevent combinatorial explosion (if (ref? cont-ast) ; prevent combinatorial explosion
(xform cont-ast) (xform cont-ast)
(let ((k (gensym 'k))) (let ((k (gensym 'k)))
(list (list 'lambda (list (ast:make-lambda
(list k) (list k)
(xform k)) (xform k))
cont-ast))))) cont-ast)))))
@ -1466,13 +1461,13 @@
(let ((k (gensym 'k)) (let ((k (gensym 'k))
(ltype (lambda-formals-type ast))) (ltype (lambda-formals-type ast)))
(list cont-ast (list cont-ast
`(lambda (ast:make-lambda
,(list->lambda-formals (list->lambda-formals
(cons k (cadr ast)) ; lam params (cons k (cadr ast)) ; lam params
(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))))) (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?
@ -1485,8 +1480,7 @@
((lambda? fn) ((lambda? fn)
(cps-list (app->args ast) (cps-list (app->args ast)
(lambda (vals) (lambda (vals)
(cons (list (cons (ast:make-lambda
'lambda
(lambda->formals fn) (lambda->formals fn)
(cps-seq (cddr fn) ;(ast-subx fn) (cps-seq (cddr fn) ;(ast-subx fn)
cont-ast)) cont-ast))
@ -1515,7 +1509,7 @@
(else (else
(let ((r (gensym 'r))) ;(new-var 'r))) (let ((r (gensym 'r))) ;(new-var 'r)))
(cps (car asts) (cps (car asts)
`(lambda (,r) ,(body r))))))) (ast:make-lambda (list r) (body r)))))))
(define (cps-seq asts cont-ast) (define (cps-seq asts cont-ast)
(cond ((null? asts) (cond ((null? asts)
@ -1525,9 +1519,9 @@
(else (else
(let ((r (gensym 'r))) (let ((r (gensym 'r)))
(cps (car asts) (cps (car asts)
`(lambda (ast:make-lambda
(,r) (list r)
,(cps-seq (cdr asts) cont-ast))))))) (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)
@ -1553,54 +1547,55 @@
;; TODO: don't think we can assume lambda body is single expr, if we want ;; TODO: don't think we can assume lambda body is single expr, if we want
;; to do optimizations such as inlining ;; to do optimizations such as inlining
(define (cps-optimize-01 exp) (define (cps-optimize-01 exp)
(define (opt-lambda exp) exp) ;; Temporarily disabling while this is reworked.
(let ((body (car (lambda->exp exp)))) ;; Single expr after CPS ; (define (opt-lambda exp)
;(trace:error `(DEBUG ; (let ((body (car (lambda->exp exp)))) ;; Single expr after CPS
; ,exp ; ;(trace:error `(DEBUG
; ,body ; ; ,exp
; ,(if (and (pair? body) (app? body) (lambda? (car body))) ; ; ,body
; (list (app->args body) ; ; ,(if (and (pair? body) (app? body) (lambda? (car body)))
; (lambda->formals exp)) ; ; (list (app->args body)
; #f))) ; ; (lambda->formals exp))
(cond ; ; #f)))
;; Does the function just call its continuation? ; (cond
((and (pair? body) ; ;; Does the function just call its continuation?
(app? body) ; ((and (pair? body)
(lambda? (car body)) ; (app? body)
;; TODO: need to check body length if we allow >1 expr in a body ; (lambda? (car body))
;; TODO: not sure this is good enough for all cases ; ;; TODO: need to check body length if we allow >1 expr in a body
(equal? (app->args body) ; ;; TODO: not sure this is good enough for all cases
;(lambda->formals (car body)) ; (equal? (app->args body)
(lambda->formals exp) ; ;(lambda->formals (car body))
) ; (lambda->formals exp)
(> (length (lambda->formals exp)) 0) ; )
;; TODO: don't do it if args are used in the body ; (> (length (lambda->formals exp)) 0)
;; this won't work if we have any num other than 1 arg ; ;; TODO: don't do it if args are used in the body
(not (member ; ;; this won't work if we have any num other than 1 arg
(car (lambda->formals exp)) ; (not (member
(free-vars (car body)))) ; (car (lambda->formals exp))
) ; (free-vars (car body))))
(cps-optimize-01 (car body))) ; )
(else ; (cps-optimize-01 (car body)))
`(lambda ,(lambda->formals exp) ; (else
,(cps-optimize-01 (car (lambda->exp exp)))) ;; Assume single expr in lambda body, since after CPS phase ; `(lambda ,(lambda->formals exp)
)))) ; ,(cps-optimize-01 (car (lambda->exp exp)))) ;; Assume single expr in lambda body, since after CPS phase
(cond ; ))))
; Core forms: ; (cond
((const? exp) exp) ; ; Core forms:
((ref? exp) exp) ; ((const? exp) exp)
((prim? exp) exp) ; ((ref? exp) exp)
((quote? exp) exp) ; ((prim? exp) exp)
((lambda? exp) (opt-lambda exp)) ; ((quote? exp) exp)
((set!? exp) `(set! ; ((lambda? exp) (opt-lambda exp))
,(set!->var exp) ; ((set!? exp) `(set!
,(cps-optimize-01 (set!->exp exp)))) ; ,(set!->var exp)
((if? exp) `(if ,(cps-optimize-01 (if->condition exp)) ; ,(cps-optimize-01 (set!->exp exp))))
,(cps-optimize-01 (if->then exp)) ; ((if? exp) `(if ,(cps-optimize-01 (if->condition exp))
,(cps-optimize-01 (if->else exp)))) ; ,(cps-optimize-01 (if->then exp))
; Application: ; ,(cps-optimize-01 (if->else exp))))
((app? exp) (map (lambda (e) (cps-optimize-01 e)) exp)) ; ; Application:
(else (error "CPS optimize unknown expression type: " exp)))) ; ((app? exp) (map (lambda (e) (cps-optimize-01 e)) exp))
; (else (error "CPS optimize unknown expression type: " exp))))
;; Closure-conversion. ;; Closure-conversion.
;; ;;
@ -1639,18 +1634,18 @@
,@(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) ((ast:lambda? exp)
(let* ((new-self-var (gensym 'self)) (let* ((new-self-var (gensym 'self))
(body (lambda->exp exp)) (body (ast:lambda-body exp))
(new-free-vars (new-free-vars
(difference (difference
(difference (free-vars body) (lambda-formals->list exp)) (difference (free-vars body) (ast:lambda-formals->list exp))
globals))) globals)))
`(%closure `(%closure
(lambda (lambda
,(list->lambda-formals ,(list->lambda-formals
(cons new-self-var (lambda-formals->list exp)) (cons new-self-var (ast:lambda-formals->list exp))
(lambda-formals-type 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 (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? ,@(map (lambda (v) ;; TODO: splice here?
(cc v)) (cc v))
@ -1663,11 +1658,11 @@
((app? exp) ((app? exp)
(let ((fn (car exp)) (let ((fn (car exp))
(args (map cc (cdr exp)))) (args (map cc (cdr exp))))
(if (lambda? fn) (if (ast:lambda? fn)
(let* ((body (lambda->exp fn)) (let* ((body (ast:lambda-body fn))
(new-free-vars (new-free-vars
(difference (difference
(difference (free-vars body) (lambda-formals->list fn)) (difference (free-vars body) (ast: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?
@ -1676,14 +1671,14 @@
`((%closure `((%closure
(lambda (lambda
,(list->lambda-formals ,(list->lambda-formals
(cons new-self-var (lambda-formals->list fn)) (cons new-self-var (ast:lambda-formals->list fn))
(lambda-formals-type fn)) (ast: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 ,(lambda->formals fn) `((lambda ,(ast:lambda-args fn)
,@(map cc body)) ,@(map cc body))
,@args))) ,@args)))
(let ((f (cc fn))) (let ((f (cc fn)))