artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

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

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

57
mes/module/mes/scm.mes
View file

@ -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)

3
tests/math.test
View file

@ -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")))