diff --git a/collects/mzlib/private/contract-arr-checks.ss b/collects/mzlib/private/contract-arr-checks.ss
new file mode 100644
index 0000000..57ac711
--- /dev/null
+++ b/collects/mzlib/private/contract-arr-checks.ss
@@ -0,0 +1,234 @@
+#lang scheme/base
+
+(provide (all-defined-out))
+(require scheme/private/contract-guts)
+
+(define empty-case-lambda/c
+  (flat-named-contract '(case->)
+                       (λ (x) (and (procedure? x) (null? (procedure-arity x))))))
+
+;; ----------------------------------------
+;; Checks and error functions used in macro expansions
+
+;; procedure-accepts-and-more? : procedure number -> boolean
+;; returns #t if val accepts dom-length arguments and
+;; any number of arguments more than dom-length. 
+;; returns #f otherwise.
+(define (procedure-accepts-and-more? val dom-length)
+  (let ([arity (procedure-arity val)])
+    (cond
+      [(number? arity) #f]
+      [(arity-at-least? arity)
+       (<= (arity-at-least-value arity) dom-length)]
+      [else
+       (let ([min-at-least (let loop ([ars arity]
+                                      [acc #f])
+                             (cond
+                               [(null? ars) acc]
+                               [else (let ([ar (car ars)])
+                                       (cond
+                                         [(arity-at-least? ar)
+                                          (if (and acc
+                                                   (< acc (arity-at-least-value ar)))
+                                              (loop (cdr ars) acc)
+                                              (loop (cdr ars) (arity-at-least-value ar)))]
+                                         [(number? ar)
+                                          (loop (cdr ars) acc)]))]))])
+         (and min-at-least
+              (begin
+                (let loop ([counts (sort (filter number? arity) >=)])
+                  (unless (null? counts)
+                    (let ([count (car counts)])
+                      (cond
+                        [(= (+ count 1) min-at-least)
+                         (set! min-at-least count)
+                         (loop (cdr counts))]
+                        [(< count min-at-least)
+                         (void)]
+                        [else (loop (cdr counts))]))))
+                (<= min-at-least dom-length))))])))
+
+(define (check->* f arity-count)
+  (unless (procedure? f)
+    (error 'object-contract "expected last argument of ->d* to be a procedure, got ~e" f))
+  (unless (and (procedure-arity-includes? f arity-count)
+               (no-mandatory-keywords? f))
+    (error 'object-contract 
+           "expected last argument of ->d* to be a procedure that accepts ~a arguments, got ~e"
+           arity-count
+           f)))
+
+(define (get-mandatory-keywords f)
+  (let-values ([(mandatory optional) (procedure-keywords f)])
+    mandatory))
+
+(define (no-mandatory-keywords? f)
+  (let-values ([(mandatory optional) (procedure-keywords f)])
+    (null? mandatory)))
+
+(define (check->*/more f arity-count)
+  (unless (procedure? f)
+    (error 'object-contract "expected last argument of ->d* to be a procedure, got ~e" f))
+  (unless (procedure-accepts-and-more? f arity-count)
+    (error 'object-contract 
+           "expected last argument of ->d* to be a procedure that accepts ~a argument~a and arbitrarily many more, got ~e"
+           arity-count
+           (if (= 1 arity-count) "" "s")
+           f)))
+
+
+(define (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
+  (unless pre-expr
+    (raise-contract-error val
+                          src-info
+                          blame
+                          orig-str
+                          "pre-condition expression failure")))
+
+(define (check-post-expr->pp/h val post-expr src-info blame orig-str)
+  (unless post-expr
+    (raise-contract-error val
+                          src-info
+                          blame
+                          orig-str
+                          "post-condition expression failure")))
+
+(define (check-procedure val dom-length optionals mandatory-kwds optional-keywords src-info blame orig-str)
+  (unless (and (procedure? val)
+               (procedure-arity-includes?/optionals val dom-length optionals)
+               (keywords-match mandatory-kwds optional-keywords val))
+    (raise-contract-error
+     val
+     src-info
+     blame
+     orig-str
+     "expected a procedure that accepts ~a arguments~a, given: ~e"
+     dom-length
+     (keyword-error-text mandatory-kwds)
+     val)))
+
+(define (procedure-arity-includes?/optionals f base optionals)
+  (cond
+    [(zero? optionals) (procedure-arity-includes? f base)]
+    [else (and (procedure-arity-includes? f (+ base optionals))
+               (procedure-arity-includes?/optionals f base (- optionals 1)))]))
+
+(define (keywords-match mandatory-kwds optional-kwds val)
+  (let-values ([(proc-mandatory proc-all) (procedure-keywords val)])
+    (and (equal? proc-mandatory mandatory-kwds)
+         (andmap (λ (kwd) (and (member kwd proc-all)
+                               (not (member kwd proc-mandatory))))
+                 optional-kwds))))
+
+(define (keyword-error-text mandatory-keywords)
+  (cond
+    [(null? mandatory-keywords) " without any keywords"]
+    [(null? (cdr mandatory-keywords))
+     (format " and the keyword ~a" (car mandatory-keywords))]
+    [else
+     (format
+      " and the keywords ~a~a"
+      (car mandatory-keywords)
+      (apply string-append (map (λ (x) (format " ~a" x)) (cdr mandatory-keywords))))]))
+
+(define ((check-procedure? arity) val)
+  (and (procedure? val)
+       (procedure-arity-includes? val arity)
+       (no-mandatory-keywords? val)))
+
+(define ((check-procedure/more? arity) val)
+  (and (procedure? val)
+       (procedure-accepts-and-more? val arity)))
+
+(define (check-procedure/kind val arity kind-of-thing src-info blame orig-str)
+  (unless (procedure? val)
+    (raise-contract-error val
+                          src-info
+                          blame
+                          orig-str
+                          "expected a procedure, got ~e"
+                          val))
+  (unless (procedure-arity-includes? val arity)
+    (raise-contract-error val
+                          src-info
+                          blame
+                          orig-str
+                          "expected a ~a of arity ~a (not arity ~a), got  ~e"
+                          kind-of-thing
+                          arity
+                          (procedure-arity val)
+                          val)))
+
+(define (check-procedure/more/kind val arity kind-of-thing src-info blame orig-str)
+  (unless (procedure? val)
+    (raise-contract-error val
+                          src-info
+                          blame
+                          orig-str
+                          "expected a procedure, got ~e"
+                          val))
+  (unless (procedure-accepts-and-more? val arity)
+    (raise-contract-error val
+                          src-info
+                          blame
+                          orig-str
+                          "expected a ~a that accepts ~a arguments and aribtrarily more (not arity ~a), got  ~e"
+                          kind-of-thing
+                          arity
+                          (procedure-arity val)
+                          val)))
+
+(define (check-procedure/more val dom-length mandatory-kwds optional-kwds src-info blame orig-str)
+  (unless (and (procedure? val)
+               (procedure-accepts-and-more? val dom-length)
+               (keywords-match mandatory-kwds optional-kwds val))
+    (raise-contract-error
+     val
+     src-info
+     blame
+     orig-str
+     "expected a procedure that accepts ~a arguments and and arbitrarily more~a, given: ~e"
+     dom-length
+     (keyword-error-text mandatory-kwds)
+     val)))
+
+
+(define (check-rng-procedure who rng-x arity)
+  (unless (and (procedure? rng-x)
+               (procedure-arity-includes? rng-x arity))
+    (error who "expected range position to be a procedure that accepts ~a arguments, given: ~e"
+           arity
+           rng-x)))
+
+(define (check-rng-procedure/more rng-mk-x arity)
+  (unless (and (procedure? rng-mk-x)
+               (procedure-accepts-and-more? rng-mk-x arity))
+    (error '->d* "expected range position to be a procedure that accepts ~a arguments and arbitrarily many more, given: ~e"
+           arity 
+           rng-mk-x)))
+
+(define (check-rng-lengths results rng-contracts)
+  (unless (= (length results) (length rng-contracts))
+    (error '->d* 
+           "expected range contract contructor and function to have the same number of values, given: ~a and ~a respectively" 
+           (length results) (length rng-contracts))))
+
+#|
+
+  test cases for procedure-accepts-and-more?
+
+  (and (procedure-accepts-and-more? (lambda (x . y) 1) 3)
+       (procedure-accepts-and-more? (lambda (x . y) 1) 2)
+       (procedure-accepts-and-more? (lambda (x . y) 1) 1)
+       (not (procedure-accepts-and-more? (lambda (x . y) 1) 0))
+       
+       (procedure-accepts-and-more? (case-lambda [(x . y) 1] [(y) 1]) 3)
+       (procedure-accepts-and-more? (case-lambda [(x . y) 1] [(y) 1]) 2)
+       (procedure-accepts-and-more? (case-lambda [(x . y) 1] [(y) 1]) 1)
+       (not (procedure-accepts-and-more? (case-lambda [(x . y) 1] [(y) 1]) 0))
+       
+       (procedure-accepts-and-more? (case-lambda [(x y . z) 1] [(x) 1]) 2)
+       (procedure-accepts-and-more? (case-lambda [(x y . z) 1] [(x) 1]) 1)
+       (not (procedure-accepts-and-more? (case-lambda [(x y . z) 1] [(x) 1]) 0)))
+  
+  |#
diff --git a/collects/mzlib/private/contract-arr-obj-helpers.ss b/collects/mzlib/private/contract-arr-obj-helpers.ss
new file mode 100644
index 0000000..71b3a11
--- /dev/null
+++ b/collects/mzlib/private/contract-arr-obj-helpers.ss
@@ -0,0 +1,1112 @@
+#lang scheme/base
+(require syntax/stx 
+         syntax/name)
+
+(require (for-syntax scheme/base))
+(require (for-template scheme/base)
+         (for-template scheme/private/contract-guts)
+         (for-template "contract-arr-checks.ss"))
+
+(provide make-/proc ->/h ->*/h ->d/h ->d*/h ->r/h 
+         ->pp/h ->pp-rest/h 
+         make-case->/proc 
+         make-opt->/proc make-opt->*/proc)
+
+;; make-/proc : boolean
+;;              (syntax -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))) 
+;;              syntax
+;;           -> (syntax -> syntax)
+(define (make-/proc method-proc? /h stx)
+  (let-values ([(arguments-check build-proj check-val first-order-check wrapper)
+                (/h method-proc? stx)])
+    (let ([outer-args (syntax (val pos-blame neg-blame src-info orig-str name-id))])
+      (with-syntax ([inner-check (check-val outer-args)]
+                    [(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 val-args body)))])
+          (let ([inner-lambda
+                 (syntax
+                  (lambda (val)
+                    inner-check
+                    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-proj-contract
+                  name-id
+                  (lambda (pos-blame neg-blame src-info orig-str)
+                    proj-code)
+                  first-order-check))))))))))
+
+(define (make-case->/proc method-proc? stx inferred-name-stx select/h)
+  (syntax-case stx ()
+    
+    ;; if there are no cases, this contract should only accept the "empty" case-lambda.
+    [(_) (syntax empty-case-lambda/c)]
+    
+    ;; if there is only a single case, just skip it.
+    [(_ case) (syntax case)]
+    
+    [(_ cases ...)
+     (let-values ([(arguments-check build-projs check-val first-order-check wrapper) 
+                   (case->/h method-proc? stx (syntax->list (syntax (cases ...))) select/h)])
+       (let ([outer-args (syntax (val pos-blame neg-blame src-info orig-str name-id))])
+         (with-syntax ([(inner-check ...) (check-val outer-args)]
+                       [(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 body ...)))])
+             (let ([inner-lambda
+                    (syntax
+                     (lambda (val)
+                       inner-check ...
+                       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-proj-contract
+                     (apply build-compound-type-name 'case-> name-id)
+                     (lambda (pos-blame neg-blame src-info orig-str)
+                       proj-code)
+                     first-order-check)))))))))]))
+
+(define (make-opt->/proc method-proc? stx select/h case-arr-stx arr-stx)
+  (syntax-case stx (any)
+    [(_ (reqs ...) (opts ...) any)
+     (make-opt->*/proc method-proc? (syntax (opt->* (reqs ...) (opts ...) any)) stx select/h case-arr-stx arr-stx)]
+    [(_ (reqs ...) (opts ...) res)
+     (make-opt->*/proc method-proc? (syntax (opt->* (reqs ...) (opts ...) (res))) stx select/h case-arr-stx arr-stx)]))
+
+(define (make-opt->*/proc method-proc? stx inferred-name-stx select/h case-arr-stx arr-stx)
+  (syntax-case stx (any)
+    [(_ (reqs ...) (opts ...) any)
+     (let* ([req-vs (generate-temporaries (syntax->list (syntax (reqs ...))))]
+            [opt-vs (generate-temporaries (syntax->list (syntax (opts ...))))]
+            [cses
+             (reverse
+              (let loop ([opt-vs (reverse opt-vs)])
+                (cond
+                  [(null? opt-vs) (list req-vs)]
+                  [else (cons (append req-vs (reverse opt-vs))
+                              (loop (cdr opt-vs)))])))])
+       (with-syntax ([(req-vs ...) req-vs]
+                     [(opt-vs ...) opt-vs]
+                     [((case-doms ...) ...) cses])
+         (with-syntax ([expanded-case->
+                        (make-case->/proc
+                         method-proc?
+                         (with-syntax ([case-> case-arr-stx]
+                                       [-> arr-stx])
+                           (syntax (case-> (-> case-doms ... any) ...)))
+                         inferred-name-stx
+                         select/h)])
+           (syntax/loc stx
+             (let ([req-vs reqs] ...
+                   [opt-vs opts] ...)
+               expanded-case->)))))]
+    [(_ (reqs ...) (opts ...) (ress ...))
+     (let* ([res-vs (generate-temporaries (syntax->list (syntax (ress ...))))]
+            [req-vs (generate-temporaries (syntax->list (syntax (reqs ...))))]
+            [opt-vs (generate-temporaries (syntax->list (syntax (opts ...))))]
+            [cses
+             (reverse
+              (let loop ([opt-vs (reverse opt-vs)])
+                (cond
+                  [(null? opt-vs) (list req-vs)]
+                  [else (cons (append req-vs (reverse opt-vs))
+                              (loop (cdr opt-vs)))])))])
+       (with-syntax ([(res-vs ...) res-vs]
+                     [(req-vs ...) req-vs]
+                     [(opt-vs ...) opt-vs]
+                     [((case-doms ...) ...) cses])
+         (with-syntax ([(single-case-result ...)
+                        (let* ([ress-lst (syntax->list (syntax (ress ...)))]
+                               [only-one?
+                                (and (pair? ress-lst)
+                                     (null? (cdr ress-lst)))])
+                          (map
+                           (if only-one?
+                               (lambda (x) (car (syntax->list (syntax (res-vs ...)))))
+                               (lambda (x) (syntax (values res-vs ...))))
+                           cses))])
+           (with-syntax ([expanded-case->
+                          (make-case->/proc
+                           method-proc?
+                           (with-syntax ([case-> case-arr-stx]
+                                         [-> arr-stx])
+                             (syntax (case-> (-> case-doms ... single-case-result) ...)))
+                           inferred-name-stx
+                           select/h)])
+             (set-inferred-name-from
+              stx
+              (syntax/loc stx
+                (let ([res-vs ress] 
+                      ...
+                      [req-vs reqs]
+                      ...
+                      [opt-vs opts]
+                      ...)
+                  expanded-case->)))))))]))
+
+;; exactract-argument-lists : syntax -> (listof syntax)
+(define (extract-argument-lists stx)
+  (map (lambda (x)
+         (syntax-case x ()
+           [(arg-list body) (syntax arg-list)]))
+       (syntax->list stx)))
+
+;; ensure-cases-disjoint : syntax syntax[list] -> void
+(define (ensure-cases-disjoint stx cases)
+  (let ([individual-cases null]
+        [dot-min #f])
+    (for-each (lambda (case)
+                (let ([this-case (get-case case)])
+                  (cond
+                    [(number? this-case) 
+                     (cond
+                       [(member this-case individual-cases)
+                        (raise-syntax-error
+                         'case-> 
+                         (format "found multiple cases with ~a arguments" this-case)
+                         stx)]
+                       [(and dot-min (dot-min . <= . this-case))
+                        (raise-syntax-error 
+                         'case-> 
+                         (format "found overlapping cases (~a+ followed by ~a)" dot-min this-case)
+                         stx)]
+                       [else (set! individual-cases (cons this-case individual-cases))])]
+                    [(pair? this-case)
+                     (let ([new-dot-min (car this-case)])
+                       (cond
+                         [dot-min
+                          (if (dot-min . <= . new-dot-min)
+                              (raise-syntax-error
+                               'case->
+                               (format "found overlapping cases (~a+ followed by ~a+)" dot-min new-dot-min)
+                               stx)
+                              (set! dot-min new-dot-min))]
+                         [else
+                          (set! dot-min new-dot-min)]))])))
+              cases)))
+
+;; get-case : syntax -> (union number (cons number 'more))
+(define (get-case stx)
+  (let ([ilist (syntax->datum stx)])
+    (if (list? ilist)
+        (length ilist)
+        (cons 
+         (let loop ([i ilist])
+           (cond
+             [(pair? i) (+ 1 (loop (cdr i)))]
+             [else 0]))
+         'more))))
+
+
+;; case->/h : boolean
+;;            syntax
+;;            (listof syntax) 
+;;            select/h
+;;         -> (values (syntax -> syntax)
+;;                    (syntax -> syntax)
+;;                    (syntax -> syntax)
+;;                    (syntax syntax -> syntax) 
+;;                    (syntax -> syntax)
+;;                    (syntax -> syntax))
+;; like the other /h functions, but composes the wrapper functions
+;; together and combines the cases of the case-lambda into a single list.
+(define (case->/h method-proc? orig-stx cases select/h)
+  (let loop ([cases cases]
+             [name-ids '()])
+    (cond
+      [(null? cases) 
+       (values 
+        (lambda (outer-args body)
+          (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 (args) (syntax ()))
+        (syntax (lambda (x) #t))
+        (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-projs check-vals first-order-checks wrappers)
+                       (loop (cdr cases) (cons new-id name-ids))]
+                      [(arguments-check build-proj check-val first-order-check wrapper)
+                       (/h method-proc? (car cases))])
+           (values
+            (lambda (outer-args x) 
+              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args]
+                            [new-id new-id])
+                (arguments-check 
+                 (syntax (val pos-blame neg-blame src-info orig-str new-id)) 
+                 (arguments-checks 
+                  outer-args
+                  x))))
+            (lambda (args inner) (build-projs args (build-proj args inner)))
+            (lambda (args)
+              (with-syntax ([checks (check-vals args)]
+                            [check (check-val args)])
+                (syntax (check . checks))))
+            (with-syntax ([checks first-order-checks]
+                          [check first-order-check])
+              (syntax (lambda (x) (and (checks x) (check x)))))
+            (lambda (args)
+              (with-syntax ([case (wrapper args)]
+                            [cases (wrappers args)])
+                (syntax (case . cases)))))))])))
+
+;; ensure-no-duplicates : syntax (listof syntax[identifier]) -> void
+(define (ensure-no-duplicates stx form-name names)
+  (let ([ht (make-hash-table)])
+    (for-each (lambda (name)
+                (let ([key (syntax-e name)])
+                  (when (hash-table-get ht key (lambda () #f))
+                    (raise-syntax-error form-name
+                                        "duplicate method name"
+                                        stx
+                                        name))
+                  (hash-table-put! ht key #t)))
+              names)))
+
+;; method-specifier? : syntax -> boolean
+;; returns #t if x is the syntax for a valid method specifier
+(define (method-specifier? x)
+  (or (eq? 'public (syntax-e x))
+      (eq? 'override (syntax-e x))))
+
+;; prefix-super : syntax[identifier] -> syntax[identifier]
+;; adds super- to the front of the identifier
+(define (prefix-super stx)
+  (datum->syntax
+   #'here
+   (string->symbol
+    (format 
+     "super-~a"
+     (syntax->datum
+      stx)))))
+
+;; method-name->contract-method-name : syntax[identifier] -> syntax[identifier]
+;; given the syntax for a method name, constructs the name of a method
+;; that returns the super's contract for the original method.
+(define (method-name->contract-method-name stx)
+  (datum->syntax
+   #'here
+   (string->symbol
+    (format 
+     "ACK_DONT_GUESS_ME-super-contract-~a"
+     (syntax->datum
+      stx)))))
+
+;; Each of the /h functions builds six pieces of syntax:
+;;  - [arguments-check]
+;;    code that binds the contract values to names and
+;;    does error checking for the contract specs
+;;    (were the arguments all contracts?)
+;;  - [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?)
+;;  - [first-order-check]
+;;    predicate function that does the first order check and returns a boolean
+;;    (is it a function of the right arity?)
+;;  - [pos-wrapper]
+;;    a piece of syntax that has the arguments to the wrapper
+;;    and the body of the wrapper.
+;;  - [neg-wrapper]
+;;    a piece of syntax that has the arguments to the wrapper
+;;    and the body of the wrapper.
+;; the first function accepts a body expression and wraps
+;;    the body expression with checks. In addition, it
+;;    adds a let that binds the contract exprssions to names
+;;    the results of the other functions mention these names.
+;; the second and third function's input syntax should be five
+;;    names: val, blame, src-info, orig-str, name-id
+;; the fourth function returns a syntax list with two elements,
+;;    the argument list (to be used as the first arg to lambda,
+;;    or as a case-lambda clause) and the body of the function.
+;; They are combined into a lambda for the -> ->* ->d ->d* macros,
+;; and combined into a case-lambda for the case-> macro.
+
+;; ->/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->/h method-proc? stx)
+  (syntax-case stx ()
+    [(_) (raise-syntax-error '-> "expected at least one argument" stx)]
+    [(_ dom ... rng)
+     (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 ...)))])
+       (with-syntax ([(name-dom-contract-x ...)
+                      (if method-proc?
+                          (cdr
+                           (syntax->list
+                            (syntax (dom-contract-x ...))))
+                          (syntax (dom-contract-x ...)))])
+         (syntax-case* (syntax rng) (any values) module-or-top-identifier=?
+           [any 
+            (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 0 '() '() #|keywords|# 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-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 ...)))])
+              (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 ...
+                                (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 0 '() '() #|keywords|# 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-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)))])
+              (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 0 '() '() #|keywords|# 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))))))))])))]))
+
+;; ->*/h : boolean stx -> (values (syntax -> syntax) (syntax syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->*/h method-proc? stx)
+  (syntax-case stx (any)
+    [(_ (dom ...) (rng ...))
+     (->/h method-proc? (syntax (-> dom ... (values rng ...))))]
+    [(_ (dom ...) any)
+     (->/h method-proc? (syntax (-> dom ... any)))]
+    [(_ (dom ...) rest (rng ...))
+     (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-rest-x (car (generate-temporaries (list (syntax rest))))]
+                   [dom-rest-contract-x (car (generate-temporaries (list (syntax rest))))]
+                   [dom-rest-projection-x (car (generate-temporaries (list (syntax rest))))]
+                   [arg-rest-x (car (generate-temporaries (list (syntax rest))))]
+                   
+                   [(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 ...))))])
+       (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-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 '() '() #|keywords|# 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-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-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 ...))))])
+       (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-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 '() '() #|keywords|# 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)
+  (syntax-case stx ()
+    [(_) (raise-syntax-error '->d "expected at least one argument" stx)]
+    [(_ dom ... rng)
+     (with-syntax ([(rng-x) (generate-temporaries (syntax (rng)))]
+                   [(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 ...)))]
+                   [arity (length (syntax->list (syntax (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)] ...)
+               (let ([dom-x (contract-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))))))
+        
+        ;; 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 arity 0 '() '() #|keywords|# src-info pos-blame orig-str))))
+        
+        (syntax (check-procedure? arity))
+        
+        (lambda (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-proc (coerce-contract '->d rng-contract))
+                    pos-blame
+                    neg-blame
+                    src-info
+                    orig-str)
+                   (val arg-x ...))))))))))]))
+
+;; ->d*/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->d*/h method-proc? stx)
+  (syntax-case stx ()
+    [(_ (dom ...) rng-mk)
+     (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 ...)))])
+       (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 0 '() '() #|keywords|# 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-x ...) (generate-temporaries (syntax (dom ...)))]
+                   [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
+                   [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
+                   [(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 ...))))])
+       (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-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 '() '() #|keywords|# 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 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)
+  (syntax-case stx ()
+    [(_ ([x dom] ...) rng)
+     (syntax-case* (syntax rng) (any values) module-or-top-identifier=?
+       [any 
+        (->r-pp/h method-proc? '->r (syntax (->r ([x dom] ...) #t any)))]
+       [(values . args)
+        (->r-pp/h method-proc? '->r (syntax (->r ([x dom] ...) #t rng #t)))]
+       [rng
+        (->r-pp/h method-proc? '->r (syntax (->r ([x dom] ...) #t rng unused-id #t)))]
+       [_
+        (raise-syntax-error '->r "unknown result contract spec" stx (syntax rng))])]
+    
+    [(_ ([x dom] ...) rest-x rest-dom rng)
+     (syntax-case* (syntax rng) (values any) module-or-top-identifier=?
+       [any 
+        (->r-pp-rest/h method-proc? '->r (syntax (->r ([x dom] ...) rest-x rest-dom #t any)))]
+       [(values . whatever)
+        (->r-pp-rest/h method-proc? '->r (syntax (->r ([x dom] ...) rest-x rest-dom #t rng #t)))]
+       [_
+        (->r-pp-rest/h method-proc? '->r (syntax (->r ([x dom] ...) rest-x rest-dom #t rng unused-id #t)))])]))
+
+;; ->pp/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->pp/h method-proc? stx) (->r-pp/h method-proc? '->pp stx))
+
+;; ->pp/h : boolean symbol stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->r-pp/h method-proc? name stx)
+  (syntax-case stx ()
+    [(_ ([x dom] ...) pre-expr . result-stuff)
+     (and (andmap identifier? (syntax->list (syntax (x ...))))
+          (not (check-duplicate-identifier (syntax->list (syntax (x ...))))))
+     (with-syntax ([stx-name name])
+       (with-syntax ([(dom-id ...) (generate-temporaries (syntax (dom ...)))]
+                     [arity (length (syntax->list (syntax (dom ...))))]
+                     [name-stx
+                      (with-syntax ([(name-xs ...) (if method-proc?
+                                                       (cdr (syntax->list (syntax (x ...))))
+                                                       (syntax (x ...)))])
+                        (syntax 
+                         (build-compound-type-name 'stx-name
+                                                   (build-compound-type-name
+                                                    (build-compound-type-name 'name-xs '(... ...))
+                                                    ...)
+                                                   '(... ...))))])
+         (values
+          (lambda (outer-args body)
+            (with-syntax ([body body]
+                          [(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)
+            (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 pos-blame orig-str)))))
+          
+          (syntax (check-procedure? arity))
+          
+          (lambda (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 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)
+                 (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
+                       (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) ...)])
+                           (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 ...))))
+                 (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 ...)
+                   (begin
+                     (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-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 
+      name
+      "duplicate identifier"
+      stx
+      (check-duplicate-identifier (syntax->list (syntax (x ...)))))]
+    [(_ ([x dom] ...) pre-expr . result-stuff)
+     (for-each (lambda (x) (unless (identifier? x) (raise-syntax-error name "expected identifier" stx x)))
+               (syntax->list (syntax (x ...))))]
+    [(_ (x ...) pre-expr . result-stuff)
+     (for-each (lambda (x)
+                 (syntax-case x ()
+                   [(x y) (identifier? (syntax x)) (void)]
+                   [bad (raise-syntax-error name "expected identifier and contract" stx (syntax bad))]))
+               (syntax->list (syntax (x ...))))]
+    [(_ x dom pre-expr . result-stuff)
+     (raise-syntax-error name "expected list of identifiers and expression pairs" stx (syntax x))]))
+
+;; ->pp-rest/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->pp-rest/h method-proc? stx) (->r-pp-rest/h method-proc? '->pp-rest stx))
+
+;; ->r-pp-rest/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
+(define (->r-pp-rest/h method-proc? name stx)
+  (syntax-case stx ()
+    [(_ ([x dom] ...) rest-x rest-dom pre-expr . result-stuff)
+     (and (identifier? (syntax rest-x))
+          (andmap identifier? (syntax->list (syntax (x ...))))
+          (not (check-duplicate-identifier (cons (syntax rest-x) (syntax->list (syntax (x ...)))))))
+     (with-syntax ([stx-name name])
+       (with-syntax ([(dom-id ...) (generate-temporaries (syntax (dom ...)))]
+                     [arity (length (syntax->list (syntax (dom ...))))]
+                     [name-stx 
+                      (with-syntax ([(name-xs ...) (if method-proc?
+                                                       (cdr (syntax->list (syntax (x ...))))
+                                                       (syntax (x ...)))])
+                        (syntax 
+                         (build-compound-type-name 'stx-name
+                                                   `(,(build-compound-type-name 'name-xs '(... ...)) ...)
+                                                   'rest-x
+                                                   '(... ...)
+                                                   '(... ...))))])
+         (values
+          (lambda (outer-args body)
+            (with-syntax ([body body]
+                          [(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)
+            (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 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-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 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-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))]
+                [((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)
+                     (begin
+                       (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-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))])
+                           (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 ...))))
+                      (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)
+                   (begin
+                     (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-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))]
+                [_
+                 (raise-syntax-error name "malformed result sepecification" stx (syntax result-stuff))]))))))]
+    [(_ ([x dom] ...) rest-x rest-dom pre-expr . result-stuff)
+     (not (identifier? (syntax rest-x)))
+     (raise-syntax-error name "expected identifier" stx (syntax rest-x))]
+    [(_ ([x dom] ...) rest-x rest-dom rng . result-stuff)
+     (and (identifier? (syntax rest-x))
+          (andmap identifier? (cons (syntax rest-x) (syntax->list (syntax (x ...))))))
+     (raise-syntax-error 
+      name
+      "duplicate identifier"
+      stx
+      (check-duplicate-identifier (syntax->list (syntax (x ...)))))]
+    
+    [(_ ([x dom] ...) rest-x rest-dom rng . result-stuff)
+     (for-each (lambda (x) (unless (identifier? x) (raise-syntax-error name "expected identifier" stx x)))
+               (cons
+                (syntax rest-x)
+                (syntax->list (syntax (x ...)))))]
+    [(_ x dom rest-x rest-dom rng . result-stuff)
+     (raise-syntax-error name "expected list of identifiers and expression pairs" stx (syntax x))]))
+
+;; set-inferred-name-from : syntax syntax -> syntax
+(define (set-inferred-name-from with-name to-be-named)
+  (let ([name (syntax-local-infer-name with-name)])
+    (cond
+      [(identifier? name)
+       (with-syntax ([rhs (syntax-property to-be-named 'inferred-name (syntax-e name))]
+                     [name (syntax-e name)])
+         (syntax (let ([name rhs]) name)))]
+      [(symbol? name)
+       (with-syntax ([rhs (syntax-property to-be-named 'inferred-name name)]
+                     [name name])
+         (syntax (let ([name rhs]) name)))]
+      [else to-be-named])))
+
+;; generate-indicies : syntax[list] -> (cons number (listof number))
+;; given a syntax list of length `n', returns a list containing
+;; the number n followed by th numbers from 0 to n-1
+(define (generate-indicies stx)
+  (let ([n (length (syntax->list stx))])
+    (cons n
+          (let loop ([i n])
+            (cond
+              [(zero? i) null]
+              [else (cons (- n i)
+                          (loop (- i 1)))])))))
\ No newline at end of file
diff --git a/collects/mzlib/private/contract-arrow.ss b/collects/mzlib/private/contract-arrow.ss
index ee60620..e1f0551 100644
--- a/collects/mzlib/private/contract-arrow.ss
+++ b/collects/mzlib/private/contract-arrow.ss
@@ -1,12 +1,12 @@
 #lang scheme/base
 
 (require scheme/private/contract-guts
-         scheme/private/contract-arr-checks
-         scheme/private/contract-opt)
+         scheme/private/contract-opt
+         "contract-arr-checks.ss")
 (require (for-syntax scheme/base)
          (for-syntax scheme/private/contract-opt-guts)
          (for-syntax scheme/private/contract-helpers)
-         (for-syntax scheme/private/contract-arr-obj-helpers)
+         (for-syntax "contract-arr-obj-helpers.ss")
          (for-syntax syntax/stx)
          (for-syntax syntax/name))
 
diff --git a/collects/mzlib/private/contract-object.ss b/collects/mzlib/private/contract-object.ss
index 15cf8e5..4de48a0 100644
--- a/collects/mzlib/private/contract-object.ss
+++ b/collects/mzlib/private/contract-object.ss
@@ -2,11 +2,11 @@
 (require "contract-arrow.ss"
          scheme/private/contract-guts
          scheme/private/class-internal
-         scheme/private/contract-arr-checks)
+         "contract-arr-checks.ss")
 
 (require (for-syntax scheme/base
                      scheme/private/contract-helpers
-                     scheme/private/contract-arr-obj-helpers))
+                     "contract-arr-obj-helpers.ss"))
 
 (provide mixin-contract
          make-mixin-contract