mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-06 20:20:20 +02:00
Code Activity

Scope and scope-level in DFG vector

Browse source 
* module/language/cps/dfg.scm ($dfg): Hoist scopes and scope levels out
  of $block and into $dfg.  Adapt all callers.
This commit is contained in:
Andy Wingo 2014-03-30 21:14:31 +02:00
parent 21d6d183a9
commit 5fc403911e
1 changed files with 37 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

78
module/language/cps/dfg.scm
View file

@ -101,30 +101,29 @@
;; Data-flow graph for CPS: both for values and continuations. ;; Data-flow graph for CPS: both for values and continuations.
(define-record-type $dfg (define-record-type $dfg
(make-dfg conts blocks preds succs defs uses min-label nlabels min-var nvars) (make-dfg conts preds succs defs uses scopes scope-levels
min-label nlabels min-var nvars)
dfg? dfg?
;; vector of label -> $kif, $kargs, etc ;; vector of label -> $kif, $kargs, etc
(conts dfg-cont-table) (conts dfg-cont-table)
;; vector of label -> $block ;; vector of label -> (pred-label ...)
(blocks dfg-blocks)
(preds dfg-preds) (preds dfg-preds)
;; vector of label -> (succ-label ...)
(succs dfg-succs) (succs dfg-succs)
;; vector of var -> def label ;; vector of var -> def-label
(defs dfg-defs) (defs dfg-defs)
;; vector of var -> (use label ...) ;; vector of var -> (use-label ...)
(uses dfg-uses) (uses dfg-uses)
;; vector of label -> label
(scopes dfg-scopes)
;; vector of label -> int
(scope-levels dfg-scope-levels)
(min-label dfg-min-label) (min-label dfg-min-label)
(nlabels dfg-nlabels) (nlabels dfg-nlabels)
(min-var dfg-min-var) (min-var dfg-min-var)
(nvars dfg-nvars)) (nvars dfg-nvars))
(define-record-type $block
(make-block scope scope-level)
block?
(scope block-scope)
(scope-level block-scope-level))
;; Some analyses assume that the only relevant set of nodes is the set ;; Some analyses assume that the only relevant set of nodes is the set
;; that is reachable from some start node. Others need to include nodes ;; that is reachable from some start node. Others need to include nodes
;; that are reachable from an end node as well, or all nodes in a ;; that are reachable from an end node as well, or all nodes in a
@ -759,7 +758,8 @@ BODY for each body continuation in the prompt."
(newline) (newline)
(lp (1+ n))))))) (lp (1+ n)))))))
(define (visit-fun fun conts blocks preds succs defs uses min-label min-var global?) (define (visit-fun fun conts preds succs defs uses scopes scope-levels
min-label min-var global?)
(define (add-def! var def-k) (define (add-def! var def-k)
(vector-set! defs (- var min-var) def-k)) (vector-set! defs (- var min-var) def-k))
@ -768,12 +768,12 @@ BODY for each body continuation in the prompt."
(define* (declare-block! label cont parent (define* (declare-block! label cont parent
#:optional (level #:optional (level
(1+ (block-scope-level (1+ (vector-ref
(vector-ref scope-levels
blocks (- parent min-label)))))
(- parent min-label))))))
(vector-set! conts (- label min-label) cont) (vector-set! conts (- label min-label) cont)
(vector-set! blocks (- label min-label) (make-block parent level))) (vector-set! scopes (- label min-label) parent)
(vector-set! scope-levels (- label min-label) level))
(define (link-blocks! pred succ) (define (link-blocks! pred succ)
(vector-push! succs (- pred min-label) succ) (vector-push! succs (- pred min-label) succ)
@ -813,7 +813,8 @@ BODY for each body continuation in the prompt."
(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! syms)
(for-each (for-each
(cut visit-fun <> conts blocks preds succs defs uses min-label min-var global?) (cut visit-fun <> conts preds succs defs uses scopes scope-levels
min-label min-var global?)
funs) funs)
(visit body exp-k)) (visit body exp-k))
@ -840,7 +841,8 @@ BODY for each body continuation in the prompt."
(($ $fun) (($ $fun)
(when global? (when global?
(visit-fun exp conts blocks preds succs defs uses min-label min-var global?))) (visit-fun exp conts preds succs defs uses scopes scope-levels
min-label min-var global?)))
(_ #f))))) (_ #f)))))
@ -902,13 +904,15 @@ BODY for each body continuation in the prompt."
(let* ((nlabels (- (1+ max-label) min-label)) (let* ((nlabels (- (1+ max-label) min-label))
(nvars (- (1+ max-var) min-var)) (nvars (- (1+ max-var) min-var))
(conts (make-vector nlabels #f)) (conts (make-vector nlabels #f))
(blocks (make-vector nlabels #f))
(preds (make-vector nlabels '())) (preds (make-vector nlabels '()))
(succs (make-vector nlabels '())) (succs (make-vector nlabels '()))
(defs (make-vector nvars #f)) (defs (make-vector nvars #f))
(uses (make-vector nvars '()))) (uses (make-vector nvars '()))
(visit-fun fun conts blocks preds succs defs uses min-label min-var global?) (scopes (make-vector nlabels #f))
(make-dfg conts blocks preds succs defs uses (scope-levels (make-vector nlabels #f)))
(visit-fun fun conts preds succs defs uses scopes scope-levels
min-label min-var global?)
(make-dfg conts preds succs defs uses scopes scope-levels
min-label label-count min-var var-count))))) min-label label-count min-var var-count)))))
(define (lookup-cont label dfg) (define (lookup-cont label dfg)
@ -917,11 +921,11 @@ BODY for each body continuation in the prompt."
(error "Unknown continuation!" label)) (error "Unknown continuation!" label))
res)) res))
(define (lookup-block k dfg) (define (lookup-predecessors k dfg)
(let ((res (vector-ref (dfg-blocks dfg) (- k (dfg-min-label dfg))))) (vector-ref (dfg-preds dfg) (- k (dfg-min-label dfg))))
(unless res
(error "Unknown continuation!" k)) (define (lookup-successors k dfg)
res)) (vector-ref (dfg-succs dfg) (- k (dfg-min-label dfg))))
(define (lookup-def var dfg) (define (lookup-def var dfg)
(vector-ref (dfg-defs dfg) (- var (dfg-min-var dfg)))) (vector-ref (dfg-defs dfg) (- var (dfg-min-var dfg))))
@ -929,17 +933,11 @@ BODY for each body continuation in the prompt."
(define (lookup-uses var dfg) (define (lookup-uses var dfg)
(vector-ref (dfg-uses dfg) (- var (dfg-min-var dfg)))) (vector-ref (dfg-uses dfg) (- var (dfg-min-var dfg))))
(define (lookup-scope-level k dfg)
(block-scope-level (lookup-block k dfg)))
(define (lookup-block-scope k dfg) (define (lookup-block-scope k dfg)
(block-scope (lookup-block k dfg))) (vector-ref (dfg-scopes dfg) (- k (dfg-min-label dfg))))
(define (lookup-predecessors k dfg) (define (lookup-scope-level k dfg)
(vector-ref (dfg-preds dfg) (- k (dfg-min-label dfg)))) (vector-ref (dfg-scope-levels dfg) (- k (dfg-min-label dfg))))
(define (lookup-successors k dfg)
(vector-ref (dfg-succs dfg) (- k (dfg-min-label dfg))))
(define (find-defining-term sym dfg) (define (find-defining-term sym dfg)
(match (lookup-predecessors (lookup-def sym dfg) dfg) (match (lookup-predecessors (lookup-def sym dfg) dfg)
@ -1026,10 +1024,8 @@ BODY for each body continuation in the prompt."
(let ((scope-level (lookup-scope-level scope-k dfg))) (let ((scope-level (lookup-scope-level scope-k dfg)))
(let lp ((k k)) (let lp ((k k))
(or (eq? scope-k k) (or (eq? scope-k k)
(match (lookup-block k dfg) (and (< scope-level (lookup-scope-level k dfg))
(($ $block scope level) (lp (lookup-block-scope k dfg)))))))
(and (< scope-level level)
(lp scope))))))))
(define (continuation-bound-in? k use-k dfg) (define (continuation-bound-in? k use-k dfg)
(continuation-scope-contains? (lookup-block-scope k dfg) use-k dfg)) (continuation-scope-contains? (lookup-block-scope k dfg) use-k dfg))