mes: string->number: Support #x-prefixed hex numbers.

[mes.git] / mes / module / mes / scm.mes

diff --git a/mes/module/mes/scm.mes b/mes/module/mes/scm.mes
index 4b4f4c9466b6978852235732a472baf9425e33f4..b874299a2340109fb28a9000f4085f42e5e115ef 100644 (file)
--- a/mes/module/mes/scm.mes
+++ b/mes/module/mes/scm.mes
@@ -229,34 +229,35 @@
      (equal? (substring string (- length suffix-length)) suffix))))
 
 (define (string->number s . rest)
-  (let ((lst (string->list s)))
-    (and (pair? lst)
-         (let* ((radix (if (null? rest) 10 (car rest)))
-                (sign (if (and (pair? lst) (char=? (car lst) #\-)) -1 1))
-                (lst (if (= sign -1) (cdr lst) lst)))
-           (let loop ((lst lst) (n 0))
-             (if (null? lst) (* sign n)
-                 (let ((i (char->integer (car lst))))
-                   (cond ((and (>= i (char->integer #\0))
-                               (<= i (char->integer #\9)))
-                          (let ((d (char->integer #\0)))
-                            (loop (cdr lst) (+ (* n radix) (- i d)))))
-                         ((and (= radix 16)
-                               (>= i (char->integer #\a))
-                               (<= i (char->integer #\f)))
-                          (let ((d (char->integer #\a)))
-                            (loop (cdr lst) (+ (* n radix) (- i (- d 10))))))
-                         ((and (= radix 16)
-                               (>= i (char->integer #\A))
-                               (<= i (char->integer #\F)))
-                          (let ((d (char->integer #\A)))
-                            (loop (cdr lst) (+ (* n radix) (- i (- d 10))))))
-                         ((= i (char->integer #\.)) ; minimal FLOAT support
-                          (let ((fraction (cdr lst)))
-                            (if (null? fraction) n
-                                (let ((fraction ((compose string->number list->string) fraction)))
-                                  (and fraction n))))) ; FLOAT as integer
-                         (else #f)))))))))
+  (if (string-prefix? "#x" s) (string->number (string-drop s 2) 16)
+      (let ((lst (string->list s)))
+        (and (pair? lst)
+             (let* ((radix (if (null? rest) 10 (car rest)))
+                    (sign (if (and (pair? lst) (char=? (car lst) #\-)) -1 1))
+                    (lst (if (= sign -1) (cdr lst) lst)))
+               (let loop ((lst lst) (n 0))
+                 (if (null? lst) (* sign n)
+                     (let ((i (char->integer (car lst))))
+                       (cond ((and (>= i (char->integer #\0))
+                                   (<= i (char->integer #\9)))
+                              (let ((d (char->integer #\0)))
+                                (loop (cdr lst) (+ (* n radix) (- i d)))))
+                             ((and (= radix 16)
+                                   (>= i (char->integer #\a))
+                                   (<= i (char->integer #\f)))
+                              (let ((d (char->integer #\a)))
+                                (loop (cdr lst) (+ (* n radix) (- i (- d 10))))))
+                             ((and (= radix 16)
+                                   (>= i (char->integer #\A))
+                                   (<= i (char->integer #\F)))
+                              (let ((d (char->integer #\A)))
+                                (loop (cdr lst) (+ (* n radix) (- i (- d 10))))))
+                             ((= i (char->integer #\.)) ; minimal FLOAT support
+                              (let ((fraction (cdr lst)))
+                                (if (null? fraction) n
+                                    (let ((fraction ((compose string->number list->string) fraction)))
+                                      (and fraction n))))) ; FLOAT as integer
+                             (else #f))))))))))
 
 (define inexact->exact identity)