basis/compiler/cfg/iterator/iterator.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces sequences kernel compiler.tree ;
   4 IN: compiler.cfg.iterator
   5
   6 SYMBOL: node-stack
   7
   8 : >node ( cursor -- ) node-stack get push ;
   9 : node> ( -- cursor ) node-stack get pop ;
  10 : node@ ( -- cursor ) node-stack get last ;
  11 : current-node ( -- node ) node@ first ;
  12 : iterate-next ( -- cursor ) node@ rest-slice ;
  13 : skip-next ( -- next ) node> rest-slice [ first ] [ >node ] bi ;
  14
  15 : iterate-nodes ( cursor quot: ( -- ) -- )
  16     over empty? [
  17         2drop
  18     ] [
  19         [ swap >node call node> drop ] keep iterate-nodes
  20     ] if ; inline recursive
  21
  22 DEFER: (tail-call?)
  23
  24 : tail-phi? ( cursor -- ? )
  25     [ first #phi? ] [ rest-slice (tail-call?) ] bi and ;
  26
  27 : (tail-call?) ( cursor -- ? )
  28     [ t ] [
  29         [
  30             first
  31             [ #return? ]
  32             [ #return-recursive? ]
  33             [ #terminate? ] tri or or
  34         ] [ tail-phi? ] bi or
  35     ] if-empty ;
  36
  37 : tail-call? ( -- ? )
  38     node-stack get [
  39         rest-slice
  40         [ t ] [ (tail-call?) ] if-empty
  41     ] all? ;
  42
  43 : terminate-call? ( -- ? )
  44     node-stack get peek
  45     rest-slice [ f ] [ first #terminate? ] if-empty ;