From 2e64069d1459a5ed885da8640028551464e748b4 Mon Sep 17 00:00:00 2001
From: Carl Eastlund <cce@racket-lang.org>
Date: Wed, 3 Feb 2010 17:08:26 +0000
Subject: [PATCH] Re-disabled legacy (contract ...) form.

svn: r17960
---
 collects/scheme/contract/base.ss           |  5 +---
 collects/scheme/contract/private/base.ss   | 28 ++++++----------------
 collects/scheme/contract/private/legacy.ss |  2 --
 3 files changed, 8 insertions(+), 27 deletions(-)

diff --git a/collects/scheme/contract/base.ss b/collects/scheme/contract/base.ss
index b6e83b931c..cc331a8588 100644
--- a/collects/scheme/contract/base.ss
+++ b/collects/scheme/contract/base.ss
@@ -27,10 +27,7 @@
              check-unary-between/c)
  (all-from-out "private/provide.ss")
  (all-from-out "private/base.ss")
- (except-out (all-from-out "private/legacy.ss")
-             unpack-blame
-             unpack-source
-             unpack-name)
+ (all-from-out "private/legacy.ss")
  (except-out (all-from-out "private/guts.ss")
              check-flat-contract
              check-flat-named-contract))
diff --git a/collects/scheme/contract/private/base.ss b/collects/scheme/contract/private/base.ss
index 570b20b421..508ea1b38e 100644
--- a/collects/scheme/contract/private/base.ss
+++ b/collects/scheme/contract/private/base.ss
@@ -18,8 +18,7 @@ improve method arity mismatch contract violation error messages?
          unstable/srcloc
          unstable/location
          "guts.ss"
-         "blame.ss"
-         "legacy.ss")
+         "blame.ss")
 
 (define-syntax-parameter current-contract-region
   (λ (stx) #'(quote-module-path)))
@@ -28,28 +27,15 @@ improve method arity mismatch contract violation error messages?
   (syntax-case stx ()
     [(_ c v pos neg name loc)
      (syntax/loc stx
-       (apply-contract c
-                       v
-                       (unpack-blame pos)
-                       (unpack-blame neg)
-                       name
-                       loc))]
+       (apply-contract c v pos neg name loc))]
     [(_ c v pos neg)
      (syntax/loc stx
-       (apply-contract c
-                       v
-                       (unpack-blame pos)
-                       (unpack-blame neg)
-                       #f
-                       (build-source-location #f)))]
+       (apply-contract c v pos neg #f (build-source-location #f)))]
     [(_ c v pos neg src)
-     (syntax/loc stx
-       (apply-contract c
-                       v
-                       (unpack-blame pos)
-                       (unpack-blame neg)
-                       (unpack-name src)
-                       (unpack-source 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)
   (let* ([c (coerce-contract 'contract c)])
diff --git a/collects/scheme/contract/private/legacy.ss b/collects/scheme/contract/private/legacy.ss
index 3dcc229283..8ebaf215eb 100644
--- a/collects/scheme/contract/private/legacy.ss
+++ b/collects/scheme/contract/private/legacy.ss
@@ -12,8 +12,6 @@
          first-order-prop first-order-get first-order-pred?
          flat-prop flat-get flat-pred?
 
-         unpack-blame unpack-source unpack-name
-
          )
 
 (define (raise-contract-error x src pos name fmt . args)