unfinished/compiler/cfg/vn/simplify/simplify.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors combinators classes math math.order
   4 layouts locals
   5 compiler.vops
   6 compiler.cfg.vn.graph
   7 compiler.cfg.vn.expressions ;
   8 IN: compiler.cfg.vn.simplify
   9
  10 ! Return value of f means we didn't simplify.
  11 GENERIC: simplify* ( expr -- vn/expr/f )
  12
  13 : constant ( val type -- expr ) swap constant-expr boa ;
  14
  15 : simplify-not ( in -- vn/expr/f )
  16     {
  17         { [ dup constant-expr? ] [ value>> bitnot %iconst constant ] }
  18         { [ dup op>> %not = ] [ in>> ] }
  19         [ drop f ]
  20     } cond ;
  21
  22 : simplify-box-float ( in -- vn/expr/f )
  23     {
  24         { [ dup op>> %%unbox-float = ] [ in>> ] }
  25         [ drop f ]
  26     } cond ;
  27
  28 : simplify-unbox-float ( in -- vn/expr/f )
  29     {
  30         { [ dup literal-expr? ] [ object>> %fconst constant ] }
  31         { [ dup op>> %%box-float = ] [ in>> ] }
  32         [ drop f ]
  33     } cond ;
  34
  35 M: unary-expr simplify*
  36     #! Note the copy propagation: a %copy always simplifies to
  37     #! its source vn.
  38     [ in>> vn>expr ] [ op>> ] bi {
  39         { %copy [ ] }
  40         { %not [ simplify-not ] }
  41         { %%box-float [ simplify-box-float ] }
  42         { %%unbox-float [ simplify-unbox-float ] }
  43         [ 2drop f ]
  44     } case ;
  45
  46 : izero? ( expr -- ? ) T{ constant-expr f %iconst 0 } = ;
  47
  48 : ione? ( expr -- ? ) T{ constant-expr f %iconst 1 } = ;
  49
  50 : ineg-one? ( expr -- ? ) T{ constant-expr f %iconst -1 } = ;
  51
  52 : fzero? ( expr -- ? ) T{ constant-expr f %fconst 0 } = ;
  53
  54 : fone? ( expr -- ? ) T{ constant-expr f %fconst 1 } = ;
  55
  56 : fneg-one? ( expr -- ? ) T{ constant-expr f %fconst -1 } = ;
  57
  58 : identity ( in1 in2 val type -- expr ) constant 2nip ;
  59
  60 : constant-fold? ( in1 in2 -- ? )
  61     [ constant-expr? ] both? ;
  62
  63 :: constant-fold ( in1 in2 quot type -- expr )
  64     in1 in2 constant-fold?
  65     [ in1 value>> in2 value>> quot call type constant ]
  66     [ f ]
  67     if ; inline
  68
  69 : simplify-iadd ( in1 in2 -- vn/expr/f )
  70     {
  71         { [ over izero? ] [ nip ] }
  72         { [ dup izero? ] [ drop ] }
  73         [ [ + ] %iconst constant-fold ]
  74     } cond ;
  75
  76 : simplify-imul ( in1 in2 -- vn/expr/f )
  77     {
  78         { [ over ione? ] [ nip ] }
  79         { [ dup ione? ] [ drop ] }
  80         [ [ * ] %iconst constant-fold ]
  81     } cond ;
  82
  83 : simplify-and ( in1 in2 -- vn/expr/f )
  84     {
  85         { [ dup izero? ] [ 0 %iconst identity ] }
  86         { [ dup ineg-one? ] [ drop ] }
  87         { [ 2dup = ] [ drop ] }
  88         [ [ bitand ] %iconst constant-fold ]
  89     } cond ;
  90
  91 : simplify-or ( in1 in2 -- vn/expr/f )
  92     {
  93         { [ dup izero? ] [ drop ] }
  94         { [ dup ineg-one? ] [ -1 %iconst identity ] }
  95         { [ 2dup = ] [ drop ] }
  96         [ [ bitor ] %iconst constant-fold ]
  97     } cond ;
  98
  99 : simplify-xor ( in1 in2 -- vn/expr/f )
 100     {
 101         { [ dup izero? ] [ drop ] }
 102         [ [ bitxor ] %iconst constant-fold ]
 103     } cond ;
 104
 105 : simplify-fadd ( in1 in2 -- vn/expr/f )
 106     {
 107         { [ over fzero? ] [ nip ] }
 108         { [ dup fzero? ] [ drop ] }
 109         [ [ + ] %fconst constant-fold ]
 110     } cond ;
 111
 112 : simplify-fmul ( in1 in2 -- vn/expr/f )
 113     {
 114         { [ over fone? ] [ nip ] }
 115         { [ dup fone? ] [ drop ] }
 116         [ [ * ] %fconst constant-fold ]
 117     } cond ;
 118
 119 : commutative-operands ( expr -- in1 in2 )
 120     [ in1>> vn>expr ] [ in2>> vn>expr ] bi
 121     over constant-expr? [ swap ] when ;
 122
 123 M: commutative-expr simplify*
 124     [ commutative-operands ] [ op>> ] bi {
 125         { %iadd [ simplify-iadd ] }
 126         { %imul [ simplify-imul ] }
 127         { %and [ simplify-and ] }
 128         { %or [ simplify-or ] }
 129         { %xor [ simplify-xor ] }
 130         { %fadd [ simplify-fadd ] }
 131         { %fmul [ simplify-fmul ] }
 132         [ 3drop f ]
 133     } case ;
 134
 135 : simplify-isub ( in1 in2 -- vn/expr/f )
 136     {
 137         { [ dup izero? ] [ drop ] }
 138         { [ 2dup = ] [ 0 %iconst identity ] }
 139         [ [ - ] %iconst constant-fold ]
 140     } cond ;
 141
 142 : simplify-idiv ( in1 in2 -- vn/expr/f )
 143     {
 144         { [ dup ione? ] [ drop ] }
 145         [ [ /i ] %iconst constant-fold ]
 146     } cond ;
 147
 148 : simplify-imod ( in1 in2 -- vn/expr/f )
 149     {
 150         { [ dup ione? ] [ 0 %iconst identity ] }
 151         { [ 2dup = ] [ 0 %iconst identity ] }
 152         [ [ mod ] %iconst constant-fold ]
 153     } cond ;
 154
 155 : simplify-shl ( in1 in2 -- vn/expr/f )
 156     {
 157         { [ dup izero? ] [ drop ] }
 158         { [ over izero? ] [ drop ] }
 159         [ [ shift ] %iconst constant-fold ]
 160     } cond ;
 161
 162 : unsigned ( n -- n' )
 163     cell-bits 2^ 1- bitand ;
 164
 165 : useless-shift? ( in1 in2 -- ? )
 166     over op>> %shl = [ [ in2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ;
 167
 168 : simplify-shr ( in1 in2 -- vn/expr/f )
 169     {
 170         { [ dup izero? ] [ drop ] }
 171         { [ over izero? ] [ drop ] }
 172         { [ 2dup useless-shift? ] [ drop in1>> ] }
 173         [ [ neg shift unsigned ] %iconst constant-fold ]
 174     } cond ;
 175
 176 : simplify-sar ( in1 in2 -- vn/expr/f )
 177     {
 178         { [ dup izero? ] [ drop ] }
 179         { [ over izero? ] [ drop ] }
 180         { [ 2dup useless-shift? ] [ drop in1>> ] }
 181         [ [ neg shift ] %iconst constant-fold ]
 182     } cond ;
 183
 184 : simplify-icmp ( in1 in2 -- vn/expr/f )
 185     = [ +eq+ %cconst constant ] [ f ] if ;
 186
 187 : simplify-fsub ( in1 in2 -- vn/expr/f )
 188     {
 189         { [ dup izero? ] [ drop ] }
 190         [ [ - ] %fconst constant-fold ]
 191     } cond ;
 192
 193 : simplify-fdiv ( in1 in2 -- vn/expr/f )
 194     {
 195         { [ dup fone? ] [ drop ] }
 196         [ [ /i ] %fconst constant-fold ]
 197     } cond ;
 198
 199 M: binary-expr simplify*
 200     [ in1>> vn>expr ] [ in2>> vn>expr ] [ op>> ] tri {
 201         { %isub [ simplify-isub ] }
 202         { %idiv [ simplify-idiv ] }
 203         { %imod [ simplify-imod ] }
 204         { %shl [ simplify-shl ] }
 205         { %shr [ simplify-shr ] }
 206         { %sar [ simplify-sar ] }
 207         { %icmp [ simplify-icmp ] }
 208         { %fsub [ simplify-fsub ] }
 209         { %fdiv [ simplify-fdiv ] }
 210         [ 3drop f ]
 211     } case ;
 212
 213 M: expr simplify* drop f ;
 214
 215 : simplify ( expr -- vn )
 216     dup simplify* {
 217         { [ dup not ] [ drop expr>vn ] }
 218         { [ dup expr? ] [ expr>vn nip ] }
 219         { [ dup vn? ] [ nip ] }
 220     } cond ;