1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-01 01:40:21 +02:00

more peval refactoring

* module/language/tree-il/optimize.scm (peval): Rename `var-table' to
  `store', as we're going to put some more things in it.  Rename
  `record-lexical-bindings' to `record-source-expression', which also
  takes the original, pre-renaming expression.  Keep a mapping from new
  expressions to original expressions, available using the
  `source-expression' helper.
This commit is contained in:
Andy Wingo 2011-09-23 00:18:13 +02:00
parent 8018dfdc02
commit 062bf3aa44

View file

@ -320,18 +320,28 @@ it does not handle <fix> and <let-values>, it should be called before
(define (local-toplevel? name) (define (local-toplevel? name)
(vhash-assq name local-toplevel-env)) (vhash-assq name local-toplevel-env))
(define var-table (build-var-table exp)) (define store (build-var-table exp))
(define (record-lexical-bindings! x)
(set! var-table (build-var-table x var-table))
x)
(define (assigned-lexical? sym) (define (assigned-lexical? sym)
(let ((v (vhash-assq sym var-table))) (let ((v (vhash-assq sym store)))
(and v (var-set? (cdr v))))) (and v (var-set? (cdr v)))))
(define (lexical-refcount sym) (define (lexical-refcount sym)
(let ((v (vhash-assq sym var-table))) (let ((v (vhash-assq sym store)))
(if v (var-refcount (cdr v)) 0))) (if v (var-refcount (cdr v)) 0)))
(define (record-source-expression! orig new)
(set! store (vhash-consq new
(source-expression orig)
(build-var-table new store)))
new)
(define (source-expression new)
(let ((x (vhash-assq new store)))
(if x (cdr x) new)))
(define residual-lexical-references (make-hash-table)) (define residual-lexical-references (make-hash-table))
(define (record-residual-lexical-reference! sym) (define (record-residual-lexical-reference! sym)
(hashq-set! residual-lexical-references sym #t)) (hashq-set! residual-lexical-references sym #t))
@ -528,7 +538,7 @@ it does not handle <fix> and <let-values>, it should be called before
;; This is an anonymous lambda that we're going to inline. ;; This is an anonymous lambda that we're going to inline.
;; Inlining creates new variable bindings, so we need to provide ;; Inlining creates new variable bindings, so we need to provide
;; the new code with fresh names. ;; the new code with fresh names.
(make-lambda src '() (record-lexical-bindings! (alpha-rename lc)))) (record-source-expression! new (alpha-rename new)))
(_ new))) (_ new)))
(catch 'match-error (catch 'match-error