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

   1 ! Copyright (C) 2008, 2009 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 ;
   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 M: copy-expr simplify* src>> ;
  13
  14 : simplify-unbox-alien ( expr -- vn/expr/f )
  15     src>> vn>expr dup box-alien-expr? [ src>> ] [ drop f ] if ;
  16
  17 M: unbox-alien-expr simplify* simplify-unbox-alien ;
  18
  19 M: unbox-any-c-ptr-expr simplify* simplify-unbox-alien ;
  20
  21 : expr-zero? ( expr -- ? ) T{ constant-expr f 0 } = ; inline
  22
  23 : expr-one? ( expr -- ? ) T{ constant-expr f 1 } = ; inline
  24
  25 : >binary-expr< ( expr -- in1 in2 )
  26     [ src1>> vn>expr ] [ src2>> vn>expr ] bi ; inline
  27
  28 : simplify-add ( expr -- vn/expr/f )
  29     >binary-expr< {
  30         { [ over expr-zero? ] [ nip ] }
  31         { [ dup expr-zero? ] [ drop ] }
  32         [ 2drop f ]
  33     } cond ; inline
  34
  35 M: add-expr simplify* simplify-add ;
  36 M: add-imm-expr simplify* simplify-add ;
  37
  38 : simplify-sub ( expr -- vn/expr/f )
  39     >binary-expr< {
  40         { [ dup expr-zero? ] [ drop ] }
  41         [ 2drop f ]
  42     } cond ; inline
  43
  44 M: sub-expr simplify* simplify-sub ;
  45 M: sub-imm-expr simplify* simplify-sub ;
  46
  47 : simplify-mul ( expr -- vn/expr/f )
  48     >binary-expr< {
  49         { [ over expr-one? ] [ drop ] }
  50         { [ dup expr-one? ] [ drop ] }
  51         [ 2drop f ]
  52     } cond ; inline
  53
  54 M: mul-expr simplify* simplify-mul ;
  55 M: mul-imm-expr simplify* simplify-mul ;
  56
  57 : simplify-and ( expr -- vn/expr/f )
  58     >binary-expr< {
  59         { [ 2dup eq? ] [ drop ] }
  60         [ 2drop f ]
  61     } cond ; inline
  62
  63 M: and-expr simplify* simplify-and ;
  64 M: and-imm-expr simplify* simplify-and ;
  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 M: or-expr simplify* simplify-or ;
  75 M: or-imm-expr simplify* simplify-or ;
  76
  77 : simplify-xor ( expr -- vn/expr/f )
  78     >binary-expr< {
  79         { [ over expr-zero? ] [ nip ] }
  80         { [ dup expr-zero? ] [ drop ] }
  81         [ 2drop f ]
  82     } cond ; inline
  83
  84 M: xor-expr simplify* simplify-xor ;
  85 M: xor-imm-expr simplify* simplify-xor ;
  86
  87 : useless-shr? ( in1 in2 -- ? )
  88     over shl-imm-expr?
  89     [ [ src2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline
  90
  91 : simplify-shr ( expr -- vn/expr/f )
  92     >binary-expr< {
  93         { [ 2dup useless-shr? ] [ drop src1>> ] }
  94         { [ dup expr-zero? ] [ drop ] }
  95         [ 2drop f ]
  96     } cond ; inline
  97
  98 M: shr-expr simplify* simplify-shr ;
  99 M: shr-imm-expr simplify* simplify-shr ;
 100
 101 : simplify-shl ( expr -- vn/expr/f )
 102     >binary-expr< {
 103         { [ dup expr-zero? ] [ drop ] }
 104         [ 2drop f ]
 105     } cond ; inline
 106
 107 M: shl-expr simplify* simplify-shl ;
 108 M: shl-imm-expr simplify* simplify-shl ;
 109
 110 M: box-displaced-alien-expr simplify*
 111     [ base>> ] [ displacement>> ] bi {
 112         { [ dup vn>expr expr-zero? ] [ drop ] }
 113         [ 2drop f ]
 114     } cond ;
 115
 116 M: expr simplify* drop f ;
 117
 118 : simplify ( expr -- vn )
 119     dup simplify* {
 120         { [ dup not ] [ drop expr>vn ] }
 121         { [ dup expr? ] [ expr>vn nip ] }
 122         { [ dup integer? ] [ nip ] }
 123     } cond ;
 124
 125 : number-values ( insn -- )
 126     [ >expr simplify ] [ dst>> ] bi set-vn ;