Support radix for string->number, number->string.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 4 Jan 2017 20:11:52 +0000 (21:11 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 4 Jan 2017 20:45:32 +0000 (21:45 +0100)
* module/mes/scm.mes (string->number, number->string): Support radix.

module/mes/scm.mes

index 6172a4ba4d8e78e8053623bb2b3ebb1a186af7ab..6cb6ed5973829ab896cc2e12eb6995471f79f912 100644 (file)
    (>= (string-length string) (string-length prefix))
    (equal? (substring string 0 (string-length prefix)) prefix)))
 
-(define (string->number s . radix)
-  (if (and (pair? radix) (not (= (car radix) 10))) '*STRING->NUMBER:RADIX-NOT-SUPPORTED
-      (let* ((lst (string->list s))
-             (sign (if (char=? (car lst) #\-) -1 1))
-             (lst (if (= sign -1) (cdr lst) lst)))
-        (let loop ((lst lst) (n 0))
-          (if (null? lst) (* sign n)
-              (loop (cdr lst) (+ (* n 10) (- (char->integer (car lst)) (char->integer #\0)))))))))
-
-(define (number->string n)
-  (let ((sign (if (< n 0) '(#\-) '())))
+(define (string->number s . rest)
+  (let* ((radix (if (null? rest) 10 (car rest)))
+         (lst (string->list s))
+         (sign (if (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))))
+            (loop (cdr lst) (+ (* n radix) (- i (if (<= i (char->integer #\9)) (char->integer #\0)
+                                                    (- (char->integer #\a) 10))))))))))
+
+(define (number->string n . rest)
+  (let* ((radix (if (null? rest) 10 (car rest)))
+         (sign (if (< n 0) '(#\-) '())))
     (let loop ((n (abs n)) (lst '()))
-      (let* ((lst (cons (integer->char (+ (remainder n 10) (char->integer #\0))) lst))
-             (n (quotient n 10)))
+      (let* ((i (remainder n radix))
+             (lst (cons (integer->char (+ i (if (<= i 10) (char->integer #\0)
+                                                (- (char->integer #\a) 10)))) lst))
+             (n (quotient n radix)))
         (if (= 0 n) (list->string (append sign lst))
             (loop n lst))))))