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 prettyprint math.private accessors slots.private sequences
   5 sequences.private strings sbufs compiler.tree.builder
   6 compiler.tree.normalization compiler.tree.debugger alien.accessors
   7 layouts combinators byte-arrays arrays ;
   8 IN: compiler.tree.modular-arithmetic.tests
   9
  10 : test-modular-arithmetic ( quot -- quot' )
  11     cleaned-up-tree nodes>quot ;
  12
  13 { [ >R >fixnum R> >fixnum fixnum+fast ] }
  14 [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
  15
  16 { [ +-integer-integer dup >fixnum ] }
  17 [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
  18
  19 { [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] }
  20 [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
  21
  22 TUPLE: declared-fixnum { x fixnum } ;
  23
  24 { t } [
  25     [ { declared-fixnum } declare [ 1 + ] change-x ]
  26     { + } inlined?
  27     ! XXX: As of .97, we do a bounds check and throw an error on
  28     ! overflow, so we no longer convert fixnum+ to fixnum+fast.
  29     ! If this is too big a regression, we can revert it.
  30     ! { + fixnum+ >fixnum } inlined?
  31 ] unit-test
  32
  33 { t } [
  34     [ { declared-fixnum } declare x>> drop ]
  35     { slot } inlined?
  36 ] unit-test
  37
  38 { f } [
  39     [ { integer } declare -63 shift 4095 bitand ]
  40     \ shift inlined?
  41 ] unit-test
  42
  43 { t } [
  44     [ { integer } declare 127 bitand 3 + ]
  45     { + +-integer-fixnum bitand } inlined?
  46 ] unit-test
  47
  48 { f } [
  49     [ { integer } declare 127 bitand 3 + ]
  50     { integer>fixnum } inlined?
  51 ] unit-test
  52
  53 { t } [
  54     [
  55         { integer } declare
  56         dup 0 >= [
  57             615949 * 797807 + 20 2^ mod dup 19 2^ -
  58         ] [ dup ] if
  59     ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
  60 ] unit-test
  61
  62 { t } [
  63     [
  64         { fixnum } declare
  65         615949 * 797807 + 20 2^ mod dup 19 2^ -
  66     ] { >fixnum } inlined?
  67 ] unit-test
  68
  69 { t } [
  70     [
  71         { integer } declare 0 swap
  72         [
  73             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
  74         ] map
  75     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
  76 ] unit-test
  77
  78 { t } [
  79     [
  80         { fixnum } declare <iota> 0 swap
  81         [
  82             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
  83         ] map
  84     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
  85 ] unit-test
  86
  87 { t } [
  88     [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
  89 ] unit-test
  90
  91 { t } [
  92     [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
  93 ] unit-test
  94
  95 { t } [
  96     [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
  97 ] unit-test
  98
  99 { t } [
 100     [
 101         { integer } declare <iota> [ 256 mod ] map
 102     ] { mod fixnum-mod } inlined?
 103 ] unit-test
 104
 105 { f } [
 106     [
 107         256 mod
 108     ] { mod fixnum-mod } inlined?
 109 ] unit-test
 110
 111 { f } [
 112     [
 113         >fixnum 256 mod
 114     ] { mod fixnum-mod } inlined?
 115 ] unit-test
 116
 117 { f } [
 118     [
 119         dup 0 >= [ 256 mod ] when
 120     ] { mod fixnum-mod } inlined?
 121 ] unit-test
 122
 123 { t } [
 124     [
 125         { integer } declare dup 0 >= [ 256 mod ] when
 126     ] { mod fixnum-mod } inlined?
 127 ] unit-test
 128
 129 { t } [
 130     [
 131         { integer } declare 256 rem
 132     ] { mod fixnum-mod } inlined?
 133 ] unit-test
 134
 135 { t } [
 136     [
 137         { iota } declare [ 256 rem ] map
 138     ] { mod fixnum-mod rem } inlined?
 139 ] unit-test
 140
 141 { [ drop 0 ] }
 142 [ [ >integer 1 rem ] test-modular-arithmetic ] unit-test
 143
 144 { [ drop 0 ] }
 145 [ [ >integer 1 mod ] test-modular-arithmetic ] unit-test
 146
 147 { [ >fixnum 255 >R R> fixnum-bitand ] }
 148 [ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
 149
 150 { t } [
 151     [ { fixnum fixnum } declare + [ 1 + >fixnum ] [ 2 + >fixnum ] bi ]
 152     { >fixnum } inlined?
 153 ] unit-test
 154
 155 { [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-1 ] }
 156 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-1 ] test-modular-arithmetic ] unit-test
 157
 158 { [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-2 ] }
 159 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-2 ] test-modular-arithmetic ] unit-test
 160
 161 cell {
 162     { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
 163     { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
 164 } case
 165 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-4 ] test-modular-arithmetic ] unit-test
 166
 167 { [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] }
 168 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-8 ] test-modular-arithmetic ] unit-test
 169
 170 { [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-1 ] }
 171 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-1 ] test-modular-arithmetic ] unit-test
 172
 173 { [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-2 ] }
 174 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-2 ] test-modular-arithmetic ] unit-test
 175
 176 cell {
 177     { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
 178     { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
 179 } case
 180 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-4 ] test-modular-arithmetic ] unit-test
 181
 182 { [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] }
 183 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
 184
 185 { t } [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
 186
 187 { t } [
 188     [ 0 10 <byte-array> 10 [ 1 pick 0 + >fixnum pick set-nth-unsafe [ 1 + >fixnum ] dip ] times ]
 189     { >fixnum } inlined?
 190 ] unit-test
 191
 192 { f } [ [ + >fixnum ] { >fixnum } inlined? ] unit-test
 193
 194 { t } [
 195     [ >integer [ >fixnum ] [ >fixnum ] bi ]
 196     { >integer } inlined?
 197 ] unit-test
 198
 199 { f } [
 200     [ >integer [ >fixnum ] [ >fixnum ] bi ]
 201     { >fixnum } inlined?
 202 ] unit-test
 203
 204 { t } [
 205     [ >integer [ 2 + >fixnum ] [ 3 + >fixnum ] bi ]
 206     { >integer } inlined?
 207 ] unit-test
 208
 209 { f } [
 210     [ >integer [ 2 + >fixnum ] [ 3 + >fixnum ] bi ]
 211     { >fixnum } inlined?
 212 ] unit-test
 213
 214 { t } [
 215     [ >integer [ >fixnum ] [ >fixnum ] bi ]
 216     { >integer } inlined?
 217 ] unit-test
 218
 219 { f } [
 220     [ >bignum [ >fixnum ] [ >fixnum ] bi ]
 221     { >fixnum } inlined?
 222 ] unit-test
 223
 224 { t } [
 225     [ >bignum [ >fixnum ] [ >fixnum ] bi ]
 226     { >bignum } inlined?
 227 ] unit-test
 228
 229 { f } [
 230     [ [ { fixnum } declare 2 fixnum+ ] dip [ >fixnum 2 - ] [ ] if ]
 231     { fixnum+ } inlined?
 232 ] unit-test
 233
 234 { t } [
 235     [ { fixnum boolean } declare [ 1 + ] [ "HI" throw ] if >fixnum ]
 236     { fixnum+ >fixnum } inlined?
 237 ] unit-test
 238
 239 { t } [
 240     [ { fixnum boolean } declare [ 1 + ] [ drop 5 ] if >fixnum ]
 241     { fixnum+ >fixnum } inlined?
 242 ] unit-test
 243
 244 { t } [
 245     [ { fixnum boolean } declare [ 1 + ] [ 2 + ] if >fixnum ]
 246     { fixnum+ >fixnum } inlined?
 247 ] unit-test
 248
 249 { [ [ 1 ] [ 4 ] if ] } [
 250     [ [ 1.5 ] [ 4 ] if >fixnum ] test-modular-arithmetic
 251 ] unit-test
 252
 253 { [ [ 1 ] [ 2 ] if ] } [
 254     [ [ 1.5 ] [ 2.3 ] if >fixnum ] test-modular-arithmetic
 255 ] unit-test
 256
 257 { f } [
 258     [ { fixnum fixnum boolean } declare [ [ 3 * ] [ 1 + ] dip ] [ [ 4 - ] [ 2 + ] dip ] if >fixnum ]
 259     { fixnum+ >fixnum } inlined?
 260 ] unit-test
 261
 262 { t } [
 263     [ 0 1000 [ 1 + dup >fixnum . ] times drop ]
 264     { fixnum+ >fixnum } inlined?
 265 ] unit-test
 266
 267 { t } [
 268     [ { fixnum } declare 3 + [ 1000 ] dip [ >fixnum . ] curry times ]
 269     { fixnum+ >fixnum } inlined?
 270 ] unit-test
 271
 272 { t } [
 273     [ 0 1000 [ 1 + ] times >fixnum ]
 274     { fixnum+ >fixnum } inlined?
 275 ] unit-test
 276
 277 { f } [
 278     [ f >fixnum ]
 279     { >fixnum } inlined?
 280 ] unit-test
 281
 282 { f } [
 283     [ [ >fixnum ] 2dip set-alien-unsigned-1 ]
 284     { >fixnum } inlined?
 285 ] unit-test
 286
 287 { t } [
 288     [ { fixnum } declare 123 >bignum bitand >fixnum ]
 289     { >bignum fixnum>bignum bignum-bitand } inlined?
 290 ] unit-test
 291
 292 ! Shifts
 293 { t } [
 294     [
 295         [ 0 ] 2dip { array } declare [
 296             hashcode* >fixnum swap [
 297                 [ -2 shift ] [ 5 shift ] bi
 298                 + +
 299             ] keep bitxor >fixnum
 300         ] with each
 301     ] { + bignum+ fixnum-shift bitxor bignum-bitxor } inlined?
 302 ] unit-test