diff options
Diffstat (limited to 'module/language/tree-il/cse.scm')
| -rw-r--r-- | module/language/tree-il/cse.scm | 27 |
1 files changed, 16 insertions, 11 deletions
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm index 117f5666f..f55c48127 100644 --- a/module/language/tree-il/cse.scm +++ b/module/language/tree-il/cse.scm @@ -353,29 +353,30 @@ (expressions-equal? exp exp*)) (_ #f))) - (define (unroll db from to) - (or (<= from to) - (match (vlist-ref db (1- from)) + (define (unroll db base n) + (or (zero? n) + (match (vlist-ref db base) (('lambda . h*) ;; See note in find-dominating-expression. (and (not (depends-on-effects? effects &all-effects)) - (unroll db (1- from) to))) + (unroll db (1+ base) (1- n)))) ((#(exp* effects* ctx*) . h*) (and (effects-commute? effects effects*) - (unroll db (1- from) to)))))) + (unroll db (1+ base) (1- n))))))) (let ((h (hash-expression exp))) (and (effect-free? (exclude-effects effects &type-check)) (vhash-assoc exp env entry-matches? (hasher h)) - (let ((env-len (vlist-length env))) - (let lp ((n 0) (db-len (vlist-length db))) + (let ((env-len (vlist-length env)) + (db-len (vlist-length db))) + (let lp ((n 0) (m 0)) (and (< n env-len) (match (vlist-ref env n) ((#(exp* name sym db-len*) . h*) - (and (unroll db db-len db-len*) + (and (unroll db m (- db-len db-len*)) (if (and (= h h*) (expressions-equal? exp* exp)) (make-lexical-ref (tree-il-src exp) name sym) - (lp (1+ n) db-len*))))))))))) + (lp (1+ n) (- db-len db-len*)))))))))))) (define (intersection db+ db-) (vhash-fold-right @@ -414,8 +415,12 @@ (logior &zero-values &allocation))) (has-dominating-effect? exp effects db))) - (log 'elide ctx (unparse-tree-il exp)) - (values (make-void #f) db*)) + (cond + ((void? exp) + (values exp db*)) + (else + (log 'elide ctx (unparse-tree-il exp)) + (values (make-void #f) db*)))) ((and (boolean-valued-expression? exp ctx) (find-dominating-test exp effects db)) => (lambda (exp) |