From 020c75792ca4649ed0b6994aa095cb3d02793be8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 29 Jun 2019 15:40:43 -0600 Subject: [PATCH] add `fixnum-for-every-system?` The `case` macro needs to use the new predicate instead of `fixnum?`, but delay swittching over until Typed Racket is ready. --- pkgs/base/info.rkt | 2 +- .../scribblings/reference/fixnums.scrbl | 10 ++++++++ .../racket-test-core/tests/racket/fixnum.rktl | 23 ++++++++++++++----- racket/collects/racket/fixnum.rkt | 2 ++ racket/collects/racket/private/case.rkt | 10 ++++---- racket/collects/racket/private/fixnum.rkt | 14 +++++++++++ racket/src/racket/src/schvers.h | 2 +- 7 files changed, 49 insertions(+), 14 deletions(-) create mode 100644 racket/collects/racket/private/fixnum.rkt diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index c6101846ef..97db39e088 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.3.0.10") +(define version "7.3.0.11") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/fixnums.scrbl b/pkgs/racket-doc/scribblings/reference/fixnums.scrbl index 4dd9402359..fd530ccfbb 100644 --- a/pkgs/racket-doc/scribblings/reference/fixnums.scrbl +++ b/pkgs/racket-doc/scribblings/reference/fixnums.scrbl @@ -99,6 +99,16 @@ Safe versions of @racket[unsafe-fx=], @racket[unsafe-fx<], Safe versions of @racket[unsafe-fx->fl] and @racket[unsafe-fl->fx].} + +@defproc[(fixnum-for-every-system? [v any/c]) boolean?]{ + +Returns @racket[#t] if @racket[v] is a @tech{fixnum} and is +represented by fixnum by every Racket implementation, @racket[#f] +otherwise. + +@history[#:added "7.3.0.11"]} + + @; ------------------------------------------------------------ @section[#:tag "fxvectors"]{Fixnum Vectors} diff --git a/pkgs/racket-test-core/tests/racket/fixnum.rktl b/pkgs/racket-test-core/tests/racket/fixnum.rktl index 796b409306..eb43941c83 100644 --- a/pkgs/racket-test-core/tests/racket/fixnum.rktl +++ b/pkgs/racket-test-core/tests/racket/fixnum.rktl @@ -1,15 +1,26 @@ (load-relative "loadtest.rktl") (Section 'fixnum) -(require scheme/fixnum - scheme/unsafe/ops +(require racket/fixnum + racket/unsafe/ops "for-util.rkt") -(define 64-bit? (fixnum? (expt 2 33))) +(define 64-bit? (= (system-type 'word) 64)) -(define (fixnum-width) (if 64-bit? 63 31)) -(define (least-fixnum) (if 64-bit? (- (expt 2 62)) -1073741824)) -(define (greatest-fixnum) (if 64-bit? (- (expt 2 62) 1) +1073741823)) +(define (fixnum-width) (if (eq? 'racket (system-type)) + (if 64-bit? 63 31) + (if 64-bit? 61 30))) +(define (least-fixnum) (- (expt 2 (fixnum-width)))) +(define (greatest-fixnum) (sub1 (expt 2 (fixnum-width)))) +(test #t fixnum-for-every-system? 0) +(test #t fixnum-for-every-system? -100) +(test #t fixnum-for-every-system? 100) +(test #t fixnum-for-every-system? (- (expt 2 29))) +(test #t fixnum-for-every-system? (sub1 (expt 2 29))) +(test #t fixnum? (- (expt 2 29))) +(test #t fixnum? (sub1 (expt 2 29))) +(test #f fixnum-for-every-system? (sub1 (- (expt 2 29)))) +(test #f fixnum-for-every-system? (expt 2 29)) (define unary-table (list (list fxnot unsafe-fxnot) diff --git a/racket/collects/racket/fixnum.rkt b/racket/collects/racket/fixnum.rkt index c7d6bec355..441f226ffd 100644 --- a/racket/collects/racket/fixnum.rkt +++ b/racket/collects/racket/fixnum.rkt @@ -2,6 +2,7 @@ (require '#%flfxnum "private/vector-wraps.rkt" + "private/fixnum.rkt" "unsafe/ops.rkt" (for-syntax racket/base)) @@ -13,6 +14,7 @@ fxnot fxrshift fxlshift fx>= fx> fx= fx< fx<= fxmin fxmax + fixnum-for-every-system? fxvector? fxvector make-fxvector shared-fxvector make-shared-fxvector fxvector-length fxvector-ref fxvector-set! diff --git a/racket/collects/racket/private/case.rkt b/racket/collects/racket/private/case.rkt index cc7c8c3b79..8aba59a955 100644 --- a/racket/collects/racket/private/case.rkt +++ b/racket/collects/racket/private/case.rkt @@ -3,12 +3,11 @@ ;; [http://scheme2006.cs.uchicago.edu/07-clinger.pdf] (module case '#%kernel - (#%require '#%paramz '#%unsafe "small-scheme.rkt" "define.rkt" + (#%require '#%paramz '#%unsafe "small-scheme.rkt" "define.rkt" "fixnum.rkt" (for-syntax '#%kernel "small-scheme.rkt" "stxcase-scheme.rkt" - "qqstx.rkt" "define.rkt" "sort.rkt")) + "qqstx.rkt" "define.rkt" "sort.rkt" "fixnum.rkt")) (#%provide case) - (define-syntax (case stx) (syntax-case stx (else) ;; Empty case @@ -158,13 +157,12 @@ #,exp))] [exp (if (null? (consts-fixnum ks)) exp - #`(if (fixnum? v) + #`(if (fixnum? #;fixnum-for-every-system? v) #,(dispatch-fixnum #'v (consts-fixnum ks)) #,exp))]) exp)]) #,(index-binary-search #'index #'([xs ...] [es ...] ...))))])) - (begin-for-syntax (define *sequential-threshold* 12) (define *hash-threshold* 10) @@ -196,7 +194,7 @@ [else (let ([y (syntax->datum (car ys))]) (cond [(duplicate? y) (inner f s c o (cdr ys))] - [(fixnum? y) (inner (add f y idx) s c o (cdr ys))] + [(fixnum? #;fixnum-for-every-system? y) (inner (add f y idx) s c o (cdr ys))] [(symbol? y) (inner f (add s y idx) c o (cdr ys))] [(keyword? y) (inner f (add s y idx) c o (cdr ys))] [(char? y) (inner f s (add c y idx) o (cdr ys))] diff --git a/racket/collects/racket/private/fixnum.rkt b/racket/collects/racket/private/fixnum.rkt new file mode 100644 index 0000000000..82ed378263 --- /dev/null +++ b/racket/collects/racket/private/fixnum.rkt @@ -0,0 +1,14 @@ +(module fixnum '#%kernel + (#%require '#%flfxnum) + (#%provide fixnum-for-every-system?) + + ;; Smallest number of bits used for a fixnum across Racket + ;; implementation is 30 bits. + + (define-values (fixnum-for-every-system?) + (lambda (v) + (if (fixnum? v) + (if (fx>= v -536870912) + (fx<= v 536870911) + #f) + #f)))) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index bce9fce2e0..7d4e0a64a9 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 3 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 10 +#define MZSCHEME_VERSION_W 11 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x