From b83d5837558b2a07d57ab78dc68639bb181373dd Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 4 Jan 2017 21:11:52 +0100 Subject: [PATCH] Support radix for string->number, number->string. * module/mes/scm.mes (string->number, number->string): Support radix. --- module/mes/scm.mes | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/module/mes/scm.mes b/module/mes/scm.mes index 6172a4ba..6cb6ed59 100644 --- a/module/mes/scm.mes +++ b/module/mes/scm.mes @@ -213,20 +213,25 @@ (>= (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 (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) - (let ((sign (if (< n 0) '(#\-) '()))) +(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))))))