diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl
index d5c3ebf027..3c9eb2d2f0 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl
@@ -408,6 +408,54 @@
                                3))
   (test #t procedure-arity-includes? (a) 2))
 
+;; ----------------------------------------
+;; Make sure that keyword function application propagates syntax properties
+;; on the argument expressions
+;;
+;; This feature is needed for Typed Racket to cooperate with the contract
+;; system's addition of extra arguments for modular boundary contracts
+;;
+;; See typed-racket/typecheck/tc-app-keywords.rkt for its use.
+
+(let ()
+  (define (f x #:foo foo) x)
+  (define-syntax (m stx)
+    (syntax-case stx ()
+      [(_ f a . es)
+       #`(f #,(syntax-property #'a 'test #t) . es)]))
+
+  (define-syntax (expander stx)
+    (syntax-case stx ()
+      [(_ e)
+       (let ([expansion (local-expand #'e 'expression null)])
+         (displayln (syntax->datum expansion))
+         (syntax-case expansion (let-values #%plain-app if)
+           [(let-values _
+              (if _
+                  _
+                  (#%plain-app (#%plain-app . _) _ _ a)))
+            (if (syntax-property #'a 'test)
+                #'#t
+                #'#f)]))]))
+
+  ;; the syntax for `1` should have the syntax property
+  ;; in which case this expands to (lambda () #t)
+  (test #t (lambda () (expander (m f 1 #:foo 3)))))
+
+;; ----------------------------------------
+;; Test that syntax property propagation in kw applications isn't
+;; buggy for symbolic inferred names.
+
+(let ()
+  (define (f #:x [x 10]) x)
+
+  (define-syntax (ba stx)
+    (syntax-property #'(#%app f #:x 8)
+                     'inferred-name
+                     'bind-accum))
+
+  (test 8 (lambda () (ba))))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt
index 8fa2b09e51..5356a64a9c 100644
--- a/racket/collects/racket/contract/private/provide.rkt
+++ b/racket/collects/racket/contract/private/provide.rkt
@@ -7,7 +7,10 @@
                                   ;make-provide/contract-transformer
                                   provide/contract-info?
                                   provide/contract-info-contract-id
-                                  provide/contract-info-original-id)))
+                                  provide/contract-info-original-id
+                                  contract-rename-id-property
+                                  contract-lifted-property
+                                  contract-neg-party-property)))
 
 (require (for-syntax racket/base
                      racket/list
@@ -55,9 +58,39 @@
     make-))
 
 (begin-for-syntax
-  
-  (struct provide/contract-info (contract-id original-id))
-  
+
+  ;; rename-id : identifier? : the name the lifted expression is bound to
+  ;; contract-id : identifier? : the name of the contract expression
+  ;; original-id : identifier? : the identifier being contracted
+  (struct provide/contract-info (rename-id contract-id original-id))
+
+  ;; keys for syntax property used below
+  (define rename-id-key (gensym 'contract:rename-id))
+  (define lifted-key    (gensym 'contract:lifted))
+  (define neg-party-key (gensym 'contract:neg-party))
+
+  ;; identifier? identifier? -> identifier?
+  ;; add a property that tells clients what the exported id was
+  (define (add-rename-id rename-id partial-id)
+    (syntax-property partial-id rename-id-key rename-id))
+
+  ;; syntax? -> syntax?
+  ;; tells clients that the expression is a lifted application
+  (define (add-lifted-property stx)
+    (syntax-property stx lifted-key #t))
+
+  ;; identifier? -> identifier?
+  ;; tells clients that the application of this id has an extra inserted argument
+  (define (add-neg-party stx)
+    (syntax-property stx neg-party-key #t))
+
+  ;; getter functions for syntax properties keyed by symbols above
+  (define (contract-rename-id-property stx)
+    (syntax-property stx rename-id-key))
+  (define (contract-lifted-property stx)
+    (syntax-property stx lifted-key))
+  (define (contract-neg-party-property stx)
+    (syntax-property stx neg-party-key))
 
   (struct provide/contract-arrow-transformer provide/contract-info
     (saved-id-table 
@@ -73,7 +106,8 @@
             [saved-ho-id-table (provide/contract-arrow-transformer-saved-ho-id-table self)]
             [extra-neg-party-argument-fn 
              (provide/contract-arrow-transformer-extra-neg-party-argument-fn self)]
-            [valid-arg-lists (provide/contract-arrow-transformer-valid-argument-lists self)])
+            [valid-arg-lists (provide/contract-arrow-transformer-valid-argument-lists self)]
+            [rename-id (provide/contract-info-rename-id self)])
         (with-syntax ([partially-applied-id partially-applied-id]
                       [extra-neg-party-argument-fn extra-neg-party-argument-fn])
           (if (eq? 'expression (syntax-local-context))
@@ -96,8 +130,10 @@
                         ;; No: lift the neg name creation
                         (with-syntax ([lifted-neg-party (syntax-local-introduce lifted-neg-party)])
                           (syntax-local-introduce 
-                           (syntax-local-lift-expression
-                            #'(partially-applied-id lifted-neg-party))))))
+                           (add-rename-id rename-id
+                            (syntax-local-lift-expression
+                             (add-lifted-property
+                              #'(partially-applied-id lifted-neg-party))))))))
                   (when key (hash-set! saved-ho-id-table key lifted-ctc-val))
                   (adjust-location (syntax-local-introduce lifted-ctc-val)))
                 (syntax-case stx (set!)
@@ -114,7 +150,9 @@
                      (if (valid-argument-list? stx valid-arg-lists)
                          (with-syntax ([lifted-neg-party (syntax-local-introduce lifted-neg-party)])
                            (adjust-location
-                            #'(app extra-neg-party-argument-fn 
+                            #`(app #,(add-neg-party (add-rename-id
+                                                     rename-id
+                                                     #'extra-neg-party-argument-fn))
                                    lifted-neg-party
                                    more ...)))
                          #`(app #,(gen-slow-path-code) more ...)))]))
@@ -129,7 +167,8 @@
     prop:set!-transformer
     (λ (self stx)
       (let ([partially-applied-id (provide/contract-transformer-partially-applied-id self)]
-            [saved-id-table (provide/contract-transformer-saved-id-table self)])
+            [saved-id-table (provide/contract-transformer-saved-id-table self)]
+            [rename-id (provide/contract-info-rename-id self)])
         (with-syntax ([partially-applied-id partially-applied-id])
           (if (eq? 'expression (syntax-local-context))
               ;; In an expression context:
@@ -138,9 +177,11 @@
                      [lifted-ctcd-val
                       (or (hash-ref saved-id-table key #f)
                           ;; No: lift the neg name creation
-                          (syntax-local-introduce 
-                           (syntax-local-lift-expression
-                            #'(partially-applied-id (quote-module-name)))))])
+                          (add-rename-id rename-id
+                           (syntax-local-introduce
+                            (syntax-local-lift-expression
+                             (add-lifted-property
+                              #'(partially-applied-id (quote-module-name)))))))])
                 (when key (hash-set! saved-id-table key lifted-ctcd-val))
                 (define (adjust-location new-stx)
                   (datum->syntax new-stx (syntax-e new-stx) stx new-stx))
@@ -164,9 +205,9 @@
               ;; expressions:
               (quasisyntax/loc stx (#%expression #,stx)))))))
 
-  (define (make-provide/contract-transformer cid id eid pos [pid #f])
+  (define (make-provide/contract-transformer rename-id cid id eid pos [pid #f])
     (if pid
-        (provide/contract-transformer cid id (make-hasheq) pid)
+        (provide/contract-transformer rename-id cid id (make-hasheq) pid)
         (begin
           ;; TODO: this needs to change!
           ;; syntax/parse uses this
@@ -178,8 +219,9 @@
                  #`(app #,id args ...))]
               [x (identifier? #'x) id])))))
   
-  (define (make-provide/contract-arrow-transformer contract-id id pai enpfn val)
-    (provide/contract-arrow-transformer contract-id id
+  (define (make-provide/contract-arrow-transformer rename-id contract-id id pai enpfn val)
+    (provide/contract-arrow-transformer rename-id
+                                        contract-id id
                                         (make-hasheq) (make-hasheq)
                                         pai enpfn val)))
 
@@ -283,11 +325,13 @@
         (define-syntax #,id-rename
           #,(if arrow?
                 #`(make-provide/contract-arrow-transformer 
+                   (quote-syntax #,id-rename)
                    (quote-syntax contract-id) (quote-syntax id)
                    (quote-syntax partially-applied-id)
                    (quote-syntax extra-neg-party-argument-fn)
                    #,the-valid-app-shapes)
-                #'(make-provide/contract-transformer 
+                #`(make-provide/contract-transformer
+                   (quote-syntax #,id-rename)
                    (quote-syntax contract-id) (quote-syntax id)
                    #f #f
                    (quote-syntax partially-applied-id)))))))
diff --git a/racket/collects/racket/private/kw.rkt b/racket/collects/racket/private/kw.rkt
index 30ff381e53..1a850be38a 100644
--- a/racket/collects/racket/private/kw.rkt
+++ b/racket/collects/racket/private/kw.rkt
@@ -951,9 +951,11 @@
                                  (loop (cddr l)))])]
                        [else
                         (cons (car l) (loop (cdr l)))])))])
-            (let ([ids (cons (or (syntax-local-infer-name stx #f)
-                                 'procedure)
-                             (generate-temporaries exprs))])
+            (let* ([name (syntax-local-infer-name stx #f)]
+                   [ids (cons (if name
+                                  (if (syntax? name) name (datum->syntax #f name))
+                                  (datum->syntax #f 'procedure))
+                              (generate-temporaries exprs))])
               (let loop ([l (cdr l)]
                          [ids ids]
                          [bind-accum null]
@@ -996,7 +998,7 @@
                   [else (loop (cdr l)
                               (cdr ids)
                               (cons (list (car ids) (car l)) bind-accum)
-                              (cons (car ids) arg-accum)
+                              (cons (copy-properties (car ids) (car l)) arg-accum)
                               kw-pairs)])))))))
 
   (define-syntax (new-app stx)
@@ -1743,4 +1745,9 @@
              req-kws
              allowed-kws
              proc)))]
-     [else proc])))
+     [else proc]))
+
+  ;; copy-properties : (or/c symbol? syntax?) syntax? -> syntax?
+  ;; Return the first arg as a stx obj with the properties of the second
+  (define-for-syntax (copy-properties to from)
+    (datum->syntax to (syntax->datum to) to from)))