diff --git a/collects/typed-scheme/infer/constraint-structs.ss b/collects/typed-scheme/infer/constraint-structs.ss
index a676a8fb..1fbf9742 100644
--- a/collects/typed-scheme/infer/constraint-structs.ss
+++ b/collects/typed-scheme/infer/constraint-structs.ss
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require "../utils/utils.ss" (rep type-rep) scheme/contract)
+(require "../utils/utils.ss" (rep type-rep) scheme/contract scheme/match (for-syntax scheme/base syntax/parse))
 
 ;; S, T types
 ;; X a var
@@ -29,7 +29,13 @@
 ;; don't want to rule them out too early
 (define-struct cset (maps) #:prefab)
 
-(p/c (struct c ([S Type?] [X symbol?] [T Type?]))
+(define-match-expander c:
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ s x t)
+       #'(struct c ((app (lambda (v) (if (Type? v) v (Un))) s) x (app (lambda (v) (if (Type? v) v Univ)) t)))])))
+
+(p/c (struct c ([S (or/c boolean? Type?)] [X symbol?] [T (or/c boolean? Type?)]))
      (struct dcon ([fixed (listof c?)] [rest (or/c c? false/c)]))
      (struct dcon-exact ([fixed (listof c?)] [rest c?]))
      (struct dcon-dotted ([type c?] [bound symbol?]))
diff --git a/collects/typed-scheme/infer/infer-unit.ss b/collects/typed-scheme/infer/infer-unit.ss
index eb2ce093..fa4d5267 100644
--- a/collects/typed-scheme/infer/infer-unit.ss
+++ b/collects/typed-scheme/infer/infer-unit.ss
@@ -428,7 +428,7 @@
     (match v
       [(struct c (S X T))
        (let ([var (hash-ref (free-vars* R) (or variable X) Constant)])
-         ;(printf "variance was: ~a~nR was ~a~nX was ~a~n" var R (or variable X))
+         ;(printf "variance was: ~a~nR was ~a~nX was ~a~nS T ~a ~a~n" var R (or variable X) S T)
          (evcase var 
                  [Constant S]
                  [Covariant S]
@@ -440,7 +440,7 @@
      (check-vars
       must-vars
       (append 
-       (for/list ([(k dc) dm])
+       (for/list ([(k dc) (in-hash dm)])
          (match dc
            [(struct dcon (fixed rest))
             (list k
@@ -452,7 +452,7 @@
                   (for/list ([f fixed])
                     (constraint->type f #:variable k))
                   (constraint->type rest))]))
-       (for/list ([(k v) cmap])
+       (for/list ([(k v) (in-hash cmap)])
          (list k (constraint->type v)))))]))
 
 (define (cgen/list V X S T)
diff --git a/collects/typed-scheme/rep/filter-rep.ss b/collects/typed-scheme/rep/filter-rep.ss
index 4e60c8a8..1ae4f5ab 100644
--- a/collects/typed-scheme/rep/filter-rep.ss
+++ b/collects/typed-scheme/rep/filter-rep.ss
@@ -50,7 +50,7 @@
                                 [(ormap Bot? t)
                                  (flat-named-contract "t was Bot" (list/c))]
                                 [else (listof Filter/c)])])
-                      ()
+                      (#:syntax [stx #f])
                       [result FilterSet?])])
 
 ;; represents no info about the filters of this expression
@@ -89,7 +89,7 @@
                                 [(ormap LBot? t)
                                  (flat-named-contract "t was LBot" (list/c))]
                                 [else (listof LatentFilter/c)])])
-                      ()
+                      (#:syntax [stx #f])
                       [result LFilterSet?])])
 
 (define FilterSet/c
diff --git a/collects/typed-scheme/rep/free-variance.ss b/collects/typed-scheme/rep/free-variance.ss
index 7a210bc7..c42f9c6b 100644
--- a/collects/typed-scheme/rep/free-variance.ss
+++ b/collects/typed-scheme/rep/free-variance.ss
@@ -4,9 +4,12 @@
          (utils tc-utils) scheme/list
          mzlib/etc scheme/contract)
 
