basis/compiler/cfg/value-numbering/expressions/expressions.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors classes kernel math namespaces combinators
   4 compiler.cfg.instructions compiler.cfg.value-numbering.graph ;
   5 IN: compiler.cfg.value-numbering.expressions
   6
   7 ! Referentially-transparent expressions
   8 TUPLE: expr op ;
   9 TUPLE: unary-expr < expr in ;
  10 TUPLE: binary-expr < expr in1 in2 ;
  11 TUPLE: commutative-expr < binary-expr ;
  12 TUPLE: compare-expr < binary-expr cc ;
  13 TUPLE: constant-expr < expr value ;
  14
  15 : <constant> ( constant -- expr )
  16     f swap constant-expr boa ; inline
  17
  18 M: constant-expr equal?
  19     over constant-expr? [
  20         [ [ value>> ] bi@ = ]
  21         [ [ value>> class ] bi@ = ] 2bi
  22         and
  23     ] [ 2drop f ] if ;
  24
  25 SYMBOL: input-expr-counter
  26
  27 : next-input-expr ( -- n )
  28     input-expr-counter [ dup 1 + ] change ;
  29
  30 ! Expressions whose values are inputs to the basic block. We
  31 ! can eliminate a second computation having the same 'n' as
  32 ! the first one; we can also eliminate input-exprs whose
  33 ! result is not used.
  34 TUPLE: input-expr < expr n ;
  35
  36 : constant>vn ( constant -- vn ) <constant> expr>vn ; inline
  37
  38 GENERIC: >expr ( insn -- expr )
  39
  40 M: ##load-immediate >expr val>> <constant> ;
  41
  42 M: ##load-indirect >expr obj>> <constant> ;
  43
  44 M: ##unary >expr
  45     [ class ] [ src>> vreg>vn ] bi unary-expr boa ;
  46
  47 M: ##binary >expr
  48     [ class ] [ src1>> vreg>vn ] [ src2>> vreg>vn ] tri
  49     binary-expr boa ;
  50
  51 M: ##binary-imm >expr
  52     [ class ] [ src1>> vreg>vn ] [ src2>> constant>vn ] tri
  53     binary-expr boa ;
  54
  55 M: ##commutative >expr
  56     [ class ] [ src1>> vreg>vn ] [ src2>> vreg>vn ] tri
  57     commutative-expr boa ;
  58
  59 M: ##commutative-imm >expr
  60     [ class ] [ src1>> vreg>vn ] [ src2>> constant>vn ] tri
  61     commutative-expr boa ;
  62
  63 : compare>expr ( insn -- expr )
  64     {
  65         [ class ]
  66         [ src1>> vreg>vn ]
  67         [ src2>> vreg>vn ]
  68         [ cc>> ]
  69     } cleave compare-expr boa ; inline
  70
  71 M: ##compare >expr compare>expr ;
  72
  73 : compare-imm>expr ( insn -- expr )
  74     {
  75         [ class ]
  76         [ src1>> vreg>vn ]
  77         [ src2>> constant>vn ]
  78         [ cc>> ]
  79     } cleave compare-expr boa ; inline
  80
  81 M: ##compare-imm >expr compare-imm>expr ;
  82
  83 M: ##compare-float >expr compare>expr ;
  84
  85 M: ##flushable >expr class next-input-expr input-expr boa ;
  86
  87 : init-expressions ( -- )
  88     0 input-expr-counter set ;