more conversion tests

1 files changed, 65 insertions, 32 deletions

diff --git a/test.scm b/test.scm
index 3db9478..eb09065 100644
--- a/test.scm
+++ b/test.scm
@@ -1,3 +1,7 @@
+;;; XXX: These tests depend on the properties of gensym. A proper test
+;;; would consider the passed structures up to alpha conversion but
+;;; that would be time consuming.
+
 (load "gamma-scheme.cps.sld")
 (import (gamma-scheme cps) test)
 
@@ -5,39 +9,68 @@
   (write (cps->sexpr (core->cps x)))
   (newline))
 
-#;(wnl (cps->sexpr cps:with-sub-kont))
-
-(test "constant"
-      '(pass (5) () __toplevel)
-      (cps->sexpr (core->cps 5)))
-
-(test "symbol"
-      '(pass (x) () __toplevel)
-      (cps->sexpr (core->cps 'x)))
-
-(test "thunk"
-      '(apply x () () __toplevel)
-      (cps->sexpr (core->cps '(x))))
+(test-group "atomic objects"
+  (test "constant"
+        '(pass (5) () __toplevel)
+        (cps->sexpr (core->cps 5)))
+  (test "symbol"
+        '(pass (x) () __toplevel)
+        (cps->sexpr (core->cps 'x)))
+  (test "quote"
+        '(pass ((quote x)) () __toplevel)
+        (cps->sexpr (core->cps ''x))))
 
-(test "one symbol arg"
-      '(apply x (y) () __toplevel)
-      (cps->sexpr (core->cps '(x y))))
+(test-group "function application"
+  (test "thunk"
+        '(apply x () () __toplevel)
+        (cps->sexpr (core->cps '(x))))
+  (test "one symbol arg"
+        '(apply x (y) () __toplevel)
+        (cps->sexpr (core->cps '(x y))))
+  (test "one constant arg"
+        '(apply x (5) () __toplevel)
+        (cps->sexpr (core->cps '(x 5))))
+  (test "one quoted arg"
+        '(apply x ((quote y)) () __toplevel)
+        (cps->sexpr (core->cps '(x 'y))))
+  (test "one compound arg"
+        '(apply f (x) () (kappa (__v2) __γ1 (apply x (__v2) __γ1 __toplevel)))
+        (cps->sexpr (core->cps '(x (f x)))))
+  (test "one constant one compound arg"
+        '(apply g (x) () (kappa (__v2) __γ1 (apply f (__v2 10) __γ1 __toplevel)))
+        (cps->sexpr (core->cps '(f (g x) 10))))
+  (test "sequencing"
+        '(apply t1 () ()
+                (kappa (__v2) __γ1
+                       (apply t2 () __γ1
+                              (kappa (__v4) __γ3
+                                     (apply t3 () __γ3
+                                            (kappa (__v6) __γ5
+                                                   (apply f
+                                                          (__v2 __v4 __v6)
+                                                          __γ5
+                                                          __toplevel)))))))
+        (cps->sexpr (core->cps '(f (t1) (t2) (t3))))))
 
-(test "one constant arg"
-      '(apply x (5) () __toplevel)
-      (cps->sexpr (core->cps '(x 5))))
-
-(test "one compound arg"
-      '(apply f (x) () (kappa (__v2) __γ1 (apply x (__v2) __γ1 __toplevel)))
-      (cps->sexpr (core->cps '(x (f x)))))
+(test-group "lambdas"
+  (test "identity"
+        '(pass (lambda ((__γ1 __κ2) (x)) (pass (x) __γ1 __κ2)) () __toplevel)
+        (cps->sexpr (core->cps '(lambda (x) x))))
+  (test "let bind"
+        '(pass (lambda ((__γ3 __κ4) (x))
+               (pass (x) __γ3 __κ4)) ()
+               (kappa (__v2) __γ1
+                      (apply __v2 (y) __γ1 __toplevel)))
+        (cps->sexpr (core->cps '((lambda (x) x) y)))))
 
-(test "identity"
-      '(pass (lambda ((__γ1 __κ2) (x)) (pass (x) __γ1 __κ2)) () __toplevel)
-      (cps->sexpr (core->cps '(lambda (x) x))))
+(test-group "if"
+  (test "if #t"
+        '(pass (y) () __toplevel)
+        (cps->sexpr (core->cps '(if #t y z))))
+  (test "if #f"
+        '(pass (z) () __toplevel)
+        (cps->sexpr (core->cps '(if #f y z))))
+  (test "if truthy number"
+        '(pass (y) () __toplevel)
+        (cps->sexpr (core->cps '(if 5 y z)))))
 
-(test "let bind"
-      '(pass (lambda ((__γ3 __κ4) (x))
-               (pass (x) __γ3 __κ4)) ()
-             (kappa (__v2) __γ1
-                    (apply __v2 (y) __γ1 __toplevel)))
-      (cps->sexpr (core->cps '((lambda (x) x) y))))