Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

do not ignore explicitly given mantissa width #868

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

do not ignore explicitly given mantissa width #868

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 11 additions & 1 deletion mats/5_3.ms
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -138,7 +138,17 @@
(symbol? '2@3+4i)
; check for float read bug introduced into 3.0:
(< -.039 -.038413 -.038)
)
; non-empty mantissa widths
(eqv? #e0.1|1 1/8)
(eqv? 77|1 64.0)
(eqv? 12|0 0.0)
(eqv? 9|3 8.0)
(eqv? -10|3 -10.0)
(eqv? #e99999999999999983222784|54 99999999999999983222784)
(eqv? #e99999999999999983222784|53 99999999999999991611392)
(eqv? #e99999999999999983222783|54 99999999999999983222784)
(eqv? #e99999999999999983222783|53 99999999999999974834176)
)

(mat string->number
; error cases
Expand Down
5 changes: 5 additions & 0 deletions release_notes/release_notes.stex
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2726,6 +2726,11 @@ in fasl files does not generally make sense.
%-----------------------------------------------------------------------------
\section{Bug Fixes}\label{section:bugfixes}

\subsection{Non-empty mantissa widths (10.1.0)}

Non-empty mantissa widths are now taken into account. For example,
\scheme{(string->number "#e0.1|1")} now evaluates to \scheme{1/8}.

\subsection{Case-insensitive ``V'' format directive (10.1.0)}

The ``V'' format directive is now recognized in uppercase as well as lowercase.
Expand Down
71 changes: 50 additions & 21 deletions s/strnum.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
;;; strnum.ss
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
Expand Down Expand Up @@ -180,14 +180,15 @@ an exception.
; other "interesting" variables:
; r: radix, 2 <= r <= 36 (can be outside this range while constructing #<r>r prefix)
; ex: exactness: 'i, 'e, or #f
; s: function to add sign to number
; s: function to add sign to number
; ms: meta-state: real, imag, angle
; n: exact integer
; m: exact or inexact integer
; w: exact or inexact integer or norep
; wi: exact integer or norep or 'inf or 'nan
; x: number, thunk, or norep
; x: number, thunk, procedure taking rounding procedure, or norep
; e: exact integer exponent
; mw: exact integer mantissa width
; i?: #t if number should be made inexact
; invariant: (thunk) != exact 0.

Expand All @@ -201,18 +202,46 @@ an exception.

(define (implied-i ex) (if (not ex) 'i ex))

(define noround (lambda (x) x))
(define rounder
(lambda (p)
(if (zero? p)
(lambda (n) 0)
(lambda (n)
(let ([a (numerator n)]
[b (denominator n)])
(let ([d (- (bitwise-length a) (bitwise-length b))])
(let*-values
([(a b)
(if (positive? d)
(values a (bitwise-arithmetic-shift-left b d))
(values (bitwise-arithmetic-shift-left a (- d)) b))]
[(b d)
(if (>= a b)
(values (bitwise-arithmetic-shift-left b 1) (+ d 1))
(values b d))]
[(q r)
(div-and-mod (bitwise-arithmetic-shift-left a (+ p 1))
b)])
(* (+ q
(cond [(not (bitwise-bit-set? q 0)) 0]
[(or (not (zero? r))
(bitwise-bit-set? q 1)) 1]
[else -1]))
(expt 2 (- d p 1))))))))))

(define make-part
(lambda (i? s n)
(s (if i? (inexact n) n))))

(define make-part/exponent
(lambda (i? s wi r e)
(lambda (i? s t wi r e)
; get out quick for really large/small exponents, like 1e1000000000
; no need for great precision here; using 2x the min/max base two
; exponent, which should be conservative for all bases. 1x should
; actually work for positive n, but for negative e we need something
; smaller than 1x to allow denormalized numbers.
; s must be the actual sign of the result, with w >= 0
; s must be the actual sign of the result, with w >= 0
(define max-float-exponent
(float-type-case
[(ieee) 1023]))
Expand All @@ -230,10 +259,10 @@ an exception.
(integer-length (denominator wi)))
(log r 2)))
(* max-float-exponent 2))
(inexact (* wi (expt r e)))
(inexact (t (* wi (expt r e))))
(if (< e 0) 0.0 +inf.0))))]
[(eqv? wi 0) 0]
[else (lambda () (s (* wi (expt r e))))])))
[else (lambda () (s (t (* wi (expt r e)))))])))

