From 7894e97fd2eff516cb771f39b0c2ec91b13df128 Mon Sep 17 00:00:00 2001
From: shhyou <shu-hung.you@eecs.northwestern.edu>
Date: Thu, 7 Jan 2021 16:15:39 -0600
Subject: [PATCH] Stop keyworded functions from changing args' name

---
 pkgs/racket-test-core/tests/racket/procs.rktl | 54 +++++++++++++++++++
 racket/collects/racket/private/kw.rkt         | 17 +++---
 2 files changed, 65 insertions(+), 6 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/procs.rktl b/pkgs/racket-test-core/tests/racket/procs.rktl
index 8f56cf64bb..6e96209b67 100644
--- a/pkgs/racket-test-core/tests/racket/procs.rktl
+++ b/pkgs/racket-test-core/tests/racket/procs.rktl
@@ -785,4 +785,58 @@
 
 ;; ----------------------------------------
 
+(module kw-defns racket/base
+  (provide (all-defined-out))
+
+  (define (func-name/opt.1 arg [opt.1 (lambda (x) x)])
+    (object-name arg))
+
+  (define (func-name/opt.2 arg [opt.2 (lambda (x) x)])
+    (object-name opt.2))
+
+  (define (func-name/kw.1 arg1 #:kw.1 arg2)
+    (object-name arg1))
+
+  (define (func-name/kw.2 arg1 #:kw.2 arg2)
+    (object-name arg2))
+
+  (define (func-name/kw.opt.1 arg #:kw.opt.1 [kw.opt.1 (lambda (x) x)])
+    (object-name arg))
+
+  (define (func-name/kw.opt.2 arg #:kw.opt.2 [kw.opt.2 (lambda (x) x)])
+    (object-name kw.opt.2))
+  )
+(require 'kw-defns)
+
+(define ((proc-has-name? name) s)
+  (and (symbol? s) (regexp-match? name (symbol->string s))))
+
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/opt.1 (lambda (z) z)))
+
+;; the default value of the optional argument picks up
+;; the name of the optional argument
+(test #t (proc-has-name? #rx"opt[.]2")
+         (func-name/opt.2 (lambda (z) z)))
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/opt.2 (lambda (z) z) (lambda (w) w)))
+
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/kw.1 (lambda (z) z) #:kw.1 (lambda (w) w)))
+
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/kw.2 (lambda (z) z) #:kw.2 (lambda (w) w)))
+
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/kw.opt.1 (lambda (z) z)))
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/kw.opt.1 (lambda (z) z) #:kw.opt.1 (lambda (w) w)))
+
+(test #t (proc-has-name? #rx"kw[.]opt[.]2")
+         (func-name/kw.opt.2 (lambda (z) z)))
+(test #t (proc-has-name? #rx"procs.rktl:")
+         (func-name/kw.opt.2 (lambda (z) z) #:kw.opt.2 (lambda (w) w)))
+
+;; ----------------------------------------
+
 (report-errs)
diff --git a/racket/collects/racket/private/kw.rkt b/racket/collects/racket/private/kw.rkt
index 0ebc8257ea..29825b2dd7 100644
--- a/racket/collects/racket/private/kw.rkt
+++ b/racket/collects/racket/private/kw.rkt
@@ -421,6 +421,12 @@
        (syntax-property (datum->syntax #'e (syntax-e #'e) #f #'e)
                         'inferred-name (void))]))
 
+  (define-for-syntax (hide-binding-name stx)
+    (syntax-property stx
+                     'inferred-name
+                     ;; void hides binding name
+                     (void)))
+
   ;; Similar to the above, when we copy source locations from an input
   ;; expression, we need to ensure the source location is copied even if there
   ;; is no source location on the input, but (quasi)syntax/loc doesn’t copy
@@ -1267,17 +1273,15 @@
                   [(keyword? (syntax-e (car l)))
                    (loop (cddr l)
                          (cdr ids)
-                         (cons (list (car ids) (syntax-property (cadr l)
-                                                                'inferred-name
-                                                                ;; void hides binding name
-                                                                (void)))
+                         (cons (list (car ids) (hide-binding-name (cadr l)))
                                bind-accum)
                          arg-accum
                          (cons (cons (car l) (car ids))
                                kw-pairs))]
                   [else (loop (cdr l)
                               (cdr ids)
-                              (cons (list (car ids) (car l)) bind-accum)
+                              (cons (list (car ids) (hide-binding-name (car l)))
+                                    bind-accum)
                               (cons (copy-properties (car ids) (car l)) arg-accum)
                               kw-pairs)])))))))
 
@@ -1346,7 +1350,8 @@
                                                  (if (not lifted?)
                                                      ;; caller didn't lift expressions out
                                                      (let ([ids (generate-temporaries args)])
-                                                       #`(let #,(map list ids args)
+                                                       #`(let #,(map list ids
+                                                                     (map hide-binding-name args))
                                                            #,(k ids)))
                                                      ;; caller already lifted expression:
                                                      (k args)))])