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

WIP

Browse source
This commit is contained in:
Justin Ethier 2016-06-02 22:04:37 -04:00
parent 8f5308de37
commit eec41cce39
2 changed files with 43 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -28,6 +28,7 @@
optimize-cps
analyze-cps
opt:contract
contract-prims
adb:clear!
adb:get
adb:get/default
@ -415,6 +416,44 @@
(else
(error "CPS optimize [1] - Unknown expression" exp))))
(define (contract-prims exp)
(cond
((const? exp) exp)
((quote? exp) exp)
((ref? exp) exp)
((ast:lambda? exp)
(ast:%make-lambda
(ast:lambda-id exp)
(ast:lambda-args exp)
(map contract-prims (ast:lambda-body exp))))
((define? exp)
`(define ,(define->var exp)
,(contract-prims (define->exp exp))))
((set!? exp)
`(set! ,(set!->var exp)
,(contract-prims (set!->exp exp))))
((if? exp) `(if ,(contract-prims (if->condition exp))
,(contract-prims (if->then exp))
,(contract-prims (if->else exp))))
; Application:
((app? exp)
(cond
((ast:lambda? exp)
'TODO)
(else
(map contract-prims exp))))
(else
(error `(Unexpected expression passed to contract-prims ,exp)))))
;; Do all the expressions contain prim calls?
;; TODO: check for prim calls accepting no continuation
(define (all-prim-calls? exps)
(cond
((null? exps) #t)
((prim-call? (car exps))
(all-prim-calls? (cdr exps)))
(else #f)))
(define (analyze-cps exp)
(analyze exp -1) ;; Top-level is lambda ID -1
(analyze2 exp) ;; Second pass

14
test-cps.scm
View file

@ -76,7 +76,7 @@ makes some assumptions about there only being one prim per function, I believe
0)))))
;; TODO: update
#;(#((record-marker)
(#((record-marker)
#((record-marker) #f (id args body))
#(6
()
@ -88,20 +88,10 @@ makes some assumptions about there only being one prim per function, I believe
#((record-marker) #f (id args body))
#(4
(x$3 y$2 z$1)
((#((record-marker)
#((record-marker) #f (id args body))
#(3
(r$4)
((#((record-marker)
#((record-marker) #f (id args body))
#(2
(r$3)
((write #((record-marker)
#((record-marker) #f (id args body))
#(1 (r$1) ((r$1 %halt))))
r$3))))
(cons x$3 r$4)))))
(cons y$2 z$1)))))
(cons x$3 (cons y$2 z$1))))))
1
2
3))))