From 5587285fac7298bb6ea36c3359852f3e47c79150 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 26 Jan 2020 07:25:55 -0700 Subject: [PATCH] faster `bitwise-arithmetic-shift` on bignum shift Immediately produce 0, -1, or out-of-memory, instead of looping towards one of those. original commit: dccc7e81b2f0909ce3c7871b849b0faa83eae576 --- mats/5_3.ms | 8 ++++++++ s/5_3.ss | 16 +++++++++++----- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/mats/5_3.ms b/mats/5_3.ms index 06ddea7b6f..e1b37e629c 100644 --- a/mats/5_3.ms +++ b/mats/5_3.ms @@ -3127,6 +3127,14 @@ (eqv? (bitwise-arithmetic-shift #x-8000000000000000 -31) #x-100000000) (eqv? (bitwise-arithmetic-shift #x-8000000000000000 -32) #x-80000000) (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 diff --git a/s/5_3.ss b/s/5_3.ss index f2f88f7eba..fdbc867fc6 100644 --- a/s/5_3.ss +++ b/s/5_3.ss @@ -2402,11 +2402,17 @@ [else (nonexact-integer-error who x)])] [(bignum?) (type-case x - [(fixnum? bignum?) - (let ([k (if (negative? n) - (most-negative-fixnum) - (most-positive-fixnum))]) - (ash (ash x k) (- n k)))] + [(fixnum?) + (cond + [(fx= x 0) 0] + [($bigpositive? n) ($oops who "out of memory")] + [(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 n)])))