Adding compiler transforms in propagation
parent
d2fe75276e
commit
aa1651032d
|
@ -300,3 +300,12 @@ CONSTANT: lookup-table-at-max 256
|
||||||
tester '[ _ filter ] ;
|
tester '[ _ filter ] ;
|
||||||
|
|
||||||
\ intersect [ intersect-quot ] 1 define-partial-eval
|
\ intersect [ intersect-quot ] 1 define-partial-eval
|
||||||
|
|
||||||
|
: fixnum-bits ( -- n )
|
||||||
|
cell-bits tag-bits get - ;
|
||||||
|
|
||||||
|
: bit-quot ( #call -- quot/f )
|
||||||
|
in-d>> second value-info interval>> 0 fixnum-bits [a,b] interval-subset?
|
||||||
|
[ [ >fixnum ] dip fixnum-bit? ] f ? ;
|
||||||
|
|
||||||
|
\ bit? [ bit-quot ] "custom-inlining" set-word-prop
|
||||||
|
|
|
@ -55,7 +55,10 @@ M: fixnum shift >fixnum fixnum-shift ; inline
|
||||||
|
|
||||||
M: fixnum bitnot fixnum-bitnot ; inline
|
M: fixnum bitnot fixnum-bitnot ; inline
|
||||||
|
|
||||||
M: fixnum bit? neg shift 1 bitand 0 > ; inline
|
: fixnum-bit? ( n m -- b )
|
||||||
|
neg shift 1 bitand 0 > ;
|
||||||
|
|
||||||
|
M: fixnum bit? fixnum-bit? ; inline
|
||||||
|
|
||||||
: fixnum-log2 ( x -- n )
|
: fixnum-log2 ( x -- n )
|
||||||
0 swap [ dup 1 eq? ] [ [ 1 + ] [ 2/ ] bi* ] until drop ;
|
0 swap [ dup 1 eq? ] [ [ 1 + ] [ 2/ ] bi* ] until drop ;
|
||||||
|
|
Loading…
Reference in New Issue