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.

diff --git a/module/mes/read-0-32.mo b/module/mes/read-0-32.mo
index 5ddf8c2a292c781788d4f58fc6e7fd6f2f8a093d..ed377e94d7b802ac5c219dc6d23ed91accc452d4 100644 (file)
Binary files a/module/mes/read-0-32.mo and b/module/mes/read-0-32.mo differ

diff --git a/module/mes/read-0.mes b/module/mes/read-0.mes
index 8cf185a5ddd01b4f7aa9db67c11bf5a1a1c48109..afb990446a49e1941792690097115d026c94da03 100644 (file)
--- a/module/mes/read-0.mes
+++ b/module/mes/read-0.mes
@@ -238,13 +238,14 @@
             ((and (> c 96) (< c 103)) (+ (- c 97) 10))
             ((and (> c 47) (< c 58)) (- c 48))
             (#t 0)))
-    (define (read-hex c p n)
+    (define (read-hex c p s n)
       (if (not (or (and (> p 64) (< p 71))
                    (and (> p 96) (< p 103))
-                   (and (> p 47) (< p 58)))) (+ (ash n 4) (calc c))
-                   (read-hex (read-byte) (peek-byte) (+ (ash n 4) (calc c)))))
+                   (and (> p 47) (< p 58)))) (* s (+ (ash n 4) (calc c)))
+                   (read-hex (read-byte) (peek-byte) s (+ (ash n 4) (calc c)))))
     ((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)))
 
   (define (read-string)

diff --git a/tests/math.test b/tests/math.test
index 6a567e62aa93d238a97841a6cf984073291f870c..e9e6ffc7cdc65087a7548b49a3793d4c7a5ed058 100755 (executable)
--- a/tests/math.test
+++ b/tests/math.test
@@ -79,4 +79,6 @@ exit $?
 (pass-if "min 1" (seq? (min 0 1) 0))
 (pass-if "min 2" (seq? (min 1 0 2) 0))
 
+(pass-if-equal "#x-10" -16 #x-10)
+
 (result 'report)

diff --git a/tests/read.test b/tests/read.test
index 41aaf8ce123192670a3ac00413dd611ed59e0f2a..c23a530ebebbb4ca1e1c06eb12b80dff74afc848 100755 (executable)
--- a/tests/read.test
+++ b/tests/read.test
@@ -18,6 +18,7 @@ cons
 'foo
 (display 'foo) (newline)
 (display #x16) (newline)
+(display #x-16) (newline)
 (display #\A) (newline)
 (display #\newline) (newline)
 #\alarm