From d3a8834f75572da6fcad76706d2178e4bc9b5d76 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 8 Aug 2018 15:09:58 -0600
Subject: [PATCH] cs: improve `procedure-{reduce-arity,rename}`

---
 racket/src/cs/rumble/object-name.ss |  2 +-
 racket/src/cs/rumble/procedure.ss   | 47 ++++++++++++++++++++++-------
 2 files changed, 37 insertions(+), 12 deletions(-)

diff --git a/racket/src/cs/rumble/object-name.ss b/racket/src/cs/rumble/object-name.ss
index 9ed25e6e04..42a1e47712 100644
--- a/racket/src/cs/rumble/object-name.ss
+++ b/racket/src/cs/rumble/object-name.ss
@@ -38,7 +38,7 @@
      [(arity-wrapper-procedure? v)
       (extract-jit-procedure-name v)]
      [else
-      (let ([name (((inspect/object v) 'code) 'name)])
+      (let ([name (#%$code-name (#%$closure-code v))])
         (and name
              (string->symbol name)))])]
    [(impersonator? v)
diff --git a/racket/src/cs/rumble/procedure.ss b/racket/src/cs/rumble/procedure.ss
index 3f32883770..e6a59e8f22 100644
--- a/racket/src/cs/rumble/procedure.ss
+++ b/racket/src/cs/rumble/procedure.ss
@@ -251,16 +251,39 @@
                              "arity of procedure does not include requested arity"
                              "procedure" proc
                              "requested arity" a))
-    (make-reduced-arity-procedure
-     (lambda args
-       (unless (bitwise-bit-set? mask (length args))
-         (apply raise-arity-error
-                (or (object-name proc) 'procedure)
-                (mask->arity mask)
-                args))
-       (apply proc args))
-     mask
-     (object-name proc))))
+    (let ([name (object-name proc)])
+      (case mask
+        [(1) (make-arity-wrapper-procedure (if (#%procedure? proc)
+                                               (lambda () (proc))
+                                               (lambda () (|#%app| proc)))
+                                           mask
+                                           name)]
+        [(2) (make-arity-wrapper-procedure (if (#%procedure? proc)
+                                               (lambda (x) (proc x))
+                                               (lambda (x) (|#%app| proc x)))
+                                           mask
+                                           name)]
+        [(4) (make-arity-wrapper-procedure (if (#%procedure? proc)
+                                               (lambda (x y) (proc x y))
+                                               (lambda (x y) (|#%app| proc x y)))
+                                           mask
+                                           name)]
+        [(8) (make-arity-wrapper-procedure (if (#%procedure? proc)
+                                               (lambda (x y z) (proc x y z))
+                                               (lambda (x y z) (|#%app| proc x y z)))
+                                           mask
+                                           name)]
+        [else
+         (make-reduced-arity-procedure
+          (lambda args
+            (unless (bitwise-bit-set? mask (length args))
+              (apply raise-arity-error
+                     (or (object-name proc) 'procedure)
+                     (mask->arity mask)
+                     args))
+            (apply proc args))
+          mask
+          name)]))))
 
 ;; ----------------------------------------
 
@@ -279,7 +302,9 @@
    [else
     (check who procedure? proc)
     (check who symbol? name)
-    (make-named-procedure proc name)]))
+    (if (#%procedure? proc)
+        (make-arity-wrapper-procedure proc (procedure-arity-mask proc) name)
+        (make-named-procedure proc name))]))
 
 (define (procedure-maybe-rename proc name)
   (if name