diff options
author | Andy Wingo <wingo@pobox.com> | 2018-01-03 17:17:23 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-01-03 17:32:43 +0100 |
commit | ee15ca1455806b04f4785655ec8a2fd9dda6c01c (patch) | |
tree | 532b7604609085928a652af8330a333c360ca240 /module/language/cps/contification.scm | |
parent | 29fee39c2aafc13245fb5fd48bcf6db195251282 (diff) | |
download | guile-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.scm | 17 |
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 |