diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss
index 9ec1820917..703c09ebf3 100644
--- a/collects/framework/gui-utils.ss
+++ b/collects/framework/gui-utils.ss
@@ -11,242 +11,6 @@
       [(_ (name contract docs ...) ...)
        (syntax (provide/contract (name contract) ...))]))
   
-  (provide/contract/docs
-   
-   (gui-utils:trim-string
-    (string?
-     (and/c number? positive?)
-     . ->d .
-     (λ (str size)
-       (and/c string?
-	      (λ (str)
-		((string-length str) . <= . size)))))
-    (str size)
-    "Constructs a string whose size is less"
-    "than \\var{size} by trimming the \\var{str}"
-    "and inserting an ellispses into it.")
-
-   (gui-utils:cancel-on-right?
-    (-> boolean?)
-    ()
-    "Returns \\scheme{#t} if cancel should be on the right-hand side (or below)"
-    "in a dialog and \\scheme{#f} otherwise."
-    ""
-    "See also"
-    "@flink gui-utils:ok/cancel-buttons %"
-    ".")
-   (gui-utils:ok/cancel-buttons
-    (opt->*
-     ((is-a?/c area-container<%>)
-      ((is-a?/c button%) (is-a?/c event%) . -> . any)
-      ((is-a?/c button%) (is-a?/c event%) . -> . any))
-     (string?
-      string?)
-     ((is-a?/c button%)
-      (is-a?/c button%)))
-    ((parent
-      confirm-callback
-      cancel-callback)
-     ((confirm-label (string-constant ok))
-      (cancel-label (string-constant cancel))))
-    "Adds an Ok and a cancel button to a panel, changing the order"
-    "to suit the platform. Under \\MacOSBoth{} and unix, the confirmation action"
-    "is on the right (or bottom) and under Windows, the canceling action is on the"
-    "right (or bottom)."
-    "The confirmation action button has the \\scheme|'(border)| style."
-    "The buttons are also sized to be the same width."
-    ""
-    "The first result is be the OK button and the second is"
-    "the cancel button."
-    ""
-    "See also"
-    "@flink gui-utils:cancel-on-right? %"
-    ".")
-   
-   (gui-utils:next-untitled-name
-    (-> string?)
-    ()
-    "Returns a name for the next opened untitled frame. The first"
-    "name is ``Untitled'', the second is ``Untitled 2'',"
-    "the third is ``Untitled 3'', and so forth.")
-   (gui-utils:cursor-delay
-    (case->
-     (-> real?)
-     (real? . -> . void?))
-    (() (new-delay))
-    "This function is {\\em not\\/} a parameter."
-    "Instead, the state is just stored in the closure."
-    ""
-    "The first case in the case lambda"
-    "returns the current delay in seconds before a watch cursor is shown,"
-    "when either \\iscmprocedure{gui-utils:local-busy-cursor} or"
-    "\\iscmprocedure{gui-utils:show-busy-cursor} is called."
-
-    "The second case in the case lambda"
-    "Sets the delay, in seconds, before a watch cursor is shown, when"
-    "either \\iscmprocedure{gui-utils:local-busy-cursor} or"
-    "\\iscmprocedure{gui-utils:show-busy-cursor} is called.")
-   (gui-utils:show-busy-cursor
-    (opt->
-     ((-> any/c))
-     (integer?)
-     any/c)
-    ((thunk)
-     ((delay (gui-utils:cursor-delay))))
-    "Evaluates \\rawscm{(\\var{thunk})} with a watch cursor. The argument"
-    "\\var{delay} specifies the amount of time before the watch cursor is"
-    "opened. Use \\iscmprocedure{gui-utils:cursor-delay} to set this value"
-    "to all calls."
-    ""
-    "This function returns the result of \\var{thunk}.")
-   (gui-utils:delay-action
-    (real?
-     (-> void?)
-     (-> void?)
-     . -> .
-     void?)
-    (delay-time open close)
-    "Use this function to delay an action for some period of time. It also"
-    "supports cancelling the action before the time period elapses. For"
-    "example, if you want to display a watch cursor, but you only want it"
-    "to appear after 2 seconds and the action may or may not take more than"
-    "two seconds, use this pattern:"
-    ""
-    "\\begin{schemedisplay}"
-    "(let ([close-down"
-    "       (gui-utils:delay-action"
-    "        2"
-    "        (λ () .. init watch cursor ...)"
-    "        (λ () .. close watch cursor ...))])"
-    "  ;; .. do action ..."
-    "  (close-down))"
-    "\\end{schemedisplay}"
-    ""
-    "Creates a thread that waits \\var{delay-time}. After \\var{delay-time}"
-    "has elapsed, if the result thunk has {\\em not} been called, call"
-    "\\var{open}. Then, when the result thunk is called, call"
-    "\\var{close}. The function \\var{close} will only be called if"
-    "\\var{open} has been called.")
-
-   (gui-utils:local-busy-cursor
-    (opt->
-     ((is-a?/c window<%>)
-      (-> any/c))
-     (integer?)
-     any/c)
-    ((window thunk)
-     ((delay (gui-utils:cursor-delay))))
-    "Evaluates \\rawscm{(\\var{thunk})} with a watch cursor in \\var{window}. If"
-    "\\var{window} is \\rawscm{\\#f}, the watch cursor is turned on globally. The"
-    "argument \\var{delay} specifies the amount of time before the watch"
-    "cursor is opened. Use "
-    "@flink gui-utils:cursor-delay "
-    "to set this value for all uses of this function."
-    ""
-    "The result of this function is the result of \\var{thunk}.")
-
-   (gui-utils:unsaved-warning
-    (opt->
-     (string?
-      string?)
-     (boolean?
-      (or/c false/c
-            (is-a?/c frame%)
-            (is-a?/c dialog%)))
-     (symbols 'continue 'save 'cancel))
-    ((filename action)
-     ((can-save-now? #f)
-      (parent #f)))
-
-    "This displays a dialog that warns the user of a unsaved file."
-    ""
-    "The string, \\var{action}, indicates what action is about to"
-    "take place, without saving. For example, if the application"
-    "is about to close a file, a good action is \\rawscm{\"Close"
-    "Anyway\"}. The result symbol indicates the user's choice. If"
-    "\\var{can-save-now?} is \\rawscm{\\#f}, this function does not"
-    "give the user the ``Save'' option and thus will not return"
-    "\\rawscm{'save}.")
-
-   (gui-utils:get-choice
-    (opt->
-     (string?
-      string?
-      string?)
-     (string?
-      any/c
-      (or/c false/c (is-a?/c frame%) (is-a?/c dialog%))
-      (symbols 'app 'caution 'stop)
-      (or/c false/c (case-> (boolean? . -> . void?)
-                            (-> boolean?)))
-      string?)
-     any/c)
-    ((message true-choice false-choice)
-     ((title (string-constant warning))
-      (default-result 'disallow-close)
-      (parent #f)
-      (style 'app)
-      (checkbox-proc #f)
-      (checkbox-label (string-constant dont-ask-again))))
-
-    "Opens a dialog that presents a binary choice to the user. The user is forced"
-    "to choose between these two options, ie cancelling or closing the dialog"
-    "opens a message box asking the user to actually choose one of the two options."
-    ""
-    "The dialog will contain the string \\var{message} and two buttons,"
-    "labeled with the \\var{true-choice} and the \\var{false-choice}.  If the"
-    "user clicks on \\var{true-choice} \\rawscm{\\#t} is returned. If the user"
-    "clicks on \\var{false-choice}, \\rawscm{\\#f} is returned."
-    ""
-    "The argument \\var{default-result} determines how closing the window is"
-    "treated. If the argument is \\rawscm{'disallow-close}, closing the window"
-    "is not allowed. If it is anything else, that value is returned when"
-    "the user closes the window."
-    ""
-    "If "
-    "@flink gui-utils:cancel-on-right?"
-    "returns \\scheme|#t|, the false choice is on the right."
-    "Otherwise, the true choice is on the right."
-    ""
-    "The \\var{style} parameter is (eventually) passed to"
-    "@link message"
-    "as an icon in the dialog."
-    ""
-    "If \\var{checkbox-proc} is given, it should be a procedure that behaves"
-    "like a parameter for getting/setting a boolean value.  The intention for"
-    "this value is that it can be used to disable the dialog.  When it is"
-    "given, a checkbox will appear with a \\var{checkbox-label} label"
-    "(defaults to the \\rawscm{dont-ask-again} string constant), and that"
-    "checkbox value will be sent to the \\var{checkbox-proc} when the dialog"
-    "is closed.  Note that the dialog will always pop-up --- it is the"
-    "caller's responsibility to avoid the dialog if not needed.")
-
-   (gui-utils:get-clicked-clickback-delta
-    (-> (is-a?/c style-delta%))
-    ()
-    "This delta is designed for use with"
-    "@link text set-clickback %"
-    ". Use it as one of the \\iscmclass{style-delta} argument to"
-    "@link text set-clickback %"
-    "."
-    ""
-    "See also"
-    "@flink gui-utils:get-clickback-delta %"
-    ".")
-
-   (gui-utils:get-clickback-delta
-    (-> (is-a?/c style-delta%))
-    ()
-    "This delta is designed for use with"
-    "@link text set-clickback %"
-    ". Use the result of this function as the style"
-    "for the region"
-    "text where the clickback is set." 
-    ""
-    "See also"
-    "@flink gui-utils:get-clicked-clickback-delta %"
-    "."))
-
   (define (trim-string str size)
     (let ([str-size (string-length str)])
       (cond
@@ -497,4 +261,241 @@
   (define gui-utils:get-clickback-delta get-clickback-delta)
   (define gui-utils:ok/cancel-buttons ok/cancel-buttons)
   (define gui-utils:cancel-on-right? cancel-on-right?)
-  (define gui-utils:cursor-delay cursor-delay))
+  (define gui-utils:cursor-delay cursor-delay)
+  
+  
+  (provide/contract/docs
+   
+   (gui-utils:trim-string
+    (string?
+     (and/c number? positive?)
+     . ->d .
+     (λ (str size)
+       (and/c string?
+	      (λ (str)
+		((string-length str) . <= . size)))))
+    (str size)
+    "Constructs a string whose size is less"
+    "than \\var{size} by trimming the \\var{str}"
+    "and inserting an ellispses into it.")
+
+   (gui-utils:cancel-on-right?
+    (-> boolean?)
+    ()
+    "Returns \\scheme{#t} if cancel should be on the right-hand side (or below)"
+    "in a dialog and \\scheme{#f} otherwise."
+    ""
+    "See also"
+    "@flink gui-utils:ok/cancel-buttons %"
+    ".")
+   (gui-utils:ok/cancel-buttons
+    (opt->*
+     ((is-a?/c area-container<%>)
+      ((is-a?/c button%) (is-a?/c event%) . -> . any)
+      ((is-a?/c button%) (is-a?/c event%) . -> . any))
+     (string?
+      string?)
+     ((is-a?/c button%)
+      (is-a?/c button%)))
+    ((parent
+      confirm-callback
+      cancel-callback)
+     ((confirm-label (string-constant ok))
+      (cancel-label (string-constant cancel))))
+    "Adds an Ok and a cancel button to a panel, changing the order"
+    "to suit the platform. Under \\MacOSBoth{} and unix, the confirmation action"
+    "is on the right (or bottom) and under Windows, the canceling action is on the"
+    "right (or bottom)."
+    "The confirmation action button has the \\scheme|'(border)| style."
+    "The buttons are also sized to be the same width."
+    ""
+    "The first result is be the OK button and the second is"
+    "the cancel button."
+    ""
+    "See also"
+    "@flink gui-utils:cancel-on-right? %"
+    ".")
+   
+   (gui-utils:next-untitled-name
+    (-> string?)
+    ()
+    "Returns a name for the next opened untitled frame. The first"
+    "name is ``Untitled'', the second is ``Untitled 2'',"
+    "the third is ``Untitled 3'', and so forth.")
+   (gui-utils:cursor-delay
+    (case->
+     (-> real?)
+     (real? . -> . void?))
+    (() (new-delay))
+    "This function is {\\em not\\/} a parameter."
+    "Instead, the state is just stored in the closure."
+    ""
+    "The first case in the case lambda"
+    "returns the current delay in seconds before a watch cursor is shown,"
+    "when either \\iscmprocedure{gui-utils:local-busy-cursor} or"
+    "\\iscmprocedure{gui-utils:show-busy-cursor} is called."
+
+    "The second case in the case lambda"
+    "Sets the delay, in seconds, before a watch cursor is shown, when"
+    "either \\iscmprocedure{gui-utils:local-busy-cursor} or"
+    "\\iscmprocedure{gui-utils:show-busy-cursor} is called.")
+   (gui-utils:show-busy-cursor
+    (opt->
+     ((-> any/c))
+     (integer?)
+     any/c)
+    ((thunk)
+     ((delay (gui-utils:cursor-delay))))
+    "Evaluates \\rawscm{(\\var{thunk})} with a watch cursor. The argument"
+    "\\var{delay} specifies the amount of time before the watch cursor is"
+    "opened. Use \\iscmprocedure{gui-utils:cursor-delay} to set this value"
+    "to all calls."
+    ""
+    "This function returns the result of \\var{thunk}.")
+   (gui-utils:delay-action
+    (real?
+     (-> void?)
+     (-> void?)
+     . -> .
+     void?)
+    (delay-time open close)
+    "Use this function to delay an action for some period of time. It also"
+    "supports cancelling the action before the time period elapses. For"
+    "example, if you want to display a watch cursor, but you only want it"
+    "to appear after 2 seconds and the action may or may not take more than"
+    "two seconds, use this pattern:"
+    ""
+    "\\begin{schemedisplay}"
+    "(let ([close-down"
+    "       (gui-utils:delay-action"
+    "        2"
+    "        (λ () .. init watch cursor ...)"
+    "        (λ () .. close watch cursor ...))])"
+    "  ;; .. do action ..."
+    "  (close-down))"
+    "\\end{schemedisplay}"
+    ""
+    "Creates a thread that waits \\var{delay-time}. After \\var{delay-time}"
+    "has elapsed, if the result thunk has {\\em not} been called, call"
+    "\\var{open}. Then, when the result thunk is called, call"
+    "\\var{close}. The function \\var{close} will only be called if"
+    "\\var{open} has been called.")
+
+   (gui-utils:local-busy-cursor
+    (opt->
+     ((is-a?/c window<%>)
+      (-> any/c))
+     (integer?)
+     any/c)
+    ((window thunk)
+     ((delay (gui-utils:cursor-delay))))
+    "Evaluates \\rawscm{(\\var{thunk})} with a watch cursor in \\var{window}. If"
+    "\\var{window} is \\rawscm{\\#f}, the watch cursor is turned on globally. The"
+    "argument \\var{delay} specifies the amount of time before the watch"
+    "cursor is opened. Use "
+    "@flink gui-utils:cursor-delay "
+    "to set this value for all uses of this function."
+    ""
+    "The result of this function is the result of \\var{thunk}.")
+
+   (gui-utils:unsaved-warning
+    (opt->
+     (string?
+      string?)
+     (boolean?
+      (or/c false/c
+            (is-a?/c frame%)
+            (is-a?/c dialog%)))
+     (symbols 'continue 'save 'cancel))
+    ((filename action)
+     ((can-save-now? #f)
+      (parent #f)))
+
+    "This displays a dialog that warns the user of a unsaved file."
+    ""
+    "The string, \\var{action}, indicates what action is about to"
+    "take place, without saving. For example, if the application"
+    "is about to close a file, a good action is \\rawscm{\"Close"
+    "Anyway\"}. The result symbol indicates the user's choice. If"
+    "\\var{can-save-now?} is \\rawscm{\\#f}, this function does not"
+    "give the user the ``Save'' option and thus will not return"
+    "\\rawscm{'save}.")
+
+   (gui-utils:get-choice
+    (opt->
+     (string?
+      string?
+      string?)
+     (string?
+      any/c
+      (or/c false/c (is-a?/c frame%) (is-a?/c dialog%))
+      (symbols 'app 'caution 'stop)
+      (or/c false/c (case-> (boolean? . -> . void?)
+                            (-> boolean?)))
+      string?)
+     any/c)
+    ((message true-choice false-choice)
+     ((title (string-constant warning))
+      (default-result 'disallow-close)
+      (parent #f)
+      (style 'app)
+      (checkbox-proc #f)
+      (checkbox-label (string-constant dont-ask-again))))
+
+    "Opens a dialog that presents a binary choice to the user. The user is forced"
+    "to choose between these two options, ie cancelling or closing the dialog"
+    "opens a message box asking the user to actually choose one of the two options."
+    ""
+    "The dialog will contain the string \\var{message} and two buttons,"
+    "labeled with the \\var{true-choice} and the \\var{false-choice}.  If the"
+    "user clicks on \\var{true-choice} \\rawscm{\\#t} is returned. If the user"
+    "clicks on \\var{false-choice}, \\rawscm{\\#f} is returned."
+    ""
+    "The argument \\var{default-result} determines how closing the window is"
+    "treated. If the argument is \\rawscm{'disallow-close}, closing the window"
+    "is not allowed. If it is anything else, that value is returned when"
+    "the user closes the window."
+    ""
+    "If "
+    "@flink gui-utils:cancel-on-right?"
+    "returns \\scheme|#t|, the false choice is on the right."
+    "Otherwise, the true choice is on the right."
+    ""
+    "The \\var{style} parameter is (eventually) passed to"
+    "@link message"
+    "as an icon in the dialog."
+    ""
+    "If \\var{checkbox-proc} is given, it should be a procedure that behaves"
+    "like a parameter for getting/setting a boolean value.  The intention for"
+    "this value is that it can be used to disable the dialog.  When it is"
+    "given, a checkbox will appear with a \\var{checkbox-label} label"
+    "(defaults to the \\rawscm{dont-ask-again} string constant), and that"
+    "checkbox value will be sent to the \\var{checkbox-proc} when the dialog"
+    "is closed.  Note that the dialog will always pop-up --- it is the"
+    "caller's responsibility to avoid the dialog if not needed.")
+
+   (gui-utils:get-clicked-clickback-delta
+    (-> (is-a?/c style-delta%))
+    ()
+    "This delta is designed for use with"
+    "@link text set-clickback %"
+    ". Use it as one of the \\iscmclass{style-delta} argument to"
+    "@link text set-clickback %"
+    "."
+    ""
+    "See also"
+    "@flink gui-utils:get-clickback-delta %"
+    ".")
+
+   (gui-utils:get-clickback-delta
+    (-> (is-a?/c style-delta%))
+    ()
+    "This delta is designed for use with"
+    "@link text set-clickback %"
+    ". Use the result of this function as the style"
+    "for the region"
+    "text where the clickback is set." 
+    ""
+    "See also"
+    "@flink gui-utils:get-clicked-clickback-delta %"
+    ".")))
diff --git a/collects/framework/test.ss b/collects/framework/test.ss
index b9b9bb86e0..b72d3a06ef 100644
--- a/collects/framework/test.ss
+++ b/collects/framework/test.ss
@@ -10,207 +10,6 @@
       [(_ (name contract docs ...) ...)
        (syntax (provide/contract (name contract) ...))]))
   
-  (provide/contract/docs
-   (test:number-pending-actions
-    (-> number?)
-    ()
-    "Returns the number of pending events (those that haven't completed yet)")
-
-   (test:run-interval
-    (case->
-     (number? . -> . void?)
-     (-> number?))
-    ((msec) ())
-    "See also"
-    "\\hyperref{Actions and completeness}{Actions and completeness, section~}{}{fw:actions-completeness}."
-    "The first case in the case-lambda sets"
-    "the run interval to \\var{msec} milliseconds and the second"
-    "returns the current setting.")
-
-   (test:reraise-error
-    (-> void?)
-    ()
-    "See also"
-    "\\hyperref{Errors}{Errors, section~}{}{fw:test:errors}.")
-
-   (test:run-one
-    ((-> void?) . -> . void?)
-    (f)
-    "Runs the function \\var{f} as if it was a simulated event. See also"
-    "\\hyperref{the test section}{section ~}{}{fw:test}.")
-
-   (test:current-get-eventspaces
-    (case->
-     ((-> (listof eventspace?)) . -> . void?)
-     (-> (-> (listof eventspace?))))
-    ((func) ())
-
-    "This parameter that specifies which "
-    "\\hyperref{eventspaces}{eventspace (see section~}{)}{eventspaceinfo}"
-    "are considered when finding the frontmost frame."
-
-    "The first case"
-    "sets the parameter to \\var{func}. The procedure \\var{func} will be"
-    "invoked with no arguments to determine the eventspaces to consider"
-    "when finding the frontmost frame for simulated user events."
-
-    "The second case"
-    "returns the current value of the parameter. This will be a procedure"
-    "which, when invoked, returns a list of eventspaces.")
-   (test:close-top-level-window
-    ((is-a?/c top-level-window<%>) . -> . void?)
-    (tlw)
-    "Use this function to simulate clicking on the close box of a frame."
-    "Closes \\var{tlw} with this expression:"
-    ""
-    "\\begin{schemedisplay}"
-    "(when (send tlw can-close?)"
-    "  (send tlw on-close)"
-    "  (send tlw show #f))"
-    "\\end{schemedisplay}")
-
-   (test:top-level-focus-window-has?
-    (((is-a?/c area<%>) . -> . boolean?) . -> . boolean?)
-    (test)
-    "Calls \\var{test} for each child of the top-level-focus-frame"
-    "and returns \\scheme|#t| if \\var{test} ever does, otherwise"
-    "returns \\scheme|#f|. If there"
-    "is no top-level-focus-window, returns \\scheme|#f|.")
-
-   ;; ((frame-has? p) f) =
-   ;;    f is a frame and it has a child (in it or a subpanel) that responds #t to p
-   (test:button-push
-    ((or/c (λ (str)
-              (and (string? str)
-                   (test:top-level-focus-window-has?
-                    (λ (c)
-                      (and (is-a? c button%)
-                           (string=? (send c get-label) str)
-                           (send c is-enabled?)
-                           (send c is-shown?))))))
-	    
-            (and/c (is-a?/c button%)
-		   (λ (btn)
-		     (and (send btn is-enabled?)
-			  (send btn is-shown?)))
-		   (λ (btn)
-		     (test:top-level-focus-window-has?
-		      (λ (c) (eq? c btn))))))
-     . -> .
-     void?)
-    (button)
-    "Simulates pushing \\var{button}.  If a string is supplied, the"
-    "primitive searches for a button labelled with that string in the"
-    "active frame. Otherwise, it pushes the button argument.")
-
-   (test:set-radio-box!
-    ((or/c string? (is-a?/c radio-box%)) (or/c string? number?) . -> . void?)
-    (radio-box state)
-    "Sets the radio-box to \\var{state}. If \\var{state} is a"
-    "string, this function finds the choice with that label and"
-    "if it is a number, it uses the number as an index into the"
-    "state. If the number is out of range or if the label isn't"
-    "in the radio box, an exception is raised."
-    ""
-    "If \\var{radio-box} is a string, this function searches for a"
-    "\\iscmclass{radio-box} with a label matching that string,"
-    "otherwise it uses \\var{radio-box} itself.")
-
-   (test:set-radio-box-item!
-    (string? . -> . void?)
-    (entry)
-    "Finds a \\iscmclass{radio-box} that has a label \\var{entry}"
-    "and sets the radio-box to \\var{entry}.")
-   (test:set-check-box!
-    ((or/c string? (is-a?/c check-box%)) boolean? . -> . void?)
-    (check-box state)
-    "Clears the \\iscmclass{check-box} item if \\var{state} is \\rawscm{\\#f}, and sets it"
-    "otherwise."
-    ""
-    "If \\var{check-box} is a string,"
-    "this function searches for a \\iscmclass{check-box} with a label matching that string,"
-    "otherwise it uses \\var{check-box} itself.")
-
-   (test:set-choice!
-    ((or/c string? (is-a?/c choice%)) string? . -> . void?)
-    (choice str)
-    "Selects \\var{choice}'s item \\var{str}. If \\var{choice} is a string,"
-    "this function searches for a \\iscmclass{choice} with a label matching"
-    "that string, otherwise it uses \\var{choice} itself.")
-
-   (test:keystroke
-    (opt->
-     ((or/c char? symbol?))
-     ((listof (symbols 'alt 'control 'meta 'shift 'noalt 'nocontrol 'nometea 'noshift)))
-     void?)
-    ((key)
-     ((modifier-list null)))
-    "This function simulates a user pressing a key. The argument, \\var{key},"
-    "is just like the argument to the"
-    "@link key-event get-key-code"
-    "method of the"
-    "@link key-event"
-    "class. "
-    ""
-    "{\\it Note:}"
-    "To send the ``Enter'' key, use \\verb|#\return|,"
-    "not \\verb|#\newline|."
-    ""
-    "The \\rawscm{'shift} or \\rawscm{'noshift} modifier is implicitly set from \\var{key},"
-    "but is overridden by the argument list. The \\rawscm{'shift} modifier is"
-    "set for any capitol alpha-numeric letters and any of the following characters:"
-    "\\begin{schemedisplay}"
-    "#\\? #\\: #\\~ #\\\\ #\\|"
-    "#\\< #\\> #\\{ #\\} #\\[ #\\] #\\( #\\)"
-    "#\\! #\\@ #\\# #\\$ #\\% #\\^ #\\& #\\* #\\_ #\\+"
-    "\\end{schemedisplay}"
-    ""
-    "If conflicting modifiers are provided, the ones later in the list are used.")
-
-   (test:menu-select
-    (string? string? . -> . void?)
-    (menu item)
-    "Selects the menu-item named \\var{item} in the menu named \\var{menu}."
-    ""
-    "{\\it Note:}"
-    "The string for the menu item does not include its keyboard equivalent."
-    "For example, to select ``New'' from the ``File'' menu, "
-    "use ``New'', not ``New Ctrl+m n''.")
-
-   (test:mouse-click
-    (opt->
-     ((symbols 'left 'middle 'right)
-      (and/c exact? integer?)
-      (and/c exact? integer?))
-     ((listof (symbols 'alt 'control 'meta 'shift 'noalt 'nocontrol 'nometa 'noshift)))
-     void?)
-    ((button x y)
-     ((modifiers null)))
-    "Simulates a mouse click at the coordinate: $(x,y)$ in the currently"
-    "focused \\iscmintf{window}, assuming that it supports the "
-    "@ilink canvas on-event"
-    "method."
-    "Use"
-    "@flink test:button-push"
-    "to click on a button."
-    ""
-    "On the Macintosh, \\rawscm{'right} corresponds to holding down the command"
-    "modifier key while clicking and \\rawscm{'middle} cannot be generated."
-    ""
-    "Under Windows, \\rawscm{'middle} can only be generated if the user has a"
-    "three button mouse."
-    ""
-    "The modifiers later in the list \\var{modifiers} take precedence over"
-    "ones that appear earlier.")
-
-   (test:new-window 
-    ((is-a?/c window<%>) . -> . void?)
-    (window)
-    "Moves the keyboard focus to a new window within the currently active"
-    "frame.  Unfortunately, neither this function nor any other function in"
-    "the test engine can cause the focus to move from the top-most (active)"
-    "frame. "))
-
   (define (test:top-level-focus-window-has? pred)
     (let ([tlw (get-top-level-focus-window)])
       (and tlw
@@ -1036,4 +835,205 @@
   (define test:keystroke keystroke)
   (define test:menu-select menu-select)
   (define test:mouse-click mouse-click)
-  (define test:new-window new-window))
+  (define test:new-window new-window)
+  
+  (provide/contract/docs
+   (test:number-pending-actions
+    (-> number?)
+    ()
+    "Returns the number of pending events (those that haven't completed yet)")
+
+   (test:run-interval
+    (case->
+     (number? . -> . void?)
+     (-> number?))
+    ((msec) ())
+    "See also"
+    "\\hyperref{Actions and completeness}{Actions and completeness, section~}{}{fw:actions-completeness}."
+    "The first case in the case-lambda sets"
+    "the run interval to \\var{msec} milliseconds and the second"
+    "returns the current setting.")
+
+   (test:reraise-error
+    (-> void?)
+    ()
+    "See also"
+    "\\hyperref{Errors}{Errors, section~}{}{fw:test:errors}.")
+
+   (test:run-one
+    ((-> void?) . -> . void?)
+    (f)
+    "Runs the function \\var{f} as if it was a simulated event. See also"
+    "\\hyperref{the test section}{section ~}{}{fw:test}.")
+
+   (test:current-get-eventspaces
+    (case->
+     ((-> (listof eventspace?)) . -> . void?)
+     (-> (-> (listof eventspace?))))
+    ((func) ())
+
+    "This parameter that specifies which "
+    "\\hyperref{eventspaces}{eventspace (see section~}{)}{eventspaceinfo}"
+    "are considered when finding the frontmost frame."
+
+    "The first case"
+    "sets the parameter to \\var{func}. The procedure \\var{func} will be"
+    "invoked with no arguments to determine the eventspaces to consider"
+    "when finding the frontmost frame for simulated user events."
+
+    "The second case"
+    "returns the current value of the parameter. This will be a procedure"
+    "which, when invoked, returns a list of eventspaces.")
+   (test:close-top-level-window
+    ((is-a?/c top-level-window<%>) . -> . void?)
+    (tlw)
+    "Use this function to simulate clicking on the close box of a frame."
+    "Closes \\var{tlw} with this expression:"
+    ""
+    "\\begin{schemedisplay}"
+    "(when (send tlw can-close?)"
+    "  (send tlw on-close)"
+    "  (send tlw show #f))"
+    "\\end{schemedisplay}")
+
+   (test:top-level-focus-window-has?
+    (((is-a?/c area<%>) . -> . boolean?) . -> . boolean?)
+    (test)
+    "Calls \\var{test} for each child of the top-level-focus-frame"
+    "and returns \\scheme|#t| if \\var{test} ever does, otherwise"
+    "returns \\scheme|#f|. If there"
+    "is no top-level-focus-window, returns \\scheme|#f|.")
+
+   ;; ((frame-has? p) f) =
+   ;;    f is a frame and it has a child (in it or a subpanel) that responds #t to p
+   (test:button-push
+    ((or/c (λ (str)
+              (and (string? str)
+                   (test:top-level-focus-window-has?
+                    (λ (c)
+                      (and (is-a? c button%)
+                           (string=? (send c get-label) str)
+                           (send c is-enabled?)
+                           (send c is-shown?))))))
+	    
+            (and/c (is-a?/c button%)
+		   (λ (btn)
+		     (and (send btn is-enabled?)
+			  (send btn is-shown?)))
+		   (λ (btn)
+		     (test:top-level-focus-window-has?
+		      (λ (c) (eq? c btn))))))
+     . -> .
+     void?)
+    (button)
+    "Simulates pushing \\var{button}.  If a string is supplied, the"
+    "primitive searches for a button labelled with that string in the"
+    "active frame. Otherwise, it pushes the button argument.")
+
+   (test:set-radio-box!
+    ((or/c string? (is-a?/c radio-box%)) (or/c string? number?) . -> . void?)
+    (radio-box state)
+    "Sets the radio-box to \\var{state}. If \\var{state} is a"
+    "string, this function finds the choice with that label and"
+    "if it is a number, it uses the number as an index into the"
+    "state. If the number is out of range or if the label isn't"
+    "in the radio box, an exception is raised."
+    ""
+    "If \\var{radio-box} is a string, this function searches for a"
+    "\\iscmclass{radio-box} with a label matching that string,"
+    "otherwise it uses \\var{radio-box} itself.")
+
+   (test:set-radio-box-item!
+    (string? . -> . void?)
+    (entry)
+    "Finds a \\iscmclass{radio-box} that has a label \\var{entry}"
+    "and sets the radio-box to \\var{entry}.")
+   (test:set-check-box!
+    ((or/c string? (is-a?/c check-box%)) boolean? . -> . void?)
+    (check-box state)
+    "Clears the \\iscmclass{check-box} item if \\var{state} is \\rawscm{\\#f}, and sets it"
+    "otherwise."
+    ""
+    "If \\var{check-box} is a string,"
+    "this function searches for a \\iscmclass{check-box} with a label matching that string,"
+    "otherwise it uses \\var{check-box} itself.")
+
+   (test:set-choice!
+    ((or/c string? (is-a?/c choice%)) string? . -> . void?)
+    (choice str)
+    "Selects \\var{choice}'s item \\var{str}. If \\var{choice} is a string,"
+    "this function searches for a \\iscmclass{choice} with a label matching"
+    "that string, otherwise it uses \\var{choice} itself.")
+
+   (test:keystroke
+    (opt->
+     ((or/c char? symbol?))
+     ((listof (symbols 'alt 'control 'meta 'shift 'noalt 'nocontrol 'nometea 'noshift)))
+     void?)
+    ((key)
+     ((modifier-list null)))
+    "This function simulates a user pressing a key. The argument, \\var{key},"
+    "is just like the argument to the"
+    "@link key-event get-key-code"
+    "method of the"
+    "@link key-event"
+    "class. "
+    ""
+    "{\\it Note:}"
+    "To send the ``Enter'' key, use \\verb|#\return|,"
+    "not \\verb|#\newline|."
+    ""
+    "The \\rawscm{'shift} or \\rawscm{'noshift} modifier is implicitly set from \\var{key},"
+    "but is overridden by the argument list. The \\rawscm{'shift} modifier is"
+    "set for any capitol alpha-numeric letters and any of the following characters:"
+    "\\begin{schemedisplay}"
+    "#\\? #\\: #\\~ #\\\\ #\\|"
+    "#\\< #\\> #\\{ #\\} #\\[ #\\] #\\( #\\)"
+    "#\\! #\\@ #\\# #\\$ #\\% #\\^ #\\& #\\* #\\_ #\\+"
+    "\\end{schemedisplay}"
+    ""
+    "If conflicting modifiers are provided, the ones later in the list are used.")
+
+   (test:menu-select
+    (string? string? . -> . void?)
+    (menu item)
+    "Selects the menu-item named \\var{item} in the menu named \\var{menu}."
+    ""
+    "{\\it Note:}"
+    "The string for the menu item does not include its keyboard equivalent."
+    "For example, to select ``New'' from the ``File'' menu, "
+    "use ``New'', not ``New Ctrl+m n''.")
+
+   (test:mouse-click
+    (opt->
+     ((symbols 'left 'middle 'right)
+      (and/c exact? integer?)
+      (and/c exact? integer?))
+     ((listof (symbols 'alt 'control 'meta 'shift 'noalt 'nocontrol 'nometa 'noshift)))
+     void?)
+    ((button x y)
+     ((modifiers null)))
+    "Simulates a mouse click at the coordinate: $(x,y)$ in the currently"
+    "focused \\iscmintf{window}, assuming that it supports the "
+    "@ilink canvas on-event"
+    "method."
+    "Use"
+    "@flink test:button-push"
+    "to click on a button."
+    ""
+    "On the Macintosh, \\rawscm{'right} corresponds to holding down the command"
+    "modifier key while clicking and \\rawscm{'middle} cannot be generated."
+    ""
+    "Under Windows, \\rawscm{'middle} can only be generated if the user has a"
+    "three button mouse."
+    ""
+    "The modifiers later in the list \\var{modifiers} take precedence over"
+    "ones that appear earlier.")
+
+   (test:new-window 
+    ((is-a?/c window<%>) . -> . void?)
+    (window)
+    "Moves the keyboard focus to a new window within the currently active"
+    "frame.  Unfortunately, neither this function nor any other function in"
+    "the test engine can cause the focus to move from the top-most (active)"
+    "frame. ")))
diff --git a/collects/help/private/colldocs.ss b/collects/help/private/colldocs.ss
index d438faa6e1..33ec5d0806 100644
--- a/collects/help/private/colldocs.ss
+++ b/collects/help/private/colldocs.ss
@@ -3,10 +3,6 @@
            (lib "getinfo.ss" "setup")
            (lib "contract.ss"))
   
-  (provide/contract 
-   [colldocs (-> (values (listof (list/c path? path?))
-                         (listof string?)))])
-
   (define (colldocs)
     (let loop ([dirs (sort (map path->string (find-relevant-directories
                                               '(doc.txt) 'all-available))
@@ -27,4 +23,8 @@
                                       docs)
                                 (cons name names))
                           (loop (cdr dirs) docs names)))
-                    (loop (cdr dirs) docs names)))]))))
+                    (loop (cdr dirs) docs names)))])))
+  
+  (provide/contract 
+   [colldocs (-> (values (listof (list/c path? path?))
+                         (listof string?)))]))
diff --git a/collects/help/private/docpos.ss b/collects/help/private/docpos.ss
index e218c5a76e..eb2dcfdaa0 100644
--- a/collects/help/private/docpos.ss
+++ b/collects/help/private/docpos.ss
@@ -2,10 +2,6 @@
   (require (lib "list.ss")
            (lib "contract.ss"))
 
-  (provide/contract
-   [standard-html-doc-position (path? . -> . number?)]
-   [known-docs (listof (cons/c path? string?))])
-
   ;; Define an order on the standard docs.
   (define (standard-html-doc-position d)
     (let ([str (path->string d)])
@@ -61,4 +57,8 @@
       ("profj-intermediate" "ProfessorJ Intermediate Language" 211)
       ("profj-advanced" "ProfessorJ Advanced Language" 212)))
 
-  (define known-docs (map (lambda (x) (cons (string->path (car x)) (cadr x))) docs-and-positions)))
+  (define known-docs (map (lambda (x) (cons (string->path (car x)) (cadr x))) docs-and-positions))
+  
+  (provide/contract
+   [standard-html-doc-position (path? . -> . number?)]
+   [known-docs (listof (cons/c path? string?))]))
diff --git a/collects/help/private/get-help-url.ss b/collects/help/private/get-help-url.ss
index 379bce1dd3..a727e743c0 100644
--- a/collects/help/private/get-help-url.ss
+++ b/collects/help/private/get-help-url.ss
@@ -8,12 +8,6 @@
 	   (lib "config.ss" "planet")
            (lib "dirs.ss" "setup"))
   
-  (provide/contract (get-help-url
-                     (opt->
-                      ((or/c path? path-string?))
-                      (string?)
-                      string?)))
-  
   ; given a manual path, convert to absolute Web path
   ; manual path is an anchored path to a doc manual, never a servlet
   (define get-help-url
@@ -64,4 +58,10 @@
         [(null? long) #f]
         [(equal? (car short) (car long))
          (loop (cdr short) (cdr long))]
-        [else #f]))))
+        [else #f])))
+  
+  (provide/contract (get-help-url
+                     (opt->
+                      ((or/c path? path-string?))
+                      (string?)
+                      string?))))
diff --git a/collects/help/private/manuals.ss b/collects/help/private/manuals.ss
index 6a541e9f57..82cebe3ba6 100644
--- a/collects/help/private/manuals.ss
+++ b/collects/help/private/manuals.ss
@@ -17,21 +17,6 @@
            "../servlets/private/util.ss"
            "../servlets/private/headelts.ss")
 
-  (provide main-manual-page)
-  (provide finddoc
-	   finddoc-page-anchor)
-  
-  (provide/contract [manual-entry (string? string? xexpr? . -> . xexpr?)]
-                    [finddoc-page (string? string? . -> . string?)]
-                    [get-doc-name (path? . -> . string?)]
-                    [find-doc-directories (-> (listof path?))]
-                    [find-doc-directory (path? . -> . (or/c false/c path?))]
-                    [find-doc-names (-> (listof (cons/c path? string?)))]
-                    [get-manual-index (-> string? string?)]
-                    [get-index-file (path? . -> . (or/c false/c path?))])
-  
-  (provide find-manuals)
-
   ;; type sec = (make-sec name regexp (listof regexp))
   (define-struct sec (name reg seps))
   
@@ -380,4 +365,20 @@
                            (if (file-exists? (build-path dir index-file))
                                index-file
                                #f)))
-                    (loop (cdr contents))))]))))
+                    (loop (cdr contents))))])))
+  
+  
+  (provide main-manual-page)
+  (provide finddoc
+	   finddoc-page-anchor)
+  
+  (provide/contract [manual-entry (string? string? xexpr? . -> . xexpr?)]
+                    [finddoc-page (string? string? . -> . string?)]
+                    [get-doc-name (path? . -> . string?)]
+                    [find-doc-directories (-> (listof path?))]
+                    [find-doc-directory (path? . -> . (or/c false/c path?))]
+                    [find-doc-names (-> (listof (cons/c path? string?)))]
+                    [get-manual-index (-> string? string?)]
+                    [get-index-file (path? . -> . (or/c false/c path?))])
+  
+  (provide find-manuals))
diff --git a/collects/help/private/path.ss b/collects/help/private/path.ss
index d5c78564e2..f842a3ae08 100644
--- a/collects/help/private/path.ss
+++ b/collects/help/private/path.ss
@@ -1,11 +1,10 @@
 (module path mzscheme
   (require (lib "contract.ss"))
-  (provide/contract
-   [servlet-path? (path? . -> . boolean?)])
-
   (define (servlet-path? path)
     (if (regexp-match #rx#"^/servlets/" 
                       (path->bytes path))
         #t
-        #f)))
+        #f))
+  (provide/contract
+   [servlet-path? (path? . -> . boolean?)]))
 
diff --git a/collects/help/private/standard-urls.ss b/collects/help/private/standard-urls.ss
index ab25d17c96..ca46273c00 100644
--- a/collects/help/private/standard-urls.ss
+++ b/collects/help/private/standard-urls.ss
@@ -15,32 +15,6 @@
   (define (search-how? x)
     (member x '("exact-match" "containing-match" "regexp-match")))
   
-  (provide search-type? search-how?)
-  (provide/contract 
-   (make-relative-results-url (string? 
-                               search-type? 
-                               search-how?
-                               any/c 
-                               (listof path?)
-                               any/c
-                               (or/c false/c string?) . -> . string?))
-   (make-results-url (string?
-                      search-type? search-how? any/c 
-                      (listof path?) 
-                      any/c
-                      (or/c false/c string?)
-                      . -> .
-                      string?))
-   (flush-manuals-url string?)
-   (flush-manuals-path string?)
-   (make-missing-manual-url (string? string? string? . -> . string?))
-   (get-hd-location ((lambda (sym) (memq sym hd-location-syms))
-                     . -> . 
-                     string?))
-   [prefix-with-server (string? . -> . string?)]
-   [make-docs-plt-url (string? . -> . string?)]
-   [make-docs-html-url (string? . -> . string?)])
-
   (define (base-docs-url)
     (if (repos-or-nightly-build?)
       "http://pre.plt-scheme.org/docs"
@@ -112,4 +86,30 @@
 
   (define (get-hd-location sym)
     ; the assq is guarded by the contract
-    (cadr (assq sym hd-locations))))
+    (cadr (assq sym hd-locations)))
+  
+  (provide search-type? search-how?)
+  (provide/contract 
+   (make-relative-results-url (string? 
+                               search-type? 
+                               search-how?
+                               any/c 
+                               (listof path?)
+                               any/c
+                               (or/c false/c string?) . -> . string?))
+   (make-results-url (string?
+                      search-type? search-how? any/c 
+                      (listof path?) 
+                      any/c
+                      (or/c false/c string?)
+                      . -> .
+                      string?))
+   (flush-manuals-url string?)
+   (flush-manuals-path string?)
+   (make-missing-manual-url (string? string? string? . -> . string?))
+   (get-hd-location ((lambda (sym) (memq sym hd-location-syms))
+                     . -> . 
+                     string?))
+   [prefix-with-server (string? . -> . string?)]
+   [make-docs-plt-url (string? . -> . string?)]
+   [make-docs-html-url (string? . -> . string?)]))
diff --git a/collects/help/servlets/private/util.ss b/collects/help/servlets/private/util.ss
index 5810d99339..16b07452e3 100644
--- a/collects/help/servlets/private/util.ss
+++ b/collects/help/servlets/private/util.ss
@@ -6,28 +6,6 @@
            (lib "string-constant.ss" "string-constants")
            (lib "contract.ss"))
 
-  (provide/contract
-   [fold-into-web-path ((listof string?) . -> . string?)])
-  
-  (provide get-pref/default
-           get-bool-pref/default
-           put-prefs
-           repos-or-nightly-build?
-           search-height-default
-           search-bg-default
-           search-text-default
-           search-link-default
-           color-highlight
-           color-with
-           collection-doc-link
-           home-page
-           format-collection-message
-           nl
-           plt-version
-           make-javascript
-           redir-javascript
-           onload-redir)
-
   ;; would be nice if this could use version:version from the framework.
   (define (plt-version)
     (let ([mz-version (version)]
@@ -138,9 +116,26 @@
     (string-append 
      "setTimeout(\"redir()\","
      (number->string (* secs 1000))
-     ")")))
-
-
-
-
-
+     ")"))
+  
+  (provide/contract
+   [fold-into-web-path ((listof string?) . -> . string?)])
+  
+  (provide get-pref/default
+           get-bool-pref/default
+           put-prefs
+           repos-or-nightly-build?
+           search-height-default
+           search-bg-default
+           search-text-default
+           search-link-default
+           color-highlight
+           color-with
+           collection-doc-link
+           home-page
+           format-collection-message
+           nl
+           plt-version
+           make-javascript
+           redir-javascript
+           onload-redir))
diff --git a/collects/mzlib/port.ss b/collects/mzlib/port.ss
index a15c128b2d..c2c929ee0d 100644
--- a/collects/mzlib/port.ss
+++ b/collects/mzlib/port.ss
@@ -5,23 +5,6 @@
 	   (lib "list.ss")
 	   "private/port.ss")
 
