mes: string->number: Support #x-prefixed hex numbers.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 2 Aug 2019 20:52:46 +0000 (22:52 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 2 Aug 2019 20:52:46 +0000 (22:52 +0200)
* mes/module/mes/scm.mes (string->number): Support "#x"-prefix.
* tests/math.test ("string->number #hex"): Test it.

mes/module/mes/scm.mes
tests/math.test

index 4b4f4c9466b6978852235732a472baf9425e33f4..b874299a2340109fb28a9000f4085f42e5e115ef 100644 (file)
      (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)
 
index 00d1a4311920ef4fb804a8def60d0529602c00cb..8ff404dad71a1e606ca955abb9a8848f61300fcf 100755 (executable)
@@ -6,7 +6,7 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -30,6 +30,7 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
 (mes-use-module (mes test))
 (pass-if-equal "string->number" 42 (string->number "42"))
 (pass-if-equal "string->number neg" -42 (string->number "-42"))
+(pass-if-equal "string->number #hex" 170 (string->number "#xaa"))
 (pass-if-not "string->number hex" (string->number "aa"))
 (pass-if-equal "string->number hex" 170 (string->number "aa" 16))
 (pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0")))