[Guile-commits] 02/05: Better folding of branches on $values

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 52965e03ec47b92e5bd34c9dc9d9bbcaf100f26a
Author: Andy Wingo <wi...@pobox.com>
Date:   Sun Jan 3 16:17:53 2016 +0100

    Better folding of branches on $values
    
    * module/language/cps/type-fold.scm (local-type-fold): Fold branches on
      $values, if we can.
---
 module/language/cps/type-fold.scm |   14 ++++++++++++++
 1 files changed, 14 insertions(+), 0 deletions(-)

diff --git a/module/language/cps/type-fold.scm 
b/module/language/cps/type-fold.scm
index d935ea2..9459e31 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -408,6 +408,20 @@
            ((x y)
             (or (fold-binary-branch cps label names vars k kt src name x y)
                 cps))))
+        (($ $branch kt ($ $values (arg)))
+         ;; We might be able to fold branches on values.
+         (call-with-values (lambda () (lookup-pre-type types label arg))
+           (lambda (type min max)
+             (cond
+              ((zero? (logand type (logior &false &nil)))
+               (with-cps cps
+                 (setk label
+                       ($kargs names vars ($continue kt src ($values ()))))))
+              ((zero? (logand type (lognot (logior &false &nil))))
+               (with-cps cps
+                 (setk label
+                       ($kargs names vars ($continue k src ($values ()))))))
+              (else cps)))))
         (_ cps)))
     (let lp ((label start) (cps cps))
       (if (<= label end)