mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Keep track of lambda's with continuations
This commit is contained in:
parent
c7aa3700ea
commit
3bd5d52671
3 changed files with 20 additions and 10 deletions
|
@ -21,16 +21,21 @@
|
|||
ast:set-lambda-args!
|
||||
ast:lambda-body
|
||||
ast:set-lambda-body!
|
||||
ast:lambda-has-cont
|
||||
ast:set-lambda-has-cont!
|
||||
)
|
||||
(begin
|
||||
(define *lambda-id* 0)
|
||||
(define-record-type <lambda-ast>
|
||||
(ast:%make-lambda id args body)
|
||||
(ast:%make-lambda id args body has-cont)
|
||||
ast:lambda?
|
||||
(id ast:lambda-id)
|
||||
(args ast:lambda-args ast:set-lambda-args!)
|
||||
(body ast:lambda-body ast:set-lambda-body!))
|
||||
(define (ast:make-lambda args body)
|
||||
(set! *lambda-id* (+ 1 *lambda-id*))
|
||||
(ast:%make-lambda *lambda-id* args body))
|
||||
(body ast:lambda-body ast:set-lambda-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*))
|
||||
(ast:%make-lambda *lambda-id* args body has-cont)))
|
||||
))
|
||||
|
|
|
@ -598,7 +598,8 @@
|
|||
(ast:%make-lambda
|
||||
(ast:lambda-id 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)
|
||||
((ref? exp)
|
||||
(let ((var (adb:get/default exp #f)))
|
||||
|
@ -652,7 +653,8 @@
|
|||
(ast:%make-lambda
|
||||
(ast:lambda-id fnc)
|
||||
(reverse new-params)
|
||||
(ast:lambda-body fnc))
|
||||
(ast:lambda-body fnc)
|
||||
(ast:lambda-has-cont fnc))
|
||||
(map
|
||||
opt:contract
|
||||
(reverse new-args)))))
|
||||
|
@ -683,7 +685,8 @@
|
|||
(ast:%make-lambda
|
||||
(ast:lambda-id 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)
|
||||
((quote? exp) exp)
|
||||
((define? exp)
|
||||
|
|
|
@ -1300,7 +1300,8 @@
|
|||
(let ((k (gensym 'k)))
|
||||
(list (ast:make-lambda
|
||||
(list k)
|
||||
(list (xform k)))
|
||||
(list (xform k))
|
||||
#t)
|
||||
cont-ast)))))
|
||||
|
||||
((prim-call? ast)
|
||||
|
@ -1327,7 +1328,8 @@
|
|||
(if (equal? ltype 'args:varargs)
|
||||
'args:fixed-with-varargs ;; OK? promote due to k
|
||||
ltype))
|
||||
(list (cps-seq (cddr ast) k))))))
|
||||
(list (cps-seq (cddr ast) k))
|
||||
#t))))
|
||||
|
||||
((app? ast)
|
||||
;; Syntax check the function
|
||||
|
|
Loading…
Add table
Reference in a new issue