From acc561366f3fe6ec0377103f52ef0f7e923711c9 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 1 Aug 2022 19:35:19 -0700
Subject: Modify the project structure.

Now the lib directory contains what will eventually end up on the
user's /usr/lib/csc. When I write make install, it will copy all of
the .csc files from lib into the destination lib directory. This means I
can start working on the standard library in lib/scheme.
---
 lib/csc/cps-test.csc | 499 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 499 insertions(+)
 create mode 100644 lib/csc/cps-test.csc

(limited to 'lib/csc/cps-test.csc')

diff --git a/lib/csc/cps-test.csc b/lib/csc/cps-test.csc
new file mode 100644
index 0000000..156ba60
--- /dev/null
+++ b/lib/csc/cps-test.csc
@@ -0,0 +1,499 @@
+(define-library (csc cps-test)
+  (import (scheme base)
+          (only (csc gensym)
+            gensym
+            gensym?)
+          (only (csc ir1)
+            %constant
+            %lexical-ref
+            %library-ref
+            constant?
+            lexical-ref?
+            library-ref?
+            make-call
+            make-call-builtin
+            make-constant
+            make-define-syntax
+            make-if
+            make-lambda
+            make-letrec
+            make-lexical-ref
+            make-lexical-set
+            make-library-ref
+            make-sequence)
+          (only (csc ir2)
+            %apply
+            %branch
+            %closure
+            %fix
+            %globals
+            %label
+            %primitive
+            %variable
+            *globals*
+            apply?
+            branch?
+            closure?
+            fix?
+            globals?
+            label?
+            make-apply
+            make-branch
+            make-call-closure
+            make-closure
+            make-fix
+            make-label
+            make-primitive
+            make-variable
+            primitive?
+            variable?)
+          (only (csc testing)
+            assert-equal
+            test)
+          (csc cps))
+  (begin
+
+
+    (define transform-ir2
+      (list
+        (cons constant? %constant)
+        (cons lexical-ref? %lexical-ref)
+        (cons library-ref? %library-ref)
+        (cons variable? %variable)
+        (cons globals? %globals)
+        (cons label? %label)
+        (cons primitive? %primitive)
+        (cons branch? %branch)
+        (cons apply? %apply)
+        (cons closure? %closure)
+        (cons fix? %fix)
+        (cons gensym? (lambda (x) 'gensym))))
+
+
+    (define (test-ref name)
+      (make-lexical-ref name (gensym)))
+
+
+    (define (tail x)
+      (make-apply (test-ref 'tail) (list x)))
+
+
+    (test atom-const
+      (assert-equal
+        (make-apply (test-ref 'tail) (list (make-constant 5)))
+        (ir1->ir2 (make-constant 5) tail)
+        transform-ir2))
+
+
+    (test atom-lexical-ref
+      (assert-equal
+        (make-apply (test-ref 'tail) (list (test-ref 'var)))
+        (ir1->ir2 (test-ref 'var) tail)
+        transform-ir2))
+
+
+    (test atom-library-ref
+      (assert-equal
+        (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list (test-ref 'generated-symbol))
+          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
+        (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail)
+        transform-ir2))
+
+
+    (test lexical-set
+      (assert-equal
+        (make-primitive 'poke (list (make-constant 5) (test-ref 'var) (make-constant 0)) '()
+          (make-apply (test-ref 'tail) (list (make-constant #f))))
+        (ir1->ir2 (make-lexical-set (test-ref 'var) (make-constant 5))
+                  tail)
+        transform-ir2))
+
+
+    (test no-op-define-syntax
+      (assert-equal
+        (make-apply (test-ref 'tail) (list (make-constant #f)))
+        (ir1->ir2 (make-define-syntax 'name '(transformer))
+                  tail)
+        transform-ir2))
+
+
+    (test branch
+      (assert-equal
+        (make-fix
+          (list
+            (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+              (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
+          (make-branch (make-constant #t)
+            (make-apply (test-ref 'generated-symbol) (list (make-constant 1)))
+            (make-apply (test-ref 'generated-symbol) (list (make-constant 2)))))
+        (ir1->ir2 (make-if (make-constant #t)
+                    (make-constant 1)
+                    (make-constant 2))
+                  tail)
+        transform-ir2))
+
+
+    (test call-closure
+      (assert-equal
+        (make-fix
+          (list
+            (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+              (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
+          (make-fix
+            (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                    (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                      (make-primitive 'poke (list (make-constant 2) (test-ref 'generated-symbol) (make-constant 1)) '()
+                        (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 2)) '()
+                          (make-primitive 'poke (list (make-constant 20) (test-ref 'generated-symbol) (make-constant 3)) '()
+                            (make-fix
+                              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                              (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))
+            (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
+              (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
+        (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 10) (make-constant 20)))
+                  tail)
+        transform-ir2))
+
+
+    (test call-builtin-alloc
+      (assert-equal
+        (make-primitive 'alloc (list (make-constant 10)) (list (test-ref 'generated-symbol))
+          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
+        (ir1->ir2 (make-call-builtin 'alloc (list (make-constant 10))) tail)
+        transform-ir2))
+
+
+    (test call-builtin-peek
+      (assert-equal
+        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'generated-symbol))
+          (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+            (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
+        (ir1->ir2
+          (make-call-builtin 'peek (list (make-call-builtin 'alloc (list (make-constant 1))) (make-constant 0)))
+          tail)
+        transform-ir2))
+
+
+    (test call-builtin-poke
+      (assert-equal
+        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'generated-symbol))
+          (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 0)) '()
+            (make-apply (test-ref 'tail) (list (make-constant #f)))))
+        (ir1->ir2
+          (make-call-builtin 'poke (list (make-constant 10)
+                                         (make-call-builtin 'alloc (list (make-constant 1)))
+                                         (make-constant 0)))
+          tail)
+        transform-ir2))
+
+
+    (test sequence
+      (assert-equal
+        (make-primitive 'poke (list (make-constant 5) (test-ref 'a) (make-constant 0)) '()
+          (make-primitive 'poke (list (make-constant 6) (test-ref 'b) (make-constant 0)) '()
+            (make-apply (test-ref 'tail) (list (make-constant #f)))))
+        (ir1->ir2 (make-sequence (make-lexical-set (test-ref 'a) (make-constant 5))
+                                 (make-lexical-set (test-ref 'b) (make-constant 6)))
+                  tail)
+        transform-ir2))
+
+
+    ; It's pretty bad
+    (test closure-rest
+      (assert-equal
+        (make-fix
+          (list (make-closure (test-ref 'generated-symbol)
+                                      (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                  (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'int<? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-fix (list (make-closure (test-ref 'generated-symbol)
+                                                    (list (test-ref 'generated-symbol))
+                                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-branch (test-ref 'generated-symbol)
+                          (make-fix (list (make-closure (test-ref 'generated-symbol)
+                                                        (list (test-ref 'generated-symbol))
+                                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                            (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
+                              (make-apply (test-ref 'generated-symbol)
+                                          (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
+                          (make-fix (list (make-closure (test-ref 'generated-symbol)
+                                                        (list (test-ref 'generated-symbol))
+                                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                            (make-fix
+                              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'c))
+                                      (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))))
+                              (make-fix
+                                (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
+                                (make-fix
+                                  (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                                          (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                                            (make-primitive 'poke (list (make-constant 2) (test-ref 'generated-symbol) (make-constant 1)) '()
+                                              (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'generated-symbol) (make-constant 2)) '()
+                                                (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 3)) '()
+                                                  (make-fix
+                                                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                                                    (make-primitive 'peek (list *globals* (make-library-ref 'vector->list '(csc based))) (list (test-ref 'generated-symbol))
+                                                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+                                  (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
+                                    (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))))))
+          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
+        (ir1->ir2 (make-lambda
+                    '()
+                    (test-ref 'c)
+                    (make-constant 5))
+                  tail)
+        transform-ir2))
+
+
+    (test letrec-functions
+      (define x (test-ref 'x))
+      (define f (gensym))
+      (assert-equal
+        (make-fix
+          (list
+            (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+              (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-branch (test-ref 'generated-symbol)
+                      (make-fix
+                        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'x))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'x)))))
+                          (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 2)) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
+                      (make-fix
+                        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
+                          (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+          (make-fix
+            (list
+              (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
+            (make-fix
+              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                      (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                        (make-primitive 'poke (list (make-constant 1) (test-ref 'generated-symbol) (make-constant 1)) '()
+                          (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 2)) '()
+                            (make-fix
+                              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                              (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))
+              (make-primitive 'alloc (list (make-constant 3)) (list (test-ref 'generated-symbol))
+                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))
+        (ir1->ir2
+          (make-letrec #f '(f) (list f)
+                       (list (make-lambda (list x) #f x))
+            (make-call (make-lexical-ref 'f f) (list (make-constant 10))))
+          tail)
+        transform-ir2))
+
+
+    (test letrec-in-order
+      (define a (gensym))
+      (define b (gensym))
+      (assert-equal
+        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'b))
+          (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'a))
+            (make-primitive 'poke (list (make-constant 1) (test-ref 'a) (make-constant 0)) '()
+              (make-primitive 'poke (list (test-ref 'a) (test-ref 'b) (make-constant 0)) '()
+                (make-apply (test-ref 'tail) (list (test-ref 'b)))))))
+        (ir1->ir2
+          (make-letrec #t
+            '(a b)
+            (list a (gensym))
+            (list (make-constant 1)
+                  (make-lexical-ref 'a a))
+            (make-lexical-ref 'b b))
+          tail)
+        transform-ir2))
+
+
+    (test letrec-in-order-function
+      (assert-equal
+        (make-fix
+          (list (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                  (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-fix
+                        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-branch (test-ref 'generated-symbol)
+                          (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))
+                          (make-fix
+                            (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                    (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                            (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
+                              (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+          (make-apply (test-ref 'tail) (list (make-constant 10))))
+        (ir1->ir2
+          (make-letrec #t
+            '(f)
+            (list (gensym))
+            (list (make-lambda '() #f (make-constant 5)))
+            (make-constant 10))
+          tail)
+        transform-ir2))
+
+
+    ; What does the following letrec return?
+    ; (letrec* ((f (lambda () x))
+    ;           (x (f)))
+    ;   x)
+    (test letrec-very-cool
+      (define f (gensym))
+      (define x (gensym))
+      (assert-equal
+        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x))
+          (make-fix
+            (list
+              (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                  (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-fix
+                      (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                              (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                      (make-branch (test-ref 'generated-symbol)
+                        (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list (test-ref 'generated-symbol))
+                          (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                          (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+            (make-fix
+              (list
+                (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                  (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'x) (make-constant 0)) '()
+                    (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))))
+              (make-fix
+                (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                        (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                          (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 1)) '()
+                            (make-fix
+                              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                              (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))
+                (make-primitive 'alloc (list (make-constant 2)) (list (test-ref 'generated-symbol))
+                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))
+        (ir1->ir2
+          (make-letrec #t
+            '(f x)
+            (list f x)
+            (list (make-lambda '() #f (make-lexical-ref 'x x))
+                  (make-call (make-lexical-ref 'f f) '()))
+            (make-lexical-ref 'x x))
+          tail)
+        transform-ir2))
+
+
+    (test set-argument
+      (define test-sym (gensym))
+      (assert-equal
+        (make-fix
+          (list
+            (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
+                                              (test-ref 'generated-symbol))
+              (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-branch (test-ref 'generated-symbol)
+                      (make-fix
+                        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                                  (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x))
+                                    (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'x) (make-constant 0)) '()
+                                      (make-primitive 'poke (list (make-constant 10) (test-ref 'x) (make-constant 0)) '()
+                                        (make-apply (test-ref 'generated-symbol) (list (make-constant #f))))))))
+                          (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 2)) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
+                      (make-fix
+                        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
+                          (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+          (make-apply (test-ref 'tail) (list (make-constant 5))))
+        (ir1->ir2 (make-letrec
+                    #f
+                    '(f)
+                    (list (gensym))
+                    (list (make-lambda (list (make-lexical-ref 'x test-sym)) #f
+                            (make-lexical-set (make-lexical-ref 'x test-sym) (make-constant 10))))
+                    (make-constant 5))
+                  tail)
+        transform-ir2))
+
+    (test set-function
+      (define test-sym (gensym))
+      (assert-equal
+        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'f))
+          (make-fix
+            (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                    (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                      (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                          (make-branch (test-ref 'generated-symbol)
+                            (make-apply (test-ref 'generated-symbol) (list (make-constant 10)))
+                            (make-fix
+                              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                              (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+            (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '()
+              (make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '()
+                (make-apply (test-ref 'tail) (list (make-constant #f)))))))
+        (ir1->ir2 (make-letrec
+                    #f
+                    '(f)
+                    (list test-sym)
+                    (list (make-lambda '() #f (make-constant 10)))
+                    (make-lexical-set (make-lexical-ref 'f test-sym) (make-constant 5)))
+                  tail)
+        transform-ir2))
+
+
+    (define (test-var)
+      (make-variable (gensym)))
+
+
+    (test closure-convert-primitive
+      (define a-sym (gensym))
+      (define f-sym (gensym))
+      (define ret-sym (gensym))
+      (define x-sym (gensym))
+      (assert-equal
+        (make-fix
+          (list (make-closure (make-label (gensym)) (list (test-var) (test-var) (test-var))
+                  (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var))
+                    (make-primitive 'poke (list (test-var) (test-var) (make-constant 0)) '()
+                      (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var))
+                        (make-apply (test-var) (list (test-var) (make-constant #f))))))))
+          (make-primitive 'alloc (list (make-constant 1)) (list (test-var))
+            (make-primitive 'alloc (list (make-constant 2)) (list (test-var))
+              (make-primitive 'poke (list (make-label (gensym)) (test-var) (make-constant 0)) '()
+                (make-primitive 'poke (list (test-var) (test-var) (make-constant 1)) '()
+                  (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var))
+                    (make-apply (test-var) (list (test-var) (make-library-ref 'tail '(csc builtins)) (make-constant 10)))))))))
+        (closure-convert (make-primitive 'alloc (list (make-constant 1)) (list (make-lexical-ref 'a a-sym))
+                           (make-fix
+                             (list
+                               (make-closure (make-lexical-ref 'f f-sym) (list (make-lexical-ref 'ret ret-sym) (make-lexical-ref 'x x-sym))
+                                 (make-primitive 'poke (list (make-lexical-ref 'x x-sym) (make-lexical-ref 'a a-sym) (make-constant 0)) '()
+                                   (make-apply (make-lexical-ref 'ret ret-sym) (list (make-constant #f))))))
+                             (make-apply (make-lexical-ref 'f f-sym) (list (make-library-ref 'tail '(csc builtins)) (make-constant 10))))))
+        transform-ir2))))
-- 
cgit v1.3.1