Fix bug which caused (string->number "2e-get") to signal an error
authorChris Hanson <org/chris-hanson/cph>
Tue, 25 Aug 1987 20:49:23 +0000 (20:49 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 25 Aug 1987 20:49:23 +0000 (20:49 +0000)
instead of returning #F.

v7/src/runtime/numpar.scm

index d359592fcf4051ef870f22a2eeeb944523661b6e..b230c5535f7a2cdda70e89cf456e0459cde4f88d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/numpar.scm,v 13.42 1987/02/09 23:10:13 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/numpar.scm,v 13.43 1987/08/25 20:49:23 cph Rel $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
 (define *radix*)
 
 (set! string->number
-(named-lambda (string->number string #!optional exactness radix)
-  ((cond ((or (unassigned? exactness) (not exactness)) identity-procedure)
-        ((eq? exactness 'E) ->exact)
-        ((eq? exactness 'I) ->inexact)
-        (else (error "Illegal exactness argument" exactness)))
-   (fluid-let ((*radix*
-               (cond ((unassigned? radix) *parser-radix*)
-                     ((memv radix '(2 8 10 16)) radix)
-                     ((eq? radix 'B) 2)
-                     ((eq? radix 'O) 8)
-                     ((eq? radix 'D) 10)
-                     ((eq? radix 'X) 16)
-                     (else (error "Illegal radix argument" radix)))))
-     (parse-number (string->list string))))))
+  (named-lambda (string->number string #!optional exactness radix)
+    ((cond ((or (unassigned? exactness) (not exactness)) identity-procedure)
+          ((eq? exactness 'E) ->exact)
+          ((eq? exactness 'I) ->inexact)
+          (else (error "Illegal exactness argument" exactness)))
+     (fluid-let ((*radix*
+                 (cond ((unassigned? radix) *parser-radix*)
+                       ((memv radix '(2 8 10 16)) radix)
+                       ((eq? radix 'B) 2)
+                       ((eq? radix 'O) 8)
+                       ((eq? radix 'D) 10)
+                       ((eq? radix 'X) 16)
+                       (else (error "Illegal radix argument" radix)))))
+       (parse-number (string->list string))))))
 
 (define (parse-number chars)
   (parse-real chars
 (define (parse-unsigned-real chars receiver)
   (parse-prefix chars false false false
     (lambda (chars radix exactness precision)
-      (define (finish)
-       (parse-body chars
-         (lambda (chars real)
-           (parse-suffix chars
-             (lambda (chars exponent)
-               (receiver chars
-                         ((case exactness
-                            ((#F) identity-procedure)
-                            ((#\e) ->exact)
-                            ((#\i) ->inexact))
-                          ((case precision
-                             ((#F) identity-procedure)
-                             ((#\s) ->short-flonum)
-                             ((#\l) ->long-flonum))
-                           (if exponent
-                               (* real (expt 10 exponent))
-                               real)))))))))
-      (if radix
-         (fluid-let ((*radix*
-                      (cdr (assv radix
-                                 '((#\b . 2)
-                                   (#\o . 8)
-                                   (#\d . 10)
-                                   (#\x . 16))))))
-           (finish))
-         (finish)))))
+      (let ((finish
+            (lambda ()
+              (parse-body chars
+                (lambda (chars real)
+                  (parse-suffix chars
+                    (lambda (chars exponent)
+                      (receiver chars
+                                ((case exactness
+                                   ((#F) identity-procedure)
+                                   ((#\e) ->exact)
+                                   ((#\i) ->inexact))
+                                 ((case precision
+                                    ((#F) identity-procedure)
+                                    ((#\s) ->short-flonum)
+                                    ((#\l) ->long-flonum))
+                                  (if exponent
+                                      (* real (expt 10 exponent))
+                                      real)))))))))))
+       (if radix
+           (fluid-let ((*radix*
+                        (cdr (assv radix
+                                   '((#\b . 2)
+                                     (#\o . 8)
+                                     (#\d . 10)
+                                     (#\x . 16))))))
+             (finish))
+           (finish))))))
 \f
 (define (parse-prefix chars radix exactness precision receiver)
   (and (not (null? chars))
         ((#\-)
          (parse-unsigned-suffix (cdr chars)
            (lambda (chars exponent)
-             (receiver chars (- exponent)))))
+             (receiver chars (and exponent (- exponent))))))
         (else
          (parse-unsigned-suffix chars
            receiver)))))
               (otherwise chars))))))
 
 ;;; end NUMBER-PARSER-PACKAGE
-))
+))
\ No newline at end of file