mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-19 05:39:17 +02:00
Use lambda ID's to confirm if var truly is a loop
This commit is contained in:
parent
e34aa09270
commit
983974fdd1
2 changed files with 58 additions and 1 deletions
|
@ -1786,6 +1786,35 @@
|
|||
(define (let->vars exp)
|
||||
(map car (cadr exp)))
|
||||
|
||||
;; Is ADBV only referenced by lambda's in its own scope?
|
||||
(define (loop:only-ref-in-scope var)
|
||||
(let* ((loop-lam (adbv:assigned-value var))
|
||||
(adbv-refs (adbv:ref-by var))
|
||||
(inner-refs (cons (adbv:defined-by var)
|
||||
(find-all-lambdas loop-lam))))
|
||||
;(trace:error `(DEBUG ,loop-lam ,adbv-refs ,inner-refs))
|
||||
;; OK only if all adbv-refs are inner-refs
|
||||
(every
|
||||
(lambda (r)
|
||||
(member r inner-refs))
|
||||
adbv-refs)))
|
||||
|
||||
;; Find all lambda ID's referenced by the given CPS sexp
|
||||
(define (find-all-lambdas sexp)
|
||||
(define ids '())
|
||||
(define (scan exp)
|
||||
(cond
|
||||
((ast:lambda? exp)
|
||||
(set! ids (cons (ast:lambda-id exp) ids))
|
||||
(scan (ast:lambda-body exp)))
|
||||
((quote? exp)
|
||||
exp)
|
||||
((app? exp)
|
||||
(map (lambda (e) (scan e)) exp))
|
||||
(else exp)))
|
||||
(scan sexp)
|
||||
ids)
|
||||
|
||||
(define (closure-convert exp globals . opts)
|
||||
(let ((optimization-level 2))
|
||||
(if (pair? opts)
|
||||
|
@ -1889,7 +1918,8 @@
|
|||
(with-var (car (ast:lambda-formals->list (car exp))) (lambda (var)
|
||||
(cond
|
||||
((and (adbv:mutated-by-set? var)
|
||||
(ast:lambda? (adbv:assigned-value var)))
|
||||
(ast:lambda? (adbv:assigned-value var))
|
||||
(loop:only-ref-in-scope var))
|
||||
(trace:error `(found loop var ,(car (ast:lambda-formals->list (car exp)))))
|
||||
(car (ast:lambda-formals->list (car exp))))
|
||||
(else #f)))))
|
||||
|
|
|
@ -126,4 +126,31 @@
|
|||
)
|
||||
)
|
||||
|
||||
;; Is ADBV only referenced by lambda's in its own scope?
|
||||
(define (loop:only-ref-in-scope var)
|
||||
(let* ((loop-lam (adbv:assigned-value var))
|
||||
(adbv-refs (adbv:ref-by var))
|
||||
(inner-refs (cons (adbv:defines-lambda-id var)
|
||||
(find-all-lambdas loop-lam))))
|
||||
;; OK only if all adbv-refs are inner-refs
|
||||
(every
|
||||
(lambda (r)
|
||||
(member r inner-refs))
|
||||
adbv-refs)))
|
||||
|
||||
;; Find all lambda ID's referenced by the given CPS sexp
|
||||
(define (find-all-lambdas sexp)
|
||||
(define ids '())
|
||||
(define (scan exp)
|
||||
(cond
|
||||
((ast:lambda? exp)
|
||||
(set! ids (cons (ast:lambda-id exp) ids))
|
||||
(scan (ast:lambda-body exp)))
|
||||
((quote? exp)
|
||||
exp)
|
||||
((app? exp)
|
||||
(map (lambda (e) (scan e)) exp))
|
||||
(else exp)))
|
||||
(scan sexp)
|
||||
ids)
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue