[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/10: CPS2 closure conversion bugfixes
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/10: CPS2 closure conversion bugfixes |
Date: |
Thu, 16 Jul 2015 08:06:23 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 6cfb7afb61343d061ad04fb28cfd496e136dd2e8
Author: Andy Wingo <address@hidden>
Date: Wed Jul 15 16:11:09 2015 +0200
CPS2 closure conversion bugfixes
* module/language/cps2/closure-conversion.scm
(rewrite-shared-closure-calls): Fix to make shared closures call the
right label.
(closure-label): New helper.
(prune-free-vars): If a shared closure is not well-known, don't use
the alias optimization.
(convert-one): Fix for shared closures with one not-well-known
closure.
---
module/language/cps2/closure-conversion.scm | 29 +++++++++++++++++---------
1 files changed, 19 insertions(+), 10 deletions(-)
diff --git a/module/language/cps2/closure-conversion.scm
b/module/language/cps2/closure-conversion.scm
index cf15e15..0ae1bf3 100644
--- a/module/language/cps2/closure-conversion.scm
+++ b/module/language/cps2/closure-conversion.scm
@@ -261,16 +261,16 @@ shared closures to use the appropriate 'self' variable,
if possible."
($prompt escape? (subst tag) handler))))))))
(define (visit-exp label cps names vars k src exp)
- (define (compute-env label bound self rec-bound env)
- (define (add-bound-var bound env)
+ (define (compute-env label bound self rec-bound rec-labels env)
+ (define (add-bound-var bound label env)
(intmap-add env bound (cons self label) (lambda (old new) new)))
(if (intmap-ref shared label (lambda (_) #f))
;; Within a function with a shared closure, rewrite
;; references to bound vars to use the "self" var.
- (fold add-bound-var env rec-bound)
+ (fold add-bound-var env rec-bound rec-labels)
;; Otherwise be sure to use "self" references in any
;; closure.
- (add-bound-var bound env)))
+ (add-bound-var bound label env)))
(match exp
(($ $fun label)
(rewrite-fun label cps env))
@@ -279,7 +279,8 @@ shared closures to use the appropriate 'self' variable, if
possible."
(match (intmap-ref cps label)
(($ $kfun src meta self)
(rewrite-fun label cps
- (compute-env label var self vars env)))))
+ (compute-env label var self vars labels
+ env)))))
cps labels vars))
(_ (rename-exp label cps names vars k src exp))))
@@ -395,11 +396,18 @@ references."
(define (eliminate-closure? label free-vars)
(eq? (intmap-ref free-vars label) empty-intset))
+(define (closure-label label shared bound->label)
+ (cond
+ ((intmap-ref shared label (lambda (_) #f))
+ => (lambda (closure)
+ (intmap-ref bound->label closure)))
+ (else label)))
+
(define (closure-alias label well-known free-vars)
(and (intset-ref well-known label)
(trivial-intset (intmap-ref free-vars label))))
-(define (prune-free-vars free-vars bound->label well-known)
+(define (prune-free-vars free-vars bound->label well-known shared)
"Given the label->bound-var map @var{free-vars}, remove free variables
that are known functions with zero free variables, and replace
references to well-known functions with one free variable with that free
@@ -412,7 +420,8 @@ variable, until we reach a fixed point on the free-vars
map."
(cond
((eliminate-closure? label free-vars)
(intset-remove free var))
- ((closure-alias label well-known free-vars)
+ ((closure-alias (closure-label label shared
bound->label)
+ well-known free-vars)
=> (lambda (alias)
;; If VAR is free in LABEL, then ALIAS must
;; also be free because its definition must
@@ -455,7 +464,7 @@ variable, until we reach a fixed point on the free-vars
map."
(let* ((free (intmap-ref free-vars label))
(nfree (intset-count free))
- (self-known? (well-known? label))
+ (self-known? (well-known? (closure-label label shared bound->label)))
(self (match (intmap-ref cps label) (($ $kfun _ _ self) self))))
(define (convert-arg cps var k)
"Convert one possibly free variable reference to a bound reference.
@@ -642,7 +651,7 @@ bound to @var{var}, and continue to @var{k}."
(with-cps cps
($ (with-cps-constants ((false #f))
($ (have-closure false))))))
- ((and (well-known? label)
+ ((and (well-known? (closure-label label shared bound->label))
(trivial-intset (intmap-ref free-vars label)))
;; Well-known closures with one free variable are
;; replaced at their use sites by uses of the one free
@@ -810,7 +819,7 @@ and allocate and initialize flat closures."
kfun))
;; label -> free-var...
(free-vars (compute-free-vars cps kfun shared))
- (free-vars (prune-free-vars free-vars bound->label well-known)))
+ (free-vars (prune-free-vars free-vars bound->label well-known
shared)))
(let ((free-in-program (intmap-ref free-vars kfun)))
(unless (eq? empty-intset free-in-program)
(error "Expected no free vars in program" free-in-program)))
- [Guile-commits] branch master updated (981802c -> 90aabcc), Andy Wingo, 2015/07/16
- [Guile-commits] 01/10: closure-conversion docstring tweak, Andy Wingo, 2015/07/16
- [Guile-commits] 02/10: CPS2 closure conversion bugfixes,
Andy Wingo <=
- [Guile-commits] 03/10: Enable CPS2 closure conversion, Andy Wingo, 2015/07/16
- [Guile-commits] 04/10: Prepare DCE pass for first-order CPS2, Andy Wingo, 2015/07/16
- [Guile-commits] 06/10: DCE works on first-order CPS, Andy Wingo, 2015/07/16
- [Guile-commits] 05/10: compute-reachable-functions refactor, Andy Wingo, 2015/07/16
- [Guile-commits] 10/10: Fix type/range inference for mul, Andy Wingo, 2015/07/16
- [Guile-commits] 07/10: Beta reduction over first-order CPS, Andy Wingo, 2015/07/16
- [Guile-commits] 08/10: Optimize first-order CPS, Andy Wingo, 2015/07/16
- [Guile-commits] 09/10: Remove CPS optimization passes and closure conversion, Andy Wingo, 2015/07/16