basis/compiler/cfg/value-numbering/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 layouts
   4 compiler.cfg.instructions
   5 compiler.cfg.value-numbering.graph
   6 compiler.cfg.value-numbering.expressions locals ;
   7 IN: compiler.cfg.value-numbering.simplify
   8
   9 ! Return value of f means we didn't simplify.
  10 GENERIC: simplify* ( expr -- vn/expr/f )
  11
  12 : simplify-unbox ( in boxer -- vn/expr/f )
  13     over op>> eq? [ in>> ] [ drop f ] if ; inline
  14
  15 : simplify-unbox-float ( in -- vn/expr/f )
  16     \ ##box-float simplify-unbox ; inline
  17
  18 : simplify-unbox-alien ( in -- vn/expr/f )
  19     \ ##box-alien simplify-unbox ; inline
  20
  21 M: unary-expr simplify*
  22     #! Note the copy propagation: a copy always simplifies to
  23     #! its source VN.
  24     [ in>> vn>expr ] [ op>> ] bi {
  25         { \ ##copy [ ] }
  26         { \ ##copy-float [ ] }
  27         { \ ##unbox-float [ simplify-unbox-float ] }
  28         { \ ##unbox-alien [ simplify-unbox-alien ] }
  29         { \ ##unbox-any-c-ptr [ simplify-unbox-alien ] }
  30         [ 2drop f ]
  31     } case ;
  32
  33 : expr-zero? ( expr -- ? ) T{ constant-expr f f 0 } = ; inline
  34
  35 : expr-one? ( expr -- ? ) T{ constant-expr f f 1 } = ; inline
  36
  37 : >binary-expr< ( expr -- in1 in2 )
  38     [ in1>> vn>expr ] [ in2>> vn>expr ] bi ; inline
  39
  40 : simplify-add ( expr -- vn/expr/f )
  41     >binary-expr< {
  42         { [ over expr-zero? ] [ nip ] }
  43         { [ dup expr-zero? ] [ drop ] }
  44         [ 2drop f ]
  45     } cond ; inline
  46
  47 : simplify-sub ( expr -- vn/expr/f )
  48     >binary-expr< {
  49         { [ dup expr-zero? ] [ drop ] }
  50         [ 2drop f ]
  51     } cond ; inline
  52
  53 : simplify-mul ( expr -- vn/expr/f )
  54     >binary-expr< {
  55         { [ over expr-one? ] [ drop ] }
  56         { [ dup expr-one? ] [ drop ] }
  57         [ 2drop f ]
  58     } cond ; inline
  59
  60 : simplify-and ( expr -- vn/expr/f )
  61     >binary-expr< {
  62         { [ 2dup eq? ] [ drop ] }
  63         [ 2drop f ]
  64     } cond ; inline
  65
  66 : simplify-or ( expr -- vn/expr/f )
  67     >binary-expr< {
  68         { [ 2dup eq? ] [ drop ] }
  69         { [ over expr-zero? ] [ nip ] }
  70         { [ dup expr-zero? ] [ drop ] }
  71         [ 2drop f ]
  72     } cond ; inline
  73
  74 : simplify-xor ( expr -- vn/expr/f )
  75     >binary-expr< {
  76         { [ over expr-zero? ] [ nip ] }
  77         { [ dup expr-zero? ] [ drop ] }
  78         [ 2drop f ]
  79     } cond ; inline
  80
  81 : useless-shr? ( in1 in2 -- ? )
  82     over op>> \ ##shl-imm eq?
  83     [ [ in2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline
  84
  85 : simplify-shr ( expr -- vn/expr/f )
  86     >binary-expr< {
  87         { [ 2dup useless-shr? ] [ drop in1>> ] }
  88         { [ dup expr-zero? ] [ drop ] }
  89         [ 2drop f ]
  90     } cond ; inline
  91
  92 : simplify-shl ( expr -- vn/expr/f )
  93     >binary-expr< {
  94         { [ dup expr-zero? ] [ drop ] }
  95         [ 2drop f ]
  96     } cond ; inline
  97
  98 M: binary-expr simplify*
  99     dup op>> {
 100         { \ ##add [ simplify-add ] }
 101         { \ ##add-imm [ simplify-add ] }
 102         { \ ##sub [ simplify-sub ] }
 103         { \ ##sub-imm [ simplify-sub ] }
 104         { \ ##mul [ simplify-mul ] }
 105         { \ ##mul-imm [ simplify-mul ] }
 106         { \ ##and [ simplify-and ] }
 107         { \ ##and-imm [ simplify-and ] }
 108         { \ ##or [ simplify-or ] }
 109         { \ ##or-imm [ simplify-or ] }
 110         { \ ##xor [ simplify-xor ] }
 111         { \ ##xor-imm [ simplify-xor ] }
 112         { \ ##shr [ simplify-shr ] }
 113         { \ ##shr-imm [ simplify-shr ] }
 114         { \ ##sar [ simplify-shr ] }
 115         { \ ##sar-imm [ simplify-shr ] }
 116         { \ ##shl [ simplify-shl ] }
 117         { \ ##shl-imm [ simplify-shl ] }
 118         [ 2drop f ]
 119     } case ;
 120
 121 M: expr simplify* drop f ;
 122
 123 : simplify ( expr -- vn )
 124     dup simplify* {
 125         { [ dup not ] [ drop expr>vn ] }
 126         { [ dup expr? ] [ expr>vn nip ] }
 127         { [ dup integer? ] [ nip ] }
 128     } cond ;
 129
 130 : number-values ( insn -- )
 131     [ >expr simplify ] [ dst>> ] bi set-vn ;