Use lambda ID's to confirm if var truly is a loop

This commit is contained in:
Justin Ethier 2019-09-24 18:18:07 -04:00
parent e34aa09270
commit 983974fdd1
2 changed files with 58 additions and 1 deletions

View file

@ -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)))))

View file

@ -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)