From dd34569751b9969ca1991ae4c5be9f3b7963f430 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Fri, 2 Aug 2019 22:52:46 +0200
Subject: [PATCH] mes: string->number: Support #x-prefixed hex numbers.

* mes/module/mes/scm.mes (string->number): Support "#x"-prefix.
* tests/math.test ("string->number #hex"): Test it.
---
 mes/module/mes/scm.mes | 57 +++++++++++++++++++++---------------------
 tests/math.test        |  3 ++-
 2 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/mes/module/mes/scm.mes b/mes/module/mes/scm.mes
index 4b4f4c94..b874299a 100644
--- 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)
 
diff --git a/tests/math.test b/tests/math.test
index 00d1a431..8ff404da 100755
--- a/tests/math.test
+++ b/tests/math.test
@@ -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")))