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

DFG refactor

Browse source 
* module/language/cps/dfg.scm (lookup-cont, lookup-block):
  (lookup-def, constant-needs-allocation?): Rework these accessors to
  avoid completely destructuring the $dfg.
This commit is contained in:
Andy Wingo 2014-03-30 20:27:31 +02:00
parent 62b7180bfd
commit f49e994b52
1 changed files with 47 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -99,14 +99,6 @@
(make-vector (1+ max-k) #f)
fun)))
(define (lookup-cont label dfg)
(match dfg
(($ $dfg conts blocks defs uses min-label nlabels min-var nvars)
(let ((res (vector-ref conts (- label min-label))))
(unless res
(error "Unknown continuation!" label conts))
res))))
;; Data-flow graph for CPS: both for values and continuations.
(define-record-type $dfg
(make-dfg conts blocks defs uses min-label nlabels min-var nvars)
@ -929,27 +921,27 @@ BODY for each body continuation in the prompt."
(make-dfg conts blocks defs uses
min-label label-count min-var var-count)))))
(define (lookup-block k dfg)
(match dfg
(($ $dfg conts blocks defs uses min-label nlabels min-var nvars)
(let ((res (vector-ref blocks (- k min-label))))
(define (lookup-cont label dfg)
(let ((res (vector-ref (dfg-cont-table dfg) (- label (dfg-min-label dfg)))))
(unless res
(error "Unknown continuation!" k blocks))
res))))
(error "Unknown continuation!" label))
res))
(define (lookup-block k dfg)
(let ((res (vector-ref (dfg-blocks dfg) (- k (dfg-min-label dfg)))))
(unless res
(error "Unknown continuation!" k))
res))
(define (lookup-scope-level k dfg)
(match (lookup-block k dfg)
(($ $block _ scope-level) scope-level)))
(define (lookup-def var dfg)
(match dfg
(($ $dfg conts blocks defs uses min-label nlabels min-var nvars)
(vector-ref defs (- var min-var)))))
(vector-ref (dfg-defs dfg) (- var (dfg-min-var dfg))))
(define (lookup-uses var dfg)
(match dfg
(($ $dfg conts blocks defs uses min-label nlabels min-var nvars)
(vector-ref uses (- var min-var)))))
(vector-ref (dfg-uses dfg) (- var (dfg-min-var dfg))))
(define (lookup-block-scope k dfg)
(block-scope (lookup-block k dfg)))
@ -1007,8 +999,7 @@ BODY for each body continuation in the prompt."
(($ $kargs names syms body) (find-exp body))
(($ $letk conts body) (find-exp body))
(else term)))
(match dfg
(($ $dfg conts blocks defs uses min-label nlabels min-var nvars)
(or-map
(lambda (use)
(match (find-expression (lookup-cont use dfg))
@ -1042,7 +1033,7 @@ BODY for each body continuation in the prompt."
(($ $primcall 'builtin-ref (idx))
#f)
(_ #t)))
(vector-ref uses (- sym min-var))))))
(vector-ref (dfg-uses dfg) (- sym (dfg-min-var dfg)))))
(define (continuation-scope-contains? scope-k k dfg)
(let ((scope-level (lookup-scope-level scope-k dfg)))