basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel kernel.private tools.test math math.partial-dispatch
   4 math.private accessors slots.private sequences sequences.private strings sbufs
   5 compiler.tree.builder
   6 compiler.tree.normalization
   7 compiler.tree.debugger
   8 alien.accessors layouts combinators byte-arrays ;
   9 IN: compiler.tree.modular-arithmetic.tests
  10
  11 : test-modular-arithmetic ( quot -- quot' )
  12     cleaned-up-tree nodes>quot ;
  13
  14 [ [ >R >fixnum R> >fixnum fixnum+fast ] ]
  15 [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
  16
  17 [ [ +-integer-integer dup >fixnum ] ]
  18 [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
  19
  20 [ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ]
  21 [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
  22
  23 TUPLE: declared-fixnum { x fixnum } ;
  24
  25 [ t ] [
  26     [ { declared-fixnum } declare [ 1 + ] change-x ]
  27     { + fixnum+ >fixnum } inlined?
  28 ] unit-test
  29
  30 [ t ] [
  31     [ { declared-fixnum } declare x>> drop ]
  32     { slot } inlined?
  33 ] unit-test
  34
  35 [ f ] [
  36     [ { integer } declare -63 shift 4095 bitand ]
  37     \ shift inlined?
  38 ] unit-test
  39
  40 [ t ] [
  41     [ { integer } declare 127 bitand 3 + ]
  42     { + +-integer-fixnum bitand } inlined?
  43 ] unit-test
  44
  45 [ f ] [
  46     [ { integer } declare 127 bitand 3 + ]
  47     { >fixnum } inlined?
  48 ] unit-test
  49
  50 [ t ] [
  51     [
  52         { integer } declare
  53         dup 0 >= [
  54             615949 * 797807 + 20 2^ mod dup 19 2^ -
  55         ] [ dup ] if
  56     ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
  57 ] unit-test
  58
  59 [ t ] [
  60     [
  61         { fixnum } declare
  62         615949 * 797807 + 20 2^ mod dup 19 2^ -
  63     ] { >fixnum } inlined?
  64 ] unit-test
  65
  66 [ t ] [
  67     [
  68         { integer } declare 0 swap
  69         [
  70             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
  71         ] map
  72     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
  73 ] unit-test
  74
  75 [ t ] [
  76     [
  77         { fixnum } declare 0 swap
  78         [
  79             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
  80         ] map
  81     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
  82 ] unit-test
  83
  84 [ t ] [
  85     [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
  86 ] unit-test
  87
  88 [ t ] [
  89     [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
  90 ] unit-test
  91
  92 [ t ] [
  93     [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
  94 ] unit-test
  95
  96
  97
  98 [ t ] [
  99     [
 100         { integer } declare [ 256 mod ] map
 101     ] { mod fixnum-mod } inlined?
 102 ] unit-test
 103
 104 [ f ] [
 105     [
 106         256 mod
 107     ] { mod fixnum-mod } inlined?
 108 ] unit-test
 109
 110 [ f ] [
 111     [
 112         >fixnum 256 mod
 113     ] { mod fixnum-mod } inlined?
 114 ] unit-test
 115
 116 [ f ] [
 117     [
 118         dup 0 >= [ 256 mod ] when
 119     ] { mod fixnum-mod } inlined?
 120 ] unit-test
 121
 122 [ t ] [
 123     [
 124         { integer } declare dup 0 >= [ 256 mod ] when
 125     ] { mod fixnum-mod } inlined?
 126 ] unit-test
 127
 128 [ t ] [
 129     [
 130         { integer } declare 256 rem
 131     ] { mod fixnum-mod } inlined?
 132 ] unit-test
 133
 134 [ t ] [
 135     [
 136         { integer } declare [ 256 rem ] map
 137     ] { mod fixnum-mod rem } inlined?
 138 ] unit-test
 139
 140 [ [ >fixnum 255 fixnum-bitand ] ]
 141 [ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
 142
 143 [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-1 ] ]
 144 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-1 ] test-modular-arithmetic ] unit-test
 145
 146 [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-2 ] ]
 147 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-2 ] test-modular-arithmetic ] unit-test
 148
 149 cell {
 150     { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
 151     { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
 152 } case
 153 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-4 ] test-modular-arithmetic ] unit-test
 154
 155 [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] ]
 156 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-8 ] test-modular-arithmetic ] unit-test
 157
 158 [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-1 ] ]
 159 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-1 ] test-modular-arithmetic ] unit-test
 160
 161 [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-2 ] ]
 162 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-2 ] test-modular-arithmetic ] unit-test
 163
 164 cell {
 165     { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
 166     { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
 167 } case
 168 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-4 ] test-modular-arithmetic ] unit-test
 169
 170 [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] ]
 171 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
 172
 173 [ t ] [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
 174
 175 [ t ] [
 176     [ 0 10 <byte-array> 10 [ 1 pick 0 + >fixnum pick set-nth-unsafe [ 1 + >fixnum ] dip ] times ]
 177     { >fixnum } inlined?
 178 ] unit-test