mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-29 08:20:20 +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:
parent
8018dfdc02
commit
062bf3aa44
1 changed files with 17 additions and 7 deletions
|
@ -320,18 +320,28 @@ it does not handle <fix> and <let-values>, it should be called before
|
|||
(define (local-toplevel? name)
|
||||
(vhash-assq name local-toplevel-env))
|
||||
|
||||
(define var-table (build-var-table exp))
|
||||
(define (record-lexical-bindings! x)
|
||||
(set! var-table (build-var-table x var-table))
|
||||
x)
|
||||
(define store (build-var-table exp))
|
||||
|
||||
(define (assigned-lexical? sym)
|
||||
(let ((v (vhash-assq sym var-table)))
|
||||
(let ((v (vhash-assq sym store)))
|
||||
(and v (var-set? (cdr v)))))
|
||||
|
||||
(define (lexical-refcount sym)
|
||||
(let ((v (vhash-assq sym var-table)))
|
||||
(let ((v (vhash-assq sym store)))
|
||||
(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 (record-residual-lexical-reference! sym)
|
||||
(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.
|
||||
;; Inlining creates new variable bindings, so we need to provide
|
||||
;; the new code with fresh names.
|
||||
(make-lambda src '() (record-lexical-bindings! (alpha-rename lc))))
|
||||
(record-source-expression! new (alpha-rename new)))
|
||||
(_ new)))
|
||||
|
||||
(catch 'match-error
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue