Initial commit.

Not sure if everything here will be needed eventually, but we have a
working bytecode interpreter. Next I will write the linker, then the
core compiler, and finish with the macro expander.

1 files changed, 98 insertions, 0 deletions

diff --git a/hash-map-test.csc b/hash-map-test.csc
new file mode 100644
index 0000000..8f51dfa
--- /dev/null
+++ b/hash-map-test.csc
@@ -0,0 +1,98 @@
+(import (scheme base)
+        (only (csc sort) sort)
+        (only (csc testing)
+              define-test
+              errorf
+              subtest)
+        (csc hash-map))
+
+
+(define (hash-symbol s)
+  (hash-bytevector (string->utf8 (symbol->string s))))
+
+
+(define (symbol<? s1 s2)
+  (string<? (symbol->string s1) (symbol->string s2)))
+
+
+(define-test (test-hash-map->alist t)
+  (define-record-type <test-case>
+    (test-case desc vals)
+    test-case?
+    (desc desc)
+    (vals vals))
+  (let ((tests (list
+                 (test-case
+                   "singleton"
+                   '((a . 1)))
+                 (test-case
+                   "two"
+                   '((a . 1) (b . 2)))
+                 (test-case
+                   "longer"
+                   '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))))))
+    (for-each
+      (lambda (tc)
+        (subtest t (desc tc)
+                 (let* ((m (alist->hash-map hash-symbol symbol<? (vals tc)))
+                        (got (hash-map->alist m)))
+                   (unless (equal?
+                             (sort
+                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
+                               got)
+                             (sort
+                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
+                               (vals tc)))
+                     (errorf t "(hash-map->alist {}) = {}, want {}." m got (vals tc))))))
+      tests)))
+
+
+(define-test (test-alist->hash-map t)
+  (define-record-type <test-case>
+    (test-case desc vals want)
+    test-case?
+    (desc desc)
+    (vals vals)
+    (want want))
+  (let ((tests (list
+                 (test-case
+                   "singleton"
+                   '((a . 1))
+                   '((a . 1)))
+                 (test-case
+                   "two"
+                   '((a . 1) (b . 2))
+                   '((a . 1) (b . 2)))
+                 (test-case
+                   "larger"
+                   '((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))
+                   '((f . 5) (m . 1) (n . 7) (q . 3) (x . 8)))
+                 (test-case
+                   "in-order"
+                   '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))
+                   '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
+                 (test-case
+                   "reversed"
+                   '((h . ()) (g . ()) (f . ()) (e . ()) (d . ()) (c . ()) (b . ()) (a . ()))
+                   '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
+                 (test-case
+                   "overwrite"
+                   '((a . 1) (a . 2))
+                   '((a . 2)))
+                 (test-case
+                   "alternating"
+                   '((h . ()) (g . ()) (i . ()) (f . ()) (j . ()) (e . ()) (k . ()) (d . ()) (l . ()) (c . ()))
+                   '((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))))))
+    (for-each
+      (lambda (tc)
+        (subtest t (desc tc)
+                 (let ((got (alist->hash-map hash-symbol symbol<? (vals tc))))
+                   (unless (equal?
+                             (sort
+                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
+                               (hash-map->alist got))
+                             (sort
+                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
+                               (want tc)))
+                     (errorf t "(alist->hash-map {}) = {}, want {}." (vals tc) (hash-map->alist got) (want tc))))))
+      tests)))