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

Support radix for string->number, number->string.

Browse source 
* module/mes/scm.mes (string->number, number->string): Support radix.
This commit is contained in:
Jan Nieuwenhuizen 2017-01-04 21:11:52 +01:00
parent a0baa98196
commit b83d583755
1 changed files with 17 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
module/mes/scm.mes
View file

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