[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/08: Simplify prompt slot allocation now that bailouts
From: |
Andy Wingo |
Subject: |
[Guile-commits] 07/08: Simplify prompt slot allocation now that bailouts can't continue |
Date: |
Wed, 3 Jan 2018 15:31:24 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 824864996695be239a725cd8b0d5548d23bc6118
Author: Andy Wingo <address@hidden>
Date: Wed Jan 3 18:30:13 2018 +0100
Simplify prompt slot allocation now that bailouts can't continue
* module/language/cps/slot-allocation.scm (add-prompt-control-flow-edges):
Simplify now that bailouts don't continue.
---
module/language/cps/slot-allocation.scm | 35 +++++++++++++--------------------
1 file changed, 14 insertions(+), 21 deletions(-)
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index d74b20d..b3bf19e 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -224,27 +224,20 @@ body continuation in the prompt."
((zero? level) labels)
((intset-ref labels label) labels)
(else
- (match (intmap-ref conts label)
- ;; fixme: remove me?
- (($ $ktail)
- ;; Possible for bailouts; never reached and not part of
- ;; prompt body.
- labels)
- (cont
- (let ((labels (intset-add! labels label)))
- (match cont
- (($ $kreceive arity k) (visit-cont k level labels))
- (($ $kargs names syms ($ $continue k src ($ $primcall 'wind)))
- (visit-cont k (1+ level) labels))
- (($ $kargs names syms ($ $continue k src ($ $primcall
'unwind)))
- (visit-cont k (1- level) labels))
- (($ $kargs names syms ($ $continue k src exp))
- (visit-cont k level labels))
- (($ $kargs names syms ($ $branch kf kt))
- (visit-cont kf level (visit-cont kt level labels)))
- (($ $kargs names syms ($ $prompt k kh src escape? tag))
- (visit-cont kh level (visit-cont k (1+ level) labels)))
- (($ $kargs names syms ($ $throw)) labels))))))))))
+ (let ((labels (intset-add! labels label)))
+ (match (intmap-ref conts label)
+ (($ $kreceive arity k) (visit-cont k level labels))
+ (($ $kargs names syms ($ $continue k src ($ $primcall 'wind)))
+ (visit-cont k (1+ level) labels))
+ (($ $kargs names syms ($ $continue k src ($ $primcall 'unwind)))
+ (visit-cont k (1- level) labels))
+ (($ $kargs names syms ($ $continue k src exp))
+ (visit-cont k level labels))
+ (($ $kargs names syms ($ $branch kf kt))
+ (visit-cont kf level (visit-cont kt level labels)))
+ (($ $kargs names syms ($ $prompt k kh src escape? tag))
+ (visit-cont kh level (visit-cont k (1+ level) labels)))
+ (($ $kargs names syms ($ $throw)) labels))))))))
(define (visit-prompt label handler succs)
(let ((body (compute-prompt-body label)))
(define (out-or-back-edge? label)
- [Guile-commits] branch master updated (108ade6 -> 118f516), Andy Wingo, 2018/01/03
- [Guile-commits] 05/08: Fix add-prompt-control-flow-edges for terms with no continuation, Andy Wingo, 2018/01/03
- [Guile-commits] 02/08: Fix sandbox, Andy Wingo, 2018/01/03
- [Guile-commits] 07/08: Simplify prompt slot allocation now that bailouts can't continue,
Andy Wingo <=
- [Guile-commits] 03/08: Variable renaming in type-fold.scm, Andy Wingo, 2018/01/03
- [Guile-commits] 08/08: $primcall always continues to $kargs, Andy Wingo, 2018/01/03
- [Guile-commits] 06/08: $throw is a new kind of CPS term, Andy Wingo, 2018/01/03
- [Guile-commits] 04/08: $prompt is now its own kind of CPS term., Andy Wingo, 2018/01/03
- [Guile-commits] 01/08: $branch is now a distinct CPS term type, Andy Wingo, 2018/01/03