From fd61004764931116bcf2d9875b2aa7dc05992d7c Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sat, 31 May 2014 21:13:33 -0400
Subject: [PATCH] CPS conversion produces $branch nodes, not $kif

* module/language/tree-il/compile-cps.scm (unbound?, convert): Create
  $branch nodes instead of $kif nodes.
---
 module/language/tree-il/compile-cps.scm | 26 ++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 96f27cd44..d81a82c85 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -167,13 +167,12 @@
   (define tc8-iflag 4)
   (define unbound-val 9)
   (define unbound-bits (logior (ash unbound-val 8) tc8-iflag))
-  (let-fresh (ktest) (unbound)
+  (let-fresh () (unbound)
     (build-cps-term
       ($letconst (('unbound unbound
                             (pointer->scm (make-pointer unbound-bits))))
-        ($letk ((ktest ($kif kt kf)))
-          ($continue ktest src
-            ($primcall 'eq? (var unbound))))))))
+        ($continue kf src
+          ($branch kt ($primcall 'eq? (var unbound))))))))
 
 (define (init-default-value name sym subst init body)
   (match (hashq-ref subst sym)
@@ -358,12 +357,12 @@
       ((branching-primitive? name)
        (convert-args args
          (lambda (args)
-           (let-fresh (kt kf kif) ()
+           (let-fresh (kt kf) ()
              (build-cps-term
                ($letk ((kt ($kargs () () ($continue k src ($const #t))))
-                       (kf ($kargs () () ($continue k src ($const #f))))
-                       (kif ($kif kt kf)))
-                 ($continue kif src ($primcall name args))))))))
+                       (kf ($kargs () () ($continue k src ($const #f)))))
+                 ($continue kf src
+                   ($branch kt ($primcall name args)))))))))
       ((and (eq? name 'list)
             (and-map (match-lambda
                       ((or ($ <const>)
@@ -467,21 +466,22 @@
            ($continue k src ($primcall 'apply args*))))))
 
     (($ <conditional> src test consequent alternate)
-     (let-fresh (kif kt kf) ()
+     (let-fresh (kt kf) ()
        (build-cps-term
          ($letk* ((kt ($kargs () () ,(convert consequent k subst)))
-                  (kf ($kargs () () ,(convert alternate k subst)))
-                  (kif ($kif kt kf)))
+                  (kf ($kargs () () ,(convert alternate k subst))))
            ,(match test
               (($ <primcall> src (? branching-primitive? name) args)
                (convert-args args
                  (lambda (args)
                    (build-cps-term
-                     ($continue kif src ($primcall name args))))))
+                     ($continue kf src
+                       ($branch kt ($primcall name args)))))))
               (_ (convert-arg test
                    (lambda (test)
                      (build-cps-term
-                       ($continue kif src ($values (test))))))))))))
+                       ($continue kf src
+                         ($branch kt ($values (test)))))))))))))
 
     (($ <lexical-set> src name gensym exp)
      (convert-arg exp