suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

faster bitwise-arithmetic-shift on bignum shift

Browse Source 
Immediately produce 0, -1, or out-of-memory, instead of looping
towards one of those.

original commit: dccc7e81b2f0909ce3c7871b849b0faa83eae576
This commit is contained in:
Matthew Flatt 2020-01-26 07:25:55 -07:00
parent 16acbf1ae6
commit 5587285fac
2 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
mats/5_3.ms
View File

@ -3127,6 +3127,14 @@
(eqv? (bitwise-arithmetic-shift #x-8000000000000000 -31) #x-100000000) (eqv? (bitwise-arithmetic-shift #x-8000000000000000 -31) #x-100000000)
(eqv? (bitwise-arithmetic-shift #x-8000000000000000 -32) #x-80000000) (eqv? (bitwise-arithmetic-shift #x-8000000000000000 -32) #x-80000000)
(eqv? (bitwise-arithmetic-shift #x-8000000000000000 -33) #x-40000000) (eqv? (bitwise-arithmetic-shift #x-8000000000000000 -33) #x-40000000)
(eqv? (bitwise-arithmetic-shift 10 (- (expt 2 100))) 0)
(eqv? (bitwise-arithmetic-shift (expt 10 100) (- (expt 2 100))) 0)
(eqv? (bitwise-arithmetic-shift -10 (- (expt 2 100))) -1)
(eqv? (bitwise-arithmetic-shift (- (expt 10 100)) (- (expt 2 100))) -1)
(eqv? (bitwise-arithmetic-shift 0 (- (expt 2 100))) 0)
(eqv? (bitwise-arithmetic-shift 0 (- (expt 2 100))) 0)
(eqv? (bitwise-arithmetic-shift 0 (expt 2 100)) 0)
(eqv? (bitwise-arithmetic-shift 0 (expt 2 100)) 0)
) )
(mat bitwise-arithmetic-shift-left/right (mat bitwise-arithmetic-shift-left/right

16
s/5_3.ss
View File

@ -2402,11 +2402,17 @@
[else (nonexact-integer-error who x)])] [else (nonexact-integer-error who x)])]
[(bignum?) [(bignum?)
(type-case x (type-case x
[(fixnum? bignum?) [(fixnum?)
(let ([k (if (negative? n) (cond
(most-negative-fixnum) [(fx= x 0) 0]
(most-positive-fixnum))]) [($bigpositive? n) ($oops who "out of memory")]
(ash (ash x k) (- n k)))] [(fxpositive? x) 0]
[else -1])]
[(bignum?)
(cond
[($bigpositive? n) ($oops who "out of memory")]
[($bigpositive? x) 0]
[else -1])]
[else (nonexact-integer-error who x)])] [else (nonexact-integer-error who x)])]
[else (nonexact-integer-error who n)]))) [else (nonexact-integer-error who n)])))