From e4fa7d403aa010dda326167f460a128a12e7a8d4 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 22 Dec 2013 11:14:13 -0500
Subject: [PATCH] Prefer "receive" over "receive-values"+"reset-frame"

* module/language/cps/compile-bytecode.scm (compile-fun): Attempt to
  emit "receive" instead of "receive-values"+"reset-frame" where
  possible.
---
 module/language/cps/compile-bytecode.scm | 33 ++++++++++++++++--------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 183998bb7..d9da2f86c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -466,17 +466,28 @@
                      (lookup-parallel-moves label allocation))
            (for-each maybe-load-constant arg-slots (cons proc args))
            (emit-call asm proc-slot nargs)
-           ;; FIXME: Only allow more values if there is a rest arg.
-           ;; Express values truncation by the presence of an
-           ;; unused rest arg instead of implicitly.
-           (unless (zero? nreq)
-             (emit-receive-values asm proc-slot #t nreq))
-           (when (and rest-var (maybe-slot rest-var))
-             (emit-bind-rest asm (+ proc-slot 1 nreq)))
-           (for-each (match-lambda
-                      ((src . dst) (emit-mov asm dst src)))
-                     (lookup-parallel-moves k allocation))
-           (emit-reset-frame asm nlocals)))))
+           (cond
+            ((and (= 1 nreq) (and rest-var) (not (maybe-slot rest-var))
+                  (match (lookup-parallel-moves k allocation)
+                    ((((? (lambda (src) (= src (1+ proc-slot))) src)
+                       . dst)) dst)
+                    (_ #f)))
+             ;; The usual case: one required live return value, ignoring
+             ;; any additional values.
+             => (lambda (dst)
+                  (emit-receive asm dst proc-slot nlocals)))
+            (else
+             ;; FIXME: Only allow more values if there is a rest arg.
+             ;; Express values truncation by the presence of an unused
+             ;; rest arg instead of implicitly.
+             (unless (zero? nreq)
+               (emit-receive-values asm proc-slot #t nreq))
+             (when (and rest-var (maybe-slot rest-var))
+               (emit-bind-rest asm (+ proc-slot 1 nreq)))
+             (for-each (match-lambda
+                        ((src . dst) (emit-mov asm dst src)))
+                       (lookup-parallel-moves k allocation))
+             (emit-reset-frame asm nlocals)))))))
 
     (match f
       (($ $fun src meta free ($ $cont k ($ $kentry self tail clauses)))