[Guile-commits] 08/27: Replace return primcalls with $values

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 2f08838cd66d67b1c6a58eb426f445ff6aa9eec5
Author: Andy Wingo <address@hidden>
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