-  (provide open-output-nowhere
-	   make-pipe-with-specials
-	   make-input-port/read-to-peek
-	   peeking-input-port
-	   relocate-input-port
-	   transplant-input-port
-	   relocate-output-port
-	   transplant-output-port
-	   merge-input
-	   copy-port
-	   input-port-append
-	   convert-stream
-	   make-limited-input-port
-	   reencode-input-port
-	   reencode-output-port
-	   strip-shell-command-start)
-
   (define (exact-non-negative-integer? i)
     (and (number? i) (exact? i) (integer? i) (i . >= . 0)))
 
@@ -40,42 +23,6 @@
   (define (evt?/false v)
     (or (eq? #f v) (evt? v)))
   
-  (provide/contract (read-bytes-avail!-evt (mutable-bytes? input-port-with-progress-evts?
-							   . -> . evt?))
-		    (peek-bytes-avail!-evt (mutable-bytes? exact-non-negative-integer? evt?/false
-							   input-port-with-progress-evts? 
-							   . -> . evt?))
-		    (read-bytes!-evt (mutable-bytes? input-port-with-progress-evts? . -> . evt?))
-		    (peek-bytes!-evt (mutable-bytes? exact-non-negative-integer? evt?/false
-						     input-port-with-progress-evts? 
-						     . -> . evt?))
-		    (read-bytes-evt (exact-non-negative-integer? input-port-with-progress-evts? 
-								 . -> . evt?))
-		    (peek-bytes-evt (exact-non-negative-integer? exact-non-negative-integer? evt?/false
-								 input-port-with-progress-evts? 
-								 . -> . evt?))
-		    (read-string!-evt (mutable-string? input-port-with-progress-evts? 
-						       . -> . evt?))
-		    (peek-string!-evt (mutable-string? exact-non-negative-integer? evt?/false
-						       input-port-with-progress-evts? 
-						       . -> . evt?))
-		    (read-string-evt (exact-non-negative-integer? input-port-with-progress-evts? 
-								  . -> . evt?))
-		    (peek-string-evt (exact-non-negative-integer? exact-non-negative-integer? evt?/false
-								  input-port-with-progress-evts? 
-								  . -> . evt?))
-		    (regexp-match-evt ((or/c regexp? byte-regexp? string? bytes?)
-				       input-port-with-progress-evts? 
-				       . -> . evt?))
-
-		    (read-bytes-line-evt (case->
-					  (input-port-with-progress-evts? . -> . evt?)
-					  (input-port-with-progress-evts? line-mode-symbol? . -> . evt?)))
-		    (read-line-evt (case->
-				    (input-port-with-progress-evts? . -> . evt?)
-				    (input-port-with-progress-evts? line-mode-symbol? . -> . evt?)))
-		    (eof-evt (input-port-with-progress-evts? . -> . evt?)))
-
   ;; ----------------------------------------
 
   (define (strip-shell-command-start in)
@@ -1535,4 +1482,57 @@
 			      (and (eq? old 'line)
 				   (memq mode '(none))))
 		      ;; Flush output
-		      (write-it #"" 0 0 #f #f)))]))))))
+		      (write-it #"" 0 0 #f #f)))])))))
+  
+  (provide open-output-nowhere
+	   make-pipe-with-specials
+	   make-input-port/read-to-peek
+	   peeking-input-port
+	   relocate-input-port
+	   transplant-input-port
+	   relocate-output-port
+	   transplant-output-port
+	   merge-input
+	   copy-port
+	   input-port-append
+	   convert-stream
+	   make-limited-input-port
+	   reencode-input-port
+	   reencode-output-port
+	   strip-shell-command-start)
+  
+  (provide/contract (read-bytes-avail!-evt (mutable-bytes? input-port-with-progress-evts?
+							   . -> . evt?))
+		    (peek-bytes-avail!-evt (mutable-bytes? exact-non-negative-integer? evt?/false
+							   input-port-with-progress-evts? 
+							   . -> . evt?))
+		    (read-bytes!-evt (mutable-bytes? input-port-with-progress-evts? . -> . evt?))
+		    (peek-bytes!-evt (mutable-bytes? exact-non-negative-integer? evt?/false
+						     input-port-with-progress-evts? 
+						     . -> . evt?))
+		    (read-bytes-evt (exact-non-negative-integer? input-port-with-progress-evts? 
+								 . -> . evt?))
+		    (peek-bytes-evt (exact-non-negative-integer? exact-non-negative-integer? evt?/false
+								 input-port-with-progress-evts? 
+								 . -> . evt?))
+		    (read-string!-evt (mutable-string? input-port-with-progress-evts? 
+						       . -> . evt?))
+		    (peek-string!-evt (mutable-string? exact-non-negative-integer? evt?/false
+						       input-port-with-progress-evts? 
+						       . -> . evt?))
+		    (read-string-evt (exact-non-negative-integer? input-port-with-progress-evts? 
+								  . -> . evt?))
+		    (peek-string-evt (exact-non-negative-integer? exact-non-negative-integer? evt?/false
+								  input-port-with-progress-evts? 
+								  . -> . evt?))
+		    (regexp-match-evt ((or/c regexp? byte-regexp? string? bytes?)
+				       input-port-with-progress-evts? 
+				       . -> . evt?))
+
+		    (read-bytes-line-evt (case->
+					  (input-port-with-progress-evts? . -> . evt?)
+					  (input-port-with-progress-evts? line-mode-symbol? . -> . evt?)))
+		    (read-line-evt (case->
+				    (input-port-with-progress-evts? . -> . evt?)
+				    (input-port-with-progress-evts? line-mode-symbol? . -> . evt?)))
+		    (eof-evt (input-port-with-progress-evts? . -> . evt?))))
diff --git a/collects/mzlib/private/contract-arrow.ss b/collects/mzlib/private/contract-arrow.ss
index 99b09ef096..fc0f282fe1 100644
--- a/collects/mzlib/private/contract-arrow.ss
+++ b/collects/mzlib/private/contract-arrow.ss
@@ -39,41 +39,26 @@
       (make--> rng-any? doms/c doms-rest/c rngs/c func)))
   
   (define-struct/prop -> (rng-any? doms dom-rest rngs func)
-    ((pos-proj-prop (λ (ctc) 
-                      (let* ([doms/c (map (λ (x) ((neg-proj-get x) x)) 
-                                          (if (->-dom-rest ctc)
-                                              (append (->-doms ctc) (list (->-dom-rest ctc)))
-                                              (->-doms ctc)))]
-                             [rngs/c (map (λ (x) ((pos-proj-get x) x)) (->-rngs ctc))]
-                             [func (->-func ctc)]
-                             [dom-length (length (->-doms ctc))]
-                             [check-proc
-                              (if (->-dom-rest ctc)
-                                  check-procedure/more
-                                  check-procedure)])
-                        (lambda (blame src-info orig-str)
-                          (let ([partial-doms (map (λ (dom) (dom blame src-info orig-str))
-                                                   doms/c)]
-                                [partial-ranges (map (λ (rng) (rng blame src-info orig-str))
-                                                     rngs/c)])
-                            (apply func
-                                   (λ (val) (check-proc val dom-length src-info blame orig-str))
-                                   (append partial-doms partial-ranges)))))))
-     (neg-proj-prop (λ (ctc) 
-                      (let* ([doms/c (map (λ (x) ((pos-proj-get x) x)) 
-                                          (if (->-dom-rest ctc)
-                                              (append (->-doms ctc) (list (->-dom-rest ctc)))
-                                              (->-doms ctc)))]
-                             [rngs/c (map (λ (x) ((neg-proj-get x) x)) (->-rngs ctc))]
-                             [func (->-func ctc)])
-                        (lambda (blame src-info orig-str)
-                          (let ([partial-doms (map (λ (dom) (dom blame src-info orig-str))
-                                                   doms/c)]
-                                [partial-ranges (map (λ (rng) (rng blame src-info orig-str))
-                                                     rngs/c)])
-                            (apply func
-                                   void
-                                   (append partial-doms partial-ranges)))))))
+    ((proj-prop (λ (ctc) 
+                  (let* ([doms/c (map (λ (x) ((proj-get x) x)) 
+                                      (if (->-dom-rest ctc)
+                                          (append (->-doms ctc) (list (->-dom-rest ctc)))
+                                          (->-doms ctc)))]
+                         [rngs/c (map (λ (x) ((proj-get x) x)) (->-rngs ctc))]
+                         [func (->-func ctc)]
+                         [dom-length (length (->-doms ctc))]
+                         [check-proc
+                          (if (->-dom-rest ctc)
+                              check-procedure/more
+                              check-procedure)])
+                    (lambda (pos-blame neg-blame src-info orig-str)
+                      (let ([partial-doms (map (λ (dom) (dom neg-blame pos-blame src-info orig-str))
+                                               doms/c)]
+                            [partial-ranges (map (λ (rng) (rng pos-blame neg-blame src-info orig-str))
+                                                 rngs/c)])
+                        (apply func
+                               (λ (val) (check-proc val dom-length src-info pos-blame orig-str))
+                               (append partial-doms partial-ranges)))))))
      (name-prop (λ (ctc) (single-arrow-name-maker 
                           (->-doms ctc)
                           (->-dom-rest ctc)
@@ -294,44 +279,30 @@
     ;;              syntax
     ;;           -> (syntax -> syntax)
     (define (make-/proc method-proc? /h stx)
-      (let-values ([(arguments-check build-pos-proj build-neg-proj 
-                                     check-val first-order-check
-                                     pos-wrapper neg-wrapper)
+      (let-values ([(arguments-check build-proj check-val first-order-check wrapper)
                     (/h method-proc? stx)])
-        (let ([outer-args (syntax (val blame src-info orig-str name-id))])
+        (let ([outer-args (syntax (val pos-blame neg-blame src-info orig-str name-id))])
           (with-syntax ([inner-check (check-val outer-args)]
-                        [(val blame src-info orig-str name-id) outer-args]
-                        [(pos-val-args pos-body) (pos-wrapper outer-args)]
-                        [(neg-val-args neg-body) (neg-wrapper outer-args)])
-            (with-syntax ([inner-pos-lambda
+                        [(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                        [(val-args body) (wrapper outer-args)])
+            (with-syntax ([inner-lambda
                            (set-inferred-name-from
                             stx
-                            (syntax/loc stx (lambda pos-val-args pos-body)))]
-                          [inner-neg-lambda
-                           (set-inferred-name-from
-                            stx
-                            (syntax/loc stx (lambda neg-val-args neg-body)))])
-              (let ([inner-pos-lambda-w/err-check
+                            (syntax/loc stx (lambda val-args body)))])
+              (let ([inner-lambda
                      (syntax
                       (lambda (val)
                         inner-check
-                        inner-pos-lambda))]
-                    [inner-neg-lambda
-                     (syntax
-                      (lambda (val)
-                        inner-neg-lambda))])
-                (with-syntax ([pos-proj-code (build-pos-proj outer-args inner-pos-lambda-w/err-check)]
-                              [neg-proj-code (build-neg-proj outer-args inner-neg-lambda)]
+                        inner-lambda))])
+                (with-syntax ([proj-code (build-proj outer-args inner-lambda)]
                               [first-order-check first-order-check])
                   (arguments-check
                    outer-args
                    (syntax/loc stx
-                     (make-pair-proj-contract
+                     (make-proj-contract
                       name-id
-                      (lambda (blame src-info orig-str)
-                        pos-proj-code)
-                      (lambda (blame src-info orig-str)
-                        neg-proj-code)
+                      (lambda (pos-blame neg-blame src-info orig-str)
+                        proj-code)
                       first-order-check))))))))))
     
     (define (make-case->/proc method-proc? stx inferred-name-stx)
@@ -344,41 +315,30 @@
         [(_ case) (syntax case)]
         
         [(_ cases ...)
-         (let-values ([(arguments-check build-pos-projs build-neg-projs
-                                        check-val first-order-check
-                                        pos-wrapper neg-wrapper) 
+         (let-values ([(arguments-check build-projs check-val first-order-check wrapper) 
                        (case->/h method-proc? stx (syntax->list (syntax (cases ...))))])
-           (let ([outer-args (syntax (val blame src-info orig-str name-id))])
+           (let ([outer-args (syntax (val pos-blame neg-blame src-info orig-str name-id))])
              (with-syntax ([(inner-check ...) (check-val outer-args)]
-                           [(val blame src-info orig-str name-id) outer-args]
-                           [(pos-body ...) (pos-wrapper outer-args)]
-                           [(neg-body ...) (neg-wrapper outer-args)])
-               (with-syntax ([inner-pos-lambda 
+                           [(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                           [(body ...) (wrapper outer-args)])
+               (with-syntax ([inner-lambda 
                               (set-inferred-name-from
                                inferred-name-stx
-                               (syntax/loc stx (case-lambda pos-body ...)))]
-                             [inner-neg-lambda 
-                              (set-inferred-name-from
-                               inferred-name-stx
-                               (syntax/loc stx (case-lambda neg-body ...)))])
-                 (let ([inner-pos-lambda-w/err-check
+                               (syntax/loc stx (case-lambda body ...)))])
+                 (let ([inner-lambda
                         (syntax
                          (lambda (val)
                            inner-check ...
-                           inner-pos-lambda))]
-                       [inner-neg-lambda (syntax (lambda (val) inner-neg-lambda))])
-                   (with-syntax ([pos-proj-code (build-pos-projs outer-args inner-pos-lambda-w/err-check)]
-                                 [neg-proj-code (build-neg-projs outer-args inner-neg-lambda)]
+                           inner-lambda))])
+                   (with-syntax ([proj-code (build-projs outer-args inner-lambda)]
                                  [first-order-check first-order-check])
                      (arguments-check
                       outer-args
                       (syntax/loc stx
-                        (make-pair-proj-contract
+                        (make-proj-contract
                          (apply build-compound-type-name 'case-> name-id)
-                         (lambda (blame src-info orig-str)
-                           pos-proj-code)
-                         (lambda (blame src-info orig-str)
-                           neg-proj-code)
+                         (lambda (pos-blame neg-blame src-info orig-str)
+                           proj-code)
                          first-order-check)))))))))]))
     
     (define (make-opt->/proc method-proc? stx)
@@ -525,40 +485,33 @@
           [(null? cases) 
            (values 
             (lambda (outer-args body)
-              (with-syntax ([(val blame src-info orig-str name-id) outer-args]
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
                             [body body]
                             [(name-ids ...) (reverse name-ids)])
                 (syntax
                  (let ([name-id (list name-ids ...)])
                    body))))
             (lambda (x y) y)
-            (lambda (x y) y)
             (lambda (args) (syntax ()))
             (syntax (lambda (x) #t))
-            (lambda (args) (syntax ()))
             (lambda (args) (syntax ())))]
           [else
            (let ([/h (select/h (car cases) 'case-> orig-stx)]
                  [new-id (car (generate-temporaries (syntax (case->name-id))))])
-             (let-values ([(arguments-checks build-pos-projs build-neg-projs
-                                             check-vals first-order-checks
-                                             pos-wrappers neg-wrappers)
+             (let-values ([(arguments-checks build-projs check-vals first-order-checks wrappers)
                            (loop (cdr cases) (cons new-id name-ids))]
-                          [(arguments-check build-pos-proj build-neg-proj 
-                                            check-val first-order-check 
-                                            pos-wrapper neg-wrapper)
+                          [(arguments-check build-proj check-val first-order-check wrapper)
                            (/h method-proc? (car cases))])
                (values
                 (lambda (outer-args x) 
-                  (with-syntax ([(val blame src-info orig-str name-id) outer-args]
+                  (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
                                 [new-id new-id])
                     (arguments-check 
-                     (syntax (val blame src-info orig-str new-id)) 
+                     (syntax (val pos-blame neg-blame src-info orig-str new-id)) 
                      (arguments-checks 
                       outer-args
                       x))))
-                (lambda (args inner) (build-pos-projs args (build-pos-proj args inner)))
-                (lambda (args inner) (build-neg-projs args (build-neg-proj args inner)))
+                (lambda (args inner) (build-projs args (build-proj args inner)))
                 (lambda (args)
                   (with-syntax ([checks (check-vals args)]
                                 [check (check-val args)])
@@ -567,12 +520,8 @@
                               [check first-order-check])
                   (syntax (lambda (x) (and (checks x) (check x)))))
                 (lambda (args)
-                  (with-syntax ([case (pos-wrapper args)]
-                                [cases (pos-wrappers args)])
-                    (syntax (case . cases))))
-                (lambda (args)
-                  (with-syntax ([case (neg-wrapper args)]
-                                [cases (neg-wrappers args)])
+                  (with-syntax ([case (wrapper args)]
+                                [cases (wrappers args)])
                     (syntax (case . cases)))))))])))
     
     (define (object-contract/proc stx)
@@ -842,56 +791,50 @@
            (with-syntax ([(method-ctc-stx ...) (map mtd-ctc-stx mtds)]
                          [(method-name ...) (map mtd-name mtds)]
                          [(method-ctc-var ...) (generate-temporaries mtds)]
-                         [(method-pos-var ...) (generate-temporaries mtds)]
-                         [(method-neg-var ...) (generate-temporaries mtds)]
+                         [(method-var ...) (generate-temporaries mtds)]
                          [(method/app-var ...) (generate-temporaries mtds)]
                          [(methods ...) (build-methods-stx mtds)]
                          
                          [(field-ctc-stx ...) (map fld-ctc-stx flds)]
                          [(field-name ...) (map fld-name flds)]
                          [(field-ctc-var ...) (generate-temporaries flds)]
-                         [(field-pos-var ...) (generate-temporaries flds)]
-                         [(field-neg-var ...) (generate-temporaries flds)]
+                         [(field-var ...) (generate-temporaries flds)]
                          [(field/app-var ...) (generate-temporaries flds)])
              (syntax
               (let ([method-ctc-var method-ctc-stx] 
                     ...
                     [field-ctc-var (coerce-contract 'object-contract field-ctc-stx)]
                     ...)
-                (let ([method-pos-var (contract-pos-proc method-ctc-var)] 
+                (let ([method-var (contract-proc method-ctc-var)] 
                       ...
-                      [method-neg-var (contract-neg-proc method-ctc-var)] 
-                      ...
-                      [field-pos-var (contract-pos-proc field-ctc-var)] 
-                      ...
-                      [field-neg-var (contract-neg-proc field-ctc-var)] 
+                      [field-var (contract-proc field-ctc-var)]
                       ...)
                   (let ([cls (make-wrapper-class 'wrapper-class 
                                                  '(method-name ...)
                                                  (list methods ...)
                                                  '(field-name ...))])
-                  (make-pair-proj-contract
+                  (make-proj-contract
                    `(object-contract 
                      ,(build-compound-type-name 'method-name method-ctc-var) ...
                      ,(build-compound-type-name 'field 'field-name field-ctc-var) ...)
-                   (lambda (blame src-info orig-str)
-                     (let ([method/app-var (method-pos-var blame src-info orig-str)] 
+                   (lambda (pos-blame neg-blame src-info orig-str)
+                     (let ([method/app-var (method-var pos-blame neg-blame src-info orig-str)] 
                            ...
-                           [field/app-var (field-pos-var blame src-info orig-str)]
+                           [field/app-var (field-var pos-blame neg-blame src-info orig-str)]
                            ...)
                        (let ([field-names-list '(field-name ...)])
                          (lambda (val)
-			   (check-object val src-info blame orig-str)
+			   (check-object val src-info pos-blame orig-str)
                            (let ([val-mtd-names
                                   (interface->method-names
                                    (object-interface
                                     val))])
                              (void)
-			     (check-method val 'method-name val-mtd-names src-info blame orig-str)
+			     (check-method val 'method-name val-mtd-names src-info pos-blame orig-str)
                              ...)
                            
                            (unless (field-bound? field-name val)
-			     (field-error val 'field-name src-info blame orig-str)) ...
+			     (field-error val 'field-name src-info pos-blame orig-str)) ...
                            
                            (let ([vtable (extract-vtable val)]
                                  [method-ht (extract-method-ht val)])
@@ -900,20 +843,6 @@
                                (method/app-var (vector-ref vtable (hash-table-get method-ht 'method-name))) ...
                                (field/app-var (get-field field-name val)) ...
                                ))))))
-                   (lambda (blame src-info orig-str)
-                     (let ([method/app-var (method-neg-var blame src-info orig-str)] 
-                           ...
-                           [field/app-var (field-neg-var blame src-info orig-str)]
-                           ...)
-                       (let ([field-names-list '(field-name ...)])
-                         (lambda (val)
-			   (let ([vtable (extract-vtable val)]
-                                 [method-ht (extract-method-ht val)])
-                             (make-object cls
-                               val
-                               (method/app-var (vector-ref vtable (hash-table-get method-ht 'method-name))) ...
-                               (field/app-var (get-field field-name val)) ...
-                               ))))))
                    #f)))))))]))
 
     ;; ensure-no-duplicates : syntax (listof syntax[identifier]) -> void
@@ -963,10 +892,8 @@
     ;;    code that binds the contract values to names and
     ;;    does error checking for the contract specs
     ;;    (were the arguments all contracts?)
-    ;;  - [build-pos-proj]
-    ;;    code that partially applies the input contracts to build the positive projection
-    ;;  - [build-neg-proj]
-    ;;    code that partially applies the input contracts to build the negative projection
+    ;;  - [build-proj]
+    ;;    code that partially applies the input contracts to build the projection
     ;;  - [check-val]
     ;;    code that does error checking on the contract'd value itself
     ;;    (is it a function of the right arity?)
@@ -996,8 +923,7 @@
       (syntax-case stx ()
         [(_) (raise-syntax-error '-> "expected at least one argument" stx)]
         [(_ dom ... rng)
-         (with-syntax ([(dom-pos-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-neg-x ...) (generate-temporaries (syntax (dom ...)))]
+         (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
@@ -1011,171 +937,125 @@
                               (syntax (dom-contract-x ...)))])
              (syntax-case* (syntax rng) (any values) module-or-top-identifier=?
                [any 
-                (let ([wrap 
-                       (lambda (outer-args)
-                         (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                           (syntax
-                            ((arg-x ...)
-                             (val (dom-projection-x arg-x) ...)))))])
-                  (values
-                   (lambda (outer-args body)
-                     (with-syntax ([body body]
-                                   [(val blame src-info orig-str name-id) outer-args])
-                       (syntax
-                        (let ([dom-contract-x (coerce-contract '-> dom)] ...)
-                          (let ([dom-pos-x (contract-pos-proc dom-contract-x)] 
-                                ...
-                                [dom-neg-x (contract-neg-proc dom-contract-x)] ...)
-                            (let ([name-id (build-compound-type-name '-> name-dom-contract-x ... 'any)])
-                              body))))))
-                   
-                   ;; pos
-                   (lambda (outer-args inner-lambda)
-                     (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                                   [inner-lambda inner-lambda])
-                       (syntax
-                        (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] ...)
-                          inner-lambda))))
-                   
-                   ;; neg
-                   (lambda (outer-args inner-lambda)
-                     (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                                   [inner-lambda inner-lambda])
-                       (syntax
-                        (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] ...)
-                          inner-lambda))))
-                   
-                   (lambda (outer-args)
-                     (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                       (syntax
-                        (check-procedure val dom-length src-info blame orig-str))))
-                   (syntax (check-procedure? dom-length))
-                   wrap
-                   wrap))]
+                (values
+                 (lambda (outer-args body)
+                   (with-syntax ([body body]
+                                 [(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                     (syntax
+                      (let ([dom-contract-x (coerce-contract '-> dom)] ...)
+                        (let ([dom-x (contract-proc dom-contract-x)] ...)
+                          (let ([name-id (build-compound-type-name '-> name-dom-contract-x ... 'any)])
+                            body))))))
+                 
+                 ;; proj
+                 (lambda (outer-args inner-lambda)
+                   (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                                 [inner-lambda inner-lambda])
+                     (syntax
+                      (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] ...)
+                        inner-lambda))))
+                 
+                 (lambda (outer-args)
+                   (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                     (syntax
+                      (check-procedure val dom-length src-info pos-blame orig-str))))
+                 (syntax (check-procedure? dom-length))
+                 (lambda (outer-args)
+                   (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                     (syntax
+                      ((arg-x ...)
+                       (val (dom-projection-x arg-x) ...))))))]
                [(values rng ...)
-                (with-syntax ([(rng-pos-x ...) (generate-temporaries (syntax (rng ...)))]
-                              [(rng-neg-x ...) (generate-temporaries (syntax (rng ...)))]
+                (with-syntax ([(rng-x ...) (generate-temporaries (syntax (rng ...)))]
                               [(rng-contract-x ...) (generate-temporaries (syntax (rng ...)))]
                               [(rng-projection-x ...) (generate-temporaries (syntax (rng ...)))]
                               [(rng-length rng-index ...) (generate-indicies (syntax (rng ...)))]
                               [(rng-ant-x ...) (generate-temporaries (syntax (rng ...)))]
                               [(res-x ...) (generate-temporaries (syntax (rng ...)))])
-                  (let ([wrap 
-                         (lambda (outer-args)
-                           (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                             (syntax
-                              ((arg-x ...)
-                               (let-values ([(res-x ...) (val (dom-projection-x arg-x) ...)])
-                                 (values (rng-projection-x
-                                          res-x)
-                                         ...))))))])
-                    (values
-                     (lambda (outer-args body)
-                       (with-syntax ([body body]
-                                     [(val blame src-info orig-str name-id) outer-args])
-                         (syntax
-                          (let ([dom-contract-x (coerce-contract '-> dom)] 
+                  (values
+                   (lambda (outer-args body)
+                     (with-syntax ([body body]
+                                   [(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                       (syntax
+                        (let ([dom-contract-x (coerce-contract '-> dom)] 
+                              ...
+                              [rng-contract-x (coerce-contract '-> rng)] ...)
+                          (let ([dom-x (contract-proc dom-contract-x)] 
                                 ...
-                                [rng-contract-x (coerce-contract '-> rng)] ...)
-                            (let ([dom-pos-x (contract-pos-proc dom-contract-x)] 
-                                  ...
-                                  [dom-neg-x (contract-neg-proc dom-contract-x)]
-                                  ...
-                                  [rng-pos-x (contract-pos-proc rng-contract-x)]
-                                  ...
-                                  [rng-neg-x (contract-neg-proc rng-contract-x)] ...)
-                              (let ([name-id 
-                                     (build-compound-type-name 
-                                      '-> 
-                                      name-dom-contract-x ...
-                                      (build-compound-type-name 'values rng-contract-x ...))])
-                                body))))))
-                     
-                     ;; pos
-                     (lambda (outer-args inner-lambda)
-                       (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                                     [inner-lambda inner-lambda])
-                         (syntax
-                          (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] 
-                                ...
-                                [rng-projection-x (rng-pos-x blame src-info orig-str)] ...)
-                            inner-lambda))))
-                     
-                     ;; neg
-                     (lambda (outer-args inner-lambda)
-                       (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                                     [inner-lambda inner-lambda])
-                         (syntax
-                          (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] 
-                                ...
-                                [rng-projection-x (rng-neg-x blame src-info orig-str)] ...)
-                            inner-lambda))))
-                     
-                     (lambda (outer-args)
-                       (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                         (syntax
-                          (check-procedure val dom-length src-info blame orig-str))))
-                     (syntax (check-procedure? dom-length))
-                     wrap
-                     wrap)))]
+                                [rng-x (contract-proc rng-contract-x)]
+                                ...)
+                            (let ([name-id 
+                                   (build-compound-type-name 
+                                    '-> 
+                                    name-dom-contract-x ...
+                                    (build-compound-type-name 'values rng-contract-x ...))])
+                              body))))))
+                   
+                   ;; proj
+                   (lambda (outer-args inner-lambda)
+                     (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                                   [inner-lambda inner-lambda])
+                       (syntax
+                        (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] 
+                              ...
+                              [rng-projection-x (rng-x pos-blame neg-blame src-info orig-str)] ...)
+                          inner-lambda))))
+                   
+                   (lambda (outer-args)
+                     (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                       (syntax
+                        (check-procedure val dom-length src-info pos-blame orig-str))))
+                   (syntax (check-procedure? dom-length))
+                   
+                   (lambda (outer-args)
+                     (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                       (syntax
+                        ((arg-x ...)
+                         (let-values ([(res-x ...) (val (dom-projection-x arg-x) ...)])
+                           (values (rng-projection-x
+                                    res-x)
+                                   ...))))))))]
                [rng
-                (with-syntax ([(rng-pos-x) (generate-temporaries (syntax (rng)))]
-                              [(rng-neg-x) (generate-temporaries (syntax (rng)))]
+                (with-syntax ([(rng-x) (generate-temporaries (syntax (rng)))]
                               [(rng-contact-x) (generate-temporaries (syntax (rng)))]
                               [(rng-projection-x) (generate-temporaries (syntax (rng)))]
                               [(rng-ant-x) (generate-temporaries (syntax (rng)))]
                               [(res-x) (generate-temporaries (syntax (rng)))])
-                  (let ([wrap 
-                         (lambda (outer-args)
-                     (with-syntax ([(val blame src-info orig-str name-id) outer-args])
+                  (values
+                   (lambda (outer-args body)
+                     (with-syntax ([body body]
+                                   [(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                       (syntax
+                        (let ([dom-contract-x (coerce-contract '-> dom)] 
+                              ...
+                              [rng-contract-x (coerce-contract '-> rng)])
+                          (let ([dom-x (contract-proc dom-contract-x)] 
+                                ...
+                                [rng-x (contract-proc rng-contract-x)])
+                            (let ([name-id (build-compound-type-name '-> name-dom-contract-x ... rng-contract-x)])
+                              body))))))
+                   
+                   ;; proj
+                   (lambda (outer-args inner-lambda)
+                     (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                                   [inner-lambda inner-lambda])
+                       (syntax
+                        (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] 
+                              ...
+                              [rng-projection-x (rng-x pos-blame neg-blame src-info orig-str)])
+                          inner-lambda))))
+                   
+                   (lambda (outer-args)
+                     (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                       (syntax
+                        (check-procedure val dom-length src-info pos-blame orig-str))))
+                   (syntax (check-procedure? dom-length))
+                   (lambda (outer-args)
+                     (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                        (syntax
                         ((arg-x ...)
                          (let ([res-x (val (dom-projection-x arg-x) ...)])
-                           (rng-projection-x res-x))))))])
-                    (values
-                     (lambda (outer-args body)
-                       (with-syntax ([body body]
-                                     [(val blame src-info orig-str name-id) outer-args])
-                         (syntax
-                          (let ([dom-contract-x (coerce-contract '-> dom)] 
-                                ...
-                                [rng-contract-x (coerce-contract '-> rng)])
-                            (let ([dom-pos-x (contract-pos-proc dom-contract-x)] 
-                                  ...
-                                  [dom-neg-x (contract-neg-proc dom-contract-x)]
-                                  ...
-                                  [rng-pos-x (contract-pos-proc rng-contract-x)]
-                                  [rng-neg-x (contract-neg-proc rng-contract-x)])
-                              (let ([name-id (build-compound-type-name '-> name-dom-contract-x ... rng-contract-x)])
-                                body))))))
-                     
-                     ;; pos
-                     (lambda (outer-args inner-lambda)
-                       (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                                     [inner-lambda inner-lambda])
-                         (syntax
-                          (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] 
-                                ...
-                                [rng-projection-x (rng-pos-x blame src-info orig-str)])
-                            inner-lambda))))
-                     
-                     ;; neg
-                     (lambda (outer-args inner-lambda)
-                       (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                                     [inner-lambda inner-lambda])
-                         (syntax
-                          (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] 
-                                ...
-                                [rng-projection-x (rng-neg-x blame src-info orig-str)])
-                            inner-lambda))))
-                     
-                     (lambda (outer-args)
-                       (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                         (syntax
-                          (check-procedure val dom-length src-info blame orig-str))))
-                     (syntax (check-procedure? dom-length))
-                     wrap
-                     wrap)))])))]))
+                           (rng-projection-x res-x))))))))])))]))
     
     ;; ->*/h : boolean stx -> (values (syntax -> syntax) (syntax syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
     (define (->*/h method-proc? stx)
@@ -1185,8 +1065,7 @@
         [(_ (dom ...) any)
          (->/h method-proc? (syntax (-> dom ... any)))]
         [(_ (dom ...) rest (rng ...))
-         (with-syntax ([(dom-neg-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-pos-x ...) (generate-temporaries (syntax (dom ...)))]
+         (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(arg-x ...) (generate-temporaries (syntax (dom ...)))]
@@ -1197,165 +1076,127 @@
                        [dom-rest-projection-x (car (generate-temporaries (list (syntax rest))))]
                        [arg-rest-x (car (generate-temporaries (list (syntax rest))))]
                        
-                       [(rng-pos-x ...) (generate-temporaries (syntax (rng ...)))]
-                       [(rng-neg-x ...) (generate-temporaries (syntax (rng ...)))]
+                       [(rng-x ...) (generate-temporaries (syntax (rng ...)))]
                        [(rng-contract-x ...) (generate-temporaries (syntax (rng ...)))]
                        [(rng-projection-x ...) (generate-temporaries (syntax (rng ...)))]
                        [(rng-length rng-index ...) (generate-indicies (syntax (rng ...)))]
                        [(rng-ant-x ...) (generate-temporaries (syntax (rng ...)))]
                        [(res-x ...) (generate-temporaries (syntax (rng ...)))]
                        [arity (length (syntax->list (syntax (dom ...))))])
-           (let ([wrap
-                  (lambda (outer-args)
-                    (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                      (syntax
-                       ((arg-x ... . arg-rest-x)
-                        (let-values ([(res-x ...)
-                                      (apply
-                                       val
-                                       (dom-projection-x arg-x)
-                                       ...
-                                       (dom-rest-projection-x arg-rest-x))])
-                          (values (rng-projection-x res-x) ...))))))])
-             (values
-              (lambda (outer-args body)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [body body]
-                              [(name-dom-contract-x ...)
-                               (if method-proc?
-                                   (cdr
-                                    (syntax->list
-                                     (syntax (dom-contract-x ...))))
-                                   (syntax (dom-contract-x ...)))])
-                  (syntax
-                   (let ([dom-contract-x (coerce-contract '->* dom)] 
+           (values
+            (lambda (outer-args body)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [body body]
+                            [(name-dom-contract-x ...)
+                             (if method-proc?
+                                 (cdr
+                                  (syntax->list
+                                   (syntax (dom-contract-x ...))))
+                                 (syntax (dom-contract-x ...)))])
+                (syntax
+                 (let ([dom-contract-x (coerce-contract '->* dom)] 
+                       ...
+                       [dom-rest-contract-x (coerce-contract '->* rest)]
+                       [rng-contract-x (coerce-contract '->* rng)] ...)
+                   (let ([dom-x (contract-proc dom-contract-x)]
                          ...
-                         [dom-rest-contract-x (coerce-contract '->* rest)]
-                         [rng-contract-x (coerce-contract '->* rng)] ...)
-                     (let ([dom-pos-x (contract-pos-proc dom-contract-x)]
-                           ...
-                           [dom-neg-x (contract-neg-proc dom-contract-x)]
-                           ...
-                           [dom-pos-rest-x (contract-pos-proc dom-rest-contract-x)]
-                           [dom-neg-rest-x (contract-neg-proc dom-rest-contract-x)]
-                           [rng-pos-x (contract-pos-proc rng-contract-x)] 
-                           ...
-                           [rng-neg-x (contract-neg-proc rng-contract-x)] 
-                           ...)
-                       (let ([name-id 
-                              (build-compound-type-name 
-                               '->*
-                               (build-compound-type-name dom-contract-x ...)
-                               dom-rest-contract-x
-                               (build-compound-type-name rng-contract-x ...))])
-                         body))))))
-              ;; pos
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] 
-                         ...
-                         [dom-rest-projection-x (dom-neg-rest-x blame src-info orig-str)]
-                         [rng-projection-x (rng-pos-x blame src-info orig-str)] ...)
-                     inner-lambda))))
-              
-              ;; neg
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-pos-x blame src-info orig-str)]
-                         ...
-                         [dom-rest-projection-x (dom-pos-rest-x blame src-info orig-str)]
-                         [rng-projection-x (rng-neg-x blame src-info orig-str)] ...)
-                     inner-lambda))))
-              
-              (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                  (syntax
-                   (check-procedure/more val dom-length src-info blame orig-str))))
-              (syntax (check-procedure/more? dom-length))
-              wrap
-              wrap)))]
+                         [dom-rest-x (contract-proc dom-rest-contract-x)]
+                         [rng-x (contract-proc rng-contract-x)] 
+                         ...)
+                     (let ([name-id 
+                            (build-compound-type-name 
+                             '->*
+                             (build-compound-type-name dom-contract-x ...)
+                             dom-rest-contract-x
+                             (build-compound-type-name rng-contract-x ...))])
+                       body))))))
+            ;; proj
+            (lambda (outer-args inner-lambda)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [inner-lambda inner-lambda])
+                (syntax
+                 (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] 
+                       ...
+                       [dom-rest-projection-x (dom-rest-x neg-blame pos-blame src-info orig-str)]
+                       [rng-projection-x (rng-x pos-blame neg-blame src-info orig-str)] ...)
+                   inner-lambda))))
+            
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 (check-procedure/more val dom-length src-info pos-blame orig-str))))
+            (syntax (check-procedure/more? dom-length))
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 ((arg-x ... . arg-rest-x)
+                  (let-values ([(res-x ...)
+                                (apply
+                                 val
+                                 (dom-projection-x arg-x)
+                                 ...
+                                 (dom-rest-projection-x arg-rest-x))])
+                    (values (rng-projection-x res-x) ...))))))))]
 	[(_ (dom ...) rest any)
-         (with-syntax ([(dom-pos-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-neg-x ...) (generate-temporaries (syntax (dom ...)))]
+         (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(arg-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
                        [(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [dom-neg-rest-x (car (generate-temporaries (list (syntax rest))))]
-                       [dom-pos-rest-x (car (generate-temporaries (list (syntax rest))))]
+                       [dom-rest-x (car (generate-temporaries (list (syntax rest))))]
                        [dom-rest-contract-x (car (generate-temporaries (list (syntax rest))))]
                        [dom-projection-rest-x (car (generate-temporaries (list (syntax rest))))]
                        [arg-rest-x (car (generate-temporaries (list (syntax rest))))]
                        
                        [arity (length (syntax->list (syntax (dom ...))))])
-           (let ([wrap
-                  (lambda (outer-args)
-                    (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                      (syntax
-                       ((arg-x ... . arg-rest-x)
-                        (apply
-                         val
-                         (dom-projection-x arg-x)
+           (values
+            (lambda (outer-args body)
+              (with-syntax ([body body]
+                            [(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [(name-dom-contract-x ...)
+                             (if method-proc?
+                                 (cdr
+                                  (syntax->list
+                                   (syntax (dom-contract-x ...))))
+                                 (syntax (dom-contract-x ...)))])
+                (syntax
+                 (let ([dom-contract-x (coerce-contract '->* dom)] 
+                       ...
+                       [dom-rest-contract-x (coerce-contract '->* rest)])
+                   (let ([dom-x (contract-proc dom-contract-x)]
                          ...
-                         (dom-projection-rest-x arg-rest-x))))))])
-             (values
-              (lambda (outer-args body)
-                (with-syntax ([body body]
-                              [(val blame src-info orig-str name-id) outer-args]
-                              [(name-dom-contract-x ...)
-                               (if method-proc?
-                                   (cdr
-                                    (syntax->list
-                                     (syntax (dom-contract-x ...))))
-                                   (syntax (dom-contract-x ...)))])
-                  (syntax
-                   (let ([dom-contract-x (coerce-contract '->* dom)] 
-                         ...
-                         [dom-rest-contract-x (coerce-contract '->* rest)])
-                     (let ([dom-pos-x (contract-pos-proc dom-contract-x)]
-                           ...
-                           [dom-neg-x (contract-neg-proc dom-contract-x)]
-                           ...
-                           [dom-pos-rest-x (contract-pos-proc dom-rest-contract-x)]
-                           [dom-neg-rest-x (contract-neg-proc dom-rest-contract-x)])
-                       (let ([name-id (build-compound-type-name
-                                       '->* 
-                                       (build-compound-type-name name-dom-contract-x ...)
-                                       dom-rest-contract-x
-                                       'any)])
-                         body))))))
-              ;; pos
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] 
-                         ...
-                         [dom-projection-rest-x (dom-neg-rest-x blame src-info orig-str)])
-                     inner-lambda))))
-              
-              ;; neg
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] 
-                         ...
-                         [dom-projection-rest-x (dom-pos-rest-x blame src-info orig-str)])
-                     inner-lambda))))
-              
-              (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                  (syntax
-                   (check-procedure/more val dom-length src-info blame orig-str))))
-              (syntax (check-procedure/more? dom-length))
-              wrap
-              wrap)))]))
+                         [dom-rest-x (contract-proc dom-rest-contract-x)])
+                     (let ([name-id (build-compound-type-name
+                                     '->* 
+                                     (build-compound-type-name name-dom-contract-x ...)
+                                     dom-rest-contract-x
+                                     'any)])
+                       body))))))
+            ;; proj
+            (lambda (outer-args inner-lambda)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [inner-lambda inner-lambda])
+                (syntax
+                 (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] 
+                       ...
+                       [dom-projection-rest-x (dom-rest-x neg-blame pos-blame src-info orig-str)])
+                   inner-lambda))))
+            
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 (check-procedure/more val dom-length src-info pos-blame orig-str))))
+            (syntax (check-procedure/more? dom-length))
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 ((arg-x ... . arg-rest-x)
+                  (apply
+                   val
+                   (dom-projection-x arg-x)
+                   ...
+                   (dom-projection-rest-x arg-rest-x))))))))]))
 
     ;; ->d/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
     (define (->d/h method-proc? stx)
@@ -1363,8 +1204,7 @@
         [(_) (raise-syntax-error '->d "expected at least one argument" stx)]
         [(_ dom ... rng)
          (with-syntax ([(rng-x) (generate-temporaries (syntax (rng)))]
-                       [(dom-pos-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-neg-x ...) (generate-temporaries (syntax (dom ...)))]
+                       [(dom-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(arg-x ...) (generate-temporaries (syntax (dom ...)))]
@@ -1372,7 +1212,7 @@
            (values
             (lambda (outer-args body)
               (with-syntax ([body body]
-                            [(val blame src-info orig-str name-id) outer-args]
+                            [(val pos-blame neg-blame src-info orig-str name-id) outer-args]
                             [(name-dom-contract-x ...)
                              (if method-proc?
                                  (cdr
@@ -1381,59 +1221,37 @@
                                  (syntax (dom-contract-x ...)))])
                 (syntax
                  (let ([dom-contract-x (coerce-contract '->d dom)] ...)
-                   (let ([dom-pos-x (contract-pos-proc dom-contract-x)] 
+                   (let ([dom-x (contract-proc dom-contract-x)] 
                          ...
-                         [dom-neg-x (contract-neg-proc dom-contract-x)] ...
                          [rng-x rng])
 		     (check-rng-procedure '->d rng-x arity)
                      (let ([name-id (build-compound-type-name '->d name-dom-contract-x ... '(... ...))])
                        body))))))
             
-            ;; pos
+            ;; proj
             (lambda (outer-args inner-lambda)
-              (with-syntax ([(val blame src-info orig-str name-id) outer-args]
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
                             [inner-lambda inner-lambda])
                 (syntax
-                 (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] ...)
-                   inner-lambda))))
-            
-            ;; neg
-            (lambda (outer-args inner-lambda)
-              (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                            [inner-lambda inner-lambda])
-                (syntax
-                 (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] ...)
+                 (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] ...)
                    inner-lambda))))
             
             (lambda (outer-args)
-              (with-syntax ([(val blame src-info orig-str name-id) outer-args])
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                 (syntax
-		 (check-procedure val arity src-info blame orig-str))))
+		 (check-procedure val arity src-info pos-blame orig-str))))
             
             (syntax (check-procedure? arity))
             
-            ;; pos
             (lambda (outer-args)
-              (with-syntax ([(val blame src-info orig-str name-id) outer-args])
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                 (syntax
                  ((arg-x ...)
                   (let ([arg-x (dom-projection-x arg-x)] ...) 
                     (let ([rng-contract (rng-x arg-x ...)])
-                      (((contract-pos-proc (coerce-contract '->d rng-contract))
-                        blame
-                        src-info
-                        orig-str)
-                       (val arg-x ...))))))))
-            
-            ;; neg
-            (lambda (outer-args)
-              (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                (syntax
-                 ((arg-x ...)
-                  (let ([arg-x (dom-projection-x arg-x)] ...) 
-                    (let ([rng-contract (rng-x arg-x ...)])
-                      (((contract-neg-proc (coerce-contract '->d rng-contract))
-                        blame
+                      (((contract-proc (coerce-contract '->d rng-contract))
+                        pos-blame
+                        neg-blame
                         src-info
                         orig-str)
                        (val arg-x ...))))))))))]))
@@ -1442,181 +1260,150 @@
     (define (->d*/h method-proc? stx)
       (syntax-case stx ()
         [(_ (dom ...) rng-mk)
-         (with-syntax ([(dom-pos-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-neg-x ...) (generate-temporaries (syntax (dom ...)))]
+         (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
                        [(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(arg-x ...) (generate-temporaries (syntax (dom ...)))])
-           (let ([mk-wrap
-                  (λ (extract-proc)
-                    (with-syntax ([extract-proc extract-proc])
-                      (lambda (outer-args)
-                        (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                          (syntax
-                           ((arg-x ...)
-                            (call-with-values
-                             (lambda () (rng-mk-x arg-x ...))
-                             (lambda rng-contracts
-                               (call-with-values
-                                (lambda ()
-                                  (val (dom-projection-x arg-x) ...))
-                                (lambda results
-                                  (check-rng-lengths results rng-contracts)
-                                  (apply 
-                                   values
-                                   (map (lambda (rng-contract result)
-                                          (((extract-proc (coerce-contract '->d* rng-contract))
-                                            blame
-                                            src-info
-                                            orig-str)
-                                           result))
-                                        rng-contracts
-                                        results))))))))))))])
-             (values
-              (lambda (outer-args body)
-                (with-syntax ([body body]
-                              [(val blame src-info orig-str name-id) outer-args]
-                              [(name-dom-contract-x ...)
-                               (if method-proc?
-                                   (cdr
-                                    (syntax->list
-                                     (syntax (dom-contract-x ...))))
-                                   (syntax (dom-contract-x ...)))])
-                  (syntax
-                   (let ([dom-contract-x (coerce-contract '->d* dom)] ...)
-                     (let ([dom-pos-x (contract-pos-proc dom-contract-x)] 
-                           ...
-                           [dom-neg-x (contract-neg-proc dom-contract-x)] ...
-                           [rng-mk-x rng-mk])
-                       (check-rng-procedure '->d* rng-mk-x dom-length)
-                       (let ([name-id (build-compound-type-name
-                                       '->d* 
-                                       (build-compound-type-name name-dom-contract-x ...)
-                                       '(... ...))])
-                         body))))))
-              
-              ;; pos
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] ...)
-                     inner-lambda))))
-              
-              ;; neg
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] ...)
-                     inner-lambda))))
-              
-              (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                  (syntax
-                   (check-procedure val dom-length src-info blame orig-str))))
-              (syntax (check-procedure? dom-length))
-              (mk-wrap (syntax contract-pos-proc))
-              (mk-wrap (syntax contract-neg-proc)))))]
+           (values
+            (lambda (outer-args body)
+              (with-syntax ([body body]
+                            [(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [(name-dom-contract-x ...)
+                             (if method-proc?
+                                 (cdr
+                                  (syntax->list
+                                   (syntax (dom-contract-x ...))))
+                                 (syntax (dom-contract-x ...)))])
+                (syntax
+                 (let ([dom-contract-x (coerce-contract '->d* dom)] ...)
+                   (let ([dom-x (contract-proc dom-contract-x)] 
+                         ...
+                         [rng-mk-x rng-mk])
+                     (check-rng-procedure '->d* rng-mk-x dom-length)
+                     (let ([name-id (build-compound-type-name
+                                     '->d* 
+                                     (build-compound-type-name name-dom-contract-x ...)
+                                     '(... ...))])
+                       body))))))
+            
+            ;; proj
+            (lambda (outer-args inner-lambda)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [inner-lambda inner-lambda])
+                (syntax
+                 (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] ...)
+                   inner-lambda))))
+            
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 (check-procedure val dom-length src-info pos-blame orig-str))))
+            (syntax (check-procedure? dom-length))
+            
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 ((arg-x ...)
+                  (call-with-values
+                   (lambda () (rng-mk-x arg-x ...))
+                   (lambda rng-contracts
+                     (call-with-values
+                      (lambda ()
+                        (val (dom-projection-x arg-x) ...))
+                      (lambda results
+                        (check-rng-lengths results rng-contracts)
+                        (apply 
+                         values
+                         (map (lambda (rng-contract result)
+                                (((contract-proc (coerce-contract '->d* rng-contract))
+                                  pos-blame
+                                  neg-blame
+                                  src-info
+                                  orig-str)
+                                 result))
+                              rng-contracts
+                              results))))))))))))]
         [(_ (dom ...) rest rng-mk)
-         (with-syntax ([(dom-neg-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-pos-x ...) (generate-temporaries (syntax (dom ...)))]
+         (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
                        [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
-                       [(dom-pos-rest-x) (generate-temporaries (syntax (rest)))]
-                       [(dom-neg-rest-x) (generate-temporaries (syntax (rest)))]
+                       [(dom-rest-x) (generate-temporaries (syntax (rest)))]
                        [(dom-rest-contract-x) (generate-temporaries (syntax (rest)))]
                        [(dom-rest-projection-x) (generate-temporaries (syntax (rest)))]
                        [(arg-x ...) (generate-temporaries (syntax (dom ...)))]
                        [arity (length (syntax->list (syntax (dom ...))))])
-           (let ([mk-wrap
-                  (λ (extract-proj)
-                    (with-syntax ([extract-proj extract-proj])
-                      (lambda (outer-args)
-                        (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                          (syntax
-                           ((arg-x ... . rest-arg-x)
-                            (call-with-values
-                             (lambda ()
-                               (apply rng-mk-x arg-x ... rest-arg-x))
-                             (lambda rng-contracts
-                               (call-with-values
-                                (lambda ()
-                                  (apply 
-                                   val
-                                   (dom-projection-x arg-x)
-                                   ...
-                                   (dom-rest-projection-x rest-arg-x)))
-                                (lambda results
-                                  (check-rng-lengths results rng-contracts)
-                                  (apply 
-                                   values
-                                   (map (lambda (rng-contract result)
-                                          (((extract-proj (coerce-contract '->d* rng-contract))
-                                            blame
-                                            src-info
-                                            orig-str)
-                                           result))
-                                        rng-contracts
-                                        results))))))))))))])
-             (values
-              (lambda (outer-args body)
-                (with-syntax ([body body]
-                              [(val blame src-info orig-str name-id) outer-args]
-                              [(name-dom-contract-x ...)
-                               (if method-proc?
-                                   (cdr
-                                    (syntax->list
-                                     (syntax (dom-contract-x ...))))
-                                   (syntax (dom-contract-x ...)))])
-                  (syntax
-                   (let ([dom-contract-x (coerce-contract '->d* dom)] 
+           (values
+            (lambda (outer-args body)
+              (with-syntax ([body body]
+                            [(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [(name-dom-contract-x ...)
+                             (if method-proc?
+                                 (cdr
+                                  (syntax->list
+                                   (syntax (dom-contract-x ...))))
+                                 (syntax (dom-contract-x ...)))])
+                (syntax
+                 (let ([dom-contract-x (coerce-contract '->d* dom)] 
+                       ...
+                       [dom-rest-contract-x (coerce-contract '->d* rest)])
+                   (let ([dom-x (contract-proc dom-contract-x)] 
                          ...
-                         [dom-rest-contract-x (coerce-contract '->d* rest)])
-                     (let ([dom-pos-x (contract-pos-proc dom-contract-x)] 
-                           ...
-                           [dom-neg-x (contract-neg-proc dom-contract-x)] ...
-                           [dom-pos-rest-x (contract-pos-proc dom-rest-contract-x)]
-                           [dom-neg-rest-x (contract-neg-proc dom-rest-contract-x)]
-                           [rng-mk-x rng-mk])
-                       (check-rng-procedure/more rng-mk-x arity)
-                       (let ([name-id (build-compound-type-name 
-                                       '->d*
-                                       (build-compound-type-name name-dom-contract-x ...)
-                                       dom-rest-contract-x
-                                       '(... ...))])
-                         body))))))
-              
-              ;; pos
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-neg-x blame src-info orig-str)] 
+                         [dom-rest-x (contract-proc dom-rest-contract-x)]
+                         [rng-mk-x rng-mk])
+                     (check-rng-procedure/more rng-mk-x arity)
+                     (let ([name-id (build-compound-type-name 
+                                     '->d*
+                                     (build-compound-type-name name-dom-contract-x ...)
+                                     dom-rest-contract-x
+                                     '(... ...))])
+                       body))))))
+            
+            ;; proj
+            (lambda (outer-args inner-lambda)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [inner-lambda inner-lambda])
+                (syntax
+                 (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str)] 
+                       ...
+                       [dom-rest-projection-x (dom-rest-x neg-blame pos-blame src-info orig-str)])
+                   inner-lambda))))
+            
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 (check-procedure/more val arity src-info pos-blame orig-str))))
+            (syntax (check-procedure/more? arity))
+            
+            (lambda (outer-args)
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
+                (syntax
+                 ((arg-x ... . rest-arg-x)
+                  (call-with-values
+                   (lambda ()
+                     (apply rng-mk-x arg-x ... rest-arg-x))
+                   (lambda rng-contracts
+                     (call-with-values
+                      (lambda ()
+                        (apply 
+                         val
+                         (dom-projection-x arg-x)
                          ...
-                         [dom-rest-projection-x (dom-neg-rest-x blame src-info orig-str)])
-                     inner-lambda))))
-              
-              ;; neg
-              (lambda (outer-args inner-lambda)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
-                              [inner-lambda inner-lambda])
-                  (syntax
-                   (let ([dom-projection-x (dom-pos-x blame src-info orig-str)] 
-                         ...
-                         [dom-rest-projection-x (dom-pos-rest-x blame src-info orig-str)])
-                     inner-lambda))))
-              
-              (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                  (syntax
-                   (check-procedure/more val arity src-info blame orig-str))))
-              (syntax (check-procedure/more? arity))
-              
-              (mk-wrap (syntax contract-pos-proc))
-              (mk-wrap (syntax contract-neg-proc)))))]))
+                         (dom-rest-projection-x rest-arg-x)))
+                      (lambda results
+                        (check-rng-lengths results rng-contracts)
+                        (apply 
+                         values
+                         (map (lambda (rng-contract result)
+                                (((contract-proc (coerce-contract '->d* rng-contract))
+                                  pos-blame
+                                  neg-blame
+                                  src-info
+                                  orig-str)
+                                 result))
+                              rng-contracts
+                              results))))))))))))]))
 
     ;; ->r/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
     (define (->r/h method-proc? stx)
@@ -1666,78 +1453,30 @@
              (values
               (lambda (outer-args body)
                 (with-syntax ([body body]
-                              [(val blame src-info orig-str name-id) outer-args])
+                              [(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                   (syntax
                    (let ([name-id name-stx])
                      body))))
               (lambda (outer-args inner-lambda) inner-lambda)
-              (lambda (outer-args inner-lambda) inner-lambda)
+              
               (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
+                (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
                               [kind-of-thing (if method-proc? 'method 'procedure)])
                   (syntax
                    (begin 
-                     (check-procedure/kind val arity 'kind-of-thing src-info blame orig-str)))))
+                     (check-procedure/kind val arity 'kind-of-thing src-info pos-blame orig-str)))))
               
               (syntax (check-procedure? arity))
               
-              ;; pos
               (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                  (syntax-case* (syntax result-stuff) (any values) module-or-top-identifier=?
-                    [(any)
-                     (syntax
-                      ((x ...)
-                       (let ([dom-id ((contract-neg-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
-                             ...)
-                         (val (dom-id x) ...))))]
-                    [((values (rng-ids rng-ctc) ...) post-expr)
-                     (and (andmap identifier? (syntax->list (syntax (rng-ids ...))))
-                          (not (check-duplicate-identifier (syntax->list (syntax (rng-ids ...))))))
-                     (with-syntax ([(rng-ids-x ...) (generate-temporaries (syntax (rng-ids ...)))])
-                       (syntax
-                        ((x ...)
-                         (begin
-                           (let ([dom-id ((contract-neg-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
-                                 ...)
-                             (let-values ([(rng-ids ...) (val (dom-id x) ...)])
-                               (check-post-expr->pp/h val post-expr src-info blame orig-str)
-                               (let ([rng-ids-x ((contract-pos-proc (coerce-contract 'stx-name rng-ctc))
-                                                 blame src-info orig-str)] ...)
-                                 (values (rng-ids-x rng-ids) ...))))))))]
-                    [((values (rng-ids rng-ctc) ...) post-expr)
-                     (andmap identifier? (syntax->list (syntax (rng-ids ...))))
-                     (let ([dup (check-duplicate-identifier (syntax->list (syntax (rng-ids ...))))])
-                       (raise-syntax-error name "duplicate identifier" stx dup))]
-                    [((values (rng-ids rng-ctc) ...) post-expr)
-                     (for-each (lambda (rng-id) 
-                                 (unless (identifier? rng-id)
-                                   (raise-syntax-error name "expected identifier" stx rng-id)))
-                               (syntax->list (syntax (rng-ids ...))))]
-                    [((values . x) . junk)
-                     (raise-syntax-error name "malformed multiple values result" stx (syntax (values . x)))]
-                    [(rng res-id post-expr)
-                     (syntax
-                      ((x ...)
-                       (let ([dom-id ((contract-neg-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
-                             ...
-                             [rng-id ((contract-pos-proc (coerce-contract 'stx-name rng)) blame src-info orig-str)])
-                         (let ([res-id (rng-id (val (dom-id x) ...))])
-                           (check-post-expr->pp/h val post-expr src-info blame orig-str)
-                           res-id))))]
-                    [_ 
-                     (raise-syntax-error name "unknown result specification" stx (syntax result-stuff))])))
-              
-              ;; neg
-              (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
+                (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                   (syntax-case* (syntax result-stuff) (any values) module-or-top-identifier=?
                     [(any)
                      (syntax
                       ((x ...)
                        (begin
-                         (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
-                         (let ([dom-id ((contract-pos-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
+                         (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
+                         (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) neg-blame pos-blame src-info orig-str)]
                                ...)
                            (val (dom-id x) ...)))))]
                     [((values (rng-ids rng-ctc) ...) post-expr)
@@ -1747,12 +1486,13 @@
                        (syntax
                         ((x ...)
                          (begin
-                           (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
-                           (let ([dom-id ((contract-pos-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
+                           (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
+                           (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) neg-blame pos-blame src-info orig-str)]
                                  ...)
                              (let-values ([(rng-ids ...) (val (dom-id x) ...)])
-                               (let ([rng-ids-x ((contract-neg-proc (coerce-contract 'stx-name rng-ctc))
-                                                 blame src-info orig-str)] ...)
+                               (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
+                               (let ([rng-ids-x ((contract-proc (coerce-contract 'stx-name rng-ctc))
+                                                 pos-blame neg-blame src-info orig-str)] ...)
                                  (values (rng-ids-x rng-ids) ...))))))))]
                     [((values (rng-ids rng-ctc) ...) post-expr)
                      (andmap identifier? (syntax->list (syntax (rng-ids ...))))
@@ -1769,13 +1509,16 @@
                      (syntax
                       ((x ...)
                        (begin
-                         (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
-                         (let ([dom-id ((contract-pos-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
+                         (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
+                         (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) neg-blame pos-blame src-info orig-str)]
                                ...
-                               [rng-id ((contract-neg-proc (coerce-contract 'stx-name rng)) blame src-info orig-str)])
-                           (rng-id (val (dom-id x) ...))))))]
+                               [rng-id ((contract-proc (coerce-contract 'stx-name rng)) pos-blame neg-blame src-info orig-str)])
+                           (let ([res-id (rng-id (val (dom-id x) ...))])
+                             (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
+                             res-id)))))]
                     [_ 
                      (raise-syntax-error name "unknown result specification" stx (syntax result-stuff))]))))))]
+        
         [(_ ([x dom] ...) pre-expr . result-stuff)
          (andmap identifier? (syntax->list (syntax (x ...))))
          (raise-syntax-error 
@@ -1821,91 +1564,31 @@
              (values
               (lambda (outer-args body)
                 (with-syntax ([body body]
-                              [(val blame src-info orig-str name-id) outer-args])
+                              [(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                   (syntax
                    (let ([name-id name-stx])
                      body))))
               (lambda (outer-args inner-lambda) inner-lambda)
-              (lambda (outer-args inner-lambda) inner-lambda)
+              
               (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args]
+                (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
                               [kind-of-thing (if method-proc? 'method 'procedure)])
                   (syntax
                    (begin 
-                     (check-procedure/more/kind val arity 'kind-of-thing src-info blame orig-str)))))
+                     (check-procedure/more/kind val arity 'kind-of-thing src-info pos-blame orig-str)))))
               (syntax (check-procedure/more? arity))
               
-              ;; pos
               (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
-                  (syntax-case* (syntax result-stuff) (values any) module-or-top-identifier=?
-                    [(any)
-                     (syntax
-                      ((x ... . rest-x)
-                       (let ([dom-id ((contract-neg-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
-                             ...
-                             [rest-id ((contract-neg-proc (coerce-contract 'stx-name rest-dom)) blame src-info orig-str)])
-                         (apply val (dom-id x) ... (rest-id rest-x)))))]
-                    [(any . x)
-                     (raise-syntax-error name "cannot have anything after any" stx (syntax result-stuff))]
-                    [((values (rng-ids rng-ctc) ...) post-expr)
-                     (and (andmap identifier? (syntax->list (syntax (rng-ids ...))))
-                          (not (check-duplicate-identifier (syntax->list (syntax (rng-ids ...))))))
-                     (with-syntax ([(rng-ids-x ...) (generate-temporaries (syntax (rng-ids ...)))])
-                       (syntax
-                        ((x ... . rest-x)
-                         (let ([dom-id ((contract-neg-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
-                               ...
-                               [rest-id ((contract-neg-proc (coerce-contract 'stx-name rest-dom)) blame src-info orig-str)])
-                           (let-values ([(rng-ids ...) (apply val (dom-id x) ... (rest-id rest-x))])
-                             (check-post-expr->pp/h val post-expr src-info blame orig-str)
-                             (let ([rng-ids-x ((contract-pos-proc (coerce-contract 'stx-name rng-ctc))
-                                               blame src-info orig-str)] ...)
-                               (values (rng-ids-x rng-ids) ...)))))))]
-                    [((values (rng-ids rng-ctc) ...) . whatever)
-                     (and (andmap identifier? (syntax->list (syntax (rng-ids ...))))
-                          (not (check-duplicate-identifier (syntax->list (syntax (rng-ids ...))))))
-                     (raise-syntax-error name "expected exactly on post-expression at the end" stx)]
-                    [((values (rng-ids rng-ctc) ...) . whatever)
-                     (andmap identifier? (syntax->list (syntax (rng-ids ...))))
-                     (let ([dup (check-duplicate-identifier (syntax->list (syntax (rng-ids ...))))])
-                       (raise-syntax-error name "duplicate identifier" stx dup))]
-                    [((values (rng-ids rng-ctc) ...) . whatever)
-                     (for-each (lambda (rng-id) 
-                                 (unless (identifier? rng-id)
-                                   (raise-syntax-error name "expected identifier" stx rng-id)))
-                               (syntax->list (syntax (rng-ids ...))))]
-                    [((values . x) . whatever)
-                     (raise-syntax-error name "malformed multiple values result" stx (syntax (values . x)))]
-                    [(rng res-id post-expr)
-                     (identifier? (syntax res-id))
-                     (syntax
-                      ((x ... . rest-x)
-                       (let ([dom-id ((contract-neg-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
-                             ...
-                             [rest-id ((contract-neg-proc (coerce-contract 'stx-name rest-dom)) blame src-info orig-str)]
-                             [rng-id ((contract-pos-proc (coerce-contract 'stx-name rng)) blame src-info orig-str)])
-                         (let ([res-id (rng-id (apply val (dom-id x) ... (rest-id rest-x)))])
-                           (check-post-expr->pp/h val post-expr src-info blame orig-str)
-                           res-id))))]
-                    [(rng res-id post-expr)
-                     (not (identifier? (syntax res-id)))
-                     (raise-syntax-error name "expected an identifier" stx (syntax res-id))]
-                    [_
-                     (raise-syntax-error name "malformed result sepecification" stx (syntax result-stuff))])))
-              
-              ;; neg
-              (lambda (outer-args)
-                (with-syntax ([(val blame src-info orig-str name-id) outer-args])
+                (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                   (syntax-case* (syntax result-stuff) (values any) module-or-top-identifier=?
                     [(any)
                      (syntax
                       ((x ... . rest-x)
                        (begin
-                         (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
-                         (let ([dom-id ((contract-pos-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
+                         (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
+                         (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) neg-blame pos-blame src-info orig-str)]
                                ...
-                               [rest-id ((contract-pos-proc (coerce-contract 'stx-name rest-dom)) blame src-info orig-str)])
+                               [rest-id ((contract-proc (coerce-contract 'stx-name rest-dom)) neg-blame pos-blame src-info orig-str)])
                            (apply val (dom-id x) ... (rest-id rest-x))))))]
                     [(any . x)
                      (raise-syntax-error name "cannot have anything after any" stx (syntax result-stuff))]
@@ -1916,13 +1599,14 @@
                        (syntax
                         ((x ... . rest-x)
                          (begin
-                           (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
-                           (let ([dom-id ((contract-pos-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
+                           (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
+                           (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) neg-blame pos-blame src-info orig-str)]
                                  ...
-                                 [rest-id ((contract-pos-proc (coerce-contract 'stx-name rest-dom)) blame src-info orig-str)])
+                                 [rest-id ((contract-proc (coerce-contract 'stx-name rest-dom)) neg-blame pos-blame src-info orig-str)])
                              (let-values ([(rng-ids ...) (apply val (dom-id x) ... (rest-id rest-x))])
-                               (let ([rng-ids-x ((contract-neg-proc (coerce-contract 'stx-name rng-ctc))
-                                                 blame src-info orig-str)] ...)
+                               (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
+                               (let ([rng-ids-x ((contract-proc (coerce-contract 'stx-name rng-ctc))
+                                                 pos-blame neg-blame src-info orig-str)] ...)
                                  (values (rng-ids-x rng-ids) ...))))))))]
                     [((values (rng-ids rng-ctc) ...) . whatever)
                      (and (andmap identifier? (syntax->list (syntax (rng-ids ...))))
@@ -1944,12 +1628,14 @@
                      (syntax
                       ((x ... . rest-x)
                        (begin
-                         (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
-                         (let ([dom-id ((contract-pos-proc (coerce-contract 'stx-name dom)) blame src-info orig-str)]
+                         (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
+                         (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) neg-blame pos-blame src-info orig-str)]
                                ...
-                               [rest-id ((contract-pos-proc (coerce-contract 'stx-name rest-dom)) blame src-info orig-str)]
-                               [rng-id ((contract-neg-proc (coerce-contract 'stx-name rng)) blame src-info orig-str)])
-                           (rng-id (apply val (dom-id x) ... (rest-id rest-x)))))))]
+                               [rest-id ((contract-proc (coerce-contract 'stx-name rest-dom)) neg-blame pos-blame src-info orig-str)]
+                               [rng-id ((contract-proc (coerce-contract 'stx-name rng)) pos-blame neg-blame src-info orig-str)])
+                           (let ([res-id (rng-id (apply val (dom-id x) ... (rest-id rest-x)))])
+                             (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
+                             res-id)))))]
                     [(rng res-id post-expr)
                      (not (identifier? (syntax res-id)))
                      (raise-syntax-error name "expected an identifier" stx (syntax res-id))]
diff --git a/collects/mzlib/private/contract-ds.ss b/collects/mzlib/private/contract-ds.ss
index 853f71e883..d514e13114 100644
--- a/collects/mzlib/private/contract-ds.ss
+++ b/collects/mzlib/private/contract-ds.ss
@@ -128,15 +128,11 @@ it around flattened out.
                              (let ([ctc (if (procedure? ctc-field)
                                             (ctc-field f-xs ...)
                                             ctc-field)])
-                               (if (contract/info-pos contract/info)
-                                   ((((pos-proj-get ctc) ctc) (contract/info-pos contract/info)
-                                                              (contract/info-src-info contract/info)
-                                                              (contract/info-orig-str contract/info))
-                                    ctc-x)
-                                   ((((neg-proj-get ctc) ctc) (contract/info-neg contract/info)
-                                                              (contract/info-src-info contract/info)
-                                                              (contract/info-orig-str contract/info))
-                                    ctc-x))))] ...)
+                               ((((proj-get ctc) ctc) (contract/info-pos contract/info)
+                                                      (contract/info-neg contract/info)
+                                                      (contract/info-src-info contract/info)
+                                                      (contract/info-orig-str contract/info))
+                                ctc-x)))] ...)
                  (values f-x ...)))
              
              (define (stronger-lazy-contract? a b)
@@ -145,16 +141,16 @@ it around flattened out.
                      (contract-get a selector-indicies)
                      (contract-get b selector-indicies)) ...))
              
-             (define (lazy-contract-pos-proj ctc)
-               (λ (blame src-info orig-str)
-                 (let ([contract/info (make-contract/info ctc blame #f src-info orig-str)])
+             (define (lazy-contract-proj ctc)
+               (λ (pos-blame neg-blame src-info orig-str)
+                 (let ([contract/info (make-contract/info ctc pos-blame neg-blame src-info orig-str)])
                    (λ (val)
                      (unless (or (wrap-predicate val) 
                                  (raw-predicate val))
                        (raise-contract-error
                         val
                         src-info
-                        blame
+                        pos-blame
                         orig-str
                         "expected <~a>, got ~e" 'name val))
                      (cond
@@ -163,16 +159,6 @@ it around flattened out.
                        [else
                         (wrap-maker val contract/info)])))))
              
-             (define (lazy-contract-neg-proj ctc)
-               (λ (blame src-info orig-str)
-                 (let ([contract/info (make-contract/info ctc #f blame src-info orig-str)])
-                   (λ (val)
-                     (cond
-                       [(already-there? contract/info val lazy-depth-to-look)
-                        val]
-                       [else
-                        (wrap-maker val contract/info)])))))
-             
              (define (already-there? new-contract/info val depth)
                (cond
                  [(raw-predicate val) #f]
@@ -230,8 +216,7 @@ it around flattened out.
                                  field-count
                                  0 ;; auto-field-k
                                  '() ;; auto-field-v
-                                 (list (cons pos-proj-prop lazy-contract-pos-proj)
-                                       (cons neg-proj-prop lazy-contract-neg-proj)
+                                 (list (cons proj-prop lazy-contract-proj)
                                        (cons name-prop lazy-contract-name)
                                        (cons first-order-prop (λ (ctc) predicate))
                                        (cons stronger-prop stronger-lazy-contract?)))))))]))
diff --git a/collects/mzlib/private/contract-guts.ss b/collects/mzlib/private/contract-guts.ss
index 49caec6c48..614a67ecf0 100644
--- a/collects/mzlib/private/contract-guts.ss
+++ b/collects/mzlib/private/contract-guts.ss
@@ -25,9 +25,7 @@
            contract?
            contract-name
            contract-proc
-           contract-pos-proc
-           contract-neg-proc
-           make-pair-proj-contract
+           make-proj-contract
            build-flat-contract
            
            define-struct/prop
@@ -36,15 +34,11 @@
 
            contract-first-order-passes?
            
-           proj-pred? proj-get
-           pos-proj-prop pos-proj-pred? pos-proj-get
-           neg-proj-prop neg-proj-pred? neg-proj-get
+           proj-prop proj-pred? proj-get
            name-prop name-pred? name-get
            stronger-prop stronger-pred? stronger-get
            flat-prop flat-pred? flat-get
-           any-curried-proj
-           flat-pos-proj
-           
+           flat-proj
            first-order-prop
            first-order-get)
   
@@ -104,11 +98,6 @@
   (define-values (first-order-prop first-order-pred? first-order-get)
     (make-struct-type-property 'contract-first-order))
   
-  (define-values (pos-proj-prop pos-proj-pred? pos-proj-get) 
-    (make-struct-type-property 'contract-positive-projection))
-  (define-values (neg-proj-prop neg-proj-pred? neg-proj-get) 
-    (make-struct-type-property 'contract-negative-projection))
-  
   (define (contract-first-order-passes? c v)
     (cond
       [(first-order-pred? c) (((first-order-get c) c) v)]
@@ -124,16 +113,6 @@
     (cond
       [(proj-pred? ctc)
        (raw-proj-get ctc)]
-      [(and (neg-proj-pred? ctc)
-            (pos-proj-pred? ctc))
-       (let ([pos-abs ((pos-proj-get ctc) ctc)]
-             [neg-abs ((neg-proj-get ctc) ctc)])
-         (λ (ctc)
-           (λ (pos neg src-info str)
-             (let ([p-proj (pos-abs pos src-info str)]
-                   [n-proj (neg-abs neg src-info str)])
-               (lambda (v)
-                 (n-proj (p-proj v)))))))]
       [else (error 'proj-get "unknown ~e" ctc)]))
   
   ;; contract-stronger? : contract contract -> boolean
@@ -281,10 +260,10 @@
   ;; (the result function is the projection)
   ;;  
   
-  (define (flat-pos-proj ctc)
+  (define (flat-proj ctc)
     (let ([predicate ((flat-get ctc) ctc)]
           [name ((name-get ctc) ctc)])
-      (λ (pos src-info orig-str)
+      (λ (pos neg src-info orig-str)
         (λ (val)
           (if (predicate val)
               val
@@ -297,29 +276,26 @@
                name
                val))))))
   
-  (define (any-curried-proj ctc) any-curred-proj2)
-  (define (any-curred-proj2 pos src-info orig-str) values)
+  (define (double-any-curried-proj ctc) double-any-curred-proj2)
+  (define (double-any-curred-proj2 pos-blame neg-blame src-info orig-str) values)
+
   
   (define-values (make-flat-contract
-                  make-pair-proj-contract)
+                  make-proj-contract)
     (let ()
-      (define-struct/prop pair-proj-contract (the-name pos-proc neg-proc first-order-proc)
-        ((pos-proj-prop (λ (ctc) (pair-proj-contract-pos-proc ctc)))
-         (neg-proj-prop (λ (ctc) (pair-proj-contract-neg-proc ctc)))
-         (name-prop (λ (ctc) (pair-proj-contract-the-name ctc)))
-         (first-order-prop (λ (ctc) (or (pair-proj-contract-first-order-proc ctc)
+      (define-struct/prop proj-contract (the-name proj first-order-proc)
+        ((proj-prop (λ (ctc) (proj-contract-proj ctc)))
+         (name-prop (λ (ctc) (proj-contract-the-name ctc)))
+         (first-order-prop (λ (ctc) (or (proj-contract-first-order-proc ctc)
                                         (λ (x) #t))))
          (stronger-prop (λ (this that) 
-                          (and (pair-proj-contract? that)
+                          (and (proj-contract? that)
                                (procedure-closure-contents-eq?
-                                (pair-proj-contract-pos-proc this)
-                                (pair-proj-contract-pos-proc that))
-                               (procedure-closure-contents-eq?
-                                (pair-proj-contract-neg-proc that)
-                                (pair-proj-contract-neg-proc this)))))))
+                                (proj-contract-proj this)
+                                (proj-contract-proj that)))))))
+      
       (define-struct/prop flat-contract (the-name predicate)
-        ((pos-proj-prop flat-pos-proj)
-         (neg-proj-prop any-curried-proj)
+        ((proj-prop flat-proj)
          (stronger-prop (λ (this that) 
                           (and (flat-contract? that)
                                (procedure-closure-contents-eq? (flat-contract-predicate this)
@@ -327,7 +303,7 @@
          (name-prop (λ (ctc) (flat-contract-the-name ctc)))
          (flat-prop (λ (ctc) (flat-contract-predicate ctc)))))
       (values make-flat-contract
-              make-pair-proj-contract)))
+              make-proj-contract)))
   
   (define (flat-contract-predicate x) 
     (unless (flat-contract? x)
@@ -335,10 +311,8 @@
     ((flat-get x) x))
   (define (flat-contract? x) (flat-pred? x))
   (define (contract-name ctc) ((name-get ctc) ctc))
-  (define (contract? x) (or (proj-pred? x) (pos-proj-pred? x)))
+  (define (contract? x) (proj-pred? x))
   (define (contract-proc ctc) ((proj-get ctc) ctc))
-  (define (contract-pos-proc ctc) ((pos-proj-get ctc) ctc))
-  (define (contract-neg-proc ctc) ((neg-proj-get ctc) ctc))
   
   (define (flat-contract predicate)
     (unless (and (procedure? predicate)
@@ -374,22 +348,21 @@
                      `(,mk-sub-name ,@(loop (cdr subs))))]
                   [else `(,sub ,@(loop (cdr subs)))]))])))
 
-  (define (make-and-proj proj-get)
-    (λ (ctc)
-      (let ([mk-pos-projs (map (λ (x) ((proj-get x) x)) (and/c-ctcs ctc))])
-        (lambda (pos src-info orig-str)
-          (let ([projs (map (λ (c) (c pos src-info orig-str)) mk-pos-projs)])
-            (let loop ([projs (cdr projs)]
-                       [proj (car projs)])
-              (cond
-                [(null? projs) proj]
-                [else (loop (cdr projs)
-                            (let ([f (car projs)])
-                              (λ (v) (proj (f v)))))])))))))
+  (define (and-proj ctc)
+    (let ([mk-pos-projs (map (λ (x) ((proj-get x) x)) (and/c-ctcs ctc))])
+      (lambda (pos neg src-info orig-str)
+        (let ([projs (map (λ (c) (c pos neg src-info orig-str)) mk-pos-projs)])
+          (let loop ([projs (cdr projs)]
+                     [proj (car projs)])
+            (cond
+              [(null? projs) proj]
+              [else (loop (cdr projs)
+                          (let ([f (car projs)])
+                            (λ (v) (proj (f v)))))]))))))
+  
   
   (define-struct/prop and/c (ctcs)
-    ((pos-proj-prop (make-and-proj pos-proj-get))
-     (neg-proj-prop (make-and-proj neg-proj-get))
+    ((proj-prop and-proj)
      (name-prop (λ (ctc) (apply build-compound-type-name 'and/c (and/c-ctcs ctc))))
      (first-order-prop (λ (ctc)
                          (let ([tests (map (λ (x) ((first-order-get x) x)) (and/c-ctcs ctc))])
@@ -438,8 +411,7 @@
          (make-and/c contracts))]))
   
   (define-struct/prop any/c ()
-    ((pos-proj-prop any-curried-proj)
-     (neg-proj-prop any-curried-proj)
+    ((proj-prop double-any-curried-proj)
      (stronger-prop (λ (this that) (any/c? that)))
      (name-prop (λ (ctc) 'any/c))
      (first-order-prop (λ (ctc) (λ (val) #t)))
@@ -448,20 +420,19 @@
   (define any/c (make-any/c))
   
   (define (none-curried-proj ctc)
-    (λ (pos src-info orig-str) 
+    (λ (pos-blame neg-blame src-info orig-str) 
       (λ (val) 
         (raise-contract-error
          val
          src-info
-         pos
+         pos-blame
          orig-str
          "~s accepts no values, given: ~e"
          (none/c-name ctc)
          val))))
 
   (define-struct/prop none/c (name)
-    ((pos-proj-prop none-curried-proj)
-     (neg-proj-prop none-curried-proj)
+    ((proj-prop none-curried-proj)
      (stronger-prop (λ (this that) #t))
      (name-prop (λ (ctc) (none/c-name ctc)))
      (first-order-prop (λ (ctc) (λ (val) #f)))
diff --git a/collects/mzlib/private/contract.ss b/collects/mzlib/private/contract.ss
index 66c0375148..c0c9c5c552 100644
--- a/collects/mzlib/private/contract.ss
+++ b/collects/mzlib/private/contract.ss
@@ -10,8 +10,6 @@ add struct contracts for immutable structs?
 (module contract mzscheme
   
   (provide (rename -contract contract)
-           (rename -contract/pos contract/pos)
-           (rename -contract/neg contract/neg)
            recursive-contract
            provide/contract
            define/contract)
@@ -591,11 +589,12 @@ add struct contracts for immutable structs?
                               (begin
                                 (provide (rename id-rename external-name))
                                 
-                                ;; unbound id check
-                                (if #f id)
-                                
                                 (define pos-module-source (module-source-as-symbol #'pos-stx))
                                 (define contract-id ctrct)
+                                
+                                (if #f id)
+                                ;(check-first-order contract-id id #'pos-stx) ;; we'd like to use this ...
+                                
                                 (define-syntax id-rename
 				  (make-provide/contract-transformer (quote-syntax contract-id)
 								     (quote-syntax id)
@@ -607,6 +606,10 @@ add struct contracts for immutable structs?
             (begin
               bodies ...))))]))
   
+  (define (check-first-order ctc val src-info) 
+    (-contract ctc val (module-source-as-symbol src-info) 'ignored src-info)
+    (void))
+  
   (define (test-proc/flat-contract f x)
     (if (flat-contract? f)
         ((flat-contract-predicate f) x)
@@ -661,67 +664,15 @@ add struct contracts for immutable structs?
       (((contract-proc a-contract) pos-blame neg-blame src-info (contract-name a-contract))
        name)))
   
-  (define-syntax (-contract/pos stx)
-    (syntax-case stx ()
-      [(_ a-contract to-check blame-e)
-       (with-syntax ([src-loc (syntax/loc stx here)])
-         (syntax/loc stx
-           (contract/one/proc contract-pos-proc a-contract to-check blame-e (quote-syntax src-loc))))]
-      [(_ a-contract-e to-check blame-e src-info-e)
-       (syntax/loc stx
-         (contract/one/proc contract-pos-proc a-contract-e to-check blame-e src-info-e))]))
-  
-  (define-syntax (-contract/neg stx)
-    (syntax-case stx ()
-      [(_ a-contract to-check blame-e)
-       (with-syntax ([src-loc (syntax/loc stx here)])
-         (syntax/loc stx
-           (contract/one/proc contract-neg-proc a-contract to-check blame-e (quote-syntax src-loc))))]
-      [(_ a-contract-e to-check blame-e src-info-e)
-       (syntax/loc stx
-         (contract/one/proc contract-neg-proc a-contract-e to-check blame-e src-info-e))]))
-  
-  (define (contract/one/proc contract-to-proc a-contract-raw name blame src-info)
-    (unless (or (contract? a-contract-raw)
-                (and (procedure? a-contract-raw)
-                     (procedure-arity-includes? a-contract-raw 1)))
-      (error 'contract/pos "expected a contract or a procedure of arity 1 as first argument, given: ~e, other args ~e ~e ~e" 
-             a-contract-raw
-             name
-             blame
-             src-info))
-    (let ([a-contract (if (contract? a-contract-raw)
-                          a-contract-raw
-                          (flat-contract a-contract-raw))])
-      (unless (symbol? blame)
-        (error 'contract
-               "expected symbol as name for assigning blame, given: ~e, other args ~e ~e ~e"
-               blame
-               a-contract-raw 
-               name
-               src-info))
-      (unless (syntax? src-info)
-        (error 'contract "expected syntax as last argument, given: ~e, other args ~e ~e ~e"
-               src-info
-               blame
-               a-contract-raw
-               name))
-      (((contract-to-proc a-contract) blame src-info (contract-name a-contract))
-       name)))
-    
   (define-syntax (recursive-contract stx)
     (syntax-case stx ()
       [(_ arg)
-       (syntax (make-pair-proj-contract 
+       (syntax (make-proj-contract 
                 '(recursive-contract arg) 
-                (λ (blame src str)
-                  (let ([proc (contract-pos-proc arg)])
+                (λ (pos-blame neg-blame src str)
+                  (let ([proc (contract-proc arg)])
                     (λ (val)
-                      ((proc blame src str) val))))
-                (λ (blame src str)
-                  (let ([proc (contract-neg-proc arg)])
-                    (λ (val)
-                      ((proc blame src str) val))))
+                      ((proc pos-blame neg-blame src str) val))))
                 #f))]))
   
   (define (check-contract ctc)
@@ -879,31 +830,18 @@ add struct contracts for immutable structs?
               (make-multi-or/c flat-contracts ho-contracts)])))]))
 
   (define-struct/prop or/c (flat-ctcs ho-ctc)
-    ((pos-proj-prop (λ (ctc)
-                      (let ([c-proc ((pos-proj-get (or/c-ho-ctc ctc)) (or/c-ho-ctc ctc))]
-                            [predicates (map (λ (x) ((flat-get x) x))
-                                             (or/c-flat-ctcs ctc))])
-                        (λ (pos src-info orig-str)
-                          (let ([partial-contract (c-proc pos src-info orig-str)])
-                            (λ (val)
-                              (cond
-                                [(ormap (λ (pred) (pred val)) predicates)
-                                 val]
-                                [else
-                                 (partial-contract val)])))))))
-     (neg-proj-prop 
-      (λ (ctc)
-        (let ([c-proc ((neg-proj-get (or/c-ho-ctc ctc)) (or/c-ho-ctc ctc))]
-              [predicates (map (λ (x) ((flat-get x) x))
-                               (or/c-flat-ctcs ctc))])
-          (λ (pos src-info orig-str)
-            (let ([partial-contract (c-proc pos src-info orig-str)])
-              (λ (val)
-                (cond
-                  [(ormap (λ (pred) (pred val)) predicates)
-                   val]
-                  [else
-                   (partial-contract val)])))))))
+    ((proj-prop (λ (ctc)
+                  (let ([c-proc ((proj-get (or/c-ho-ctc ctc)) (or/c-ho-ctc ctc))]
+                        [predicates (map (λ (x) ((flat-get x) x))
+                                         (or/c-flat-ctcs ctc))])
+                    (λ (pos-blame neg-blame src-info orig-str)
+                      (let ([partial-contract (c-proc pos-blame neg-blame src-info orig-str)])
+                        (λ (val)
+                          (cond
+                            [(ormap (λ (pred) (pred val)) predicates)
+                             val]
+                            [else
+                             (partial-contract val)])))))))
      
      (name-prop (λ (ctc)
                   (apply build-compound-type-name 
@@ -972,9 +910,50 @@ add struct contracts for immutable structs?
                             candidate-proc
                             candidate-contract)]))])))))))
   
+  (define (multi-or/c-proj ctc)
+    (let* ([ho-contracts (multi-or/c-ho-ctcs ctc)]
+           [c-procs (map (λ (x) ((proj-get x) x)) ho-contracts)]
+           [first-order-checks (map (λ (x) ((first-order-get x) x)) ho-contracts)]
+           [predicates (map (λ (x) ((flat-get x) x))
+                            (multi-or/c-flat-ctcs ctc))])
+      (λ (pos-blame neg-blame src-info orig-str)
+        (let ([partial-contracts (map (λ (c-proc) (c-proc pos-blame neg-blame src-info orig-str)) c-procs)])
+          (λ (val)
+            (cond
+              [(ormap (λ (pred) (pred val)) predicates)
+               val]
+              [else
+               (let loop ([checks first-order-checks]
+                          [procs partial-contracts]
+                          [contracts ho-contracts]
+                          [candidate-proc #f]
+                          [candidate-contract #f])
+                 (cond
+                   [(null? checks)
+                    (if candidate-proc
+                        (candidate-proc val)
+                        (raise-contract-error val src-info pos-blame orig-str 
+                                              "none of the branches of the or/c matched"))]
+                   [((car checks) val)
+                    (if candidate-proc
+                        (error 'or/c "two arguments, ~s and ~s, might both match ~s"
+                               (contract-name candidate-contract)
+                               (contract-name (car contracts))
+                               val)
+                        (loop (cdr checks)
+                              (cdr procs)
+                              (cdr contracts)
+                              (car procs)
+                              (car contracts)))]
+                   [else
+                    (loop (cdr checks)
+                          (cdr procs)
+                          (cdr contracts)
+                          candidate-proc
+                          candidate-contract)]))]))))))
+  
   (define-struct/prop multi-or/c (flat-ctcs ho-ctcs)
-    ((pos-proj-prop (make-multi-or/c-proj pos-proj-get))
-     (neg-proj-prop (make-multi-or/c-proj neg-proj-get))
+    ((proj-prop multi-or/c-proj)
      (name-prop (λ (ctc)
                   (apply build-compound-type-name 
                          'or/c 
@@ -1006,8 +985,7 @@ add struct contracts for immutable structs?
                             that-ctcs))))))))
   
   (define-struct/prop flat-or/c (flat-ctcs)
-    ((pos-proj-prop flat-pos-proj)
-     (neg-proj-prop any-curried-proj)
+    ((proj-prop flat-proj)
      (name-prop (λ (ctc)
                   (apply build-compound-type-name 
                          'or/c 
@@ -1063,8 +1041,7 @@ add struct contracts for immutable structs?
     (make-one-of/c elems))
   
   (define-struct/prop one-of/c (elems)
-    ((pos-proj-prop flat-pos-proj)
-     (neg-proj-prop any-curried-proj)
+    ((proj-prop flat-proj)
      (name-prop (λ (ctc) 
                   (let ([elems (one-of/c-elems ctc)])
                     `(,(cond
@@ -1109,8 +1086,7 @@ add struct contracts for immutable structs?
 		  (printable? (unbox x))))))))
   
   (define-struct/prop between/c (low high)
-    ((pos-proj-prop flat-pos-proj)
-     (neg-proj-prop any-curried-proj)
+    ((proj-prop flat-proj)
      (name-prop (λ (ctc) 
                   (let ([n (between/c-low ctc)]
                         [m (between/c-high ctc)])
@@ -1210,27 +1186,22 @@ add struct contracts for immutable structs?
         (let ([fill-name fill])
           (λ (input)
             (let* ([ctc (coerce-contract 'name input)]
-                   [p-proj (contract-pos-proc ctc)]
-                   [n-proj (contract-neg-proc ctc)])
-              (make-pair-proj-contract
+                   [proj (contract-proc ctc)])
+              (make-proj-contract
                (build-compound-type-name 'name ctc)
-               (λ (blame src-info orig-str)
-                 (let ([p-app (p-proj blame src-info orig-str)])
+               (λ (pos-blame neg-blame src-info orig-str)
+                 (let ([p-app (proj pos-blame neg-blame src-info orig-str)])
                    (λ (val)
                      (unless (predicate? val)
                        (raise-contract-error
                         val
                         src-info
-                        blame
+                        pos-blame
                         orig-str
                         "expected <~a>, given: ~e"
                         'type-name
                         val))
                      (fill-name p-app val))))
-               (λ (blame src-info orig-str)
-                 (let ([n-app (n-proj blame src-info orig-str)])
-                   (λ (val)
-                     (fill-name n-app val))))
                predicate?)))))]))
   
   (define (map-immutable f lst)
@@ -1316,8 +1287,7 @@ add struct contracts for immutable structs?
        (with-syntax ([(params ...) (generate-temporaries (syntax (selectors ...)))]
                      [(p-apps ...) (generate-temporaries (syntax (selectors ...)))]
                      [(ctc-x ...) (generate-temporaries (syntax (selectors ...)))]
-                     [(pos-procs ...) (generate-temporaries (syntax (selectors ...)))]
-                     [(neg-procs ...) (generate-temporaries (syntax (selectors ...)))]
+                     [(procs ...) (generate-temporaries (syntax (selectors ...)))]
                      [(selector-names ...) (generate-temporaries (syntax (selectors ...)))])
          (syntax
           (let ([predicate?-name predicate?]
@@ -1325,13 +1295,11 @@ add struct contracts for immutable structs?
                 [selector-names selectors] ...)
             (λ (params ...)
               (let ([ctc-x (coerce-contract 'name params)] ...)
-                (let ([pos-procs (contract-pos-proc ctc-x)]
-                      ...
-                      [neg-procs (contract-neg-proc ctc-x)] ...)
-                  (make-pair-proj-contract
+                (let ([procs (contract-proc ctc-x)] ...)
+                  (make-proj-contract
                    (build-compound-type-name 'name (proc/ctc->ctc params) ...)
-                   (λ (blame src-info orig-str)
-                     (let ([p-apps (pos-procs blame src-info orig-str)] ...)
+                   (λ (pos-blame neg-blame src-info orig-str)
+                     (let ([p-apps (procs pos-blame neg-blame src-info orig-str)] ...)
                        (λ (v)
                          (if (and (immutable? v)
                                   (predicate?-name v))
@@ -1339,15 +1307,11 @@ add struct contracts for immutable structs?
                              (raise-contract-error
                               v
                               src-info
-                              blame
+                              pos-blame
                               orig-str
                               "expected <~a>, given: ~e"
                               'type-name
                               v)))))
-                   (λ (blame src-info orig-str)
-                     (let ([p-apps (neg-procs blame src-info orig-str)] ...)
-                       (λ (v)
-                         (constructor-name (p-apps (selector-names v)) ...))))
                    #f)))))))]
       [(_ predicate? constructor (arb? selector) correct-size type-name name)
        (eq? #t (syntax-object->datum (syntax arb?)))
@@ -1357,12 +1321,11 @@ add struct contracts for immutable structs?
               [selector-name selector])
           (λ params
             (let ([ctcs (map (λ (param) (coerce-contract 'name param)) params)])
-              (let ([pos-procs (map contract-pos-proc ctcs)]
-                    [neg-procs (map contract-neg-proc ctcs)])
-                (make-pair-proj-contract
+              (let ([procs (map contract-proc ctcs)])
+                (make-proj-contract
                  (apply build-compound-type-name 'name (map proc/ctc->ctc params))
-                 (λ (blame src-info orig-str)
-                   (let ([p-apps (map (λ (proc) (proc blame src-info orig-str)) pos-procs)]
+                 (λ (pos-blame neg-blame src-info orig-str)
+                   (let ([p-apps (map (λ (proc) (proc pos-blame neg-blame src-info orig-str)) procs)]
                          [count (length params)])
                      (λ (v)
                        (if (and (immutable? v)
@@ -1379,22 +1342,11 @@ add struct contracts for immutable structs?
                            (raise-contract-error
                             v
                             src-info
-                            blame
+                            pos-blame
                             orig-str
                             "expected <~a>, given: ~e"
                             'type-name
                             v)))))
-                 (λ (blame src-info orig-str)
-                   (let ([p-apps (map (λ (proc) (proc blame src-info orig-str)) neg-procs)])
-                     (λ (v)
-                       (apply constructor-name 
-                              (let loop ([p-apps p-apps]
-                                         [i 0])
-                                (cond
-                                  [(null? p-apps) null]
-                                  [else (let ([p-app (car p-apps)])
-                                          (cons (p-app (selector-name v i))
-                                                (loop (cdr p-apps) (+ i 1))))]))))))
                  #f))))))]))
   
   (define cons-immutable/c (*-immutable/c pair? cons-immutable (#f car cdr) immutable-cons cons-immutable/c))
@@ -1451,27 +1403,22 @@ add struct contracts for immutable structs?
   (define promise/c
     (λ (ctc-in)
       (let* ([ctc (coerce-contract 'promise/c ctc-in)]
-             [pos-ctc-proc (contract-pos-proc ctc)]
-             [neg-ctc-proc (contract-neg-proc ctc)])
-        (make-pair-proj-contract
+             [ctc-proc (contract-proc ctc)])
+        (make-proj-contract
          (build-compound-type-name 'promise/c ctc)
-         (λ (blame src-info orig-str)
-           (let ([p-app (pos-ctc-proc blame src-info orig-str)])
+         (λ (pos-blame neg-blame src-info orig-str)
+           (let ([p-app (ctc-proc pos-blame neg-blame src-info orig-str)])
              (λ (val)
                (unless (promise? val)
                  (raise-contract-error
                   val
                   src-info
-                  blame
+                  pos-blame
                   'ignored
                   orig-str
                   "expected <promise>, given: ~e"
                   val))
                (delay (p-app (force val))))))
-         (λ (blame src-info orig-str)
-           (let ([p-app (neg-ctc-proc blame src-info orig-str)])
-             (λ (val)
-               (delay (p-app (force val))))))
          promise?))))
   
   #|
diff --git a/collects/setup/getinfo.ss b/collects/setup/getinfo.ss
index 23b2b3c974..e735a09896 100644
--- a/collects/setup/getinfo.ss
+++ b/collects/setup/getinfo.ss
@@ -12,15 +12,6 @@
   (define info? (opt-> (symbol?) ((-> any/c)) any/c))
   (define path-or-string? (lambda (x) (or (path? x) (string? x))))
   
-  (provide/contract
-   (get-info ((listof path-or-string?) . -> . (or/c info? boolean?)))
-   (get-info/full (path? . -> . (or/c info? boolean?)))
-   (find-relevant-directories (opt-> ((listof symbol?))
-                                     ((lambda (x) (or (eq? x 'preferred)
-                                                      (eq? x 'all-available))))
-                                     (listof path?))))
-
-
   
   ;; in addition to infodomain/compiled/cache.ss, getinfo will look in this 
   ;; file to find mappings. PLaneT uses this to put info about installed
@@ -175,4 +166,12 @@
   (define (compare-directories a b)
     (let-values ([(base1 name1 dir?1) (split-path a)]
                  [(base2 name2 dir?2) (split-path b)])
-      (bytes<? (path->bytes name1) (path->bytes name2)))))
+      (bytes<? (path->bytes name1) (path->bytes name2))))
+  
+  (provide/contract
+   (get-info ((listof path-or-string?) . -> . (or/c info? boolean?)))
+   (get-info/full (path? . -> . (or/c info? boolean?)))
+   (find-relevant-directories (opt-> ((listof symbol?))
+                                     ((lambda (x) (or (eq? x 'preferred)
+                                                      (eq? x 'all-available))))
+                                     (listof path?)))))
diff --git a/collects/syntax/struct.ss b/collects/syntax/struct.ss
index 7cb84497da..59872556fe 100644
--- a/collects/syntax/struct.ss
+++ b/collects/syntax/struct.ss
@@ -5,12 +5,6 @@
 	   "stx.ss")
   (require-for-template mzscheme)
   
-  (provide/contract
-   [build-struct-names
-    (opt-> (identifier? (listof identifier?) boolean? boolean?)
-           ((union false/c syntax?))
-           (listof identifier?))])
-  
   (provide parse-define-struct
 
 	   build-struct-generation
@@ -326,4 +320,10 @@
 	      (syntax-property result 
 			       'disappeared-use 
 			       (syntax-local-introduce super-id))
-	      result))))))
+	      result)))))
+  
+  (provide/contract
+   [build-struct-names
+    (opt-> (identifier? (listof identifier?) boolean? boolean?)
+           ((union false/c syntax?))
+           (listof identifier?))]))
diff --git a/collects/syntax/to-string.ss b/collects/syntax/to-string.ss
index 25eddb9298..5b8ad1bd03 100644
--- a/collects/syntax/to-string.ss
+++ b/collects/syntax/to-string.ss
@@ -2,9 +2,6 @@
   (require (lib "contract.ss")
            (lib "stx.ss" "syntax"))
   
-  (provide/contract [syntax->string (-> (and/c syntax? stx-list?)
-                                        string?)])
-  
   (require (lib "list.ss"))
 
   (define (syntax->string c)
@@ -69,4 +66,7 @@
                  (set! col (+ col (string-length s)))
                  (display s))])))
         (for-each (loop (lambda () (set! col init-col))) l))
-      (get-output-string s))))
\ No newline at end of file
+      (get-output-string s)))
+  
+  (provide/contract [syntax->string (-> (and/c syntax? stx-list?)
+                                        string?)]))
\ No newline at end of file
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index d66c309eec..86944ee83f 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -1505,271 +1505,6 @@
                x))
       (eval '(require contract-test-suite-define1))))
   
-  (test/spec-passed
-   'provide/contract1
-   '(let ()
-      (eval '(module contract-test-suite1 mzscheme
-               (require (lib "contract.ss"))
-               (define x 1)
-               (provide/contract (x integer?))))
-      (eval '(require contract-test-suite1))
-      (eval 'x)))
-  
-  (test/spec-passed
-   'provide/contract2
-   '(let ()
-      (eval '(module contract-test-suite2 mzscheme
-               (require (lib "contract.ss"))
-               (provide/contract)))
-      (eval '(require contract-test-suite2))))
-  
-  (test/spec-failed
-   'provide/contract3
-   '(let ()
-      (eval '(module contract-test-suite3 mzscheme
-               (require (lib "contract.ss"))
-               (define x #f)
-               (provide/contract (x integer?))))
-      (eval '(require contract-test-suite3))
-      (eval 'x))
-   "contract-test-suite3")
-  
-  (test/spec-passed
-   'provide/contract4
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite4 mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a))
-               (provide/contract (struct s ((a any/c))))))
-      (eval '(require contract-test-suite4))
-      (eval '(list (make-s 1)
-                   (s-a (make-s 1))
-                   (s? (make-s 1))
-                   (set-s-a! (make-s 1) 2)))))
-  
-  (test/spec-passed/result
-   'provide/contract4-b
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite4-b mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a b))
-               (provide/contract (struct s ((a any/c) (b any/c))))))
-      (eval '(require contract-test-suite4-b))
-      (eval '(let ([an-s (make-s 1 2)])
-               (list (s-a an-s)
-                     (s-b an-s)
-                     (begin (set-s-a! an-s 3)
-                            (s-a an-s))
-                     (begin (set-s-b! an-s 4)
-                            (s-b an-s))))))
-   
-   (list 1 2 3 4))
-  
-  (test/spec-passed
-   'provide/contract5
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite5 mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a))
-               (define-struct t (a))
-               (provide/contract (struct s ((a any/c)))
-                                 (struct t ((a any/c))))))
-      (eval '(require contract-test-suite5))
-      (eval '(list (make-s 1)
-                   (s-a (make-s 1))
-                   (s? (make-s 1))
-                   (set-s-a! (make-s 1) 2)
-                   (make-t 1)
-                   (t-a (make-t 1))
-                   (t? (make-t 1))
-                   (set-t-a! (make-t 1) 2)))))
-  
-  (test/spec-passed
-   'provide/contract6
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite6 mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a))
-               (provide/contract (struct s ((a any/c))))))
-      (eval '(require contract-test-suite6))
-      (eval '(define-struct (t s) ()))))
-  
-  (test/spec-passed
-   'provide/contract6
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite6 mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a))
-               (provide/contract (struct s ((a any/c))))))
-      (eval '(require contract-test-suite6))
-      (eval '(define-struct (t s) ()))))
-  
-  (test/spec-passed
-   'provide/contract6b
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite6b mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s_ (a))
-               (provide/contract (struct s_ ((a any/c))))))
-      (eval '(require contract-test-suite6b))
-      (eval '(module contract-test-suite6b2 mzscheme
-               (require contract-test-suite6b)
-               (require (lib "contract.ss"))
-               (define-struct (t_ s_) (b))
-               (provide s_-a)
-               (provide/contract (struct (t_ s_) ((a any/c) (b any/c))))))
-      (eval '(require contract-test-suite6b2))
-      (eval '(define-struct (u_ t_) ()))
-      (eval '(s_-a (make-u_ 1 2)))))
-  
-  (test/spec-passed
-   'provide/contract7
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite7 mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a b))
-               (define-struct (t s) (c d))
-               (provide/contract 
-                (struct s ((a any/c) (b any/c)))
-                (struct (t s) ((a any/c) (b any/c) (c any/c) (d any/c))))))
-      (eval '(require contract-test-suite7))
-      (eval '(let ([x (make-t 1 2 3 4)])
-               (s-a x)
-               (s-b x)
-               (t-c x)
-               (t-d x)
-               (void)))))
-  
-  (test/spec-passed
-   'provide/contract8
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite8 mzscheme
-               (require (lib "contract.ss"))
-               (define-struct i-s (contents))
-               (define (w-f-s? x) #t)
-               (provide/contract 
-                (struct i-s ((contents (flat-named-contract "integer-set-list" w-f-s?)))))))
-      (eval '(require contract-test-suite8))
-      (eval '(i-s-contents (make-i-s 1)))))
-   
-  (test/spec-passed
-   'provide/contract9
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module contract-test-suite9 mzscheme
-               (require (lib "contract.ss"))
-               (define the-internal-name 1)
-               (provide/contract (rename the-internal-name the-external-name integer?))
-               (+ the-internal-name 1)))
-      (eval '(require contract-test-suite9))
-      (eval '(+ the-external-name 1))))
-  
-  (test/spec-passed
-   'provide/contract10
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module m mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a b) (make-inspector))
-               (provide/contract (struct s ((a number?) (b number?))))))
-      (eval '(module n mzscheme
-               (require (lib "struct.ss")
-                        m)
-               (print-struct #t)
-               (copy-struct s 
-                            (make-s 1 2)
-                            [s-a 3])))
-      (eval '(require n))))
-  
-  ;; this test is broken, not sure why
-  #|
-  (test/spec-failed
-   'provide/contract11
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module m mzscheme
-               (require (lib "contract.ss"))
-               (define-struct s (a b) (make-inspector))
-               (provide/contract (struct s ((a number?) (b number?))))))
-      (eval '(module n mzscheme
-               (require (lib "struct.ss")
-                        m)
-               (print-struct #t)
-               (copy-struct s 
-                            (make-s 1 2)
-                            [s-a #f])))
-      (eval '(require n)))
-   'n)
-|#
-  
-  (test/spec-passed
-   'provide/contract12
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module m mzscheme
-               (require (lib "contract.ss"))
-               (define-struct (exn2 exn) ())
-               (provide/contract (struct (exn2 exn) ((message any/c) (continuation-marks any/c))))))
-      (eval '(require m))))
-  
-  (test/spec-passed/result
-   'provide/contract13
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module common-msg-structs mzscheme
-               (require (lib "contract.ss" "mzlib"))
-               (define-struct register (name type) (make-inspector))
-               (provide/contract (struct register ([name any/c] [type any/c])))))
-      
-      (eval '(require common-msg-structs))
-      (eval '(require (lib "plt-match.ss")))
-      (eval '(match (make-register 1 2)
-               [(struct register (name type))
-                (list name type)])))
-   (list 1 2))
-  
-  (test/spec-passed
-   'provide/contract14
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module test1 mzscheme
-               (require (lib "contract.ss"))
-               
-               (define-struct type (flags))
-               (define-struct (type:ptr type) (type))
-               
-               (provide/contract
-                (struct type
-                        ([flags (listof string?)]))
-                
-                (struct (type:ptr type)
-                        ([flags (listof string?)] [type type?])))))
-
-      (eval '(module test2 mzscheme
-               (require (lib "plt-match.ss"))
-               (require test1)
-               (match (make-type:ptr '() (make-type '()))
-                 [(struct type:ptr (flags type)) #f])))
-      (eval '(require test2))))
-  
-  
-  ;; provide/contract should signal errors without requiring a reference to the variable
-  ;; this test is bogus, because provide/contract'd variables can be set!'d.
-  #;
-  (test/pos-blame
-   'provide/contract15
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module pos mzscheme
-               (require (lib "contract.ss"))
-               (define i #f)
-               (provide/contract [i integer?])))
-      (eval '(require pos))))
-  
-  ;; this is really a positive violation, but name the module `neg' just for an addl test
-  #;
-  (test/neg-blame
-   'provide/contract16
-   '(parameterize ([current-namespace (make-namespace)])
-      (eval '(module neg mzscheme
-               (require (lib "contract.ss"))
-               (define i #f)
-               (provide/contract [i integer?])))
-      (eval '(require neg))))
-  
 
 
   
@@ -4481,7 +4216,286 @@
   (test-name '(or/c (-> (>=/c 5) (>=/c 5)) boolean?)
              (or/c boolean? (-> (>=/c 5) (>=/c 5))))
   
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;;
+  ;; provide/contract tests
+  ;; (at the end, becuase they are slow w/out .zo files)
+  ;;
   
+    (test/spec-passed
+   'provide/contract1
+   '(let ()
+      (eval '(module contract-test-suite1 mzscheme
+               (require (lib "contract.ss"))
+               (define x 1)
+               (provide/contract (x integer?))))
+      (eval '(require contract-test-suite1))
+      (eval 'x)))
+  
+  (test/spec-passed
+   'provide/contract2
+   '(let ()
+      (eval '(module contract-test-suite2 mzscheme
+               (require (lib "contract.ss"))
+               (provide/contract)))
+      (eval '(require contract-test-suite2))))
+  
+  (test/spec-failed
+   'provide/contract3
+   '(let ()
+      (eval '(module contract-test-suite3 mzscheme
+               (require (lib "contract.ss"))
+               (define x #f)
+               (provide/contract (x integer?))))
+      (eval '(require contract-test-suite3))
+      (eval 'x))
+   "contract-test-suite3")
+  
+  (test/spec-passed
+   'provide/contract4
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite4 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a))
+               (provide/contract (struct s ((a any/c))))))
+      (eval '(require contract-test-suite4))
+      (eval '(list (make-s 1)
+                   (s-a (make-s 1))
+                   (s? (make-s 1))
+                   (set-s-a! (make-s 1) 2)))))
+  
+  (test/spec-passed/result
+   'provide/contract4-b
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite4-b mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b))
+               (provide/contract (struct s ((a any/c) (b any/c))))))
+      (eval '(require contract-test-suite4-b))
+      (eval '(let ([an-s (make-s 1 2)])
+               (list (s-a an-s)
+                     (s-b an-s)
+                     (begin (set-s-a! an-s 3)
+                            (s-a an-s))
+                     (begin (set-s-b! an-s 4)
+                            (s-b an-s))))))
+   
+   (list 1 2 3 4))
+  
+  (test/spec-passed
+   'provide/contract5
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite5 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a))
+               (define-struct t (a))
+               (provide/contract (struct s ((a any/c)))
+                                 (struct t ((a any/c))))))
+      (eval '(require contract-test-suite5))
+      (eval '(list (make-s 1)
+                   (s-a (make-s 1))
+                   (s? (make-s 1))
+                   (set-s-a! (make-s 1) 2)
+                   (make-t 1)
+                   (t-a (make-t 1))
+                   (t? (make-t 1))
+                   (set-t-a! (make-t 1) 2)))))
+  
+  (test/spec-passed
+   'provide/contract6
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite6 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a))
+               (provide/contract (struct s ((a any/c))))))
+      (eval '(require contract-test-suite6))
+      (eval '(define-struct (t s) ()))))
+  
+  (test/spec-passed
+   'provide/contract6
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite6 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a))
+               (provide/contract (struct s ((a any/c))))))
+      (eval '(require contract-test-suite6))
+      (eval '(define-struct (t s) ()))))
+  
+  (test/spec-passed
+   'provide/contract6b
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite6b mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s_ (a))
+               (provide/contract (struct s_ ((a any/c))))))
+      (eval '(require contract-test-suite6b))
+      (eval '(module contract-test-suite6b2 mzscheme
+               (require contract-test-suite6b)
+               (require (lib "contract.ss"))
+               (define-struct (t_ s_) (b))
+               (provide s_-a)
+               (provide/contract (struct (t_ s_) ((a any/c) (b any/c))))))
+      (eval '(require contract-test-suite6b2))
+      (eval '(define-struct (u_ t_) ()))
+      (eval '(s_-a (make-u_ 1 2)))))
+  
+  (test/spec-passed
+   'provide/contract7
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite7 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b))
+               (define-struct (t s) (c d))
+               (provide/contract 
+                (struct s ((a any/c) (b any/c)))
+                (struct (t s) ((a any/c) (b any/c) (c any/c) (d any/c))))))
+      (eval '(require contract-test-suite7))
+      (eval '(let ([x (make-t 1 2 3 4)])
+               (s-a x)
+               (s-b x)
+               (t-c x)
+               (t-d x)
+               (void)))))
+  
+  (test/spec-passed
+   'provide/contract8
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite8 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct i-s (contents))
+               (define (w-f-s? x) #t)
+               (provide/contract 
+                (struct i-s ((contents (flat-named-contract "integer-set-list" w-f-s?)))))))
+      (eval '(require contract-test-suite8))
+      (eval '(i-s-contents (make-i-s 1)))))
+   
+  (test/spec-passed
+   'provide/contract9
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite9 mzscheme
+               (require (lib "contract.ss"))
+               (define the-internal-name 1)
+               (provide/contract (rename the-internal-name the-external-name integer?))
+               (+ the-internal-name 1)))
+      (eval '(require contract-test-suite9))
+      (eval '(+ the-external-name 1))))
+  
+  (test/spec-passed
+   'provide/contract10
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module m mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b) (make-inspector))
+               (provide/contract (struct s ((a number?) (b number?))))))
+      (eval '(module n mzscheme
+               (require (lib "struct.ss")
+                        m)
+               (print-struct #t)
+               (copy-struct s 
+                            (make-s 1 2)
+                            [s-a 3])))
+      (eval '(require n))))
+  
+  ;; this test is broken, not sure why
+  #|
+  (test/spec-failed
+   'provide/contract11
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module m mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b) (make-inspector))
+               (provide/contract (struct s ((a number?) (b number?))))))
+      (eval '(module n mzscheme
+               (require (lib "struct.ss")
+                        m)
+               (print-struct #t)
+               (copy-struct s 
+                            (make-s 1 2)
+                            [s-a #f])))
+      (eval '(require n)))
+   'n)
+|#
+  
+  (test/spec-passed
+   'provide/contract12
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module m mzscheme
+               (require (lib "contract.ss"))
+               (define-struct (exn2 exn) ())
+               (provide/contract (struct (exn2 exn) ((message any/c) (continuation-marks any/c))))))
+      (eval '(require m))))
+  
+  (test/spec-passed/result
+   'provide/contract13
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module common-msg-structs mzscheme
+               (require (lib "contract.ss" "mzlib"))
+               (define-struct register (name type) (make-inspector))
+               (provide/contract (struct register ([name any/c] [type any/c])))))
+      
+      (eval '(require common-msg-structs))
+      (eval '(require (lib "plt-match.ss")))
+      (eval '(match (make-register 1 2)
+               [(struct register (name type))
+                (list name type)])))
+   (list 1 2))
+  
+  (test/spec-passed
+   'provide/contract14
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module test1 mzscheme
+               (require (lib "contract.ss"))
+               
+               (define-struct type (flags))
+               (define-struct (type:ptr type) (type))
+               
+               (provide/contract
+                (struct type
+                        ([flags (listof string?)]))
+                
+                (struct (type:ptr type)
+                        ([flags (listof string?)] [type type?])))))
+
+      (eval '(module test2 mzscheme
+               (require (lib "plt-match.ss"))
+               (require test1)
+               (match (make-type:ptr '() (make-type '()))
+                 [(struct type:ptr (flags type)) #f])))
+      (eval '(require test2))))
+  
+  ;; make sure unbound identifier exception is raised.
+  (error-test
+   #'(parameterize ([current-namespace (make-namespace)])
+       (eval '(module pos mzscheme
+                (require (lib "contract.ss"))
+                (provide/contract [i any/c]))))
+   exn:fail:syntax?)
+  
+  ;; provide/contract should signal errors without requiring a reference to the variable
+  ;; this test is bogus, because provide/contract'd variables can be set!'d.
+  #;
+  (test/pos-blame
+   'provide/contract15
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module pos mzscheme
+               (require (lib "contract.ss"))
+               (define i #f)
+               (provide/contract [i integer?])))
+      (eval '(require pos))))
+  
+  ;; this is really a positive violation, but name the module `neg' just for an addl test
+  #;
+  (test/neg-blame
+   'provide/contract16
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module neg mzscheme
+               (require (lib "contract.ss"))
+               (define i #f)
+               (provide/contract [i integer?])))
+      (eval '(require neg))))
+  
+
   
 ))
 (report-errs)
diff --git a/collects/xml/plist.ss b/collects/xml/plist.ss
index 23e6495319..6ca62ce0f8 100644
--- a/collects/xml/plist.ss
+++ b/collects/xml/plist.ss
@@ -3,9 +3,6 @@
   (require "xml.ss"
            (lib "contract.ss"))
 
-  (provide read-plist)
-  (provide/contract [write-plist (xexpr? output-port? . -> . void?)])
-  
    ; a dict is (list 'dict assoc-pair ...)
    ; an assoc-pair is (list 'assoc-pair key value)
    ; a key is a string
@@ -193,8 +190,6 @@
    '(equal? new-dict my-dict)
 
    ;; END OF TEST
-	 
-)		 
-		 
-	    
-		   
+
+  (provide read-plist)
+  (provide/contract [write-plist (xexpr? output-port? . -> . void?)]))