1 files changed, 96 insertions, 20 deletions
diff --git a/csc/codegen-test.csc b/csc/codegen-test.csc
index b85ebc3..01eda04 100644
--- a/csc/codegen-test.csc
+++ b/csc/codegen-test.csc
@@ -4,8 +4,12 @@
         (only (csc ir2)
           *globals*
           make-apply
+          make-branch
+          make-closure
           make-constant
           make-fix
+          make-label
+          make-library-ref
           make-primitive
           make-variable)
         (only (csc loop)
@@ -19,31 +23,103 @@
         (csc codegen))
 
 
-(define transform-bytecode
-  (list
-    (cons (lambda (expr)
-            (match expr
-              (('label _) #t)
-              (_ #f)))
-          (lambda (expr) 'label))
-    (cons (lambda (expr)
-            (match expr
-              (('local _) #t)
-              (_ #f)))
-          (lambda (expr) 'local))))
-
-
 (define (test-var)
   (make-variable (gensym)))
 
 
+(define (test-label)
+  (make-label (gensym)))
+
+
 (test codegen-apply
+  (define p (test-var))
+  (assert-equal
+    '((peek (local 1) (local 0) (const 5))
+      (mov (local 2) (local 1))
+      (mov (local 1) (const 10))
+      (jmp (local 2)))
+    (ir2->ir3
+      (make-fix '()
+        (make-primitive 'peek (list *globals* (make-constant 5)) (list p)
+          (make-apply p (list (make-constant 10))))))))
+
+
+(test codegen-call-global
+  (define p (test-var))
+  (assert-equal
+    '((peek (local 1) (local 0) (global cons (csc based)))
+      (mov (local 3) (local 1))
+      (mov (local 1) (const 5))
+      (mov (local 2) (const ()))
+      (jmp (local 3)))
+    (ir2->ir3
+      (make-fix '()
+        (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p)
+          (make-apply p (list (make-constant 5) (make-constant '()))))))))
+
+
+(test codegen-call-known
+  (define f (test-label))
+  (define ret (test-var))
+  (assert-equal
+    '((mov (local 1) (label 0))
+      (jmp (label 0))
+      (label 0)
+      (mov (local 2) (local 1))
+      (jmp (local 2)))
+    (ir2->ir3
+      (make-fix
+        (list (make-closure f (list ret)
+                (make-apply ret (list ret))))
+        (make-apply f (list f))))))
+
+
+(test codegen-permute
+  (define f (test-label))
+  (define g (test-label))
+  (define f1 (test-var))
+  (define f2 (test-var))
+  (define g1 (test-var))
+  (define g2 (test-var))
+  (define g3 (test-var))
+  (assert-equal
+    '((mov (local 1) (const 0))
+      (mov (local 2) (const 1))
+      (jmp (label 0))
+      (label 0)
+      (mov (local 127) (local 1))
+      (mov (local 1) (local 2))
+      (mov (local 2) (local 127))
+      (mov (local 3) (const 0))
+      (jmp (label 1))
+      (label 1)
+      (mov (local 2) (local 1))
+      (mov (local 1) (local 3))
+      (jmp (label 0)))
+    (ir2->ir3
+      (make-fix
+        (list (make-closure f (list f1 f2)
+                (make-apply g (list f2 f1 (make-constant 0))))
+              (make-closure g (list g1 g2 g3)
+                (make-apply f (list g3 g1))))
+        (make-apply f (list (make-constant 0) (make-constant 1)))))))
+
+
+(test codegen-branch
+  (define p (test-var))
   (assert-equal
-    '((peek (local #f) (local #f) (const 5))
-      (mov (local #f) (const 10))
-      (jmp (local #f)))
+    '((peek (local 1) (local 0) (const 1))
+      (jmpif (const #t) (label 0))
+      (mov (local 2) (local 1))
+      (mov (local 1) (const 10))
+      (jmp (local 2))
+      (label 0)
+      (mov (local 2) (local 1))
+      (mov (local 1) (const 5))
+      (jmp (local 2)))
     (ir2->ir3
       (make-fix '()
-        (make-primitive 'peek (list *globals* (make-constant 5)) (list (test-var))
-          (make-apply (test-var) (list (make-constant 10))))))
-    transform-bytecode))
+        (make-primitive 'peek (list *globals* (make-constant 1)) (list p)
+          (make-branch (make-constant #t)
+            (make-apply p (list (make-constant 5)))
+            (make-apply p (list (make-constant 10)))))))))