(define (thaw x) (if (procedure? x) (x) x))

Expand Down Expand Up @@ -329,7 +358,7 @@ an exception.
(finish-number ms ex x1 (make-part (eq? ex 'i) s n))
[(digit r) (num2 r ex ms s (+ (* n r) d))]
[#\/ (rat0 r ex ex ms s (make-part #f plus n))]
[#\| (mwidth0 r ex ms (make-part (not (eq? ex 'e)) s n))]
[#\| (mwidth0 r ex ms (lambda (t) (make-part (not (eq? ex 'e)) s (t n))))]
[#\. (let ([!r6rs (or !r6rs (not (fx= r 10)))]) (float1 r ex ms s n (fx+ i 1) 0))]
[#\# (let ([!r6rs #t]) (numhash r ex ms s (* n r)))]
[(#\e #\s #\f #\d #\l) (let ([!r6rs (or !r6rs (not (fx= r 10)))]) (exp0 r ex ms s n))]
Expand Down Expand Up @@ -415,7 +444,7 @@ an exception.
(mknum-state float1 (r ex ms s m j n) ; saw fraction digit at j
(finish-number ms ex x1 (make-part (not (eq? ex 'e)) s (+ m (* n (expt r (- j i))))))
[(digit r) (float1 r ex ms s m j (+ (* n r) d))]
[#\| (mwidth0 r ex ms (make-part (not (eq? ex 'e)) s (+ m (* n (expt r (- j i))))))]
[#\| (mwidth0 r ex ms (lambda (t) (make-part (not (eq? ex 'e)) s (t (+ m (* n (expt r (- j i))))))))]
[#\# (let ([!r6rs #t]) (floathash r ex ms s m j (* n r)))]
[(#\e #\s #\f #\d #\l) (exp0 r ex ms s (+ m (* n (expt r (- j i)))))]
[else (complex0 r ex ms (make-part (not (eq? ex 'e)) s (+ m (* n (expt r (- j i))))))])
Expand All @@ -437,19 +466,19 @@ an exception.
[(digit r) (exp2 r ex ms sm wi s d)])

(mknum-state exp2 (r ex ms sm wi s e) ; saw exponent digit(s)
(finish-number ms ex x1 (make-part/exponent (not (eq? ex 'e)) sm wi r (s e)))
(finish-number ms ex x1 (make-part/exponent (not (eq? ex 'e)) sm noround wi r (s e)))
[(digit r) (exp2 r ex ms sm wi s (+ (* e r) d))]
[#\| (mwidth0 r ex ms (make-part/exponent (not (eq? ex 'e)) sm wi r (s e)))]
[else (complex0 r ex ms (make-part/exponent (not (eq? ex 'e)) sm wi r (s e)))])
[#\| (mwidth0 r ex ms (lambda (t) (make-part/exponent (not (eq? ex 'e)) sm t wi r (s e))))]
[else (complex0 r ex ms (make-part/exponent (not (eq? ex 'e)) sm noround wi r (s e)))])

(mknum-state mwidth0 (r ex ms x) ; saw vertical bar
(mknum-state mwidth0 (r ex ms x) ; saw vertical bar
#f
[(digit 10) (mwidth1 r ex ms x)])
(mknum-state mwidth1 (r ex ms x) ; saw digit after vertical bar
(finish-number ms ex x1 x)
[(digit 10) (mwidth1 r ex ms x)]
[else (complex0 r ex ms x)])
[(digit 10) (mwidth1 r ex ms d x)])

(mknum-state mwidth1 (r ex ms mw x) ; saw digit after vertical bar
(finish-number ms ex x1 (x (rounder mw)))
[(digit 10) (mwidth1 r ex ms (+ (* 10 mw) d) x)]
[else (complex0 r ex ms (x (rounder mw)))])

(mknum-state complex0 (r ex ms x) ; saw end of real part before end of string
(assert #f) ; should arrive here only from else clauses, thus not at the end of the string
Expand Down