Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-16 09:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Parse binary/octal/hex numbers

Browse source
This commit is contained in:
Justin Ethier 2016-02-21 22:47:36 -05:00
parent 46e15ceffc
commit 1bcb119f70
2 changed files with 29 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
scheme/base.sld
View file

@ -9,6 +9,7 @@
(define-library (scheme base)
;; In the future, may include this here: (include "../srfi/9.scm")
(export
string->number2 ;; TODO: should replace string->number primitive
cons-source
syntax-rules
letrec*
@ -1051,6 +1052,31 @@
data,
k,
((p->mode == 0 && p->fp != NULL) ? boolean_t : boolean_f)); ")
(define-c Cyc-string->number
"(void *data, int argc, closure _, object k, object str, object base)"
" make_int(result, 0);
Cyc_check_str(data, str);
Cyc_check_int(data, base);
if (integer_value(base) == 2) {
result.value = binstr2int(string_str(str));
}else if (integer_value(base) == 8) {
result.value = octstr2int(string_str(str));
}else {
result.value = hexstr2int(string_str(str));
}
return_closcall1(data, k, &result); ")
;; TODO: this should become the real string->number
(define (string->number2 str . base)
(if (or (null? base) (not (integer? (car base))))
(string->number str)
(let ((b (car base)))
(cond
((or (= b 2) (= b 8) (= b 16))
(Cyc-string->number str b))
(else
(string->number str))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syntax-rules
(define identifier? symbol?)

6
scheme/read.sld
View file

@ -325,13 +325,13 @@
(parse-atom num)))))
((eq? #\b next-c)
(parse-number fp toks all? parens ptbl
2 (lambda (num) (list->string num))))
2 (lambda (num) (string->number2 (list->string num) 2))))
((eq? #\o next-c)
(parse-number fp toks all? parens ptbl
8 (lambda (num) (list->string num))))
8 (lambda (num) (string->number2 (list->string num) 8))))
((eq? #\x next-c)
(parse-number fp toks all? parens ptbl
16 (lambda (num) (list->string num))))
16 (lambda (num) (string->number2 (list->string num) 16))))
;; Vector
((eq? #\( next-c)
(let ((sub (parse fp '() '() #t #f (+ parens 1) ptbl))