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

Keep track of lambda's with continuations

Browse source
This commit is contained in:
Justin Ethier 2017-05-04 06:50:09 +00:00
parent c7aa3700ea
commit 3bd5d52671
3 changed files with 20 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
scheme/cyclone/ast.sld
View file

@ -21,16 +21,21 @@
ast:set-lambda-args! ast:set-lambda-args!
ast:lambda-body ast:lambda-body
ast:set-lambda-body! ast:set-lambda-body!
ast:lambda-has-cont
ast:set-lambda-has-cont!
) )
(begin (begin
(define *lambda-id* 0) (define *lambda-id* 0)
(define-record-type <lambda-ast> (define-record-type <lambda-ast>
(ast:%make-lambda id args body) (ast:%make-lambda id args body has-cont)
ast:lambda? ast:lambda?
(id ast:lambda-id) (id ast:lambda-id)
(args ast:lambda-args ast:set-lambda-args!) (args ast:lambda-args ast:set-lambda-args!)
(body ast:lambda-body ast:set-lambda-body!)) (body ast:lambda-body ast:set-lambda-body!)
(define (ast:make-lambda args body) (has-cont ast:lambda-has-cont ast:set-lambda-has-cont!)
)
(define (ast:make-lambda args body . opts)
(let ((has-cont (if (pair? opts) (car opts) #f)))
(set! *lambda-id* (+ 1 *lambda-id*)) (set! *lambda-id* (+ 1 *lambda-id*))
(ast:%make-lambda *lambda-id* args body)) (ast:%make-lambda *lambda-id* args body has-cont)))
)) ))

9
scheme/cyclone/cps-optimizations.sld
View file

@ -598,7 +598,8 @@
(ast:%make-lambda (ast:%make-lambda
(ast:lambda-id exp) (ast:lambda-id exp)
(ast:lambda-args exp) (ast:lambda-args exp)
(opt:contract (ast:lambda-body exp)))))) (opt:contract (ast:lambda-body exp))
(ast:lambda-has-cont exp)))))
((const? exp) exp) ((const? exp) exp)
((ref? exp) ((ref? exp)
(let ((var (adb:get/default exp #f))) (let ((var (adb:get/default exp #f)))
@ -652,7 +653,8 @@
(ast:%make-lambda (ast:%make-lambda
(ast:lambda-id fnc) (ast:lambda-id fnc)
(reverse new-params) (reverse new-params)
(ast:lambda-body fnc)) (ast:lambda-body fnc)
(ast:lambda-has-cont fnc))
(map (map
opt:contract opt:contract
(reverse new-args))))) (reverse new-args)))))
@ -683,7 +685,8 @@
(ast:%make-lambda (ast:%make-lambda
(ast:lambda-id exp) (ast:lambda-id exp)
(ast:lambda-args exp) (ast:lambda-args exp)
(map (lambda (b) (opt:inline-prims b refs)) (ast:lambda-body exp)))) (map (lambda (b) (opt:inline-prims b refs)) (ast:lambda-body exp))
(ast:lambda-has-cont exp)))
((const? exp) exp) ((const? exp) exp)
((quote? exp) exp) ((quote? exp) exp)
((define? exp) ((define? exp)

6
scheme/cyclone/transforms.sld
View file

@ -1300,7 +1300,8 @@
(let ((k (gensym 'k))) (let ((k (gensym 'k)))
(list (ast:make-lambda (list (ast:make-lambda
(list k) (list k)
(list (xform k))) (list (xform k))
#t)
cont-ast))))) cont-ast)))))
((prim-call? ast) ((prim-call? ast)
@ -1327,7 +1328,8 @@
(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))
(list (cps-seq (cddr ast) k)))))) (list (cps-seq (cddr ast) k))
#t))))
((app? ast) ((app? ast)
;; Syntax check the function ;; Syntax check the function