wingo pushed a commit to branch wip-2.1.2
in repository guile.
commit 2f08838cd66d67b1c6a58eb426f445ff6aa9eec5
Author: Andy Wingo <[email protected]>
Date: Wed Oct 28 11:11:23 2015 +0000
Replace return primcalls with $values
* module/language/cps/compile-bytecode.scm:
* module/language/cps/contification.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Never generate a return
primcall. Instead use $values.
---
module/language/cps/compile-bytecode.scm | 4 +---
module/language/cps/contification.scm | 7 ++-----
module/language/cps/slot-allocation.scm | 3 ---
module/language/cps/type-fold.scm | 2 +-
module/language/cps/verify.scm | 4 +---
module/language/tree-il/compile-cps.scm | 4 ++--
6 files changed, 7 insertions(+), 17 deletions(-)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index a313da7..22af821 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 4a398d7..c08cfbc 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 423da2c..b306898 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 2104b09..e7a343b 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 f4413af..1a9eb72 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 7f34e6b..0664b2c 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
