diff --git a/collects/mzlib/md5.ss b/collects/mzlib/md5.ss
index fde0af0..0cfc071 100644
--- a/collects/mzlib/md5.ss
+++ b/collects/mzlib/md5.ss
@@ -2,7 +2,7 @@
 
   (provide md5)
 
-  ;;; Copyright (c) 2005-2007, PLT Scheme Inc.
+  ;;; Copyright (c) 2005-2008, PLT Scheme Inc.
   ;;; Copyright (c) 2002, Jens Axel Soegaard
   ;;;
   ;;; Permission to copy this software, in whole or in part, to use this
diff --git a/collects/scheme/private/contract-arr-checks.ss b/collects/scheme/private/contract-arr-checks.ss
deleted file mode 100644
index f4896a9..0000000
--- a/collects/scheme/private/contract-arr-checks.ss
+++ /dev/null
@@ -1,234 +0,0 @@
-#lang scheme/base
-
-(provide (all-defined-out))
-(require "contract-guts.ss")
-
-(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/scheme/private/contract-arr-obj-helpers.ss b/collects/scheme/private/contract-arr-obj-helpers.ss
deleted file mode 100644
index 6ca7373..0000000
--- a/collects/scheme/private/contract-arr-obj-helpers.ss
+++ /dev/null
@@ -1,1112 +0,0 @@
-#lang scheme/base
-(require syntax/stx 
-         syntax/name)
-
-(require (for-syntax scheme/base))
-(require (for-template scheme/base)
-         (for-template "contract-guts.ss")
-         (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