basis/compiler/cfg/rpo/rpo.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors compiler.cfg kernel make namespaces sequences
   4 sets ;
   5 IN: compiler.cfg.rpo
   6
   7 : post-order-traversal ( visited bb -- visited )
   8     dup pick ?adjoin [
   9         [
  10             successors>> <reversed>
  11             [ post-order-traversal ] each
  12         ] [ , ] bi
  13     ] [ drop ] if ; inline recursive
  14
  15 : number-blocks ( blocks -- )
  16     dup length <iota> <reversed>
  17     [ >>number drop ] 2each ;
  18
  19 : post-order ( cfg -- blocks )
  20     [ post-order>> ] [
  21         [
  22             HS{ } clone over entry>>
  23             post-order-traversal drop
  24         ] { } make dup number-blocks
  25         >>post-order post-order>>
  26     ] ?unless ;
  27
  28 : reverse-post-order ( cfg -- blocks )
  29     post-order <reversed> ; inline
  30
  31 : each-basic-block ( cfg quot -- )
  32     [ reverse-post-order ] dip each ; inline
  33
  34 : optimize-basic-block ( bb quot -- )
  35     over kill-block?>> [ 2drop ] [
  36         over basic-block namespaces:set
  37         change-instructions drop
  38     ] if ; inline
  39
  40 : simple-optimization ( ... cfg quot: ( ... insns -- ... insns' ) -- ... )
  41     '[ _ optimize-basic-block ] each-basic-block ; inline
  42
  43 : analyze-basic-block ( bb quot -- )
  44     over kill-block?>> [ 2drop ] [
  45         [ dup basic-block namespaces:set instructions>> ] dip call
  46     ] if ; inline
  47
  48 : simple-analysis ( ... cfg quot: ( ... insns -- ... ) -- ... )
  49     '[ _ analyze-basic-block ] each-basic-block ; inline
  50
  51 : needs-post-order ( cfg -- )
  52     post-order drop ;