1
Fork 0
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:
Andy Wingo 2013-10-21 11:51:11 +02:00
parent d691ac2069
commit fc95a944d3

View file

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