Changeset 26249 in project


Ignore:
Timestamp:
03/23/12 20:50:15 (8 years ago)
Author:
sjamaan
Message:

numbers: Small cleanup, add some more evil tests to the suite (which might be wrong if mixed complex number types are allowed; maybe I'll delete the tests again or change them to include #f)

Location:
release/4/numbers/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers.scm

    r26247 r26249  
    15971597(define ##sys#number->string %number->string) ; for printer
    15981598
    1599 (define (%string->compnum radix str offset force-exact?)
     1599(define (%string->compnum radix str offset exactness)
     1600  (define (go-inexact!)
     1601    ;; Go inexact unless exact was requested (with #e prefix)
     1602    (unless (eq? exactness 'e) (set! exactness 'i)))
    16001603  (let* ((len (##sys#size str))
    16011604         (r..9 (integer->char (fx+ (char->integer #\0) radix)))
    16021605         (r..a (integer->char (fx+ (char->integer #\a) (fx- radix 10))))
    16031606         (r..A (integer->char (fx+ (char->integer #\A) (fx- radix 10))))
    1604          ;; Two ugly as hell flags which we unfortunately need.
     1607         ;; Ugly flag which we need (note that "exactness" is mutated too!)
    16051608         ;; Since there is (almost) no backtracking we can do this.
    1606          (inexact? #f)
    16071609         (seen-hashes? #f)
    16081610         ;; All these procedures return #f or an object consed onto an end
     
    16431645                         (num (%digits->number str start (car end) radix neg?)))
    16441646                (when hashes            ; Eeewww. Feeling dirty yet?
    1645                   (set! inexact? #t)
    1646                   (set! seen-hashes? #t))
     1647                  (set! seen-hashes? #t)
     1648                  (go-inexact!))
    16471649                (cons num (cdr end))))))
    16481650         (scan-exponent
     
    16531655                   (and-let* ((start (if sign (fx+ start 1) start))
    16541656                              (end (scan-digits start)))
    1655                      (set! inexact? #t)
     1657                     (go-inexact!)
    16561658                     (cons (%digits->number
    16571659                            str start (car end) radix (eq? sign 'neg))
     
    16841686                     (eq? (%subchar str start) #\.))
    16851687                (begin
    1686                   (set! inexact? #t)
     1688                  (go-inexact!)
    16871689                  (scan-decimal-tail (fx+ start 1) neg? #f))
    16881690                (and-let* ((end (scan-digits+hashes start neg? #f)))
    16891691                  (case (and (cdr end) (%subchar str (cdr end)))
    16901692                    ((#\.)
    1691                      (set! inexact? #t)
     1693                     (go-inexact!)
    16921694                     (and (eq? radix 10)
    16931695                          (if (fx> len (fx+ (cdr end) 1))
     
    17071709                                (d (scan-digits+hashes (fx+ (cdr end) 1) #f #f))
    17081710                                (num (car end))
    1709                                 (denom (car d))
    1710                                 ((not (eq? denom 0))))
    1711                        (cons (%/ num denom) (cdr d))))
     1711                                (denom (car d)))
     1712                       (if (not (eq? denom 0))
     1713                           (cons (%/ num denom) (cdr d))
     1714                           ;; Hacky: keep around an inexact until we decide we
     1715                           ;; *really* need exact values, then fail at the end.
     1716                           (and (not (eq? exactness 'e))
     1717                            (case (signum num)
     1718                              ((-1) (cons -inf.0 (cdr d)))
     1719                              ((0)  (cons +nan.0 (cdr d)))
     1720                              ((+1) (cons +inf.0 (cdr d))))))))
    17121721                    (else end))))))
    17131722         (scan-real
     
    17241733                                     ((fx= (fx+ next 1) len) ; [+-]i
    17251734                                      (cons (if (eq? sign 'neg) -1 1) next))
    1726                                      ((and (not force-exact?)
    1727                                            (fx<= (fx+ next 5) len)
     1735                                     ((and (fx<= (fx+ next 5) len)
    17281736                                           (string-ci=? (substring str next (fx+ next 5)) "inf.0"))
     1737                                      (go-inexact!)
    17291738                                      (cons (fp/ (if (eq? sign 'neg) -1.0 1.0) 0.0)
    17301739                                            (and (fx< (fx+ next 5) len)
     
    17341743                          ((#\n #\N)
    17351744                           (or (and sign
    1736                                     (not force-exact?)
    17371745                                    (fx<= (fx+ next 5) len)
    17381746                                    (string-ci=? (substring str next (fx+ next 5)) "nan.0")
    1739                                     (cons (fp/ 0.0 0.0)
    1740                                           (and (fx< (fx+ next 5) len)
    1741                                                (fx+ next 5))))
     1747                                    (begin (go-inexact!)
     1748                                           (cons (fp/ 0.0 0.0)
     1749                                                 (and (fx< (fx+ next 5) len)
     1750                                                      (fx+ next 5)))))
    17421751                               (scan-ureal next (eq? sign 'neg))))
    17431752                          (else (scan-ureal next (eq? sign 'neg)))))))))
     
    17631772                        (make-polar (car r1) (car r2))))
    17641773                     (else #f)))))
    1765     (and number (if (and inexact? (not force-exact?))
     1774    (and number (if (eq? exactness 'i)
    17661775                    (exact->inexact number)
    1767                     number))))
     1776                    ;; Ensure we didn't encounter +inf or +nan with #e
     1777                    (and (finite? number) number)))))
    17681778
    17691779(define (%string->number str #!optional (base 10))
     
    17781788    (if (and (fx< (fx+ i 2) len) (eq? (%subchar str i) #\#))
    17791789        (case (%subchar str (fx+ i 1))
    1780           ((#\i #\I) (and (not exness) (scan-prefix (fx+ i 2) 'inexact radix len)))
    1781           ((#\e #\E) (and (not exness) (scan-prefix (fx+ i 2) 'exact radix len)))
     1790          ((#\i #\I) (and (not exness) (scan-prefix (fx+ i 2) 'i radix len)))
     1791          ((#\e #\E) (and (not exness) (scan-prefix (fx+ i 2) 'e radix len)))
    17821792          ((#\b #\B) (and (not radix) (scan-prefix (fx+ i 2) exness 2 len)))
    17831793          ((#\o #\O) (and (not radix) (scan-prefix (fx+ i 2) exness 8 len)))
     
    17851795          ((#\x #\X) (and (not radix) (scan-prefix (fx+ i 2) exness 16 len)))
    17861796          (else #f))
    1787         (and-let* ((number (%string->compnum (or radix base) str i (eq? exness 'exact))))
    1788           (if (eq? exness 'inexact) (exact->inexact number) number)))))
     1797        (%string->compnum (or radix base) str i exness))))
    17891798
    17901799(define (randomize #!optional (seed (##sys#fudge 2)))
     
    18041813;;; Reader hook
    18051814(define (##sys#string->number str #!optional (radix 10) exactness)
    1806   (let ((num (%string->compnum radix str 0 (eq? exactness 'e))))
    1807     (if (eq? exactness 'i) (exact->inexact num) num)))
     1815  (%string->compnum radix str 0 exactness))
    18081816
    18091817
  • release/4/numbers/trunk/tests/run.scm

    r26228 r26249  
    1010  (let ((exit-status (system "./all-tests")))
    1111    (test "compiled test succeeded" 0 exit-status)))
     12
     13(test-exit)
  • release/4/numbers/trunk/tests/string-conversion.scm

    r26248 r26249  
    204204  ((exact)
    205205   ("1/2" (/ 1 2))
     206   ("#e1/2" (/ 1 2) "1/2")
    206207   ("10/2" 5 "5")
    207208   ("-1/2" (- (/ 1 2)))
    208209   ("10/0" #f)
     210   ("0/10" 0 "0")
     211   ("#e0/10" 0 "0")
    209212   ("#e1#/2" 5 (/ 15 2) "5" "15/2")
    210213   ("#e1/2#" (/ 1 20) "1/20")
     
    213216   ("1/2" (/ 1 2) "0.5" ".5" "500.0e-3")
    214217   ("10/2" 5.0 "5.0" "5.")
     218   ;; Unsure what "#e1/2" is supposed to do in Scheme w/o exact fractions
     219   ("#i10/2" 5.0 "5.0" "5.")
    215220   ("-1/2" (- (/ 1 2)) "-0.5" "-.5" "-500.0e-3")))
    216221 (fractions
    217222  ((inexact exact)
     223   ("#i1/0" pos-inf "+inf.0" "+Inf.0")
     224   ("#i-1/0" neg-inf "-inf.0" "-Inf.0")
     225   ("#i0/0" the-nan "+nan.0" "+NaN.0")
     226   ;; This _could_ be valid in some Schemes (but isn't as pretty)
     227   ;("#i1/0" #f)
     228   ;("#i-1/0" #f)
     229   ;("#i0/0" #f)
     230   
    218231   ("1/-2" #f)
    219232   ("1.0/2" #f)
     
    310323   ("0.5+1/1#2i" #f)
    311324   ("1/#+0.5i" #f)
    312    ("1/1#2+0.5i" #f)))
     325   ("1/1#2+0.5i" #f)
     326
     327   "Mixed notation with infinity (might fail on mixed exactness compnums)"
     328   ;; This is a nasty one. Switch to inexact *after* reading the first number.
     329   ;; Note that it's perfectly acceptable for a scheme with *mixed* exactness
     330   ;; in complex values to return #f here.  TODO: How to parameterize this, we
     331   ;; *really* want to test that single-exactness compnums systems accept this.
     332   ("1/0+1.2i" (make-rectangular pos-inf 1.2) "+inf.0+1.2i" "+Inf.0+1.2i")
     333   ;; Less nasty, most get this right.  Same caveat as above re: mixed exactness
     334   ("1.2+1/0i" (make-rectangular 1.2 pos-inf) "1.2+inf.0i" "1.2+Inf.0")))
    313335
    314336 (compnums
Note: See TracChangeset for help on using the changeset viewer.