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.
This commit is contained in:
Jan Nieuwenhuizen 2019-08-02 22:52:46 +02:00
parent 26891251a6
commit dd34569751
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
2 changed files with 31 additions and 29 deletions

View File

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

View File

@ -6,7 +6,7 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software ;;; 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. ;;; 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)) (mes-use-module (mes test))
(pass-if-equal "string->number" 42 (string->number "42")) (pass-if-equal "string->number" 42 (string->number "42"))
(pass-if-equal "string->number neg" -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-not "string->number hex" (string->number "aa"))
(pass-if-equal "string->number hex" 170 (string->number "aa" 16)) (pass-if-equal "string->number hex" 170 (string->number "aa" 16))
(pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0"))) (pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0")))