summaryrefslogtreecommitdiff
path: root/module/language/cps/contification.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2018-01-03 17:17:23 +0100
committerAndy Wingo <wingo@pobox.com>2018-01-03 17:32:43 +0100
commitee15ca1455806b04f4785655ec8a2fd9dda6c01c (patch)
tree532b7604609085928a652af8330a333c360ca240 /module/language/cps/contification.scm
parent29fee39c2aafc13245fb5fd48bcf6db195251282 (diff)
downloadguile-ee15ca1455806b04f4785655ec8a2fd9dda6c01c.tar.gz
$prompt is now its own kind of CPS term.
* module/language/cps.scm ($prompt): Rework to be its own term kind. Now $continue always continues to a single continuation. Adapt callers.
Diffstat (limited to 'module/language/cps/contification.scm')
-rw-r--r--module/language/cps/contification.scm17
1 files changed, 7 insertions, 10 deletions
diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index ca1a292ac..8266a2383 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -60,12 +60,9 @@ predecessor."
(($ $kfun src meta self ktail kclause) (ref2 ktail kclause))
(($ $ktail) (ref0))
(($ $kclause arity kbody kalt) (ref2 kbody kalt))
- (($ $kargs names syms ($ $branch kf kt))
- (ref2 kf kt))
- (($ $kargs names syms ($ $continue k src exp))
- (match exp
- (($ $prompt escape-only? tag handler) (ref2 k handler))
- (_ (ref1 k))))))
+ (($ $kargs names syms ($ $continue k)) (ref1 k))
+ (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
+ (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))))
(let*-values (((single multiple) (values empty-intset empty-intset))
((single multiple) (intmap-fold add-ref conts single multiple)))
(intset-subtract (persistent-intset single)
@@ -192,11 +189,11 @@ $call, and are always called with a compatible arity."
(($ $callk k proc args)
(exclude-vars functions (cons proc args)))
(($ $primcall name param args)
- (exclude-vars functions args))
- (($ $prompt escape? tag handler)
- (exclude-var functions tag))))
+ (exclude-vars functions args))))
(($ $kargs _ _ ($ $branch kf kt src op param args))
(exclude-vars functions args))
+ (($ $kargs _ _ ($ $prompt k kh src escape? tag))
+ (exclude-var functions tag))
(_ functions)))
(intmap-fold visit-cont conts functions)))
@@ -459,7 +456,7 @@ function set."
(match term
(($ $continue k src exp)
(visit-exp cps k src exp))
- (($ $branch)
+ ((or ($ $branch) ($ $prompt))
(with-cps cps term))))
;; Renumbering is not strictly necessary but some passes may not be