From 2308ad7b8a425ed3e64c93839b76e86c28bc54b5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 12 Feb 2011 11:29:20 -0600
Subject: [PATCH] remove the user field from blame structs (code cleanup after
 last commit)

---
 collects/racket/contract/private/base.rkt    |  9 +++----
 collects/racket/contract/private/blame.rkt   | 10 ++------
 collects/racket/contract/private/legacy.rkt  |  3 +--
 collects/racket/contract/private/provide.rkt | 26 --------------------
 4 files changed, 7 insertions(+), 41 deletions(-)

diff --git a/collects/racket/contract/private/base.rkt b/collects/racket/contract/private/base.rkt
index 93a20aa6fe..6dbe71ba46 100644
--- a/collects/racket/contract/private/base.rkt
+++ b/collects/racket/contract/private/base.rkt
@@ -28,25 +28,24 @@ improve method arity mismatch contract violation error messages?
   (syntax-case stx ()
     [(_ c v pos neg name loc)
      (syntax/loc stx
-       (apply-contract c v pos neg name loc (current-contract-region)))]
+       (apply-contract c v pos neg name loc))]
     [(_ 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)
-                        (current-contract-region))))]
+                        (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)"))]))
 
-(define (apply-contract c v pos neg name loc usr)
+(define (apply-contract c v pos neg name loc)
   (let ([c (coerce-contract 'contract c)])
     (check-source-location! 'contract loc)
     (let ([new-val
            (((contract-projection c)
-             (make-blame loc name (contract-name c) pos neg usr #t))
+             (make-blame loc name (contract-name c) pos neg #t))
             v)])
       (if (and (not (parameter? new-val))  ;; when PR 11221 is fixed, remove this line
                (procedure? new-val)
diff --git a/collects/racket/contract/private/blame.rkt b/collects/racket/contract/private/blame.rkt
index 2bfe1b8ada..583fcede5b 100644
--- a/collects/racket/contract/private/blame.rkt
+++ b/collects/racket/contract/private/blame.rkt
@@ -7,7 +7,6 @@
          blame-source
          blame-positive
          blame-negative
-         blame-user
          blame-contract
          blame-value
          blame-original?
@@ -36,7 +35,7 @@
                (hash/recur (blame-original? b))))
 
 (define-struct blame
-  [source value contract positive negative user original?]
+  [source value contract positive negative original?]
   #:property prop:equal+hash
   (list blame=? blame-hash blame-hash))
 
@@ -101,16 +100,11 @@
         contract-message+at)]
       [else
        (define negative-message (show/display (blame-negative b)))
-       (define user-message
-         (if (equal? (blame-positive b) (blame-user b))
-             ""
-             (format " via ~a" (show/display (blame-user b)))))
        (string-append
         (format "contract violation: ~a\n" custom-message)
-        (format "  contract~a from ~a~a~a blaming ~a~a" 
+        (format "  contract~a from ~a~a blaming ~a~a" 
                 value-message
                 negative-message 
-                user-message
                 (if (regexp-match #rx"\n" negative-message)
                     " "
                     ",")
diff --git a/collects/racket/contract/private/legacy.rkt b/collects/racket/contract/private/legacy.rkt
index c8613aec43..a8b9310d12 100644
--- a/collects/racket/contract/private/legacy.rkt
+++ b/collects/racket/contract/private/legacy.rkt
@@ -21,8 +21,7 @@
                      name
                      (unpack-blame pos)
                      "<<unknown party>>"
-                     #t
-                     "<<unknown party>>")
+                     #t)
          x
          fmt
          args))
diff --git a/collects/racket/contract/private/provide.rkt b/collects/racket/contract/private/provide.rkt
index ea0e5648ba..10f287b394 100644
--- a/collects/racket/contract/private/provide.rkt
+++ b/collects/racket/contract/private/provide.rkt
@@ -39,32 +39,6 @@
                                      (current-inspector) #f '(0))])
     make-))
 
-(define (first-requiring-module id self)
-  (define (resolved-module-path->module-path rmp)
-    (cond
-      [(not rmp) 'top-level]
-      [(path? (resolved-module-path-name rmp))
-       `(file ,(path->string (resolved-module-path-name rmp)))]
-      [(symbol? (resolved-module-path-name rmp))
-       `(module ,(resolved-module-path-name rmp))]))  
-  ;; Here we get the module-path-index corresponding to the identifier.
-  ;; We know we can split it at least once, because the contracted identifier
-  ;; we've provided must have been required.  If the second returned value is #f,
-  ;; we just fall back on the old behavior.  If we split again without getting
-  ;; either "self", that is, the first value returned is not #f, then we should
-  ;; use the second mpi result as the module that required the value.
-  (let ([mpi (syntax-source-module id)])
-    (let*-values ([(first-mp second-mpi)
-                   (module-path-index-split mpi)]
-                  [(second-mp third-mpi)
-                   (if second-mpi
-                       (module-path-index-split second-mpi)
-                       (values #f #f))])
-      (if second-mp
-          (resolved-module-path->module-path
-           (module-path-index-resolve second-mpi))
-          self))))
-
 (define-for-syntax (make-provide/contract-transformer contract-id id external-id pos-module-source)
   (make-set!-transformer
    (let ([saved-id-table (make-hasheq)])