diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm index b24d2cbe5..5c96bb340 100644 --- a/module/language/cps/contification.scm +++ b/module/language/cps/contification.scm @@ -413,19 +413,14 @@ function set." (let ((k* (lookup-return-cont k))) (if (eq? k k*) (with-cps cps (build-term ($continue k src ,exp))) - ;; We are contifying this return. It must be a call, a - ;; $primcall that can continue to $ktail (basically this is - ;; only "throw" and friends), or a $values expression. k* - ;; will be either a $ktail or a $kreceive continuation. + ;; We are contifying this return. It must be a call or a + ;; $values expression. k* will be either a $ktail or a + ;; $kreceive continuation. (match (intmap-ref conts k*) (($ $kreceive ($ $arity req () rest () #f) kargs) (match exp (($ $call) (with-cps cps (build-term ($continue k* src ,exp)))) - ;; A primcall that can continue to $ktail can also - ;; continue to $kreceive. - (($ $primcall) - (with-cps cps (build-term ($continue k* src ,exp)))) ;; We need to punch through the $kreceive; otherwise we'd ;; have to rewrite as a call to the 'values primitive. (($ $values vals) diff --git a/module/language/cps/devirtualize-integers.scm b/module/language/cps/devirtualize-integers.scm index 731089ecc..7dd66f1e7 100644 --- a/module/language/cps/devirtualize-integers.scm +++ b/module/language/cps/devirtualize-integers.scm @@ -123,7 +123,8 @@ the trace should be referenced outside of it." (match (intmap-ref cps label) ;; We know the initial label is a $kargs, and we won't follow the ;; graph to get to $kreceive etc, so we can stop with these two - ;; continuation kinds. + ;; continuation kinds. (For our purposes, only $values can + ;; continue to $ktail.) (($ $ktail) (fail)) (($ $kargs names vars term) (let* ((vars-of-interest diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm index fa3db514b..e99afb88d 100644 --- a/module/language/cps/verify.scm +++ b/module/language/cps/verify.scm @@ -282,12 +282,7 @@ definitions that are available at LABEL." (assert-kreceive-or-ktail)) (($ $primcall name param args) (match cont - (($ $kargs) #t) - ;; FIXME: Remove this case; instead use $prim and $call. - (($ $kreceive) #t) - (($ $ktail) - (unless (memv name '(throw throw/value throw/value+data)) - (error "primitive should continue to $kargs, not $ktail" name))))))) + (($ $kargs) #t))))) (define (check-term term) (match term (($ $continue k src exp)