Allow overriding the cmp function in assert-equal.

2 files changed, 6 insertions, 93 deletions

diff --git a/csc/compiler.csc b/csc/compiler.csc
deleted file mode 100644
index 5486344..0000000
--- a/csc/compiler.csc
+++ /dev/null
@@ -1,89 +0,0 @@
-(define-library (csc compiler)
-  (import (scheme base)
-          (only (csc hash-map)
-            hash-bytevector
-            insert
-            key-not-found-error?
-            lookup
-            make-map
-            map-for-each
-            merge)
-          (only (csc ir1)
-            toplevel-define?)
-          (only (csc loop)
-            loop
-            return)
-          (only (csc macros)
-            builtins-environment
-            expand)
-          (only (csc match) match))
-  (begin
-
-
-    (define (hash-symbol s)
-      (hash-bytevector (string->utf8 (symbol->string s))))
-
-
-    (define (cmp-symbol s1 s2)
-      (string<? (symbol->string s1) (symbol->string s2)))
-
-
-    (define-record-type <syntax-error>
-      (make-syntax-error msg irritants)
-      syntax-error?)
-
-
-    (define (raise-syntax-error msg . irritants)
-      (raise (make-syntax-error msg irritants)))
-
-
-    (define (parse-import-set expr)
-      (match expr
-        (((! 'only) import-set . idents)
-          (loop with bindings = (parse-import-set import-set)
-                and new-bindings = (make-map hash-symbol cmp-symbol)
-                for ident in idents
-                do (set! new-bindings
-                     (insert new-bindings
-                       ident
-                       (guard (e ((key-not-found-error? e) (raise-syntax-error "unknown symbol in `only' form" ident)))
-                         (lookup bindings ident))))
-                finally (return new-bindings)))
-        ((! '(csc builtins))
-          builtins-environment)
-        (_ (raise-syntax-error "unknown or unsupported import set form" expr))))
-          
-
-
-    (define (parse-import expr)
-      (match expr
-        (((! 'import) . import-sets)
-          (loop with bindings = (make-map hash-symbol cmp-symbol)
-                for import-set in import-sets
-                do (set! bindings
-                     (merge bindings (parse-import-set import-set)))
-                finally (return bindings)))
-        (_ (raise-syntax-error "expected import form" expr))))
-
-
-    (define-record-type <program>
-      (make-program imports body)
-      program?
-      (imports program-imports)
-      (body program-body))
-
-
-    ; A Scheme program consists of one or more import declarations
-    ; followed by a sequence of expressions and definitions.
-    ;   -- R7RS
-    (define (program->ir1 program)
-      (loop with bindings = (make-map hash-symbol cmp-symbol)
-            for body on program
-            for expr = (car body)
-            do (match expr
-                 (((! 'import) . import-sets)
-                   (set! bindings
-                     (merge bindings (parse-import expr))))
-                 (_ (loop for expr in body
-                          for expanded-expr = (expand expr bindings)
-                          if (toplevel-define? expanded-expr)
diff --git a/csc/testing.csc b/csc/testing.csc
index a0180e6..aad2a63 100644
--- a/csc/testing.csc
+++ b/csc/testing.csc
@@ -59,11 +59,13 @@
 
     (define-syntax assert-equal
       (syntax-rules ()
+        ((assert-equal cmp left right)
+          (let ((x left)
+                (y right))
+            (unless (cmp x y)
+              (fatalf "Fatal: {} is not equal to {}.\nleft is {}\nright is {}" 'left 'right x y))))
         ((assert-equal left right)
-         (let ((x left)
-               (y right))
-           (unless (equal? x y)
-             (fatalf "Fatal: {} is not equal to {}.\nleft is {}\nright is {}" 'left 'right x y))))))
+          (assert-equal equal? left right))))
 
 
     (define-syntax assert-raises