diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index a313da7c6..22af8219e 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -136,9 +136,7 @@ (for-each (match-lambda ((src . dst) (emit-mov asm (from-sp dst) (from-sp src)))) (lookup-parallel-moves label allocation)) - (emit-return-values asm (1+ (length args)))) - (($ $primcall 'return (arg)) - (emit-return asm (from-sp (slot arg)))))) + (emit-return-values asm (1+ (length args)))))) (define (compile-value label exp dst) (match exp diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm index 4a398d7e5..c08cfbc2e 100644 --- a/module/language/cps/contification.scm +++ b/module/language/cps/contification.scm @@ -415,12 +415,9 @@ function set." ,(match (intmap-ref conts k*) (($ $kreceive) (match exp - (($ $primcall 'return (val)) - (build-exp ($primcall 'values (val)))) (($ $call) exp) - ;; Except for 'return, a primcall that can continue - ;; to $ktail can also continue to $kreceive. TODO: - ;; replace 'return with 'values, for consistency. + ;; A primcall that can continue to $ktail can also + ;; continue to $kreceive. (($ $primcall) exp) (($ $values vals) (build-exp ($primcall 'values vals))))) diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm index 423da2c4e..b3068985c 100644 --- a/module/language/cps/slot-allocation.scm +++ b/module/language/cps/slot-allocation.scm @@ -660,9 +660,6 @@ are comparable with eqv?. A tmp slot may be used." (call-size label (1+ (length args)) size)) (($ $values args) (shuffle-size (get-shuffles label) size)) - (($ $primcall 'return (arg)) - ;; Return will shuffle arg into fp-relative slot 1. - (max size 2)) (_ size))))) (($ $kreceive) (values frame-sizes clause diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm index 2104b09ef..e7a343b05 100644 --- a/module/language/cps/type-fold.scm +++ b/module/language/cps/type-fold.scm @@ -276,7 +276,7 @@ (with-cps cps (letv bool) (letk kbool ($kargs (#f) (bool) - ($continue k src ($primcall 'return (bool))))) + ($continue k src ($values (bool))))) ($ (convert-to-logtest kbool))))) (with-cps cps #f)))) diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm index f4413af0d..1a9eb72e3 100644 --- a/module/language/cps/verify.scm +++ b/module/language/cps/verify.scm @@ -258,9 +258,7 @@ definitions that are available at LABEL." (when (false-if-exception (prim-arity name)) (error "primitive should continue to $kargs, not $kreceive" name))) (($ $ktail) - (unless (eq? name 'return) - (when (false-if-exception (prim-arity name)) - (error "primitive should continue to $kargs, not $ktail" name)))))) + (error "primitive should continue to $kargs, not $ktail" name)))) (($ $prompt escape? tag handler) (assert-nullary) (match (intmap-ref conts handler) diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index 7f34e6b48..0664b2c4d 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -249,7 +249,7 @@ (with-cps cps (let$ body (with-cps-constants ((unspecified *unspecified*)) (build-term - ($continue k src ($primcall 'return (unspecified)))))) + ($continue k src ($values (unspecified)))))) (letk kvoid ($kargs () () ,body)) kvoid)) (($ $kreceive arity kargs) @@ -287,7 +287,7 @@ (with-cps cps (letv val) (letk kval ($kargs ('val) (val) - ($continue k src ($primcall 'return (val))))) + ($continue k src ($values (val))))) kval)) (($ $kreceive arity kargs) (match arity