Integrate finding named let's

This commit is contained in:
Justin Ethier 2018-05-23 18:28:33 -04:00
parent e92be3e80b
commit 5a73c7b83e

View file

@ -23,6 +23,8 @@
inlinable-top-level-lambda? inlinable-top-level-lambda?
optimize-cps optimize-cps
analyze-cps analyze-cps
analyze-find-lambdas
analyze:find-named-lets
;analyze-lambda-side-effects ;analyze-lambda-side-effects
opt:add-inlinable-functions opt:add-inlinable-functions
opt:contract opt:contract
@ -35,7 +37,6 @@
adb:get-db adb:get-db
simple-lambda? simple-lambda?
one-instance-of-new-mutable-obj? one-instance-of-new-mutable-obj?
opt:find-named-lets
;; Analyze variables ;; Analyze variables
adb:make-var adb:make-var
%adb:make-var %adb:make-var
@ -1460,6 +1461,7 @@
(else exp))) (else exp)))
(define (analyze-cps exp) (define (analyze-cps exp)
(analyze:find-named-lets exp)
(analyze-find-lambdas exp -1) (analyze-find-lambdas exp -1)
(analyze-lambda-side-effects exp -1) (analyze-lambda-side-effects exp -1)
(analyze-lambda-side-effects exp -1) ;; 2nd pass guarantees lambda purity (analyze-lambda-side-effects exp -1) ;; 2nd pass guarantees lambda purity
@ -1617,7 +1619,7 @@
`(lambda () `(lambda ()
,(convert exp #f '()))) ,(convert exp #f '())))
(define (opt:find-named-lets exp) (define (analyze:find-named-lets exp)
(define (scan exp lp) (define (scan exp lp)
(cond (cond
((ast:lambda? exp) ((ast:lambda? exp)
@ -1633,22 +1635,22 @@
'() '()
(formals->list args*))) (formals->list args*)))
) )
;; TODO: (when lp (when lp
;; TODO: (for-each (for-each
;; TODO: (lambda (a) (lambda (a)
;; TODO: (write `(,a defined in a loop)) (with-var! a (lambda (var)
;; TODO: (newline)) (adbv:set-def-in-loop! var #t))))
;; TODO: args) args))
;; TODO: )
`(,sym ,(ast:lambda-args exp) `(,sym ,(ast:lambda-args exp)
,@(map (lambda (e) (scan e lp)) (ast:lambda-body exp)))) ,@(map (lambda (e) (scan e lp)) (ast:lambda-body exp))))
) )
((quote? exp) exp) ((quote? exp) exp)
((const? exp) exp) ((const? exp) exp)
((ref? exp) ((ref? exp)
;; TODO: (when lp (when lp
;; TODO: (write `(found variable ,exp within a loop)) (trace:error `(found var ref ,exp in loop))
;; TODO: (newline)) (with-var! exp (lambda (var)
(adbv:set-ref-in-loop! var #t))))
exp) exp)
((define? exp) ((define? exp)
`(define ,(define->var exp) `(define ,(define->var exp)
@ -1681,8 +1683,9 @@
((app? (car (ast:lambda-body (car inner-exp))))) ((app? (car (ast:lambda-body (car inner-exp)))))
((equal? (caar (ast:lambda-body (car inner-exp))) loop-sym)) ((equal? (caar (ast:lambda-body (car inner-exp))) loop-sym))
) )
; TODO: (write `(found named lambda loop ,loop-sym)) (trace:error `(found loop in ,exp))
;; Continue scanning ;; TODO: do we want to record the lambda that is a loop?
;; Continue scanning, indicating we are in a loop
(map (lambda (e) (scan e #t)) exp) (map (lambda (e) (scan e #t)) exp)
)) ))
(else (else