[Guile-commits] 02/02: Fix bugs introduced when allowing $kfun -> $kargs

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 5809279b9949692469d98a843227cd242217bea3
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Sun Apr 25 13:33:06 2021 +0200

    Fix bugs introduced when allowing $kfun -> $kargs
    
    * module/language/cps/dce.scm (compute-known-allocations):
    * module/language/cps/simplify.scm (eta-reduce): Allow the case-lambda
    without clauses.
---
 module/language/cps/dce.scm      | 7 +++++--
 module/language/cps/simplify.scm | 2 +-
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index bc8345d..8b06046 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -89,7 +89,10 @@ sites."
                          (($ $kreceive arity kargs)
                           (values known (intset-add! unknown kargs)))
                          (($ $kfun src meta self tail entry)
-                          (values known (intset-add! unknown entry)))
+                          (values known
+                                  (if entry
+                                      (intset-add! unknown entry)
+                                      unknown)))
                          (($ $kclause arity body alt)
                           (values known (intset-add! unknown body)))
                          (($ $ktail)
@@ -270,7 +273,7 @@ sites."
            (($ $kfun src meta self tail entry)
             (values live-labels
                     (adjoin-vars
-                     (or (cont-defs entry) '())
+                     (or (and entry (cont-defs entry)) '())
                      (if self (adjoin-var self live-vars) live-vars))))
            (($ $ktail)
             (values live-labels live-vars))))
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index 20c1279..ef7b86f 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -178,7 +178,7 @@
               (($ $kclause arity body alt)
                ($kclause ,arity (subst body) alt))
               (($ $kfun src meta self tail entry)
-               ($kfun src meta self tail (subst entry)))
+               ($kfun src meta self tail (and entry (subst entry))))
               (_ ,cont))))
      conts)))