mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-24 13:30:21 +02:00
DFG: Use maps have variable names
* module/language/cps/dfg.scm ($use-map): Add variable names to the use maps. (visit-fun, lookup-def, lookup-uses, constant-needs-allocation?) (variable-free-in?, dead-after-def?, dead-after-use?) (dead-after-branch?): Adapt to use-map change.
This commit is contained in:
parent
d691ac2069
commit
fc95a944d3
1 changed files with 17 additions and 16 deletions
|
@ -98,8 +98,9 @@
|
||||||
(use-maps dfg-use-maps))
|
(use-maps dfg-use-maps))
|
||||||
|
|
||||||
(define-record-type $use-map
|
(define-record-type $use-map
|
||||||
(make-use-map sym def uses)
|
(make-use-map name sym def uses)
|
||||||
use-map?
|
use-map?
|
||||||
|
(name use-map-name)
|
||||||
(sym use-map-sym)
|
(sym use-map-sym)
|
||||||
(def use-map-def)
|
(def use-map-def)
|
||||||
(uses use-map-uses set-use-map-uses!))
|
(uses use-map-uses set-use-map-uses!))
|
||||||
|
@ -408,15 +409,15 @@
|
||||||
(lp (1+ n)))))))
|
(lp (1+ n)))))))
|
||||||
|
|
||||||
(define (visit-fun fun conts blocks use-maps global?)
|
(define (visit-fun fun conts blocks use-maps global?)
|
||||||
(define (add-def! sym def-k)
|
(define (add-def! name sym def-k)
|
||||||
(unless def-k
|
(unless def-k
|
||||||
(error "Term outside labelled continuation?"))
|
(error "Term outside labelled continuation?"))
|
||||||
(hashq-set! use-maps sym (make-use-map sym def-k '())))
|
(hashq-set! use-maps sym (make-use-map name sym def-k '())))
|
||||||
|
|
||||||
(define (add-use! sym use-k)
|
(define (add-use! sym use-k)
|
||||||
(match (hashq-ref use-maps sym)
|
(match (hashq-ref use-maps sym)
|
||||||
(#f (error "Symbol out of scope?" sym))
|
(#f (error "Symbol out of scope?" sym))
|
||||||
((and use-map ($ $use-map sym def uses))
|
((and use-map ($ $use-map name sym def uses))
|
||||||
(set-use-map-uses! use-map (cons use-k uses)))))
|
(set-use-map-uses! use-map (cons use-k uses)))))
|
||||||
|
|
||||||
(define* (declare-block! label cont parent
|
(define* (declare-block! label cont parent
|
||||||
|
@ -434,8 +435,8 @@
|
||||||
(set-block-preds! succ-block (cons pred (block-preds succ-block)))))
|
(set-block-preds! succ-block (cons pred (block-preds succ-block)))))
|
||||||
|
|
||||||
(define (visit exp exp-k)
|
(define (visit exp exp-k)
|
||||||
(define (def! sym)
|
(define (def! name sym)
|
||||||
(add-def! sym exp-k))
|
(add-def! name sym exp-k))
|
||||||
(define (use! sym)
|
(define (use! sym)
|
||||||
(add-use! sym exp-k))
|
(add-use! sym exp-k))
|
||||||
(define (use-k! k)
|
(define (use-k! k)
|
||||||
|
@ -452,7 +453,7 @@
|
||||||
(recur body))
|
(recur body))
|
||||||
|
|
||||||
(($ $kargs names syms body)
|
(($ $kargs names syms body)
|
||||||
(for-each def! syms)
|
(for-each def! names syms)
|
||||||
(recur body))
|
(recur body))
|
||||||
|
|
||||||
(($ $kif kt kf)
|
(($ $kif kt kf)
|
||||||
|
@ -465,7 +466,7 @@
|
||||||
(($ $letrec names syms funs body)
|
(($ $letrec names syms funs body)
|
||||||
(unless global?
|
(unless global?
|
||||||
(error "$letrec should not be present when building a local DFG"))
|
(error "$letrec should not be present when building a local DFG"))
|
||||||
(for-each def! syms)
|
(for-each def! names syms)
|
||||||
(for-each (cut visit-fun <> conts blocks use-maps global?) funs)
|
(for-each (cut visit-fun <> conts blocks use-maps global?) funs)
|
||||||
(visit body exp-k))
|
(visit body exp-k))
|
||||||
|
|
||||||
|
@ -501,7 +502,7 @@
|
||||||
(and entry
|
(and entry
|
||||||
($ $kentry self ($ $cont ktail _ tail) clauses))))
|
($ $kentry self ($ $cont ktail _ tail) clauses))))
|
||||||
(declare-block! kentry entry #f 0)
|
(declare-block! kentry entry #f 0)
|
||||||
(add-def! self kentry)
|
(add-def! #f self kentry)
|
||||||
|
|
||||||
(declare-block! ktail tail kentry)
|
(declare-block! ktail tail kentry)
|
||||||
|
|
||||||
|
@ -547,14 +548,14 @@
|
||||||
(match dfg
|
(match dfg
|
||||||
(($ $dfg conts blocks use-maps)
|
(($ $dfg conts blocks use-maps)
|
||||||
(match (lookup-use-map sym use-maps)
|
(match (lookup-use-map sym use-maps)
|
||||||
(($ $use-map sym def uses)
|
(($ $use-map name sym def uses)
|
||||||
def)))))
|
def)))))
|
||||||
|
|
||||||
(define (lookup-uses sym dfg)
|
(define (lookup-uses sym dfg)
|
||||||
(match dfg
|
(match dfg
|
||||||
(($ $dfg conts blocks use-maps)
|
(($ $dfg conts blocks use-maps)
|
||||||
(match (lookup-use-map sym use-maps)
|
(match (lookup-use-map sym use-maps)
|
||||||
(($ $use-map sym def uses)
|
(($ $use-map name sym def uses)
|
||||||
uses)))))
|
uses)))))
|
||||||
|
|
||||||
(define (lookup-predecessors k dfg)
|
(define (lookup-predecessors k dfg)
|
||||||
|
@ -610,7 +611,7 @@
|
||||||
(match dfg
|
(match dfg
|
||||||
(($ $dfg conts blocks use-maps)
|
(($ $dfg conts blocks use-maps)
|
||||||
(match (lookup-use-map sym use-maps)
|
(match (lookup-use-map sym use-maps)
|
||||||
(($ $use-map _ def uses)
|
(($ $use-map _ _ def uses)
|
||||||
(or-map
|
(or-map
|
||||||
(lambda (use)
|
(lambda (use)
|
||||||
(match (find-expression (lookup-cont use conts))
|
(match (find-expression (lookup-cont use conts))
|
||||||
|
@ -676,7 +677,7 @@
|
||||||
(or-map (lambda (use)
|
(or-map (lambda (use)
|
||||||
(continuation-scope-contains? k use blocks))
|
(continuation-scope-contains? k use blocks))
|
||||||
(match (lookup-use-map var use-maps)
|
(match (lookup-use-map var use-maps)
|
||||||
(($ $use-map sym def uses)
|
(($ $use-map name sym def uses)
|
||||||
uses))))))
|
uses))))))
|
||||||
|
|
||||||
;; Does k1 dominate k2?
|
;; Does k1 dominate k2?
|
||||||
|
@ -705,7 +706,7 @@
|
||||||
(match dfg
|
(match dfg
|
||||||
(($ $dfg conts blocks use-maps)
|
(($ $dfg conts blocks use-maps)
|
||||||
(match (lookup-use-map sym use-maps)
|
(match (lookup-use-map sym use-maps)
|
||||||
(($ $use-map sym def uses)
|
(($ $use-map name sym def uses)
|
||||||
(null? uses))))))
|
(null? uses))))))
|
||||||
|
|
||||||
(define (lookup-loop-header k blocks)
|
(define (lookup-loop-header k blocks)
|
||||||
|
@ -715,7 +716,7 @@
|
||||||
(match dfg
|
(match dfg
|
||||||
(($ $dfg conts blocks use-maps)
|
(($ $dfg conts blocks use-maps)
|
||||||
(match (lookup-use-map sym use-maps)
|
(match (lookup-use-map sym use-maps)
|
||||||
(($ $use-map sym def uses)
|
(($ $use-map name sym def uses)
|
||||||
;; If all other uses dominate this use, and the variable was not
|
;; If all other uses dominate this use, and the variable was not
|
||||||
;; defined outside the current loop, it is now dead. There are
|
;; defined outside the current loop, it is now dead. There are
|
||||||
;; other ways for it to be dead, but this is an approximation.
|
;; other ways for it to be dead, but this is an approximation.
|
||||||
|
@ -751,7 +752,7 @@
|
||||||
(match dfg
|
(match dfg
|
||||||
(($ $dfg conts blocks use-maps)
|
(($ $dfg conts blocks use-maps)
|
||||||
(match (lookup-use-map sym use-maps)
|
(match (lookup-use-map sym use-maps)
|
||||||
(($ $use-map sym def uses)
|
(($ $use-map name sym def uses)
|
||||||
;; As in dead-after-use?, we don't kill the variable if it was
|
;; As in dead-after-use?, we don't kill the variable if it was
|
||||||
;; defined outside the current loop.
|
;; defined outside the current loop.
|
||||||
(and (let ((loop (lookup-loop-header branch blocks)))
|
(and (let ((loop (lookup-loop-header branch blocks)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue