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

Integrating code to find named lets

Browse source
This commit is contained in:
Justin Ethier 2018-05-23 14:00:51 -04:00
parent 3cf0e0a0c7
commit e92be3e80b
1 changed files with 86 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -15,6 +15,7 @@
(scheme cyclone ast)
(scheme cyclone primitives)
(scheme cyclone transforms)
(srfi 2)
(srfi 69))
(export
closure-convert
@ -34,6 +35,7 @@
adb:get-db
simple-lambda?
one-instance-of-new-mutable-obj?
opt:find-named-lets
;; Analyze variables
adb:make-var
%adb:make-var
@ -54,6 +56,10 @@
adbv:set-ref-count!
adbv:ref-by
adbv:set-ref-by!
adbv:def-in-loop?
adbv:set-def-in-loop!
adbv:ref-in-loop?
adbv:set-ref-in-loop!
;; Analyze functions
adb:make-fnc
%adb:make-fnc
@ -98,7 +104,10 @@
reassigned assigned-value
app-fnc-count app-arg-count
inlinable mutated-indirectly
cont)
cont
def-in-loop
ref-in-loop
)
adb:variable?
(global adbv:global? adbv:set-global!)
(defined-by adbv:defined-by adbv:set-defined-by!)
@ -121,6 +130,8 @@
;; Is the variable mutated indirectly? (EG: set-car! of a cdr)
(mutated-indirectly adbv:mutated-indirectly? adbv:set-mutated-indirectly!)
(cont adbv:cont? adbv:set-cont!)
(def-in-loop adbv:def-in-loop? adbv:set-def-in-loop!)
(ref-in-loop adbv:ref-in-loop? adbv:set-ref-in-loop!)
)
(define (adbv-set-assigned-value-helper! sym var value)
@ -149,7 +160,7 @@
)
(define (adb:make-var)
(%adb:make-var '? '? #f #f #f 0 '() #f #f 0 0 #t #f #f))
(%adb:make-var '? '? #f #f #f 0 '() #f #f 0 0 #t #f #f #f #f))
(define-record-type <analysis-db-function>
(%adb:make-fnc simple unused-params assigned-to-var side-effects)
@ -1606,4 +1617,77 @@
`(lambda ()
,(convert exp #f '())))
(define (opt:find-named-lets exp)
(define (scan exp lp)
(cond
((ast:lambda? exp)
(let* ((id (ast:lambda-id exp))
(has-cont (ast:lambda-has-cont exp))
(sym (string->symbol
(string-append
"lambda-"
(number->string id)
(if has-cont "-cont" ""))))
(args* (ast:lambda-args exp))
(args (if (null? args*)
'()
(formals->list args*)))
)
;; TODO: (when lp
;; TODO: (for-each
;; TODO: (lambda (a)
;; TODO: (write `(,a defined in a loop))
;; TODO: (newline))
;; TODO: args)
;; TODO: )
`(,sym ,(ast:lambda-args exp)
,@(map (lambda (e) (scan e lp)) (ast:lambda-body exp))))
)
((quote? exp) exp)
((const? exp) exp)
((ref? exp)
;; TODO: (when lp
;; TODO: (write `(found variable ,exp within a loop))
;; TODO: (newline))
exp)
((define? exp)
`(define ,(define->var exp)
,@(scan (define->exp exp) lp)))
((set!? exp)
`(set! ,(set!->var exp)
,(scan (set!->exp exp) lp)))
((if? exp)
`(if ,(scan (if->condition exp) lp)
,(scan (if->then exp) lp)
,(scan (if->else exp) lp)))
((app? exp)
(cond
((and-let* (
;; Find lambda with initial #f assignment
((ast:lambda? (car exp)))
((pair? (cdr exp)))
((not (cadr exp)))
(= 1 (length (ast:lambda-args (car exp))))
;; Get information for continuation
(loop-sym (car (ast:lambda-args (car exp))))
(inner-exp (car (ast:lambda-body (car exp))))
((app? inner-exp))
((ast:lambda? (car inner-exp)))
;; Find the set (assumes CPS conversion)
((pair? (cdr inner-exp)))
((set!? (cadr inner-exp)))
((equal? (set!->var (cadr inner-exp)) loop-sym))
;; Check the set's continuation
((app? (car (ast:lambda-body (car inner-exp)))))
((equal? (caar (ast:lambda-body (car inner-exp))) loop-sym))
)
; TODO: (write `(found named lambda loop ,loop-sym))
;; Continue scanning
(map (lambda (e) (scan e #t)) exp)
))
(else
(map (lambda (e) (scan e lp)) exp))))
(else exp)))
(scan exp #f))
))