diff --git a/pkgs/racket-doc/scribblings/reference/contracts.scrbl b/pkgs/racket-doc/scribblings/reference/contracts.scrbl
index 8bed7d97d8..9b6fbfa20a 100644
--- a/pkgs/racket-doc/scribblings/reference/contracts.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/contracts.scrbl
@@ -1990,13 +1990,16 @@ The @racket[define-struct/contract] form only allows a subset of the
            contract-expr
            pos-blame-party
            source-loc
-           name-for-blame)
+           name-for-blame
+           no-context)
          #:grammar ([pos-blame-party (code:line)
                                      (code:line #:pos-source pos-source-expr)]
                     [source-loc (code:line)
                                 (code:line #:srcloc srcloc-expr)]
                     [name-for-blame (code:line)
-                     (code:line #:name-for-blame blame-id)])]{
+                     (code:line #:name-for-blame blame-id)]
+                    [name-for-blame (code:line)
+                     (code:line #:no-context)])]{
   Defines @racket[id] to be @racket[orig-id], but with the contract
   @racket[contract-expr].
   
@@ -2019,7 +2022,12 @@ The @racket[define-struct/contract] form only allows a subset of the
   The name used in the error messages will be @racket[orig-id], unless
   @racket[#:name-for-blame] is supplied, in which case the identifier
   following it is used as the name in the error messages.
-  
+
+ If @racket[#:no-context] is supplied, the error message do
+ not include the context information that indicates which
+ sub-portion of the contract where the violation was
+ detected.
+
   @examples[#:eval (contract-eval) #:once
             (module server racket/base
               (require racket/contract/base)
@@ -2041,6 +2049,9 @@ The @racket[define-struct/contract] form only allows a subset of the
 
 @defform*[[(contract contract-expr to-protect-expr
                      positive-blame-expr negative-blame-expr)
+           (contract contract-expr to-protect-expr
+                     positive-blame-expr negative-blame-expr
+                     #:no-context)
            (contract contract-expr to-protect-expr
                      positive-blame-expr negative-blame-expr
                      value-name-expr source-location-expr)]]{
@@ -2076,6 +2087,10 @@ reported by contract violations.  The expression must produce a @racket[srcloc]
 structure, @tech{syntax object}, @racket[#f], or a list or vector in the format
 accepted by the third argument to @racket[datum->syntax].
 
+If @racket[#:no-context] is supplied, the error message do not include
+the context information that indicates which sub-portion of the contract
+where the violation was detected.
+
 }
 
 @; ------------------------------------------------------------------------
diff --git a/pkgs/racket-test/tests/racket/contract/blame.rkt b/pkgs/racket-test/tests/racket/contract/blame.rkt
index afb9bc3c12..eb3ef551ad 100644
--- a/pkgs/racket-test/tests/racket/contract/blame.rkt
+++ b/pkgs/racket-test/tests/racket/contract/blame.rkt
@@ -329,4 +329,17 @@
               (blame-add-context b "thing" #:important 'yes!)))
    #t)
 
+  (test/spec-passed/result
+   'blame-no-context
+   ;; when the "in" has the contract after it, there is no context
+   '(regexp-match? #rx"in: [(]list/c"
+                   (with-handlers ([exn:fail? exn-message])
+                     ((car (contract (list/c (-> integer? integer?))
+                                     (list (λ (x) x))
+                                     'pos
+                                     'neg
+                                     #:no-context))
+                      #f)))
+   #t)
+
   )
diff --git a/pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
index a74214d73a..1d8246e01e 100644
--- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt
+++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
@@ -1588,6 +1588,49 @@
    (λ (x)
      (and (exn:fail:contract:blame? x)
           (regexp-match? #rx"^my-favorite-name: " (exn-message x)))))
+
+  (contract-error-test
+   'define-module-boundary-contract6
+   '(begin
+      (eval '(module define-module-boundary-contract6-m racket/base
+               (require racket/contract/base)
+               (define internal-name (list (λ (x) #f)))
+               (define-module-boundary-contract external-name
+                 internal-name (list/c (-> integer? integer?))
+                 #:pos-source 'pos
+                 #:name-for-blame my-favorite-name
+                 #:no-context)
+               (provide external-name)))
+      (eval '(module define-module-boundary-contract6-n racket/base
+               (require 'define-module-boundary-contract6-m)
+               ((car external-name) #f)))
+      (eval '(require 'define-module-boundary-contract6-n)))
+   (λ (x)
+     (and (exn:fail:contract:blame? x)
+          ;; ensure there is no context information
+          (regexp-match? #rx"in: [(]list/c" (exn-message x))
+          (regexp-match? #rx"blaming: [^\n]*contract6-n" (exn-message x)))))
+
+  (contract-error-test
+   'define-module-boundary-contract7
+   '(begin
+      (eval '(module define-module-boundary-contract7-m racket/base
+               (require racket/contract/base)
+               (define internal-name (list (λ (x) #f)))
+               (define-module-boundary-contract external-name
+                 internal-name (list/c (-> integer? integer?))
+                 #:pos-source 'pos
+                 #:name-for-blame my-favorite-name)
+               (provide external-name)))
+      (eval '(module define-module-boundary-contract7-n racket/base
+               (require 'define-module-boundary-contract7-m)
+               ((car external-name) #f)))
+      (eval '(require 'define-module-boundary-contract7-n)))
+   (λ (x)
+     (and (exn:fail:contract:blame? x)
+          ;; ensure there is context information
+          (regexp-match? #rx"in: the 1st argument of" (exn-message x))
+          (regexp-match? #rx"blaming: [^\n]*contract7-n" (exn-message x)))))
   
   
   (contract-error-test
diff --git a/racket/collects/racket/contract/private/base.rkt b/racket/collects/racket/contract/private/base.rkt
index f39714890b..44e7815aa4 100644
--- a/racket/collects/racket/contract/private/base.rkt
+++ b/racket/collects/racket/contract/private/base.rkt
@@ -42,19 +42,21 @@
   (syntax-case stx ()
     [(_ c v pos neg name loc)
      (syntax/loc stx
-       (apply-contract c v pos neg name loc))]
+       (apply-contract c v pos neg name loc #t))]
     [(_ c v pos neg)
      (with-syntax ([name (syntax-local-infer-name stx)])
       (syntax/loc stx
         (apply-contract c v pos neg 'name
-                        (build-source-location #f))))]
-    [(_ c v pos neg src)
-     (raise-syntax-error 'contract
-       (string-append
-        "please update contract application to new protocol "
-        "(either 4 or 6 arguments)"))]))
+                        (build-source-location #f)
+                        #t)))]
+    [(_ c v pos neg #:no-context)
+     (with-syntax ([name (syntax-local-infer-name stx)])
+      (syntax/loc stx
+        (apply-contract c v pos neg 'name
+                        (build-source-location #f)
+                        #f)))]))
 
-(define (apply-contract c v pos neg name loc)
+(define (apply-contract c v pos neg name loc track-context?)
   (let ([c (coerce-contract 'contract c)])
     (check-source-location! 'contract loc)
     (define clnp (contract-late-neg-projection c))
@@ -72,7 +74,8 @@
                   (or pos "false")
                   
                   (if clnp #f neg)
-                  #t))
+                  #t
+                  #:track-context? track-context?))
     (cond
       [clnp (with-contract-continuation-mark
              (cons blame neg)
diff --git a/racket/collects/racket/contract/private/blame.rkt b/racket/collects/racket/contract/private/blame.rkt
index 4b6032e45d..0da0dbaf4b 100644
--- a/racket/collects/racket/contract/private/blame.rkt
+++ b/racket/collects/racket/contract/private/blame.rkt
@@ -65,7 +65,8 @@
 
 (define -make-blame
   (let ([make-blame
-         (lambda (source value build-name positive negative original?)
+         (lambda (source value build-name positive negative original?
+                         #:track-context? [track-context? #t])
            (unless (srcloc? source)
              (raise-argument-error 'make-blame "srcloc?" 0
                                    source value build-name positive negative original?))
@@ -90,7 +91,7 @@
             (list positive)
             (and negative (list negative))
             original?
-            '()
+            (if track-context? '() #f)
             #t 
             #f
             (not negative)
@@ -99,27 +100,39 @@
 
 ;; s : (or/c string? #f)
 (define (blame-add-context b s #:important [name #f] #:swap? [swap? #f])
-  (define new-original? (if swap? (not (blame-original? b)) (blame-original? b)))
-  (define new-context (if s (cons s (blame-context b)) (blame-context b)))
-  (struct-copy
-   blame b
-   [original? new-original?]
-   [positive (if swap? (blame-negative b) (blame-positive b))]
-   [negative (if swap? (blame-positive b) (blame-negative b))]
-   [important (if name (important name new-original?) (blame-important b))]
-   [context new-context]
-   [top-known? #t]))
+  (cond
+    [(and (not (blame-context b))
+          (not swap?)
+          (not name)
+          (blame-top-known? b))
+     b]
+    [else
+     (define new-original? (if swap? (not (blame-original? b)) (blame-original? b)))
+     (define new-context (if (and s (blame-context b))
+                             (cons s (blame-context b))
+                             (blame-context b)))
+     (struct-copy
+      blame b
+      [original? new-original?]
+      [positive (if swap? (blame-negative b) (blame-positive b))]
+      [negative (if swap? (blame-positive b) (blame-negative b))]
+      [important (if name (important name new-original?) (blame-important b))]
+      [context new-context]
+      [top-known? #t])]))
 
 (struct important (name sense-swapped?) #:transparent)
 
 (define (blame-add-unknown-context b)
   (define old (blame-context b))
-  (struct-copy
-   blame b
-   [top-known? #f]
-   [context (if (blame-top-known? b)
-                (blame-context b)
-                (cons "..." (blame-context b)))]))
+  (cond
+    [old
+     (struct-copy
+      blame b
+      [top-known? #f]
+      [context (if (blame-top-known? b)
+                   (blame-context b)
+                   (cons "..." (blame-context b)))])]
+    [else b]))
 
 (define (blame-contract b) ((blame-build-name b)))
 
@@ -287,7 +300,7 @@
   (define source-message (source-location->string (blame-source blme)))
   
   (define context (blame-context blme))
-  (define context-lines (if (null? context)
+  (define context-lines (if (or (null? context) (not context))
                             #f
                             (apply string-append 
                                    (for/list ([context (in-list context)]
diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt
index d1705a761f..eb620d4f54 100644
--- a/racket/collects/racket/contract/private/provide.rkt
+++ b/racket/collects/racket/contract/private/provide.rkt
@@ -259,7 +259,8 @@
                                                                     id-rename
                                                                     (stx->srcloc-expr srcloc-id)
                                                                     'provide/contract
-                                                                    pos-module-source)
+                                                                    pos-module-source
+                                                                    #t)
                              #,@(if provide?
                                     (list #`(provide (rename-out [#,id-rename external-name])))
                                     null)))
@@ -279,7 +280,8 @@
                                                         id-rename
                                                         srcloc-expr
                                                         contract-error-name
-                                                        pos-module-source)
+                                                        pos-module-source
+                                                        track-context?)
   (define-values (arrow? the-valid-app-shapes)
     (syntax-case ctrct (-> ->* ->i)
       [(-> . _) 
@@ -306,7 +308,8 @@
                            id
                            '#,name-for-blame
                            #,pos-module-source
-                           #,srcloc-expr))
+                           #,srcloc-expr
+                           '#,track-context?))
          #,@(if arrow?
                 (list #`(define extra-neg-party-argument-fn 
                           (wrapped-extra-arg-arrow-extra-neg-party-argument
@@ -351,15 +354,17 @@
             (raise-syntax-error #f "expected an identifier" stx #'new-id))
           (unless (identifier? #'orig-id)
             (raise-syntax-error #f "expected an identifier" stx #'orig-id))
-          (define-values (pos-blame-party-expr srcloc-expr name-for-blame)
+          (define-values (pos-blame-party-expr srcloc-expr name-for-blame track-context?)
             (let loop ([kwd-args (syntax->list #'(kwd-args ...))]
                        [pos-blame-party-expr #'(quote-module-path)]
                        [srcloc-expr #f]
-                       [name-for-blame #f])
+                       [name-for-blame #f]
+                       [track-context? #t])
               (cond
                 [(null? kwd-args) (values pos-blame-party-expr
                                           (or srcloc-expr (stx->srcloc-expr stx))
-                                          (or name-for-blame #'new-id))]
+                                          (or name-for-blame #'new-id)
+                                          track-context?)]
                 [else
                  (define kwd (car kwd-args))
                  (cond 
@@ -370,7 +375,8 @@
                     (loop (cddr kwd-args)
                           (cadr kwd-args)
                           srcloc-expr
-                          name-for-blame)]
+                          name-for-blame
+                          track-context?)]
                    [(equal? (syntax-e kwd) '#:srcloc)
                     (when (null? (cdr kwd-args))
                       (raise-syntax-error #f "expected a keyword argument to follow #:srcloc"
@@ -378,7 +384,8 @@
                     (loop (cddr kwd-args)
                           pos-blame-party-expr
                           (cadr kwd-args)
-                          name-for-blame)]
+                          name-for-blame
+                          track-context?)]
                    [(equal? (syntax-e kwd) '#:name-for-blame)
                     (when (null? (cdr kwd-args))
                       (raise-syntax-error #f "expected a keyword argument to follow #:name-for-blame"
@@ -391,11 +398,20 @@
                     (loop (cddr kwd-args)
                           pos-blame-party-expr
                           srcloc-expr
-                          name-for-blame)]
+                          name-for-blame
+                          track-context?)]
+                   [(equal? (syntax-e kwd) '#:no-context)
+                    (loop (cdr kwd-args)
+                          pos-blame-party-expr
+                          srcloc-expr
+                          name-for-blame
+                          #f)]
                    [else
                     (raise-syntax-error
                      #f
-                     "expected one of the keywords #:pos-source, #:srcloc, or #:name-for-blame"
+                     (string-append
+                      "expected one of the keywords"
+                      " #:pos-source, #:srcloc, #:name-for-blame, or #:no-context")
                      stx
                      (car kwd-args))])])))
           (internal-function-to-be-figured-out #'ctrct
@@ -405,10 +421,11 @@
                                                #'new-id
                                                srcloc-expr
                                                'define-module-boundary-contract
-                                               pos-blame-party-expr))])]))
+                                               pos-blame-party-expr
+                                               track-context?))])]))
 
 ;; ... -> (values (or/c #f (-> neg-party val)) blame)
-(define (do-partial-app ctc val name pos-module-source source)
+(define (do-partial-app ctc val name pos-module-source source track-context?)
   (define p (parameterize ([warn-about-val-first? #f])
               ;; when we're building the val-first projection
               ;; here we might be needing the plus1 arity
@@ -419,7 +436,8 @@
                            name
                            (λ () (contract-name ctc))
                            pos-module-source
-                           #f #t))
+                           #f #t
+                           #:track-context? track-context?))
   (with-contract-continuation-mark
    (cons blme 'no-negative-party) ; we don't know the negative party yet
    ;; computing neg-accepter may involve some front-loaded checking. instrument