1 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
2 ! See https://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
10 : test-modular-arithmetic ( quot -- quot' )
11 cleaned-up-tree nodes>quot ;
13 { [ >R >fixnum R> >fixnum fixnum+fast ] }
14 [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
16 { [ +-integer-integer dup >fixnum ] }
17 [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
19 { [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] }
20 [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
22 TUPLE: declared-fixnum { x fixnum } ;
25 [ { declared-fixnum } declare [ 1 + ] change-x ]
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?
34 [ { declared-fixnum } declare x>> drop ]
39 [ { integer } declare -63 shift 4095 bitand ]
44 [ { integer } declare 127 bitand 3 + ]
45 { + +-integer-fixnum bitand } inlined?
49 [ { integer } declare 127 bitand 3 + ]
50 { integer>fixnum } inlined?
57 615949 * 797807 + 20 2^ mod dup 19 2^ -
59 ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
65 615949 * 797807 + 20 2^ mod dup 19 2^ -
66 ] { >fixnum } inlined?
71 { integer } declare 0 swap
73 drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
75 ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
80 { fixnum } declare <iota> 0 swap
82 drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
84 ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
88 [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
92 [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
96 [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
101 { integer } declare <iota> [ 256 mod ] map
102 ] { mod fixnum-mod } inlined?
108 ] { mod fixnum-mod } inlined?
114 ] { mod fixnum-mod } inlined?
119 dup 0 >= [ 256 mod ] when
120 ] { mod fixnum-mod } inlined?
125 { integer } declare dup 0 >= [ 256 mod ] when
126 ] { mod fixnum-mod } inlined?
131 { integer } declare 256 rem
132 ] { mod fixnum-mod } inlined?
137 { iota } declare [ 256 rem ] map
138 ] { mod fixnum-mod rem } inlined?
142 [ [ >integer 1 rem ] test-modular-arithmetic ] unit-test
145 [ [ >integer 1 mod ] test-modular-arithmetic ] unit-test
147 { [ >fixnum 255 >R R> fixnum-bitand ] }
148 [ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
151 [ { fixnum fixnum } declare + [ 1 + >fixnum ] [ 2 + >fixnum ] bi ]
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
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
162 { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
163 { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
165 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-4 ] test-modular-arithmetic ] unit-test
167 { [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] }
168 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-8 ] test-modular-arithmetic ] unit-test
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
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
177 { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
178 { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
180 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-4 ] test-modular-arithmetic ] unit-test
182 { [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] }
183 [ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
185 { t } [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
188 [ 0 10 <byte-array> 10 [ 1 pick 0 + >fixnum pick set-nth-unsafe [ 1 + >fixnum ] dip ] times ]
192 { f } [ [ + >fixnum ] { >fixnum } inlined? ] unit-test
195 [ >integer [ >fixnum ] [ >fixnum ] bi ]
196 { >integer } inlined?
200 [ >integer [ >fixnum ] [ >fixnum ] bi ]
205 [ >integer [ 2 + >fixnum ] [ 3 + >fixnum ] bi ]
206 { >integer } inlined?
210 [ >integer [ 2 + >fixnum ] [ 3 + >fixnum ] bi ]
215 [ >integer [ >fixnum ] [ >fixnum ] bi ]
216 { >integer } inlined?
220 [ >bignum [ >fixnum ] [ >fixnum ] bi ]
225 [ >bignum [ >fixnum ] [ >fixnum ] bi ]
230 [ [ { fixnum } declare 2 fixnum+ ] dip [ >fixnum 2 - ] [ ] if ]
235 [ { fixnum boolean } declare [ 1 + ] [ "HI" throw ] if >fixnum ]
236 { fixnum+ >fixnum } inlined?
240 [ { fixnum boolean } declare [ 1 + ] [ drop 5 ] if >fixnum ]
241 { fixnum+ >fixnum } inlined?
245 [ { fixnum boolean } declare [ 1 + ] [ 2 + ] if >fixnum ]
246 { fixnum+ >fixnum } inlined?
249 { [ [ 1 ] [ 4 ] if ] } [
250 [ [ 1.5 ] [ 4 ] if >fixnum ] test-modular-arithmetic
253 { [ [ 1 ] [ 2 ] if ] } [
254 [ [ 1.5 ] [ 2.3 ] if >fixnum ] test-modular-arithmetic
258 [ { fixnum fixnum boolean } declare [ [ 3 * ] [ 1 + ] dip ] [ [ 4 - ] [ 2 + ] dip ] if >fixnum ]
259 { fixnum+ >fixnum } inlined?
263 [ 0 1000 [ 1 + dup >fixnum . ] times drop ]
264 { fixnum+ >fixnum } inlined?
268 [ { fixnum } declare 3 + [ 1000 ] dip [ >fixnum . ] curry times ]
269 { fixnum+ >fixnum } inlined?
273 [ 0 1000 [ 1 + ] times >fixnum ]
274 { fixnum+ >fixnum } inlined?
283 [ [ >fixnum ] 2dip set-alien-unsigned-1 ]
288 [ { fixnum } declare 123 >bignum bitand >fixnum ]
289 { >bignum fixnum>bignum bignum-bitand } inlined?
295 [ 0 ] 2dip { array } declare [
296 hashcode* >fixnum swap [
297 [ -2 shift ] [ 5 shift ] bi
299 ] keep bitxor >fixnum
301 ] { + bignum+ fixnum-shift bitxor bignum-bitxor } inlined?