[Guile-commits] 04/05: Better CPS conversion for tests in tests

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit fb2f7b4e5fc50c3cf42d4d4906060bd99d56cb05
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 3 18:18:51 2016 +0100

    Better CPS conversion for tests in tests
    
    * module/language/tree-il/compile-cps.scm (convert): Tests in tests have
      their consequents and alternates also converted in test context.
---
 module/language/tree-il/compile-cps.scm |   11 +++++++++--
 1 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/module/language/tree-il/compile-cps.scm 
b/module/language/tree-il/compile-cps.scm
index 5fa6010..419cb33 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -773,7 +773,7 @@
            (build-term ($continue k src ($primcall 'apply args*)))))))
 
     (($ <conditional> src test consequent alternate)
-     (define (convert-test cps kt kf)
+     (define (convert-test cps test kt kf)
        (match test
          (($ <primcall> src (? branching-primitive? name) args)
           (convert-args cps args
@@ -781,6 +781,13 @@
               (with-cps cps
                 (build-term ($continue kf src
                               ($branch kt ($primcall name args))))))))
+         (($ <conditional> src test consequent alternate)
+          (with-cps cps
+            (let$ t (convert-test consequent kt kf))
+            (let$ f (convert-test alternate kt kf))
+            (letk kt* ($kargs () () ,t))
+            (letk kf* ($kargs () () ,f))
+            ($ (convert-test test kt* kf*))))
          (_ (convert-arg cps test
               (lambda (cps test)
                 (with-cps cps
@@ -791,7 +798,7 @@
        (let$ f (convert alternate k subst))
        (letk kt ($kargs () () ,t))
        (letk kf ($kargs () () ,f))
-       ($ (convert-test kt kf))))
+       ($ (convert-test test kt kf))))
 
     (($ <lexical-set> src name gensym exp)
      (convert-arg cps exp