unfinished/compiler/cfg.bluesky/cfg.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors namespaces assocs sequences sets fry ;
   4 IN: compiler.cfg
   5
   6 ! The id is a globally unique id used for fast hashcode* and
   7 ! equal? on basic blocks. The number is assigned by
   8 ! linearization.
   9 TUPLE: basic-block < identity-tuple
  10 id
  11 number
  12 instructions
  13 successors
  14 predecessors
  15 stack-frame ;
  16
  17 SYMBOL: next-block-id
  18
  19 : <basic-block> ( -- basic-block )
  20     basic-block new
  21         next-block-id counter >>id
  22         V{ } clone >>instructions
  23         V{ } clone >>successors
  24         V{ } clone >>predecessors ;
  25
  26 M: basic-block hashcode* id>> nip ;
  27
  28 ! Utilities
  29 SYMBOL: visited-blocks
  30
  31 : visit-block ( basic-block quot -- )
  32     over visited-blocks get 2dup key?
  33     [ 2drop 2drop ] [ conjoin call ] if ; inline
  34
  35 : (each-block) ( basic-block quot -- )
  36     '[
  37         ,
  38         [ call ]
  39         [ [ successors>> ] dip '[ , (each-block) ] each ]
  40         2bi
  41     ] visit-block ; inline
  42
  43 : each-block ( basic-block quot -- )
  44     H{ } clone visited-blocks [ (each-block) ] with-variable ; inline
  45
  46 : copy-at ( from to assoc -- )
  47     3dup nip at* [ -rot set-at drop ] [ 2drop 2drop ] if ; inline