[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Fix bugs introduced when allowing $kfun -> $kargs
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/02: Fix bugs introduced when allowing $kfun -> $kargs |
Date: |
Sun, 25 Apr 2021 07:37:56 -0400 (EDT) |
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)))