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

Starting to build out analyze-cps

Browse source
This commit is contained in:
Justin Ethier 2016-05-06 22:09:50 -04:00
parent 4ae74841cf
commit acfba3751f
1 changed files with 49 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

100
scheme/cyclone/optimize-cps.sld
View file

@ -20,17 +20,11 @@
;(define-library (optimize-cps) ;(define-library (optimize-cps)
(define-library (scheme cyclone optimize-cps) (define-library (scheme cyclone optimize-cps)
(import (scheme base) (import (scheme base)
(srfi 69) (scheme cyclone util)
;(scheme char) (scheme cyclone ast)
;(scheme read) (scheme cyclone optimize-cps)
;(scheme write) (scheme cyclone transforms)
;(scheme cyclone common) (srfi 69))
;(scheme cyclone libraries)
;(scheme cyclone macros)
;(scheme cyclone pretty-print)
;(scheme cyclone util)
;(scheme cyclone transforms)
)
(export (export
analyze-cps analyze-cps
;adb:init! ;adb:init!
@ -81,44 +75,48 @@
(%adb:make-fnc #f #f)) (%adb:make-fnc #f #f))
; TODO: analyze-cps ; TODO: analyze-cps
; (define (wrap-mutables exp globals) (define (analyze-cps exp)
; (define (analyze exp lid)
; (define (wrap-mutable-formals formals body-exp) (cond
; (if (not (pair? formals)) ; Core forms:
; body-exp ((ast:lambda? exp)
; (if (is-mutable? (car formals)) (let ((id (ast:lambda-id exp)))
; `((lambda (,(car formals)) ;; save lambda to adb
; ,(wrap-mutable-formals (cdr formals) body-exp)) (adb:set!
; (cell ,(car formals))) id
; (wrap-mutable-formals (cdr formals) body-exp)))) (adb:make-fnc)) ;; TODO: anything to record???? params?
; (for-each
; (cond (lambda (expr)
; ; Core forms: (analyze expr id))
; ((ast:lambda? exp) (ast:lambda-body))))
; `(lambda ,(ast:lambda-args exp) ;TODO: `(lambda ,(ast:lambda-args exp)
; ,(wrap-mutable-formals ;TODO: ,(wrap-mutable-formals
; (ast:lambda-formals->list exp) ;TODO: (ast:lambda-formals->list exp)
; (wrap-mutables (car (ast:lambda-body exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase ;TODO: (wrap-mutables (car (ast:lambda-body exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase
; ((const? exp) exp) ;TODO: ((ref? exp) (if (and (not (member exp globals))
; ((ref? exp) (if (and (not (member exp globals)) ;TODO: (is-mutable? exp))
; (is-mutable? exp)) ;TODO: `(cell-get ,exp)
; `(cell-get ,exp) ;TODO: exp))
; exp)) ;TODO: ((set!? exp) `(,(if (member (set!->var exp) globals)
; ((prim? exp) exp) ;TODO: 'set-global!
; ((quote? exp) exp) ;TODO: 'set-cell!)
; ((lambda? exp) `(lambda ,(lambda->formals exp) ;TODO: ,(set!->var exp)
; ,(wrap-mutable-formals (lambda-formals->list exp) ;TODO: ,(wrap-mutables (set!->exp exp) globals)))
; (wrap-mutables (car (lambda->exp exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase ((if? exp) `(if ,(analyze (if->condition exp) lid)
; ((set!? exp) `(,(if (member (set!->var exp) globals) ,(analyze (if->then exp) lid)
; 'set-global! ,(analyze (if->else exp) lid)))
; 'set-cell!)
; ,(set!->var exp) ; Application:
; ,(wrap-mutables (set!->exp exp) globals))) ;TODO: ((app? exp) (map (lambda (e) (wrap-mutables e globals)) exp))
; ((if? exp) `(if ,(wrap-mutables (if->condition exp) globals)
; ,(wrap-mutables (if->then exp) globals) ; Nothing to analyze for these?
; ,(wrap-mutables (if->else exp) globals))) ;((prim? exp) exp)
; ;((quote? exp) exp)
; ; Application: ; Should never see vanilla lambda's in this function, only AST's
; ((app? exp) (map (lambda (e) (wrap-mutables e globals)) exp)) ;((lambda? exp)
; (else (error "unknown expression type: " exp)))) ;; Nothing to analyze for expressions that fall into this branch
(else
#f)))
(analyze exp -1) ;; Top-level is lambda ID -1
)
)) ))