+(provide Covariant Contravariant Invariant Constant Dotted
+         combine-frees flip-variances without-below unless-in-table empty-hash-table
+         fix-bound make-invariant variance?)
+
 ;; this file contains support for calculating the free variables/indexes of types
 ;; actual computation is done in rep-utils.ss  and type-rep.ss
-
 (define-values (Covariant Contravariant Invariant Constant Dotted)
   (let ()
     (define-struct Variance () #:inspector #f)
@@ -19,31 +22,11 @@
     (values (make-Covariant) (make-Contravariant) (make-Invariant) (make-Constant) (make-Dotted))))
 
 
-(provide Covariant Contravariant Invariant Constant Dotted)
-
 (define (variance? e)
   (memq e (list Covariant Contravariant Invariant Constant Dotted)))
 
-;; hashtables for keeping track of free variables and indexes
-(define index-table (make-weak-hash))
-;; maps Type to List[Cons[Number,Variance]]
-(define var-table (make-weak-hash))
-;; maps Type to List[Cons[Symbol,Variance]]
-
-(define ((input/c tbl) val) (hash-ref tbl val #f))
-
-#;
-(define (free-idxs* t) #;(Type-free-idxs t)
-  
-  (hash-ref index-table t (lambda _ (int-err "type ~a not in index-table" t))))
-#;
-(define (free-vars* t) #;(Type-free-vars t)
-  (hash-ref var-table t (lambda _ (int-err "type ~a not in var-table" t))))
-
 (define empty-hash-table (make-immutable-hasheq null))
 
-(provide empty-hash-table make-invariant input/c variance?)
-
 ;; frees = HT[Idx,Variance] where Idx is either Symbol or Number
 ;; (listof frees) -> frees
 (define (combine-frees freess)    
@@ -78,8 +61,7 @@
 (define (flip-variances vs)
   (hash-map* 
    (lambda (k v) 
-     (evcase 
-         v
+     (evcase v
        [Covariant Contravariant]
        [Contravariant Covariant]
        [v v]))
@@ -102,9 +84,6 @@
        (when (>= k n) (hash-set! new-ht k v)))
   new-ht)
 
-(provide combine-frees flip-variances without-below unless-in-table var-table index-table empty-hash-table
-         fix-bound)
-
 (define-syntax (unless-in-table stx) 
   (syntax-case stx ()
     [(_ table val . body)
diff --git a/collects/typed-scheme/rep/interning.ss b/collects/typed-scheme/rep/interning.ss
index c09160e7..4a44449d 100644
--- a/collects/typed-scheme/rep/interning.ss
+++ b/collects/typed-scheme/rep/interning.ss
@@ -5,19 +5,27 @@
 (provide defintern hash-id)
 
 (define-syntax (defintern stx)
+  (define-splicing-syntax-class extra-kw-spec
+    (pattern (~seq kw:keyword [name:id default:expr])
+             #:with formal #'(kw [name default])))
+  (define-splicing-syntax-class extra-spec
+    (pattern ek:extra-kw-spec
+             #:with e #'ek.name)
+    (pattern e:expr))
   (syntax-parse stx
-    [(_ name+args make-name key #:extra-args e:expr ...)
+    [(_ name+args make-name key #:extra-args e ...)
      #'(defintern name+args (lambda () (make-hash)) make-name key #:extra-args e ...)]
-    [(_ (*name:id arg:id ...) make-ht make-name key-expr #:extra-args e:expr ...)
-     #'(define *name
-	 (let ([table (make-ht)])
-	   (lambda (arg ...)
-	     (let ([key key-expr])
-	       (hash-ref table key
-			 (lambda ()
-			   (let ([new (make-name (count!) e ... arg ...)])
-			     (hash-set! table key new)
-			     new)))))))]))
+    [(_ (*name:id arg:id ...) make-ht make-name key-expr #:extra-args . (~and ((~seq es:extra-spec) ...) ((~or (~seq ek:extra-kw-spec) e:expr) ...)))
+     (with-syntax ([((extra-formals ...) ...) #'(ek.formal ...)])
+       #'(define *name
+           (let ([table (make-ht)])
+             (lambda (arg ... extra-formals ... ...)
+               (let ([key key-expr])
+                 (hash-ref table key
+                           (lambda ()
+                             (let ([new (make-name (count!) es.e ... arg ...)])
+                               (hash-set! table key new)
+                               new))))))))]))
 
 (define (make-count!)  
   (let ([state 0])
diff --git a/collects/typed-scheme/rep/rep-utils.ss b/collects/typed-scheme/rep/rep-utils.ss
index cf203fc8..c320d49e 100644
--- a/collects/typed-scheme/rep/rep-utils.ss
+++ b/collects/typed-scheme/rep/rep-utils.ss
@@ -25,27 +25,26 @@
 
 (provide == defintern hash-id (for-syntax fold-target))
 
-(define-struct Rep (seq
-                    free-vars  
-                    free-idxs))
+(define-struct Rep (seq free-vars free-idxs stx))
 
 (define-for-syntax fold-target #'fold-target)
-(define-for-syntax default-fields (list #'seq #'free-vars #'free-idxs))
+(define-for-syntax default-fields (list #'seq #'free-vars #'free-idxs #'stx))
 
 (define-for-syntax (mk par ht-stx key?)
   (define-syntax-class opt-cnt-id
     #:attributes (i cnt)
     (pattern i:id
              #:with cnt #'any/c)
-    (pattern [i:id cnt]))
-  (define-syntax-class no-provide-kw
-    (pattern #:no-provide))
-  (define-syntax-class idlist
-    #:attributes ((i 1) (cnt 1) fs)
+    (pattern [i:id cnt]))  
+  ;; fields
+  (define-syntax-class (idlist name)
+    #:attributes ((i 1) (cnt 1) fs maker pred (acc 1))
     (pattern (oci:opt-cnt-id ...)               
              #:with (i ...) #'(oci.i ...)
              #:with (cnt ...) #'(oci.cnt ...)
-             #:with fs #'(i ...)))
+             #:with fs #'(i ...)
+             #:with (_ maker pred acc ...) (build-struct-names name (syntax->list #'fs) #f #t name)))
+  
   (define (combiner f flds)
     (syntax-parse flds
       [() #'empty-hash-table]
@@ -53,15 +52,12 @@
       [(e ...) #`(combine-frees (list (#,f e) ...))]))
   (define-splicing-syntax-class frees-pat
     #:transparent
-    #:attributes (f1 f2 def)
-    (pattern (~seq f1:expr f2:expr)
-             #:with def #'(begin))
+    #:attributes (f1 f2)
+    (pattern (~seq f1:expr f2:expr))
     (pattern #f
              #:with f1 #'empty-hash-table
-             #:with f2 #'empty-hash-table
-             #:with def #'(begin))
+             #:with f2 #'empty-hash-table)
     (pattern e:expr
-             #:with def #'(begin)
              #:with f1 #'(e Rep-free-vars)
              #:with f2 #'(e Rep-free-idxs)))
   (define-syntax-class (fold-pat fold-name)
@@ -85,39 +81,40 @@
              #:with *maker (format-id #'nm "*~a" #'nm)))
   (lambda (stx)          
     (syntax-parse stx 
-      [(dform nm:form-nm flds:idlist (~or 
-                                      (~optional (~and (~fail #:unless key? "#:key not allowed")
-                                                       [#:key key-expr:expr])
-                                                 #:defaults ([key-expr #'#f]))
-                                      (~optional [#:intern intern?:expr]
-                                                 #:defaults
-                                                 ([intern? (syntax-parse #'flds.fs
-                                                             [() #'#f]
-                                                             [(f) #'f]
-                                                             [(fs ...) #'(list fs ...)])]))
-                                      (~optional [#:frees frees:frees-pat]
-                                                 #:defaults 
-                                                 ([frees.def #'(begin)]
-                                                  [frees.f1 (combiner #'Rep-free-vars #'flds.fs)]
-                                                  [frees.f2 (combiner #'Rep-free-idxs #'flds.fs)]))
-                                      (~optional [#:fold-rhs (~var fold-rhs (fold-pat #'nm.fold))]
-                                                 #:defaults
-                                                 ([fold-rhs.proc
-                                                   #'(procedure-rename
-                                                      (lambda () 
-                                                        #`(nm.*maker (#,type-rec-id flds.i) ...))
-                                                      'nm.fold)]))
-                                      (~optional [#:contract cnt:expr])
-                                      (~optional no-provide?:no-provide-kw)) ...)
-       (with-syntax* 
-        ([(s:ty maker pred acc ...) (build-struct-names #'nm (syntax->list #'flds.fs) #f #t #'nm)]
-         [*maker-cnt (or (attribute cnt) #'(flds.cnt ... . -> . pred))]
+      [(dform nm:form-nm
+              (~var flds (idlist #'nm))
+              (~or 
+               (~optional (~and (~fail #:unless key? "#:key not allowed")
+                                [#:key key-expr:expr])
+                          #:defaults ([key-expr #'#f]))
+               (~optional [#:intern intern?:expr]
+                          #:defaults
+                          ([intern? (syntax-parse #'flds.fs
+                                      [() #'#f]
+                                      [(f) #'f]
+                                      [(fs ...) #'(list fs ...)])]))
+               (~optional [#:frees frees:frees-pat]
+                          #:defaults 
+                          ([frees.f1 (combiner #'Rep-free-vars #'flds.fs)]
+                           [frees.f2 (combiner #'Rep-free-idxs #'flds.fs)]))
+               (~optional [#:fold-rhs (~var fold-rhs (fold-pat #'nm.fold))]
+                          #:defaults
+                          ([fold-rhs.proc
+                            #'(procedure-rename
+                               (lambda () 
+                                 #`(nm.*maker (#,type-rec-id flds.i) ...))
+                               'nm.fold)]))
+               (~optional [#:contract cnt:expr]
+                          #:defaults ([cnt #'((flds.cnt ...) (#:syntax (or/c syntax? #f)) . ->* . flds.pred)]))
+               (~optional (~and #:no-provide no-provide?))) ...)
+       (with-syntax
+        ([(ign-pats ...) (append (map (lambda (x) #'_) default-fields) (if key? (list #'_) (list)))]
+         ;; has to be down here to refer to #'cnt
          [provides (if (attribute no-provide?)
-                       #'(begin)                                 
-                       #`(begin 
-                           (provide nm.ex pred acc ...)
-                           (p/c (rename nm.*maker maker *maker-cnt))))]
-         [(ign-pats ...) (append (map (lambda (x) #'_) default-fields) (if key? (list #'_) (list)))])
+                       #'(begin)
+                       #'(begin 
+                           (provide nm.ex flds.pred flds.acc ...)
+                           (p/c (rename nm.*maker flds.maker cnt))))])
         #`(begin
             (define-struct (nm #,par) flds.fs #:inspector #f)
             (define-match-expander nm.ex
@@ -129,13 +126,12 @@
             (begin-for-syntax
               (hash-set! #,ht-stx 'nm.kw (list #'nm.ex #'flds.fs fold-rhs.proc #f)))
             #,(quasisyntax/loc stx
-                (w/c nm ([nm.*maker *maker-cnt])
+                (w/c nm ([nm.*maker cnt])
                      #,(quasisyntax/loc #'nm
-                         (defintern (nm.*maker . flds.fs) maker intern?
+                         (defintern (nm.*maker . flds.fs) flds.maker intern?
                            #:extra-args
-                           frees.f1 frees.f2 
-                           #,@(begin                                 
-                                (if key? (list #'key-expr) null))))))
+                           frees.f1 frees.f2 #:syntax [orig-stx #f] 
+                           #,@(if key? (list #'key-expr) null)))))
             provides))])))
 
 (define-for-syntax (mk-fold ht type-rec-id rec-ids kws)
@@ -252,4 +248,5 @@
 
 (p/c (struct Rep ([seq integer?] 
                   [free-vars (hash/c symbol? variance?)] 
-                  [free-idxs (hash/c exact-nonnegative-integer? variance?)])))
+                  [free-idxs (hash/c exact-nonnegative-integer? variance?)]
+                  [stx (or/c #f syntax?)])))
diff --git a/collects/typed-scheme/rep/type-rep.ss b/collects/typed-scheme/rep/type-rep.ss
index f260109e..a664f847 100644
--- a/collects/typed-scheme/rep/type-rep.ss
+++ b/collects/typed-scheme/rep/type-rep.ss
@@ -100,7 +100,7 @@
 (dt Poly (n body) #:no-provide 
     [#:contract (->d ([n natural-number/c]
                       [body (scope-depth n)])
-                     ()
+                     (#:syntax [stx (or/c #f syntax?)])
                      [result Poly?])]
     [#:frees (free-vars* body) (without-below n (free-idxs* body))]
     [#:fold-rhs (let ([body* (remove-scopes n body)])
@@ -113,7 +113,7 @@
 (dt PolyDots (n body) #:no-provide
     [#:contract (->d ([n natural-number/c]
                       [body (scope-depth n)])
-                     ()
+                     (#:syntax [stx (or/c #f syntax?)])
                      [result PolyDots?])]
     [#:key (Type-key body)]
     [#:frees (free-vars* body) (without-below n (free-idxs* body))]
diff --git a/collects/typed-scheme/typecheck/tc-app.ss b/collects/typed-scheme/typecheck/tc-app.ss
index 6dcd92ac..3822b55a 100644
--- a/collects/typed-scheme/typecheck/tc-app.ss
+++ b/collects/typed-scheme/typecheck/tc-app.ss
@@ -511,13 +511,13 @@
     [(#%plain-app do-make-object cl (#%plain-app list . pos-args) (#%plain-app list (#%plain-app cons 'names named-args) ...))
      (check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...))]
     ;; ormap/andmap of ... argument
-    [(#%plain-app or/andmap:id f arg)
-     #:fail-unless (or (free-identifier=? #'or/andmap #'ormap)
-                       (free-identifier=? #'or/andmap #'andmap)) #f
-     #:fail-unless (with-handlers ([exn:fail? (lambda _ #f)])
-                     (tc/dots #'arg)
-                     #t) #f
-     (let-values ([(ty bound) (tc/dots #'arg)])
+    [(#%plain-app (~or (~literal andmap) (~literal ormap)) f arg)
+     #:attr ty+bound
+     (with-handlers ([exn:fail? (lambda _ #f)])
+       (let-values ([(ty bound) (tc/dots #'arg)])
+         (list ty bound)))
+     #:when (attribute ty+bound)
+     (match-let ([(list ty bound) (attribute ty+bound)])
        (parameterize ([current-tvars (extend-env (list bound)
                                                  (list (make-DottedBoth (make-F bound)))
                                                  (current-tvars))])
@@ -677,6 +677,7 @@
                            (and vars (list fixed-vars ... dotted-var))
                            (Function: (list (and arrs (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...))) ...)))))
       (list (tc-result1: argtys-t) ...))
+     (printf "poly clause 1~n")
      (handle-clauses (doms rngs rests drests arrs) f-stx args-stx
                      ;; only try inference if the argument lengths are appropriate
                      (lambda (dom _ rest drest a)