Add a diff library.

I was hesitant to add a diff library, but it was surprisingly easy. A
straightforward application of dynamic programming.

1 files changed, 95 insertions, 38 deletions

diff --git a/csc/macros-test.csc b/csc/macros-test.csc
index db78324..d1b8d2c 100644
--- a/csc/macros-test.csc
+++ b/csc/macros-test.csc
@@ -1,31 +1,70 @@
 (import (scheme base)
+        (only (csc gensym)
+          gensym
+          gensym?)
         (only (csc ir1)
+          %call
+          %constant
+          %define-syntax
+          %if
+          %lambda
+          %letrec
+          %lexical-ref
+          %lexical-set
+          %library-define
+          %library-ref
+          %sequence
+          call?
           constant-expression
           constant?
-          ir1=?
+          define-syntax?
+          if?
+          lambda?
+          letrec?
           lexical-ref-name
           lexical-ref?
           lexical-set-expression
           lexical-set?
+          library-define?
+          library-ref?
           make-constant
+          make-lambda
           make-letrec
           make-lexical-ref
           make-library-ref
-          make-sequence)
+          make-sequence
+          sequence?)
         (only (csc testing)
           assert-equal
           test)
         (csc macros))
 
 
+(define transform-ir1
+  (list
+    (cons constant? %constant)
+    (cons lexical-ref? %lexical-ref)
+    (cons library-ref? %library-ref)
+    (cons lexical-set? %lexical-set)
+    (cons library-define? %library-define)
+    (cons define-syntax? %define-syntax)
+    (cons if? %if)
+    (cons call? %call)
+    (cons sequence? %sequence)
+    (cons lambda? %lambda)
+    (cons letrec? %letrec)
+    (cons gensym? (lambda (x) 'gensym))))
+
+
 (test builtin-quote
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant '(test 1 2 3))
-    (expand '(quote (test 1 2 3)) builtins-environment)))
+    (expand '(quote (test 1 2 3)) builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-literal
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 1)
     (expand
       '(builtin-let-syntax
@@ -36,11 +75,12 @@
              ((foo b)
                1)))
          (foo b))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-underscore
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 0)
     (expand
       '(builtin-let-syntax
@@ -48,11 +88,12 @@
            (syntax-rules ()
              ((foo _) 0)))
          (foo ignored))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-substitution
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -60,11 +101,12 @@
            (syntax-rules ()
              ((foo x) x)))
          (foo 5))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-nil
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 1)
     (expand
       '(builtin-let-syntax
@@ -73,11 +115,12 @@
              ((foo x) 0)
              ((foo) 1)))
          (foo))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-improper-list
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 1)
     (expand
       '(builtin-let-syntax
@@ -85,11 +128,12 @@
            (syntax-rules ()
              ((foo a . b) a)))
          (foo 1 2 3))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-quoted
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 'a)
     (expand
       '(builtin-let-syntax
@@ -97,11 +141,12 @@
            (syntax-rules ()
              ((foo x) (quote x))))
          (foo a))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-constant
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 2)
     (expand
       '(builtin-let-syntax
@@ -111,11 +156,12 @@
              ((foo "def") 1)
              ((foo "ghi") 2)))
          (foo "ghi"))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-ellipsis
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -123,11 +169,12 @@
            (syntax-rules ()
              ((foo x ...) (x ...))))
          (foo quote 5))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-ellipsis-improper
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -135,11 +182,12 @@
            (syntax-rules ()
              ((foo x ... . y) (x ... y))))
          (foo quote . 5))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-ellipsis-zip
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant '((1 . 3) (2 . 4)))
     (expand
       '(builtin-let-syntax
@@ -148,11 +196,12 @@
              ((zip (x ...) (y ...))
                (quote ((x . y) ...)))))
          (zip (1 2) (3 4)))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-ellipsis-nested
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant '(1 2 3 4 5))
     (expand
       '(builtin-let-syntax
@@ -161,11 +210,12 @@
              ((append (x ...) ...)
                (quote (x ... ...)))))
          (append (1 2) (3 4) () (5)))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-syntax-rules-ellipsis-custom
-  (assert-equal ir1=?
+  (assert-equal
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -173,33 +223,40 @@
            (syntax-rules ::: ()
              ((foo x :::) (x :::))))
          (foo quote 5))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
+
+
+(define (test-ref sym)
+  (make-lexical-ref sym (gensym)))
 
 
 (test builtin-lambda-rest
-  (assert-equal ir1=?
+  (assert-equal
     (make-lambda (list
-                   (make-lexical-ref 'a #f)
-                   (make-lexical-ref 'b #f)
-                   (make-lexical-ref 'c #f))
-                 (make-lexical-ref 'd #f)
+                   (test-ref 'a)
+                   (test-ref 'b)
+                   (test-ref 'c))
+                 (test-ref 'd)
                  (make-sequence (make-constant #f) (make-constant 5)))
     (expand
       '(lambda
          (a b c . d) (quote 5))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))
 
 
 (test builtin-case-lambda-defines
-  (assert-equal ir1=?
-    (make-lambda (list (make-lexical-ref 'x #f)) #f
+  (assert-equal
+    (make-lambda (list (test-ref 'x)) #f
       (make-letrec #t '(a b) #f
         (list (make-constant 6)
-              (make-lexical-ref 'a #f))
+              (test-ref 'a))
         (make-sequence (make-constant #f) (make-constant 7))))
     (expand
       '(lambda (x)
         (builtin-define a (quote 6))
         (builtin-define b a)
         (quote 7))
-      builtins-environment)))
+      builtins-environment)
+    transform-ir1))