scm: Support reading negative hex numbers.

* module/mes/read-0.mes (read-hex): Support negative hex numbers.
* tests/math.test ("#x-10"): New test.
* tests/read.test: Add test.
This commit is contained in:
Jan Nieuwenhuizen 2017-03-27 00:11:05 +02:00
parent 44755ceff2
commit 22880ac831
4 changed files with 8 additions and 4 deletions

Binary file not shown.

View file

@ -238,13 +238,14 @@
((and (> c 96) (< c 103)) (+ (- c 97) 10)) ((and (> c 96) (< c 103)) (+ (- c 97) 10))
((and (> c 47) (< c 58)) (- c 48)) ((and (> c 47) (< c 58)) (- c 48))
(#t 0))) (#t 0)))
(define (read-hex c p n) (define (read-hex c p s n)
(if (not (or (and (> p 64) (< p 71)) (if (not (or (and (> p 64) (< p 71))
(and (> p 96) (< p 103)) (and (> p 96) (< p 103))
(and (> p 47) (< p 58)))) (+ (ash n 4) (calc c)) (and (> p 47) (< p 58)))) (* s (+ (ash n 4) (calc c)))
(read-hex (read-byte) (peek-byte) (+ (ash n 4) (calc c))))) (read-hex (read-byte) (peek-byte) s (+ (ash n 4) (calc c)))))
((lambda (c p) ((lambda (c p)
(read-hex c p 0)) (if (eq? c 45) (read-hex (read-byte) (peek-byte) -1 0)
(read-hex c p 1 0)))
(read-byte) (peek-byte))) (read-byte) (peek-byte)))
(define (read-string) (define (read-string)

View file

@ -79,4 +79,6 @@ exit $?
(pass-if "min 1" (seq? (min 0 1) 0)) (pass-if "min 1" (seq? (min 0 1) 0))
(pass-if "min 2" (seq? (min 1 0 2) 0)) (pass-if "min 2" (seq? (min 1 0 2) 0))
(pass-if-equal "#x-10" -16 #x-10)
(result 'report) (result 'report)

View file

@ -18,6 +18,7 @@ cons
'foo 'foo
(display 'foo) (newline) (display 'foo) (newline)
(display #x16) (newline) (display #x16) (newline)
(display #x-16) (newline)
(display #\A) (newline) (display #\A) (newline)
(display #\newline) (newline) (display #\newline) (newline)
#\alarm #\alarm