chiark / gitweb /
optparse: Use parse-integer in parse-c-integer.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 11 Apr 2006 17:49:13 +0000 (18:49 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 11 Apr 2006 17:49:13 +0000 (18:49 +0100)
CMU CL's parse-integer has cleverness for parsing bignums relatively
quickly.  It's not as scary as Catacomb, but not bad.  Use it instead of
the grotty hack we had previously.

optparse.lisp

index 9599604083d969d925c9ed72d3649905c81ee937..7819b70a51687dbd2ed865da19de8731e5155452 100644 (file)
@@ -436,35 +436,36 @@ (defun parse-c-integer (string &key radix (start 0) end)
 Returns two values: the integer parsed (or nil if there wasn't enough for a
 sensible parse), and the index following the characters of the integer."
   (unless end (setf end (length string)))
-  (labels ((simple (a i r goodp sgn)
-            (loop
-               (when (>= i end)
-                 (return (values (and goodp (* a sgn)) i)))
-               (let ((d (digit-char-p (char string i) r)))
-                 (unless d
-                   (return (values (and goodp (* a sgn)) i)))
-                 (setf a (+ (* a r) d))
-                 (setf goodp t)
-                 (incf i))))
+  (labels ((simple (i r goodp sgn)
+            (multiple-value-bind
+                (a i)
+                (if (and (< i end)
+                         (digit-char-p (char string i) r))
+                    (parse-integer string
+                                   :start i :end end
+                                   :radix r
+                                   :junk-allowed t)
+                    (values nil i))
+              (values (if a (* sgn a) (and goodp 0)) i)))
           (get-radix (i r sgn)
-            (cond (r (simple i r nil sgn))
+            (cond (r (simple i r nil sgn))
                   ((>= i end) (values nil i))
                   ((and (char= (char string i) #\0)
                         (>= (- end i) 2))
                    (case (char string (1+ i))
-                     (#\x (simple (+ i 2) 16 nil sgn))
-                     (#\o (simple (+ i 2) 8 nil sgn))
-                     (#\b (simple (+ i 2) 2 nil sgn))
-                     (t (simple (1+ i) 8 t sgn))))
+                     (#\x (simple (+ i 2) 16 nil sgn))
+                     (#\o (simple (+ i 2) 8 nil sgn))
+                     (#\b (simple (+ i 2) 2 nil sgn))
+                     (t (simple (1+ i) 8 t sgn))))
                   (t
                    (multiple-value-bind
-                         (r i)
-                       (simple i 10 nil +1)
+                       (r i)
+                       (simple i 10 nil +1)
                      (cond ((not r) (values nil i))
                            ((and (< i end)
                                  (char= (char string i) #\_)
                                  (<= 2 r 36))
-                            (simple (1+ i) r nil sgn))
+                            (simple (1+ i) r nil sgn))
                            (t
                             (values (* r sgn) i))))))))
     (cond ((>= start end) (values nil start))