From 202c91a3c5682b65cd3681bb5bdb919ae6b13c85 Mon Sep 17 00:00:00 2001
Message-Id: <202c91a3c5682b65cd3681bb5bdb919ae6b13c85.1717117307.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Tue, 11 Apr 2006 18:49:13 +0100
Subject: [PATCH] optparse: Use parse-integer in parse-c-integer.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

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 | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/optparse.lisp b/optparse.lisp
index 9599604..7819b70 100644
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -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 0 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 0 (+ i 2) 16 nil sgn))
-		      (#\o (simple 0 (+ i 2) 8 nil sgn))
-		      (#\b (simple 0 (+ i 2) 2 nil sgn))
-		      (t (simple 0 (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 0 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 0 (1+ i) r nil sgn))
+			     (simple (1+ i) r nil sgn))
 			    (t
 			     (values (* r sgn) i))))))))
     (cond ((>= start end) (values nil start))
-- 
[mdw]