diff --git a/typed-racket-lib/typed-racket/base-env/ann-inst.rkt b/typed-racket-lib/typed-racket/base-env/ann-inst.rkt
index cfd26362..5dc9dcbf 100644
--- a/typed-racket-lib/typed-racket/base-env/ann-inst.rkt
+++ b/typed-racket-lib/typed-racket/base-env/ann-inst.rkt
@@ -17,9 +17,7 @@
      (add-ann #'arg #'ty)]))
 
 (define-for-syntax (add-ann expr-stx ty-stx)
-  (quasisyntax/loc expr-stx
-    (#,(type-ascription-property #'#%expression ty-stx)
-     #,expr-stx)))
+  (type-ascription-property (quasisyntax/loc expr-stx (#%expression #,expr-stx)) ty-stx))
 
 (define-syntax (inst stx)
   (syntax-parse stx #:literals (:)
diff --git a/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt b/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt
index fada7e16..c78a169e 100644
--- a/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt
+++ b/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt
@@ -3,7 +3,7 @@
 (begin
   (require
    (for-syntax racket/base racket/syntax syntax/parse)
-   (only-in (rep type-rep) Type/c? make-Values)
+   (only-in (rep type-rep values-rep) Type? make-Values)
    racket/list racket/math racket/flonum racket/extflonum racket/unsafe/ops racket/sequence racket/match
    (for-template racket/flonum racket/extflonum racket/fixnum racket/math racket/unsafe/ops racket/base
                  (only-in "../types/numeric-predicates.rkt" index?))
diff --git a/typed-racket-lib/typed-racket/base-env/base-env.rkt b/typed-racket-lib/typed-racket/base-env/base-env.rkt
index 3480cae1..7f350995 100644
--- a/typed-racket-lib/typed-racket/base-env/base-env.rkt
+++ b/typed-racket-lib/typed-racket/base-env/base-env.rkt
@@ -23,7 +23,7 @@
  (only-in racket/private/pre-base new-apply-proc)
  (only-in (types abbrev) [-Boolean B] [-Symbol Sym] -Flat)
  (only-in (types numeric-tower) [-Number N])
- (only-in (rep type-rep)
+ (only-in (rep type-rep values-rep)
           make-ClassTop
           make-UnitTop
           make-Name
diff --git a/typed-racket-lib/typed-racket/base-env/top-interaction.rkt b/typed-racket-lib/typed-racket/base-env/top-interaction.rkt
index 8afbae9c..a7580275 100644
--- a/typed-racket-lib/typed-racket/base-env/top-interaction.rkt
+++ b/typed-racket-lib/typed-racket/base-env/top-interaction.rkt
@@ -64,7 +64,7 @@
                       [current-type-names
                        (if (attribute verbose-kw) '() (current-type-names))]
                       [current-print-unexpanded (box '())])
-         (define type (pretty-format-type (parse-type #'ty)))
+         (define type (pretty-format-rep (parse-type #'ty)))
          (define unexpanded
            (remove-duplicates (unbox (current-print-unexpanded))))
          (define cue (if (null? unexpanded)
@@ -92,7 +92,7 @@
   (define-repl-op :print-type-impl (_ e) #'e
     (λ (type)
       #`(displayln
-         #,(pretty-format-type
+         #,(pretty-format-rep
             (match type
               [(tc-result1: t f o) t]
               [(tc-results: t) (-values t)]
@@ -108,7 +108,7 @@
                 (op dummy-arg ...)))
      (λ (type)
        #`(display
-          #,(pretty-format-type
+          #,(pretty-format-rep
              (match type
                [(tc-result1: (and t (Function: _)) f o) t]))))
      "must be applied to at least one argument" )
@@ -124,6 +124,6 @@
                   [(Function: '())
                    "Desired return type not in the given function's range.\n"]
                   [(Function: arrs)
-                   (pretty-format-type cleaned)])))]
+                   (pretty-format-rep cleaned)])))]
         [_ (error (format "~a: not a function" (syntax->datum #'op)))]))
     "must be applied to exactly two arguments"))
diff --git a/typed-racket-lib/typed-racket/core.rkt b/typed-racket-lib/typed-racket/core.rkt
index f9f46b78..6b1e6481 100644
--- a/typed-racket-lib/typed-racket/core.rkt
+++ b/typed-racket-lib/typed-racket/core.rkt
@@ -12,7 +12,6 @@
          (rep type-rep)
          (for-template (base-env top-interaction))
          (utils utils tc-utils arm)
-         (only-in (types printer) pretty-format-type)
          "standard-inits.rkt"
          "tc-setup.rkt")
 
diff --git a/typed-racket-lib/typed-racket/env/env-utils.rkt b/typed-racket-lib/typed-racket/env/env-utils.rkt
index dd981e27..5286f47b 100644
--- a/typed-racket-lib/typed-racket/env/env-utils.rkt
+++ b/typed-racket-lib/typed-racket/env/env-utils.rkt
@@ -1,14 +1,18 @@
 #lang racket/base
 
 (require racket/dict racket/sequence)
-(provide id< sorted-dict-map in-sorted-dict)
+(provide id< sorted-dict-map sorted-dict-for-each in-sorted-dict)
 
 (define (id< a b) (symbol<? (syntax-e a) (syntax-e b)))
 
 (define (sorted-dict-map dict f <)
-  (define sorted (sort #:key car (dict-map dict cons) <))
+  (define sorted (sort (dict-map dict cons) (λ (x y) (< (car x) (car y)))))
   (map (lambda (a) (f (car a) (cdr a))) sorted))
 
+(define (sorted-dict-for-each dict f <)
+  (define sorted (sort (dict-map dict cons) (λ (x y) (< (car x) (car y)))))
+  (for-each (lambda (a) (f (car a) (cdr a))) sorted))
+
 (define (in-sorted-dict dict <)
   (define sorted (sort #:key car (dict-map dict cons) <))
   (in-dict sorted))
diff --git a/typed-racket-lib/typed-racket/env/global-env.rkt b/typed-racket-lib/typed-racket/env/global-env.rkt
index c8a1fc18..167fe02a 100644
--- a/typed-racket-lib/typed-racket/env/global-env.rkt
+++ b/typed-racket-lib/typed-racket/env/global-env.rkt
@@ -18,9 +18,10 @@
          register-types
          unregister-type
          check-all-registered-types
-         type-env-map)
+         type-env-map
+         type-env-for-each)
 
-(lazy-require ["../rep/type-rep.rkt" (Type/c? type-equal?)])
+(lazy-require ["../rep/type-rep.rkt" (Type? type-equal?)])
 
 ;; free-id-table from id -> type or Box[type]
 ;; where id is a variable, and type is the type of the variable
@@ -36,7 +37,7 @@
   (cond [(free-id-table-ref the-mapping id (lambda _ #f))
          => (lambda (e)
               (define t (if (box? e) (unbox e) e))
-              (unless (and (Type/c? t) (type-equal? t type))
+              (unless (and (Type? t) (type-equal? t type))
                 (tc-error/delayed #:stx id "Duplicate type annotation of ~a for ~a, previous was ~a" type (syntax-e id) t))
               (when (box? e)
                 (free-id-table-set! the-mapping id t)))]
@@ -50,7 +51,7 @@
          =>
          (λ (t) ;; it's ok to annotate with the same type
            (define t* (if (box? t) (unbox t) t))
-           (unless (and (Type/c? t*) (type-equal? type t*))
+           (unless (and (Type? t*) (type-equal? type t*))
              (tc-error/delayed #:stx id "Duplicate type annotation of ~a for ~a, previous was ~a" type (syntax-e id) t*)))]
         [else (free-id-table-set! the-mapping id (box type))]))
 
@@ -104,3 +105,6 @@
 ;; (id type -> T) -> listof[T]
 (define (type-env-map f)
   (sorted-dict-map the-mapping f id<))
+
+(define (type-env-for-each f)
+  (sorted-dict-for-each the-mapping f id<))
diff --git a/typed-racket-lib/typed-racket/env/init-envs.rkt b/typed-racket-lib/typed-racket/env/init-envs.rkt
index 7a21a863..f5dc3eb2 100644
--- a/typed-racket-lib/typed-racket/env/init-envs.rkt
+++ b/typed-racket-lib/typed-racket/env/init-envs.rkt
@@ -10,7 +10,10 @@
          "mvar-env.rkt"
          "signature-env.rkt"
          (rename-in racket/private/sort [sort raw-sort])
-         (rep type-rep object-rep prop-rep rep-utils free-variance)
+         (rep core-rep type-rep
+              prop-rep rep-utils
+              object-rep values-rep
+              free-variance)
          (for-syntax syntax/parse racket/base)
          (types abbrev struct-table union utils)
          data/queue
@@ -57,10 +60,10 @@
 ;; Compute for a given type how many times each type inside of it
 ;; is referenced
 (define (compute-popularity ty)
-  (hash-update! pop-table ty add1 0)
-  (define (count ty) (compute-popularity ty) ty)
-  (type-case (#:Type count #:Prop (sub-f count) #:Object (sub-o count))
-             ty))
+  (when (Type? ty)
+    (hash-update! pop-table ty add1 0))
+  (when (walkable? ty)
+    (Rep-walk compute-popularity ty)))
 
 (define (popular? ty)
   (> (hash-ref pop-table ty 0) 5))
@@ -98,7 +101,7 @@
     (define-values (nums others) (partition numeric? ts))
     (cond [(or (null? nums) (null? others))
             ;; nothing interesting to do in this case
-            `(make-Union (,#'raw-sort (list ,@(map type->sexp ts)) < Type-seq #f))]
+            `(make-Union (list ,@(map type->sexp ts)))]
            [else
             ;; we do a little more work to hopefully save a bunch in serialization space
             ;; if we get a hit in the predefined-type-table
@@ -175,11 +178,11 @@
                     ,(type->sexp t)
                     ,(type->sexp ft)
                     ,(object->sexp pth))]
-    [(Function: (list (arr: dom (Values: (list (Result: t (PropSet: (NotTypeProp: (Path: pth (list 0 0))
+    [(Function: (list (arr: dom (Values: (list (Result: t (PropSet: (NotTypeProp: (Path: pth (cons 0 0))
                                                                                   (== -False))
-                                                                    (TypeProp: (Path: pth (list 0 0))
+                                                                    (TypeProp: (Path: pth (cons 0 0))
                                                                                (== -False)))
-                                                        (Path: pth (list 0 0)))))
+                                                        (Path: pth (cons 0 0)))))
                             #f #f '())))
      `(->acc (list ,@(map type->sexp dom))
              ,(type->sexp t)
@@ -217,8 +220,7 @@
                     `(quote ,v)))]
     [(Union: elems) (split-union elems)]
     [(Intersection: elems)
-     `(make-Intersection (set ,@(for/list ([elem (in-immutable-set elems)])
-                                  (type->sexp elem))))]
+     `(make-Intersection (list ,@(map type->sexp elems)))]
     [(Name: stx 0 #t)
      `(-struct-name (quote-syntax ,stx))]
     [(Name: stx args struct?)
@@ -316,7 +318,7 @@
 
 ;; Helper for class/row clauses
 (define (convert-row-clause members [inits? #f])
-  (for/list ([m members])
+  (for/list ([m (in-list members)])
     `(list (quote ,(car m))
            ,(type->sexp (cadr m))
            ,@(if inits? (cddr m) '()))))
@@ -343,15 +345,15 @@
 (define (object->sexp obj)
   (match obj
     [(Empty:) `(make-Empty)]
-    [(Path: null (list 0 arg))
+    [(Path: null (cons 0 arg))
      `(-arg-path ,arg)]
-    [(Path: null (list depth arg))
+    [(Path: null (cons depth arg))
      `(-arg-path ,arg ,depth)]
     [(Path: pes i)
      `(make-Path (list ,@(map path-elem->sexp pes))
                  ,(if (identifier? i)
                       `(quote-syntax ,i)
-                      `(list ,(car i) ,(cadr i))))]))
+                      `(cons ,(car i) ,(cdr i))))]))
 
 ;; Path-Element -> SExp
 ;; Convert a path element in an object to an s-expression
@@ -383,16 +385,16 @@
 ;; the type serialization pass. Only walks the environments that
 ;; actually track types.
 (define (compute-all-popularities)
-  (define (count-env map)
+  (define (count-env for-each)
     (define (count id ty) (compute-popularity ty))
     (define (bound-f id v)
       (and (bound-in-this-module id) (count id v)))
-    (map bound-f))
+    (for-each bound-f))
 
-  (count-env type-name-env-map)
-  (count-env type-alias-env-map)
-  (count-env type-env-map)
-  (count-env signature-env-map))
+  (count-env type-name-env-for-each)
+  (count-env type-alias-env-for-each)
+  (count-env type-env-for-each)
+  (count-env signature-env-for-each))
 
 (define (tname-env-init-code)
   (make-init-code
@@ -419,10 +421,12 @@
     (λ (f) (dict-map mvar-env f))
     (lambda (id v) (and v #`(register-mutated-var #'#,id)))))
 
+;; see 'finalize-signatures!' in 'env/signature-env.rkt',
+;; which forces these delays after all the signatures are parsed
 (define (signature-env-init-code)
   (make-init-code
    signature-env-map
-   (lambda (id sig) #`(register-signature! #'#,id #,(quote-type sig)))))
+   (lambda (id sig) #`(register-signature! #'#,id (delay #,(quote-type sig))))))
 
 (define (make-struct-table-code)
   (make-init-code
diff --git a/typed-racket-lib/typed-racket/env/lexical-env.rkt b/typed-racket-lib/typed-racket/env/lexical-env.rkt
index 0b9fe1ce..211e4283 100644
--- a/typed-racket-lib/typed-racket/env/lexical-env.rkt
+++ b/typed-racket-lib/typed-racket/env/lexical-env.rkt
@@ -10,21 +10,20 @@
          racket/keyword-transform racket/list
          (for-syntax syntax/parse racket/base)
          (contract-req)                       
-         (env type-env-structs global-env mvar-env)
+         (env type-env-structs global-env)
          (utils tc-utils)
-         (only-in (rep type-rep) Type/c)
+         (only-in (rep type-rep) Type?)
          (typecheck renamer)
          (except-in (types utils abbrev kw-types) -> ->* one-of/c))
 
-(require-for-cond-contract (rep object-rep))
+(require-for-cond-contract (rep object-rep core-rep))
 
 (provide lexical-env 
          with-lexical-env 
          with-lexical-env/extend-types
-         with-lexical-env/extend-types+aliases
-         update-type/lexical)
+         with-lexical-env/extend-types+aliases)
 (provide/cond-contract
- [lookup-type/lexical ((identifier?) (env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type/c #f))]
+ [lookup-type/lexical ((identifier?) (env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type? #f))]
  [lookup-alias/lexical ((identifier?) (env?) . ->* . (or/c Path? Empty?))])
 
 ;; the current lexical environment
@@ -74,28 +73,4 @@
 
 ;; looks up the representative object for an id (i.e. itself or an alias if one exists)
 (define (lookup-alias/lexical i [env (lexical-env)])
-  (lookup-alias env i -id-path))
-
-
-;; refine the type of i in the lexical env
-;; (identifier type -> type) identifier -> environment
-;; a macro for inlining :(
-(define-syntax (update-type/lexical stx)
-  (syntax-parse stx
-    [(_ f i env)
-     #:declare f (expr/c #'(identifier? Type/c . -> . Type/c))
-     #:declare i (expr/c #'identifier?)
-     #:declare env (expr/c #'prop-env?)
-     ;; check if i is ever the target of a set!
-     ;; or is a top-level variable
-     #'(if (or (is-var-mutated? i)
-               (not (identifier-binding i)))
-           ;; if it is, we do nothing
-           env
-           ;; otherwise, refine the type
-           (parameterize
-               ([current-orig-stx i])
-             (let* ([v (lookup-type/lexical i env #:fail (lambda _ Univ))]
-                    [new-v (f i v)]
-                    [new-env (extend env i new-v)])
-               new-env)))]))
+  (lookup-alias env i -id-path))
\ No newline at end of file
diff --git a/typed-racket-lib/typed-racket/env/signature-env.rkt b/typed-racket-lib/typed-racket/env/signature-env.rkt
index c525df67..05b21ac0 100644
--- a/typed-racket-lib/typed-racket/env/signature-env.rkt
+++ b/typed-racket-lib/typed-racket/env/signature-env.rkt
@@ -8,6 +8,7 @@
          lookup-signature
          lookup-signature/check
          signature-env-map
+         signature-env-for-each
          with-signature-env/extend)
 
 (require syntax/id-table
@@ -45,27 +46,15 @@
 ;; Iterate over the signature environment forcing the types of bindings
 ;; in each signature
 (define (finalize-signatures!)
-  (signature-env
-   (make-immutable-free-id-table
-    (signature-env-map
-     (lambda (id sig)
-       (cons
-        id
-        (match sig
-          [(Signature: name extends mapping)
-           (make-Signature
-            name
-            extends
-            (map
-             (match-lambda [(cons id ty) (cons id (force ty))])
-             mapping))]
-          [_ #f])))))))
+  (sorted-dict-for-each (signature-env) (λ (id sig) (force sig)) id<))
 
 ;; lookup-signature : identifier? -> (or/c #f Signature?)
 ;; look up the signature corresponding to the given identifier
 ;; in the signature environment
 (define (lookup-signature id)
-  (free-id-table-ref (signature-env) id #f))
+  (cond
+    [(free-id-table-ref (signature-env) id #f) => force]
+    [else #f]))
 
 ;; lookup-signature/check : identifier? -> Signature?
 ;; lookup the identifier in the signature environment
@@ -78,4 +67,7 @@
                        #:stx id)))
 
 (define (signature-env-map f)
-  (sorted-dict-map (signature-env) f id<))
+  (sorted-dict-map (signature-env) (λ (id sig) (f id (force sig))) id<))
+
+(define (signature-env-for-each f)
+  (sorted-dict-for-each (signature-env) (λ (id sig) (f id (force sig))) id<))
diff --git a/typed-racket-lib/typed-racket/env/signature-helper.rkt b/typed-racket-lib/typed-racket/env/signature-helper.rkt
index d7ac170f..ee00c52e 100644
--- a/typed-racket-lib/typed-racket/env/signature-helper.rkt
+++ b/typed-racket-lib/typed-racket/env/signature-helper.rkt
@@ -46,27 +46,35 @@
             #:parent-signature super
             (binding ...)
             #:check? check) #:local)
-              (#%plain-app values)))
-     (define raw-map (syntax->list #'(binding ...)))
-     (define check? (syntax->datum #'check))
-     (define extends (get-extended-signature #'name #'super check? form))
-     (define super-bindings (get-signature-mapping extends))
-     (define new-bindings (map parse-signature-binding raw-map))
-     (define pre-mapping (append super-bindings new-bindings))
+         (#%plain-app values)))
+     ;; helper for signature bindings
+     (define (parse-signature-binding binding-stx)
+       (syntax-parse binding-stx
+         [[name:id type]
+          (cons #'name (parse-type #'type))]))
+     ;; use a delay for mutually recursive signatures -- lookup-signature
+     ;; forces these
+     (register-signature!
+      #'name
+      (delay (let* ([raw-map (syntax->list #'(binding ...))]
+                    [check? (syntax->datum #'check)]
+                    [extends (get-extended-signature #'name #'super check? form)]
+                    [super-bindings (get-signature-mapping extends)]
+                    [new-bindings (map parse-signature-binding raw-map)]
+                    [pre-mapping (append super-bindings new-bindings)])
+               ;; Make sure a require/typed signature has bindings listed
+               ;; that are consistent with its statically determined bindings
+               (when check?
+                 (check-signature-bindings #'name (map car pre-mapping) form))
 
-     ;; Make sure a require/typed signature has bindings listed
-     ;; that are consistent with its statically determined bindings
-     (when check?
-       (check-signature-bindings #'name (map car pre-mapping) form))
+               ;; require/typed signature bindings may not be in the correct order
+               ;; this fixes the ordering based on the static order determined
+               ;; by signature-members
+               (define mapping (if check?
+                                   (fix-order #'name pre-mapping)
+                                   pre-mapping))
 
-     ;; require/typed signature bindings may not be in the correct order
-     ;; this fixes the ordering based on the static order determined
-     ;; by signature-members
-     (define mapping (if check?
-                         (fix-order #'name pre-mapping)
-                         pre-mapping))
-     (define signature (make-Signature #'name extends mapping))
-     (register-signature! #'name signature)]))
+               (make-Signature #'name extends mapping))))]))
 
 ;; check-signature-bindings : Identifier (Listof Identifier) -> Void
 ;; checks that the bindings of a signature identifier are consistent with
@@ -110,17 +118,6 @@
                               "which extends signature" (syntax-e super)
                               #:stx stx))]))
 
-;; parse-signature-binding : Syntax -> (list/c identifier? syntax?)
-;; parses the binding forms inside of a define signature into the 
-;; form used by the Signature type representation
-;; The call to `parse-type` is delayed to allow signatures and type aliases
-;; to be mutually recursive, after aliases are registered in the environment
-;; the promise will be forced to perform the actual type parsing
-(define (parse-signature-binding binding-stx)
-  (syntax-parse binding-stx
-    [[name:id type]
-     (cons #'name (delay (parse-type #'type)))]))
-
 ;; signature->bindings : identifier? -> (listof (cons/c identifier? type?))
 ;; GIVEN: a signature name
 ;; RETURNS: the list of variables bound by that signature
diff --git a/typed-racket-lib/typed-racket/env/type-alias-env.rkt b/typed-racket-lib/typed-racket/env/type-alias-env.rkt
index 68915228..bb6c02ba 100644
--- a/typed-racket-lib/typed-racket/env/type-alias-env.rkt
+++ b/typed-racket-lib/typed-racket/env/type-alias-env.rkt
@@ -11,7 +11,8 @@
          lookup-type-alias
          resolve-type-aliases
          register-resolved-type-alias
-         type-alias-env-map)
+         type-alias-env-map
+         type-alias-env-for-each)
 
 (define-struct alias-def () #:inspector #f)
 (define-struct (unresolved alias-def) (stx [in-process #:mutable]) #:inspector #f)
@@ -65,3 +66,8 @@
   (for/list ([(id t) (in-sorted-dict the-mapping id<)]
              #:when (resolved? t))
     (f id (resolved-ty t))))
+
+(define (type-alias-env-for-each f)  
+  (for ([(id t) (in-sorted-dict the-mapping id<)]
+        #:when (resolved? t))
+    (f id (resolved-ty t))))
diff --git a/typed-racket-lib/typed-racket/env/type-env-structs.rkt b/typed-racket-lib/typed-racket/env/type-env-structs.rkt
index cecca36d..39d76e9d 100644
--- a/typed-racket-lib/typed-racket/env/type-env-structs.rkt
+++ b/typed-racket-lib/typed-racket/env/type-env-structs.rkt
@@ -4,7 +4,7 @@
          syntax/id-table
          (except-in "../utils/utils.rkt" env)
          (contract-req)
-         (rep object-rep))
+         (rep core-rep object-rep))
 
 (require-for-cond-contract (rep type-rep prop-rep))
 
@@ -20,14 +20,14 @@
 
 (provide/cond-contract
   [env? predicate/c]
-  [extend (env? identifier? Type/c . -> . env?)]
-  [extend/values (env? (listof identifier?) (listof Type/c) . -> . env?)]
+  [extend (env? identifier? Type? . -> . env?)]
+  [extend/values (env? (listof identifier?) (listof Type?) . -> . env?)]
   [lookup (env? identifier? (identifier? . -> . any) . -> . any)]
   [env-props (env? . -> . (listof Prop?))]
   [replace-props (env? (listof Prop?) . -> . env?)]
   [empty-prop-env env?]
-  [extend+alias/values (env? (listof identifier?) (listof Type/c) (listof Object?) . -> . env?)]
-  [lookup-alias (env? identifier? (identifier? . -> . (or/c #f Object?)) . -> . (or/c #f Object?))])
+  [extend+alias/values (env? (listof identifier?) (listof Type?) (listof OptObject?) . -> . env?)]
+  [lookup-alias (env? identifier? (identifier? . -> . (or/c OptObject? #f)) . -> . (or/c OptObject? #f))])
 
 (define empty-prop-env
   (env
diff --git a/typed-racket-lib/typed-racket/env/type-name-env.rkt b/typed-racket-lib/typed-racket/env/type-name-env.rkt
index ad087b4b..4ac7169d 100644
--- a/typed-racket-lib/typed-racket/env/type-name-env.rkt
+++ b/typed-racket-lib/typed-racket/env/type-name-env.rkt
@@ -13,16 +13,20 @@
          (types utils))
 
 (provide/cond-contract [register-type-name
-                        (->* (identifier?) (Type/c) any)]
+                        (->* (identifier?) (Type?) any)]
                        [register-type-names
-                        (-> (listof identifier?) (listof Type/c) any)]
+                        (-> (listof identifier?) (listof Type?) any)]
                        [add-alias (-> identifier? identifier? any)]
                        [type-name-env-map
-                        (-> (-> identifier? (or/c #t Type/c) any) any)]
+                        (-> (-> identifier? (or/c #t Type?) any) any)]
                        [type-variance-env-map
                         (-> (-> identifier? (listof variance?) any) any)]
+                       [type-name-env-for-each
+                        (-> (-> identifier? (or/c #t Type?) any) void?)]
+                       [type-variance-env-for-each
+                        (-> (-> identifier? (listof variance?) any) void?)]
                        [lookup-type-name
-                        (->* (identifier?) (procedure?) (or/c #t Type/c))]
+                        (->* (identifier?) (procedure?) (or/c #t Type?))]
                        [register-type-variance!
                         (-> identifier? (listof variance?) any)]
                        [lookup-type-variance
@@ -31,7 +35,7 @@
                         (-> identifier? (or/c #f (listof identifier?)) any)]
                        [refine-variance!
                         (-> (listof identifier?)
-                            (listof Type/c)
+                            (listof Type?)
                             (listof (or/c #f (listof symbol?)))
                             any)])
 
@@ -61,6 +65,9 @@
 (define (type-name-env-map f)
   (sorted-dict-map the-mapping f id<))
 
+(define (type-name-env-for-each f)
+  (sorted-dict-for-each the-mapping f id<))
+
 (define (add-alias from to)
   (when (lookup-type-name to (lambda () #f))
     (register-resolved-type-alias
@@ -86,6 +93,9 @@
 (define (type-variance-env-map f)
   (sorted-dict-map variance-mapping f id<))
 
+(define (type-variance-env-for-each f)
+  (sorted-dict-for-each variance-mapping f id<))
+
 ;; Refines the variance of a type in the name environment
 (define (refine-variance! names types tvarss)
   (let loop ()
diff --git a/typed-racket-lib/typed-racket/infer/constraint-structs.rkt b/typed-racket-lib/typed-racket/infer/constraint-structs.rkt
index 400968ed..0577ea3f 100644
--- a/typed-racket-lib/typed-racket/infer/constraint-structs.rkt
+++ b/typed-racket-lib/typed-racket/infer/constraint-structs.rkt
@@ -6,7 +6,7 @@
 
 ;; S, T types
 ;; represents S <: X <: T (see "Local Type Inference" pg. 12)
-(define-struct/cond-contract c ([S Type/c] [T Type/c]) #:transparent)
+(define-struct/cond-contract c ([S Type?] [T Type?]) #:transparent)
 
 ;; fixed : Listof[c]
 ;; rest : option[c]
diff --git a/typed-racket-lib/typed-racket/infer/infer-unit.rkt b/typed-racket-lib/typed-racket/infer/infer-unit.rkt
index aa2cc101..2099372b 100644
--- a/typed-racket-lib/typed-racket/infer/infer-unit.rkt
+++ b/typed-racket-lib/typed-racket/infer/infer-unit.rkt
@@ -11,7 +11,8 @@
          (except-in
           (combine-in
            (utils tc-utils)
-           (rep free-variance type-rep prop-rep object-rep rep-utils)
+           (rep free-variance type-rep prop-rep object-rep
+                values-rep rep-utils type-mask)
            (types utils abbrev numeric-tower union subtype resolve
                   substitute generalize prefab)
            (env index-env tvar-env))
@@ -41,7 +42,7 @@
 ;; Type Type -> Pair<Seq, Seq>
 ;; construct a pair for the set of seen type pairs
 (define (seen-before s t)
-  (cons (Type-seq s) (Type-seq t)))
+  (cons (Rep-seq s) (Rep-seq t)))
 
 ;; Context, contains which type variables and indices to infer and which cannot be mentioned in
 ;; constraints.
@@ -198,7 +199,8 @@
 
 (define (List->seq v)
   (match v
-    [(List: ts #:tail (app List->end end)) (and end (seq ts end))]))
+    [(List: ts #:tail (app List->end end)) (and end (seq ts end))]
+    [_ #f]))
 
 
 (define-match-expander ValuesSeq:
@@ -212,7 +214,7 @@
       [(_ seq) #'(app List->seq (? values seq))])))
 
 
-;; generate-dbound-prefix: Symbol Type/c Natural (U Symbol #f) -> (Values (Listof Symbol) (Listof Type/c))
+;; generate-dbound-prefix: Symbol Type? Natural (U Symbol #f) -> (Values (Listof Symbol) (Listof Type?))
 ;; Substitutes n fresh new variables, replaces dotted occurences of v in t with the variables (and
 ;; maybe new-end), and then for each variable substitutes it in for regular occurences of v.
 (define (generate-dbound-prefix v ty n new-end)
@@ -229,6 +231,7 @@
   (match* (s t)
     [(e e) (empty-cset/context context)]
     [(e (TrueProp:)) (empty-cset/context context)]
+    [((FalseProp:) e) (empty-cset/context context)]
     ;; FIXME - is there something to be said about the logical ones?
     [((TypeProp: o s) (TypeProp: o t)) (cgen/inv context s t)]
     [((NotTypeProp: o s) (NotTypeProp: o t)) (cgen/inv context s t)]
@@ -244,7 +247,7 @@
     [(_ _) #f]))
 
 (define/cond-contract (cgen/object context s t)
-  (context? Object? Object? . -> . (or/c #f cset?))
+  (context? OptObject? OptObject? . -> . (or/c #f cset?))
   (match* (s t)
     [(e e) (empty-cset/context context)]
     [(e (Empty:)) (empty-cset/context context)]
@@ -371,7 +374,6 @@
 
 (define/cond-contract (cgen/arr context s-arr t-arr)
   (context? arr? arr? . -> . (or/c #f cset?))
-
   (match* (s-arr t-arr)
     [((arr: ss s s-rest s-drest s-kws) (arr: ts t t-rest t-drest t-kws))
      (define (rest->end rest drest)
@@ -413,10 +415,10 @@
    . -> . (or/c #F cset?))
   ;; useful quick loop
   (define/cond-contract (cg S T)
-   (Type/c Type/c . -> . (or/c #f cset?))
+   (Type? Type? . -> . (or/c #f cset?))
    (cgen context S T))
   (define/cond-contract (cg/inv S T)
-   (Type/c Type/c . -> . (or/c #f cset?))
+   (Type? Type? . -> . (or/c #f cset?))
    (cgen/inv context S T))
   ;; this places no constraints on any variables
   (define empty (empty-cset/context context))
@@ -427,332 +429,336 @@
   ;;          subtyping doesn't need to use it quite as much
   (define cs (current-seen))
   ;; if we've been around this loop before, we're done (for rec types)
-  (if (seen? S T cs)
-      empty
-      (parameterize (;; remember S and T, and obtain everything we've seen from the context
-                     ;; we can't make this an argument since we may call back and forth with
-                     ;; subtyping, for example
-                     [current-seen (remember S T cs)])
-        (match*/early (S T)
-          ;; if they're equal, no constraints are necessary (CG-Refl)
-          [(a b) #:when (type-equal? a b) empty]
-          ;; CG-Top
-          [(_ (Univ:)) empty]
-          ;; AnyValues
-          [((AnyValues: p) (AnyValues: q))
-           (cgen/prop context p q)]
+  (cond
+    [(type-equal? S T) empty] ;; (CG-Refl)
+    [(Univ? T) empty] ;; CG-Top
+    [(seen? S T cs) empty]
+    [else
+     (parameterize (;; remember S and T, and obtain everything we've seen from the context
+                    ;; we can't make this an argument since we may call back and forth with
+                    ;; subtyping, for example
+                    [current-seen (remember S T cs)])
+       (match*/early
+        (S T)
+        ;; AnyValues
+        [((AnyValues: p) (AnyValues: q))
+         (cgen/prop context p q)]
 
-          [((or (Values: (list (Result: _ psets _) ...))
-                (ValuesDots: (list (Result: _ psets _) ...) _ _))
-            (AnyValues: q))
-           (cset-join
-             (filter identity
-               (for/list ([pset (in-list psets)])
-                 (match pset
-                   [(PropSet: p+ p-)
-                    (% cset-meet (cgen/prop context p+ q) (cgen/prop context p- q))]))))]
+        [((or (Values: (list (Result: _ psets _) ...))
+              (ValuesDots: (list (Result: _ psets _) ...) _ _))
+          (AnyValues: q))
+         (cset-join
+          (filter identity
+                  (for/list ([pset (in-list psets)])
+                    (match pset
+                      [(PropSet: p+ p-)
+                       (% cset-meet (cgen/prop context p+ q) (cgen/prop context p- q))]))))]
 
-          ;; check all non Type/c first so that calling subtype is safe
+        ;; check all non Type? first so that calling subtype is safe
 
-          ;; check each element
-          [((Result: s pset-s o-s)
-            (Result: t pset-t o-t))
-           (% cset-meet (cg s t)
-                        (cgen/prop-set context pset-s pset-t)
-                        (cgen/object context o-s o-t))]
+        ;; check each element
+        [((Result: s pset-s o-s)
+          (Result: t pset-t o-t))
+         (% cset-meet (cg s t)
+            (cgen/prop-set context pset-s pset-t)
+            (cgen/object context o-s o-t))]
 
-          ;; Values just delegate to cgen/seq, except special handling for -Bottom.
-          ;; A single -Bottom in a Values means that there is no value returned and so any other
-          ;; Values or ValuesDots should be above it.
-          [((ValuesSeq: s-seq) (ValuesSeq: t-seq))
-           ;; Check for a substition that S is below (ret -Bottom).
-           (define bottom-case
-             (match S
-               [(Values: (list (Result: s f-s o-s)))
-                (cgen context s -Bottom)]
-               [else #f]))
-           (define regular-case
-             (cgen/seq context s-seq t-seq))
-           ;; If we want the OR of the csets that the two cases return.
-           (cset-join
-             (filter values
-               (list bottom-case regular-case)))]
-
-          ;; they're subtypes. easy.
-          [(a b) 
-           #:when (subtype a b)
-           empty]
-
-          ;; Lists delegate to sequences
-          [((ListSeq: s-seq) (ListSeq: t-seq))
-           (cgen/seq context s-seq t-seq)]
-
-          ;; refinements are erased to their bound
-          [((Refinement: S _) T)
-           (cg S T)]
-
-          ;; variables that are in X and should be constrained
-          ;; all other variables are compatible only with themselves
-          [((F: (? (inferable-var? context) v)) T)
-           #:return-when
-           (match T
-             ;; fail when v* is an index variable
-             [(F: v*) (and (bound-index? v*) (not (bound-tvar? v*)))]
-             [_ #f])
-           #f
-           ;; constrain v to be below T (but don't mention bounds)
-           (singleton (Un) v (var-demote T (context-bounds context)))]
-
-          [(S (F: (? (inferable-var? context) v)))
-           #:return-when
+        ;; Values just delegate to cgen/seq, except special handling for -Bottom.
+        ;; A single -Bottom in a Values means that there is no value returned and so any other
+        ;; Values or ValuesDots should be above it.
+        [((ValuesSeq: s-seq) (ValuesSeq: t-seq))
+         ;; Check for a substition that S is below (ret -Bottom).
+         (define bottom-case
            (match S
-             [(F: v*) (and (bound-index? v*) (not (bound-tvar? v*)))]
-             [_ #f])
-           #f
-           ;; constrain v to be above S (but don't mention bounds)
-           (singleton (var-promote S (context-bounds context)) v Univ)]
+             [(Values: (list (Result: s f-s o-s)))
+              (cgen context s -Bottom)]
+             [else #f]))
+         (define regular-case
+           (cgen/seq context s-seq t-seq))
+         ;; If we want the OR of the csets that the two cases return.
+         (cset-join
+          (filter values
+                  (list bottom-case regular-case)))]
 
-          ;; recursive names should get resolved as they're seen
-          [(s (? Name? t))
-           (cg s (resolve-once t))]
-          [((? Name? s) t)
-           (cg (resolve-once s) t)]
+        ;; they're subtypes. easy.
+        [(a b) #:when (cond
+                        [(Type? a) (subtype a b)]
+                        [(Result? a) (subresult a b)]
+                        [else (subval a b)])
+         empty]
 
-          ;; constrain b1 to be below T, but don't mention the new vars
-          [((Poly: v1 b1) T) (cgen (context-add context #:bounds v1) b1 T)]
+        ;; Lists delegate to sequences
+        [((ListSeq: s-seq) (ListSeq: t-seq))
+         (cgen/seq context s-seq t-seq)]
 
-          ;; Mu's just get unfolded
-          [((? Mu? s) t) (cg (unfold s) t)]
-          [(s (? Mu? t)) (cg s (unfold t))]
+        ;; refinements are erased to their bound
+        [((Refinement: S _) T)
+         (cg S T)]
 
-          ;; find *an* element of elems which can be made a subtype of T
-          [((Intersection: ts) T)
-           (cset-join
-            (for*/list ([t (in-immutable-set ts)]
-                        [v (in-value (cg t T))]
-                        #:when v)
-              v))]
-          
-          ;; constrain S to be below *each* element of elems, and then combine the constraints
-          [(S (Intersection: ts))
-           (define cs (for/list/fail ([ts (in-immutable-set ts)]) (cg S ts)))
-           (and cs (cset-meet* (cons empty cs)))]
-          
-          ;; constrain *each* element of es to be below T, and then combine the constraints
-          [((Union: es) T)
-           (define cs (for/list/fail ([e (in-list es)]) (cg e T)))
-           (and cs (cset-meet* (cons empty cs)))]
+        ;; variables that are in X and should be constrained
+        ;; all other variables are compatible only with themselves
+        [((F: (? (inferable-var? context) v)) T)
+         #:return-when
+         (match T
+           ;; fail when v* is an index variable
+           [(F: v*) (and (bound-index? v*) (not (bound-tvar? v*)))]
+           [_ #f])
+         #f
+         ;; constrain v to be below T (but don't mention bounds)
+         (singleton -Bottom v (var-demote T (context-bounds context)))]
 
-          ;; find *an* element of es which can be made to be a supertype of S
-          ;; FIXME: we're using multiple csets here, but I don't think it makes a difference
-          ;; not using multiple csets will break for: ???
-          [(S (Union: es))
-           (cset-join
-            (for*/list ([e (in-list es)]
-                        [v (in-value (cg S e))]
-                        #:when v)
-              v))]
+        [(S (F: (? (inferable-var? context) v)))
+         #:return-when
+         (match S
+           [(F: v*) (and (bound-index? v*) (not (bound-tvar? v*)))]
+           [_ #f])
+         #f
+         ;; constrain v to be above S (but don't mention bounds)
+         (singleton (var-promote S (context-bounds context)) v Univ)]
 
-          ;; from define-new-subtype
-          [((Distinction: nm1 id1 S) (app resolve (Distinction: nm2 id2 T)))
-           #:when (and (equal? nm1 nm2) (equal? id1 id2))
-           (cg S T)]
-          [((Distinction: _ _ S) T)
-           (cg S T)]
+        ;; recursive names should get resolved as they're seen
+        [(s (? Name? t))
+         (cg s (resolve-once t))]
+        [((? Name? s) t)
+         (cg (resolve-once s) t)]
 
-          ;; two structs with the same name
-          ;; just check pairwise on the fields
-          [((Struct: nm _ flds proc _ _) (Struct: nm* _ flds* proc* _ _))
-           #:when (free-identifier=? nm nm*)
-           (let ([proc-c
-                  (cond [(and proc proc*)
-                         (cg proc proc*)]
-                        [proc* #f]
-                        [else empty])])
-             (% cset-meet proc-c (cgen/flds context flds flds*)))]
+        ;; constrain b1 to be below T, but don't mention the new vars
+        [((Poly: v1 b1) T) (cgen (context-add context #:bounds v1) b1 T)]
 
-          ;; two prefab structs with the same key
-          [((Prefab: k ss) (Prefab: k* ts))
-           #:when (and (prefab-key-subtype? k k*)
-                       (>= (length ss) (length ts)))
-           (% cset-meet*
-              (for/list/fail ([s (in-list ss)]
-                              [t (in-list ts)]
-                              [mut? (in-list (prefab-key->field-mutability k*))])
-                (if mut?
-                    (cgen/inv context s t)
-                    (cgen context s t))))]
+        ;; Mu's just get unfolded
+        [((? Mu? s) t) (cg (unfold s) t)]
+        [(s (? Mu? t)) (cg s (unfold t))]
 
-          ;; two struct names, need to resolve b/c one could be a parent
-          [((Name: n _ #t) (Name: n* _ #t))
-           (if (free-identifier=? n n*)
-               empty ;; just succeed now
-               (% cg (resolve-once S) (resolve-once T)))]
-          ;; pairs are pointwise
-          [((Pair: a b) (Pair: a* b*))
-           (% cset-meet (cg a a*) (cg b b*))]
-          ;; sequences are covariant
-          [((Sequence: ts) (Sequence: ts*))
-           (cgen/list context ts ts*)]
-          [((Listof: t) (Sequence: (list t*)))
-           (cg t t*)]
-          [((Pair: t1 t2) (Sequence: (list t*)))
-           (% cset-meet (cg t1 t*) (cg t2 (-lst t*)))]
-          [((MListof: t) (Sequence: (list t*)))
-           (cg t t*)]
-          ;; To check that mutable pair is a sequence we check that the cdr is
-          ;; both an mutable list and a sequence
-          [((MPair: t1 t2) (Sequence: (list t*)))
-           (% cset-meet (cg t1 t*) (cg t2 T) (cg t2 (Un -Null (make-MPairTop))))]
-          [((List: ts) (Sequence: (list t*)))
-           (% cset-meet* (for/list/fail ([t (in-list ts)])
-                           (cg t t*)))]
-          [((HeterogeneousVector: ts) (HeterogeneousVector: ts*))
-           (% cset-meet (cgen/list context ts ts*) (cgen/list context ts* ts))]
-          [((HeterogeneousVector: ts) (Vector: s))
-           (define ts* (map (λ _ s) ts)) ;; invariant, everything has to match
-           (% cset-meet (cgen/list context ts ts*) (cgen/list context ts* ts))]
-          [((HeterogeneousVector: ts) (Sequence: (list t*)))
-           (% cset-meet* (for/list/fail ([t (in-list ts)])
-                           (cg t t*)))]
-          [((Vector: t) (Sequence: (list t*)))
-           (cg t t*)]
-          [((Base: 'String _ _ _) (Sequence: (list t*)))
-           (cg -Char t*)]
-          [((Base: 'Bytes _ _ _) (Sequence: (list t*)))
-           (cg -Nat t*)]
-          [((Base: 'Input-Port _ _ _) (Sequence: (list t*)))
-           (cg -Nat t*)]
-          [((Value: (? exact-nonnegative-integer? n)) (Sequence: (list t*)))
-           (define possibilities
-             (list
-               (list byte? -Byte)
-               (list portable-index? -Index)
-               (list portable-fixnum? -NonNegFixnum)
-               (list values -Nat)))
-           (define type
-             (for/or ([pred-type (in-list possibilities)])
-               (match pred-type
-                 ((list pred? type)
-                  (and (pred? n) type)))))
-           (cg type t*)]
-          [((Base: _ _ _ #t) (Sequence: (list t*)))
-           (define type
-             (for/or ([t (in-list (list -Byte -Index -NonNegFixnum -Nat))])
-               (and (subtype S t) t)))
-           (% cg type t*)]
-          [((Hashtable: k v) (Sequence: (list k* v*)))
-           (cgen/list context (list k v) (list k* v*))]
-          [((Set: t) (Sequence: (list t*)))
-           (cg t t*)]
+        ;; find *an* element of elems which can be made a subtype of T
+        [((Intersection: ts) T)
+         (cset-join
+          (for*/list ([t (in-list ts)]
+                      [v (in-value (cg t T))]
+                      #:when v)
+            v))]
+        
+        ;; constrain S to be below *each* element of elems, and then combine the constraints
+        [(S (Intersection: ts))
+         (define cs (for/list/fail ([ts (in-list ts)]) (cg S ts)))
+         (and cs (cset-meet* (cons empty cs)))]
+        
+        ;; constrain *each* element of es to be below T, and then combine the constraints
+        [((Union: es) T)
+         (define cs (for/list/fail ([e (in-list es)]) (cg e T)))
+         (and cs (cset-meet* (cons empty cs)))]
+
+        ;; find *an* element of es which can be made to be a supertype of S
+        ;; FIXME: we're using multiple csets here, but I don't think it makes a difference
+        ;; not using multiple csets will break for: ???
+        [(S (or (Union: es)
+                (and (Bottom:) (bind es '()))))
+         (cset-join
+          (for*/list ([e (in-list es)]
+                      [v (in-value (cg S e))]
+                      #:when v)
+            v))]
+        
+        ;; from define-new-subtype
+        [((Distinction: nm1 id1 S) (app resolve (Distinction: nm2 id2 T)))
+         #:when (and (equal? nm1 nm2) (equal? id1 id2))
+         (cg S T)]
+        [((Distinction: _ _ S) T)
+         (cg S T)]
+
+        ;; two structs with the same name
+        ;; just check pairwise on the fields
+        [((Struct: nm _ flds proc _ _) (Struct: nm* _ flds* proc* _ _))
+         #:when (free-identifier=? nm nm*)
+         (let ([proc-c
+                (cond [(and proc proc*)
+                       (cg proc proc*)]
+                      [proc* #f]
+                      [else empty])])
+           (% cset-meet proc-c (cgen/flds context flds flds*)))]
+
+        ;; two prefab structs with the same key
+        [((Prefab: k ss) (Prefab: k* ts))
+         #:when (and (prefab-key-subtype? k k*)
+                     (>= (length ss) (length ts)))
+         (% cset-meet*
+            (for/list/fail ([s (in-list ss)]
+                            [t (in-list ts)]
+                            [mut? (in-list (prefab-key->field-mutability k*))])
+                           (if mut?
+                               (cgen/inv context s t)
+                               (cgen context s t))))]
+
+        ;; two struct names, need to resolve b/c one could be a parent
+        [((Name: n _ #t) (Name: n* _ #t))
+         (if (free-identifier=? n n*)
+             empty ;; just succeed now
+             (% cg (resolve-once S) (resolve-once T)))]
+        ;; pairs are pointwise
+        [((Pair: a b) (Pair: a* b*))
+         (% cset-meet (cg a a*) (cg b b*))]
+        ;; sequences are covariant
+        [((Sequence: ts) (Sequence: ts*))
+         (cgen/list context ts ts*)]
+        [((Listof: t) (Sequence: (list t*)))
+         (cg t t*)]
+        [((Pair: t1 t2) (Sequence: (list t*)))
+         (% cset-meet (cg t1 t*) (cg t2 (-lst t*)))]
+        [((MListof: t) (Sequence: (list t*)))
+         (cg t t*)]
+        ;; To check that mutable pair is a sequence we check that the cdr is
+        ;; both an mutable list and a sequence
+        [((MPair: t1 t2) (Sequence: (list t*)))
+         (% cset-meet (cg t1 t*) (cg t2 T) (cg t2 (Un -Null (make-MPairTop))))]
+        [((List: ts) (Sequence: (list t*)))
+         (% cset-meet* (for/list/fail ([t (in-list ts)])
+                                      (cg t t*)))]
+        [((HeterogeneousVector: ts) (HeterogeneousVector: ts*))
+         (% cset-meet (cgen/list context ts ts*) (cgen/list context ts* ts))]
+        [((HeterogeneousVector: ts) (Vector: s))
+         (define ts* (map (λ _ s) ts)) ;; invariant, everything has to match
+         (% cset-meet (cgen/list context ts ts*) (cgen/list context ts* ts))]
+        [((HeterogeneousVector: ts) (Sequence: (list t*)))
+         (% cset-meet* (for/list/fail ([t (in-list ts)])
+                                      (cg t t*)))]
+        [((Vector: t) (Sequence: (list t*)))
+         (cg t t*)]
+        [((Base: 'String _ _ _) (Sequence: (list t*)))
+         (cg -Char t*)]
+        [((Base: 'Bytes _ _ _) (Sequence: (list t*)))
+         (cg -Nat t*)]
+        [((Base: 'Input-Port _ _ _) (Sequence: (list t*)))
+         (cg -Nat t*)]
+        [((Value: (? exact-nonnegative-integer? n)) (Sequence: (list t*)))
+         (define possibilities
+           (list
+            (list byte? -Byte)
+            (list portable-index? -Index)
+            (list portable-fixnum? -NonNegFixnum)
+            (list values -Nat)))
+         (define type
+           (for/or ([pred-type (in-list possibilities)])
+             (match pred-type
+               [(list pred? type)
+                (and (pred? n) type)])))
+         (cg type t*)]
+        [((Base: _ _ _ #t) (Sequence: (list t*)))
+         (define type
+           (for/or ([t (in-list (list -Byte -Index -NonNegFixnum -Nat))])
+             (and (subtype S t) t)))
+         (% cg type t*)]
+        [((Hashtable: k v) (Sequence: (list k* v*)))
+         (cgen/list context (list k v) (list k* v*))]
+        [((Set: t) (Sequence: (list t*)))
+         (cg t t*)]
 
 
-          ;; resolve applications
-          [((App: _ _ _) _)
-           (% cg (resolve-once S) T)]
-          [(_ (App: _ _ _))
-           (% cg S (resolve-once T))]
+        ;; resolve applications
+        [((App: _ _ _) _)
+         (% cg (resolve-once S) T)]
+        [(_ (App: _ _ _))
+         (% cg S (resolve-once T))]
 
-          ;; If the struct names don't match, try the parent of S
-          ;; Needs to be done after App and Mu in case T is actually the current struct
-          ;; but not currently visible
-          [((Struct: nm (? Type? parent) _ _ _ _) other)
-           (cg parent other)]
+        ;; If the struct names don't match, try the parent of S
+        ;; Needs to be done after App and Mu in case T is actually the current struct
+        ;; but not currently visible
+        [((Struct: nm (? Type? parent) _ _ _ _) other)
+         (cg parent other)]
 
-          ;; Invariant here because struct types aren't subtypes just because the
-          ;; structs are (since you can make a constructor from the type).
-          [((StructType: s) (StructType: t))
-           (cg/inv s t)]
+        ;; Invariant here because struct types aren't subtypes just because the
+        ;; structs are (since you can make a constructor from the type).
+        [((StructType: s) (StructType: t))
+         (cg/inv s t)]
 
-          ;; vectors are invariant - generate constraints *both* ways
-          [((Vector: e) (Vector: e*))
-           (cg/inv e e*)]
-          ;; boxes are invariant - generate constraints *both* ways
-          [((Box: e) (Box: e*))
-           (cg/inv e e*)]
-          [((Weak-Box: e) (Weak-Box: e*))
-           (cg/inv e e*)]
-          [((MPair: s t) (MPair: s* t*))
-           (% cset-meet (cg/inv s s*) (cg/inv t t*))]
-          [((Channel: e) (Channel: e*))
-           (cg/inv e e*)]
-          [((Async-Channel: e) (Async-Channel: e*))
-           (cg/inv e e*)]
-          [((ThreadCell: e) (ThreadCell: e*))
-           (cg/inv e e*)]
-          [((Continuation-Mark-Keyof: e) (Continuation-Mark-Keyof: e*))
-           (cg/inv e e*)]
-          [((Prompt-Tagof: s t) (Prompt-Tagof: s* t*))
-           (% cset-meet (cg/inv s s*) (cg/inv t t*))]
-          [((Promise: e) (Promise: e*))
-           (cg e e*)]
-          [((Ephemeron: e) (Ephemeron: e*))
-           (cg e e*)]
-          [((CustodianBox: e) (CustodianBox: e*))
-           (cg e e*)]
-          [((Set: a) (Set: a*))
-           (cg a a*)]
-          [((Evt: a) (Evt: a*))
-           (cg a a*)]
-          [((Base: 'Semaphore _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'Output-Port _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'Input-Port _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'TCP-Listener _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'Thread _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'Subprocess _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'Will-Executor _ _ _) (Evt: t))
-           (cg S t)]
-          [((Base: 'LogReceiver _ _ _) (Evt: t ))
-           (cg (make-HeterogeneousVector
-                   (list -Symbol -String Univ
-                         (Un (-val #f) -Symbol)))
-               t)]
-          [((Base: 'Place _ _ _) (Evt: t))
-           (cg Univ t)]
-          [((Base: 'Base-Place-Channel _ _ _) (Evt: t))
-           (cg Univ t)]
-          [((CustodianBox: t) (Evt: t*)) (cg S t*)]
-          [((Channel: t) (Evt: t*)) (cg t t*)]
-          [((Async-Channel: t) (Evt: t*)) (cg t t*)]
-          ;; we assume all HTs are mutable at the moment
-          [((Hashtable: s1 s2) (Hashtable: t1 t2))
-           ;; for mutable hash tables, both are invariant
-           (% cset-meet (cg/inv s1 t1) (cg/inv s2 t2))]
-          ;; syntax is covariant
-          [((Syntax: s1) (Syntax: s2))
-           (cg s1 s2)]
-          ;; futures are covariant
-          [((Future: s1) (Future: s2))
-           (cg s1 s2)]
-          ;; parameters are just like one-arg functions
-          [((Param: in1 out1) (Param: in2 out2))
-           (% cset-meet (cg in2 in1) (cg out1 out2))]
-          [((Function: (list s-arr ...))
-            (Function: (list t-arr ...)))
-           (% cset-meet*
-            (for/list/fail ([t-arr (in-list t-arr)])
-              ;; for each element of t-arr, we need to get at least one element of s-arr that works
-              (let ([results (for*/list ([s-arr (in-list s-arr)]
-                                         [v (in-value (cgen/arr context s-arr t-arr))]
-                                         #:when v)
-                               v)])
-                ;; ensure that something produces a constraint set
-                (and (not (null? results))
-                     (cset-join results)))))]
-          [(_ _)
-           ;; nothing worked, and we fail
-           #f]))))
+        ;; vectors are invariant - generate constraints *both* ways
+        [((Vector: e) (Vector: e*))
+         (cg/inv e e*)]
+        ;; boxes are invariant - generate constraints *both* ways
+        [((Box: e) (Box: e*))
+         (cg/inv e e*)]
+        [((Weak-Box: e) (Weak-Box: e*))
+         (cg/inv e e*)]
+        [((MPair: s t) (MPair: s* t*))
+         (% cset-meet (cg/inv s s*) (cg/inv t t*))]
+        [((Channel: e) (Channel: e*))
+         (cg/inv e e*)]
+        [((Async-Channel: e) (Async-Channel: e*))
+         (cg/inv e e*)]
+        [((ThreadCell: e) (ThreadCell: e*))
+         (cg/inv e e*)]
+        [((Continuation-Mark-Keyof: e) (Continuation-Mark-Keyof: e*))
+         (cg/inv e e*)]
+        [((Prompt-Tagof: s t) (Prompt-Tagof: s* t*))
+         (% cset-meet (cg/inv s s*) (cg/inv t t*))]
+        [((Promise: e) (Promise: e*))
+         (cg e e*)]
+        [((Ephemeron: e) (Ephemeron: e*))
+         (cg e e*)]
+        [((CustodianBox: e) (CustodianBox: e*))
+         (cg e e*)]
+        [((Set: a) (Set: a*))
+         (cg a a*)]
+        [((Evt: a) (Evt: a*))
+         (cg a a*)]
+        [((Base: 'Semaphore _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'Output-Port _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'Input-Port _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'TCP-Listener _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'Thread _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'Subprocess _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'Will-Executor _ _ _) (Evt: t))
+         (cg S t)]
+        [((Base: 'LogReceiver _ _ _) (Evt: t ))
+         (cg (make-HeterogeneousVector
+              (list -Symbol -String Univ
+                    (Un (-val #f) -Symbol)))
+             t)]
+        [((Base: 'Place _ _ _) (Evt: t))
+         (cg Univ t)]
+        [((Base: 'Base-Place-Channel _ _ _) (Evt: t))
+         (cg Univ t)]
+        [((CustodianBox: t) (Evt: t*)) (cg S t*)]
+        [((Channel: t) (Evt: t*)) (cg t t*)]
+        [((Async-Channel: t) (Evt: t*)) (cg t t*)]
+        ;; we assume all HTs are mutable at the moment
+        [((Hashtable: s1 s2) (Hashtable: t1 t2))
+         ;; for mutable hash tables, both are invariant
+         (% cset-meet (cg/inv s1 t1) (cg/inv s2 t2))]
+        ;; syntax is covariant
+        [((Syntax: s1) (Syntax: s2))
+         (cg s1 s2)]
+        ;; futures are covariant
+        [((Future: s1) (Future: s2))
+         (cg s1 s2)]
+        ;; parameters are just like one-arg functions
+        [((Param: in1 out1) (Param: in2 out2))
+         (% cset-meet (cg in2 in1) (cg out1 out2))]
+        [((Function: (list s-arr ...))
+          (Function: (list t-arr ...)))
+         (% cset-meet*
+            (for/list/fail
+             ([t-arr (in-list t-arr)])
+             ;; for each element of t-arr, we need to get at least one element of s-arr that works
+             (let ([results (for*/list ([s-arr (in-list s-arr)]
+                                        [v (in-value (cgen/arr context s-arr t-arr))]
+                                        #:when v)
+                              v)])
+               ;; ensure that something produces a constraint set
+               (and (not (null? results))
+                    (cset-join results)))))]
+        [(_ _)
+         ;; nothing worked, and we fail
+         #f]))]))
 
 ;; C : cset? - set of constraints found by the inference engine
 ;; X : (listof symbol?) - type variables that must have entries
 ;; Y : (listof symbol?) - index variables that must have entries
-;; R : Type/c - result type into which we will be substituting
+;; R : Type? - result type into which we will be substituting
 (define/cond-contract (subst-gen C X Y R)
   (cset? (listof symbol?) (listof symbol?) (or/c Values/c AnyValues? ValuesDots?)
          . -> . (or/c #f substitution/c))
@@ -853,7 +859,7 @@
 (define infer
  (let ()
   (define/cond-contract (infer X Y S T R [expected #f])
-    (((listof symbol?) (listof symbol?) (listof Type/c) (listof Type/c)
+    (((listof symbol?) (listof symbol?) (listof Type?) (listof Type?)
       (or/c #f Values/c ValuesDots?))
      ((or/c #f Values/c AnyValues? ValuesDots?))
      . ->* . (or/c boolean? substitution/c))
@@ -866,7 +872,6 @@
          (let* ([cs (cgen/list ctx S T #:expected-cset expected-cset)]
                 [cs* (% cset-meet cs expected-cset)])
            (and cs* (if R (subst-gen cs* X Y R) #t)))))
-  ;(trace infer)
   infer)) ;to export a variable binding and not syntax
 
 ;; like infer, but T-var is the vararg type:
@@ -901,10 +906,3 @@
    (define m (cset-meet cs expected-cset))
    #:return-unless m #f
    (subst-gen m X (list dotted-var) R)))
-
-
-;(trace subst-gen)
-;(trace cgen)
-;(trace cgen/list)
-;(trace cgen/arr)
-;(trace cgen/seq)
diff --git a/typed-racket-lib/typed-racket/infer/intersect.rkt b/typed-racket-lib/typed-racket/infer/intersect.rkt
index 0484714f..cfca3505 100644
--- a/typed-racket-lib/typed-racket/infer/intersect.rkt
+++ b/typed-racket-lib/typed-racket/infer/intersect.rkt
@@ -1,8 +1,8 @@
 #lang racket/unit
 
 (require "../utils/utils.rkt")
-(require (rep type-rep)
-         (types abbrev base-abbrev union subtype resolve)
+(require (rep type-rep type-mask)
+         (types abbrev base-abbrev union subtype resolve overlap)
          "signatures.rkt"
          racket/match
          racket/set)
@@ -22,55 +22,135 @@
   ;; subtyping performs a similar check for the same
   ;; reason
   (let intersect
-    ([t1 t1] [t2 t2] [resolved '()])
+      ([t1 t1] [t2 t2] [resolved '()])
     (match*/no-order
      (t1 t2)
+     ;; no overlap
+     [(_ _) #:when (disjoint-masks? (Type-mask t1) (Type-mask t2))
+      -Bottom]
+     ;; already a subtype
+     [(t1 t2) #:no-order #:when (subtype t1 t2) t1]
+     
+     ;; polymorphic intersect
+     [(t1 (Poly: vars t))
+      #:no-order
+      #:when (infer vars null (list t1) (list t) #f)
+      t1]
+     
+     ;; structural recursion on types
+     [((Pair: a1 d1) (Pair: a2 d2)) 
+      (build-type -pair 
+                  (intersect a1 a2 resolved) 
+                  (intersect d1 d2 resolved))]
+     ;; FIXME: support structural updating for structs when structs are updated to
+     ;; contain not only *if* they are polymorphic, but *which* fields are too  
+     ;;[((Struct: _ _ _ _ _ _)
+     ;; (Struct: _ _ _ _ _ _))]
+     [((Syntax: t1*) (Syntax: t2*))
+      (build-type -Syntax (intersect t1* t2* resolved))]
+     [((Promise: t1*) (Promise: t2*))
+      (build-type -Promise (intersect t1* t2* resolved))]
+     
+     ;; unions
+     [((Union: t1s) t2)
+      #:no-order
+      (apply Un (map (λ (t1) (intersect t1 t2 resolved)) t1s))]
+
+     ;; intersections
+     [((Intersection: t1s) t2)
+      #:no-order
+      (apply -unsafe-intersect (for/list ([t1 (in-list t1s)])
+                                 (intersect t1 t2 resolved)))]
+     
+     ;; resolve resolvable types if we haven't already done so
+     [((? resolvable? t1) t2)
+      #:no-order
+      #:when (not (member (cons t1 t2) resolved))
+      (intersect (resolve t1) t2 (cons (cons t1 t2) resolved))]
+
+     ;; if we're intersecting two recursive types, intersect their body
+     ;; and have their recursive references point back to the result
+     [((? Mu?) (? Mu?))
+      (define name (gensym))
+      (make-Mu name (intersect (Mu-body name t1) (Mu-body name t2) resolved))]
+
+     ;; t2 and t1 have a complex relationship, so we build an intersection
+     ;; (note: intersection checks for overlap)
+     [(t1 t2) (-unsafe-intersect t1 t2)])))
+
+
+;; restrict
+;; Type Type -> Type
+;;
+;; attempt to compute (t1 - (¬ t2))
+;; this is useful when you want to know what part of t1 intersects
+;; with t2 without adding t2 to the result (i.e. note that intersect
+;; will create an intersection type if the intersection is not obvious,
+;; and sometimes we want to make sure and _not_ add t2 to the result
+;; we just want to keep the parts of t1 consistent with t2)
+(define (restrict t1 t2)
+  ;; build-type: build a type while propogating bottom
+  (define (build-type constructor . args)
+    (if (memf Bottom? args) -Bottom (apply constructor args)))
+  ;; resolved is a set tracking previously seen restrict cases
+  ;; (i.e. pairs of t1 t2) to prevent infinite unfolding.
+  ;; subtyping performs a similar check for the same
+  ;; reason
+  (let restrict
+    ([t1 t1] [t2 t2] [resolved '()])
+    (match* (t1 t2)
+      ;; no overlap
+      [(_ _) #:when (not (overlap? t1 t2)) -Bottom]
       ;; already a subtype
-      [(t1 t2) #:no-order #:when (subtype t1 t2) t1]
+      [(t1 t2) #:when (subtype t1 t2) t1]
       
-      ;; polymorphic intersect
-      [(t1 (Poly: vars t))
-       #:no-order
-       #:when (infer vars null (list t1) (list t) #f)
-       t1]
+      ;; polymorphic restrict
+      [(t1 (Poly: vars t)) #:when (infer vars null (list t1) (list t) #f) t1]
       
       ;; structural recursion on types
       [((Pair: a1 d1) (Pair: a2 d2)) 
        (build-type -pair 
-                   (intersect a1 a2 resolved) 
-                   (intersect d1 d2 resolved))]
+                   (restrict a1 a2 resolved) 
+                   (restrict d1 d2 resolved))]
       ;; FIXME: support structural updating for structs when structs are updated to
       ;; contain not only *if* they are polymorphic, but *which* fields are too  
       ;;[((Struct: _ _ _ _ _ _)
       ;; (Struct: _ _ _ _ _ _))]
       [((Syntax: t1*) (Syntax: t2*))
-       (build-type -Syntax (intersect t1* t2* resolved))]
+       (build-type -Syntax (restrict t1* t2* resolved))]
       [((Promise: t1*) (Promise: t2*))
-       (build-type -Promise (intersect t1* t2* resolved))]
+       (build-type -Promise (restrict t1* t2* resolved))]
       
       ;; unions
       [((Union: t1s) t2)
-       #:no-order
-       (apply Un (map (λ (t1) (intersect t1 t2 resolved)) t1s))]
+       (apply Un (map (λ (t1) (restrict t1 t2 resolved)) t1s))]
 
-      ;; intersections
+      [(t1 (Union: t2s))
+       (apply Un (map (λ (t2) (restrict t1 t2 resolved)) t2s))]
+      
+      ;; restrictions
       [((Intersection: t1s) t2)
-       #:no-order
-       (apply -unsafe-intersect (for/list ([t1 (in-immutable-set t1s)])
-                                  (intersect t1 t2 resolved)))]
+       (apply -unsafe-intersect (for/list ([t1 (in-list t1s)])
+                                  (restrict t1 t2 resolved)))]
+
+      [(t1 (Intersection: t2s))
+       (apply -unsafe-intersect (for/list ([t2 (in-list t2s)])
+                                  (restrict t1 t2 resolved)))]
       
       ;; resolve resolvable types if we haven't already done so
-      [((? needs-resolving? t1) t2)
-       #:no-order
+      [((? resolvable? t1) t2)
        #:when (not (member (cons t1 t2) resolved))
-       (intersect (resolve t1) t2 (cons (cons t1 t2) resolved))]
+       (restrict (resolve t1) t2 (cons (cons t1 t2) resolved))]
 
+      [(t1 (? resolvable? t2))
+       #:when (not (member (cons t1 t2) resolved))
+       (restrict t1 (resolve t2) (cons (cons t1 t2) resolved))]
+      
       ;; if we're intersecting two recursive types, intersect their body
       ;; and have their recursive references point back to the result
       [((? Mu?) (? Mu?))
        (define name (gensym))
-       (make-Mu name (intersect (Mu-body name t1) (Mu-body name t2) resolved))]
+       (make-Mu name (restrict (Mu-body name t1) (Mu-body name t2) resolved))]
 
-      ;; t2 and t1 have a complex relationship, so we build an intersection
-      ;; (note: intersection checks for overlap)
-      [(t1 t2) (-unsafe-intersect t1 t2)])))
+      ;; else it's complicated and t1 remains unchanged
+      [(_ _) t1])))
diff --git a/typed-racket-lib/typed-racket/infer/promote-demote.rkt b/typed-racket-lib/typed-racket/infer/promote-demote.rkt
index 23170d12..618a83ab 100644
--- a/typed-racket-lib/typed-racket/infer/promote-demote.rkt
+++ b/typed-racket-lib/typed-racket/infer/promote-demote.rkt
@@ -1,15 +1,13 @@
 #lang racket/base
 
 (require "../utils/utils.rkt"
-         (rep type-rep rep-utils)
-         (types abbrev utils structural)
+         (rep type-rep values-rep rep-utils free-variance)
+         (types abbrev utils)
          (prefix-in c: (contract-req))
-         racket/performance-hint
          racket/list racket/match)
-
 (provide/cond-contract
-  [var-promote (c:-> Type/c (c:listof symbol?) Type/c)]
-  [var-demote (c:-> Type/c (c:listof symbol?) Type/c)])
+  [var-promote (c:-> Type? (c:listof symbol?) Type?)]
+  [var-demote (c:-> Type? (c:listof symbol?) Type?)])
 
 (define (V-in? V . ts)
   (for/or ([e (in-list (append* (map fv ts)))])
@@ -24,49 +22,62 @@
     [(ValuesDots: (list (Result: _ propsets _) ...) _ _) propsets]))
 
 
-(begin-encourage-inline
-  (define (var-change V T change)
-    (define (structural-recur t sym)
-      (case sym
-        [(co) (var-change V t change)]
-        [(contra) (var-change V t (not change))]
-        [(inv)
-         (if (V-in? V t)
-             (if change Univ -Bottom)
-             t)]))
-    (define (co t) (structural-recur t 'co))
-    (define (contra t) (structural-recur t 'contra))
+(define (var-promote T V)
+  (var-change V T #t))
+(define (var-demote T V)
+  (var-change V T #f))
 
-    ;; arr? -> (or/c #f arr?)
-    ;; Returns the changed arr or #f if there is no arr above it
-    (define (arr-change arr)
-      (match arr
-        [(arr: dom rng rest drest kws)
-         (cond
-           [(apply V-in? V (get-propsets rng))
-            #f]
-           [(and drest (memq (cdr drest) V))
-            (make-arr (map contra dom)
-                      (co rng)
-                      (contra (car drest))
-                      #f
-                      (map contra kws))]
-           [else
-            (make-arr (map contra dom)
-                      (co rng)
-                      (and rest (contra rest))
-                      (and drest (cons (contra (car drest)) (cdr drest)))
-                      (map contra kws))])]))
 
-    (match T
-      [(F: name) (if (memq name V) (if change Univ -Bottom) T)]
-      [(Function: arrs)
-       (make-Function (filter-map arr-change arrs))]
-      [(? structural?) (structural-map T structural-recur)]
-      [(? Prop?) ((sub-f co) T)]
-      [(? Object?) ((sub-o co) T)]
-      [(? Type?) ((sub-t co) T)]))
-  (define (var-promote T V)
-    (var-change V T #t))
-  (define (var-demote T V)
-    (var-change V T #f)))
+
+(define (var-change V cur change)
+  (define (co t) (var-change V t change))
+  (define (contra t) (var-change V t (not change)))
+  ;; arr? -> (or/c #f arr?)
+  ;; Returns the changed arr or #f if there is no arr above it
+  (define (arr-change arr)
+    (match arr
+      [(arr: dom rng rest drest kws)
+       (cond
+         [(apply V-in? V (get-propsets rng))
+          #f]
+         [(and drest (memq (cdr drest) V))
+          (make-arr (map contra dom)
+                    (co rng)
+                    (contra (car drest))
+                    #f
+                    (map contra kws))]
+         [else
+          (make-arr (map contra dom)
+                    (co rng)
+                    (and rest (contra rest))
+                    (and drest (cons (contra (car drest)) (cdr drest)))
+                    (map contra kws))])]))
+  (match cur
+    [(? structural? t)
+     (define mk (Rep-constructor t))
+     (apply mk (for/list ([t (in-list (Rep-values t))]
+                          [v (in-list (Type-variances t))])
+                 (cond
+                   [(eq? v Covariant) (co t)]
+                   [(eq? v Invariant)
+                    (if (V-in? V t)
+                        (if change Univ -Bottom)
+                        t)]
+                   [(eq? v Contravariant)
+                    (contra t)])))]
+    [(Unit: imports exports init-depends t)
+     (make-Unit (map co imports)
+                (map contra imports)
+                (map co init-depends)
+                (co t))]
+    [(F: name) (if (memq name V)
+                   (if change Univ -Bottom)
+                   cur)]
+    [(Function: arrs)
+     (make-Function (filter-map arr-change arrs))]
+    [(HeterogeneousVector: elems)
+     (make-HeterogeneousVector (map (λ (t) (if (V-in? V t)
+                                               (if change Univ -Bottom)
+                                               t))
+                                    elems))]
+    [_ (Rep-fold co cur)]))
diff --git a/typed-racket-lib/typed-racket/infer/signatures.rkt b/typed-racket-lib/typed-racket/infer/signatures.rkt
index 47899503..5c98a34d 100644
--- a/typed-racket-lib/typed-racket/infer/signatures.rkt
+++ b/typed-racket-lib/typed-racket/infer/signatures.rkt
@@ -2,7 +2,7 @@
 (require "../utils/utils.rkt"
          racket/unit (contract-req)
          (utils unit-utils)
-         (rep type-rep))
+         (rep type-rep values-rep))
 
 (require-for-cond-contract (infer constraint-structs))
 
@@ -16,12 +16,13 @@
    [cond-contracted cset-meet* ((listof cset?) . -> . (or/c #f cset?))]
    [cond-contracted no-constraint c?]
    [cond-contracted empty-cset ((listof symbol?) (listof symbol?) . -> . cset?)]
-   [cond-contracted insert (cset? symbol? Type/c Type/c . -> . cset?)]
+   [cond-contracted insert (cset? symbol? Type? Type? . -> . cset?)]
    [cond-contracted cset-join ((listof cset?) . -> . cset?)]
    [cond-contracted c-meet ((c? c?) (symbol?) . ->* . (or/c #f c?))]))
 
 (define-signature intersect^
-  ([cond-contracted intersect (Type/c Type/c . -> . Type/c)]))
+  ([cond-contracted intersect (Type? Type? . -> . Type?)]
+   [cond-contracted restrict (Type? Type? . -> . Type?)]))
 
 (define-signature infer^
   ([cond-contracted infer ((;; variables from the forall
@@ -29,9 +30,9 @@
                             ;; indexes from the forall
                             (listof symbol?)
                             ;; actual argument types from call site
-                            (listof Type/c)
+                            (listof Type?)
                             ;; domain
-                            (listof Type/c)
+                            (listof Type?)
                             ;; range
                             (or/c #f Values/c ValuesDots?))
                            ;; optional expected type
@@ -42,11 +43,11 @@
                                    ;; indexes from the forall
                                    (listof symbol?)
                                    ;; actual argument types from call site
-                                   (listof Type/c)
+                                   (listof Type?)
                                    ;; domain
-                                   (listof Type/c)
+                                   (listof Type?)
                                    ;; rest
-                                   (or/c #f Type/c)
+                                   (or/c #f Type?)
                                    ;; range
                                    (or/c #f Values/c ValuesDots?))
                                   ;; [optional] expected type
diff --git a/typed-racket-lib/typed-racket/private/parse-type.rkt b/typed-racket-lib/typed-racket/private/parse-type.rkt
index 7a12d9e8..2d187822 100644
--- a/typed-racket-lib/typed-racket/private/parse-type.rkt
+++ b/typed-racket-lib/typed-racket/private/parse-type.rkt
@@ -3,7 +3,7 @@
 ;; This module provides functions for parsing types written by the user
 
 (require (rename-in "../utils/utils.rkt" [infer infer-in])
-         (except-in (rep type-rep object-rep) make-arr)
+         (except-in (rep core-rep type-rep object-rep) make-arr)
          (rename-in (types abbrev union utils prop-ops resolve
                            classes prefab signatures)
                     [make-arr* make-arr])
@@ -31,14 +31,14 @@
            (only-in "../base-env/case-lambda.rkt" case-lambda)))
 
 (provide/cond-contract ;; Parse the given syntax as a type
-                       [parse-type (syntax? . c:-> . Type/c)]
+                       [parse-type (syntax? . c:-> . Type?)]
                        ;; Parse the given identifier using the lexical
                        ;; context of the given syntax object
-                       [parse-type/id (syntax? c:any/c . c:-> . Type/c)]
+                       [parse-type/id (syntax? c:any/c . c:-> . Type?)]
                        [parse-tc-results (syntax? . c:-> . tc-results/c)]
                        [parse-literal-alls (syntax? . c:-> . (c:listof (c:or/c (c:listof identifier?) (c:list/c (c:listof identifier?) identifier?))))]
                        ;; Parse a row, which is only allowed in row-inst
-                       [parse-row (syntax? . c:-> . Type/c)])
+                       [parse-row (syntax? . c:-> . Row?)])
 
 (provide star ddd/bound
          current-referenced-aliases
@@ -340,7 +340,7 @@
     (syntax-parse
         stx
       [t
-       #:declare t (3d Type/c?)
+       #:declare t (3d Type?)
        (attribute t.datum)]
       [(fst . rst)
        #:fail-unless (not (syntax->list #'rst)) #f
@@ -408,9 +408,9 @@
                       "Unit types must import and export distinct signatures"))
        (define (init-depend-error)
          (parse-error
-            #:stx stx
-            #:delayed? #f
-            "Unit type initialization dependencies must be a subset of imports"))
+          #:stx stx
+          #:delayed? #f
+          "Unit type initialization dependencies must be a subset of imports"))
        (define imports
          (check-imports/exports (stx-map id->sig #'(import ...)) import/export-error))
        (define exports
@@ -448,27 +448,27 @@
        (let* ([var (syntax-e #'x)]
               [tvar (make-F var)])
          (extend-tvars (list var)
-           (let ([t* (parse-type #'t)])
-             ;; is t in a productive position?
-             (define productive
-               (let loop ((ty t*))
-                 (match ty
-                  [(Union: elems) (andmap loop elems)]
-                  [(F: _) (not (equal? ty tvar))]
-                  [(App: rator rands stx)
-                   (loop (resolve-app rator rands stx))]
-                  [(Mu: _ body) (loop body)]
-                  [(Poly: names body) (loop body)]
-                  [(PolyDots: names body) (loop body)]
-                  [(PolyRow: _ _ body) (loop body)]
-                  [else #t])))
-             (unless productive
-               (parse-error
-                #:stx stx
-                "recursive types are not allowed directly inside their definition"))
-             (if (memq var (fv t*))
-                 (make-Mu var t*)
-                 t*))))]
+                       (let ([t* (parse-type #'t)])
+                         ;; is t in a productive position?
+                         (define productive
+                           (let loop ((ty t*))
+                             (match ty
+                               [(Union: elems) (andmap loop elems)]
+                               [(F: _) (not (equal? ty tvar))]
+                               [(App: rator rands stx)
+                                (loop (resolve-app rator rands stx))]
+                               [(Mu: _ body) (loop body)]
+                               [(Poly: names body) (loop body)]
+                               [(PolyDots: names body) (loop body)]
+                               [(PolyRow: _ _ body) (loop body)]
+                               [else #t])))
+                         (unless productive
+                           (parse-error
+                            #:stx stx
+                            "recursive types are not allowed directly inside their definition"))
+                         (if (memq var (fv t*))
+                             (make-Mu var t*)
+                             t*))))]
       [(:U^ ts ...)
        (apply Un (parse-types #'(ts ...)))]
       [(:∩^ ts ...)
@@ -549,9 +549,9 @@
                             (extend-tvars (list var) (parse-type #'rest))
                             var)))))]
       #| ;; has to be below the previous one
-     [(dom:expr ... :->^ rng)
+      [(dom:expr ... :->^ rng)
       (->* (parse-types #'(dom ...))
-           (parse-values-type #'rng))]     |#
+      (parse-values-type #'rng))]     |#
       ;; use expr to rule out keywords
       [(~or (:->^ dom:non-keyword-ty ... kws:keyword-tys ... rng)
             (dom:non-keyword-ty ... kws:keyword-tys ... :->^ rng))
@@ -566,9 +566,9 @@
                    #:kws (map force (attribute kws.Keyword)))))))]
       ;; This case needs to be at the end because it uses cut points to give good error messages.
       [(~or (:->^ ~! dom:non-keyword-ty ... rng:expr
-             :colon^ (~var latent (full-latent (syntax->list #'(dom ...)))))
+                  :colon^ (~var latent (full-latent (syntax->list #'(dom ...)))))
             (dom:non-keyword-ty ... :->^ rng:expr
-             ~! :colon^ (~var latent (full-latent (syntax->list #'(dom ...))))))
+                                ~! :colon^ (~var latent (full-latent (syntax->list #'(dom ...))))))
        ;; use parse-type instead of parse-values-type because we need to add the props from the pred-ty
        (with-arity (length (syntax->list #'(dom ...)))
          (->* (parse-types #'(dom ...))
@@ -625,8 +625,8 @@
        (parse-error "bad syntax in ->")]
       [(id arg args ...)
        (let loop
-         ([rator (parse-type #'id)]
-          [args (parse-types #'(arg args ...))])
+           ([rator (parse-type #'id)]
+            [args (parse-types #'(arg args ...))])
          (resolve-app-check-error rator args stx)
          (match rator
            [(? Name?) (make-App rator args stx)]
diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt
index 91a10da1..9f8e8229 100644
--- a/typed-racket-lib/typed-racket/private/type-contract.rkt
+++ b/typed-racket-lib/typed-racket/private/type-contract.rkt
@@ -8,7 +8,7 @@
  (rep type-rep prop-rep object-rep)
  (utils tc-utils)
  (env type-name-env row-constraint-env)
- (rep rep-utils)
+ (rep core-rep rep-utils type-mask values-rep)
  (types resolve union utils printer)
  (prefix-in t: (types abbrev numeric-tower subtype))
  (private parse-type syntax-properties)
@@ -28,7 +28,7 @@
 (provide
   (c:contract-out
     [type->static-contract
-      (c:parametric->/c (a) ((Type/c (c:-> #:reason (c:or/c #f string?) a))
+      (c:parametric->/c (a) ((Type? (c:-> #:reason (c:or/c #f string?) a))
                              (#:typed-side boolean?) . c:->* . (c:or/c a static-contract?)))]))
 
 (provide change-contract-fixups
@@ -137,7 +137,7 @@
                                  "could not convert type to a contract"
                                  #:more #,failure-reason
                                  "identifier" #,(symbol->string (syntax-e orig-id))
-                                 "type" #,(pretty-format-type type #:indent 8)))]
+                                 "type" #,(pretty-format-rep type #:indent 8)))]
            [else
             (match-define (list defs ctc) result)
             (define maybe-inline-val
@@ -319,7 +319,7 @@
     [(_ sc-cache type-expr typed-side-expr match-clause ...)
      #'(let ([type type-expr]
              [typed-side typed-side-expr])
-         (define key (cons (Type-seq type) typed-side))
+         (define key (cons (Rep-seq type) typed-side))
          (cond [(hash-ref sc-cache key #f)]
                [else
                 (define sc (match type match-clause ...))
@@ -389,6 +389,7 @@
         ;; Ordinary type applications or struct type names, just resolve
         [(or (App: _ _ _) (Name/struct:)) (t->sc (resolve-once type))]
         [(Univ:) (if (from-typed? typed-side) any-wrap/sc any/sc)]
+        [(Bottom:) (or/sc)]
         [(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var)))))
          (listof/sc (t->sc elem-ty))]
         [(Base: sym cnt _ _)
@@ -398,7 +399,7 @@
         [(Refinement: par p?)
          (and/sc (t->sc par) (flat/sc p?))]
         [(Union: elems)
-         (define-values (numeric non-numeric) (partition (λ (t) (equal? 'number (Type-key t))) elems ))
+         (define-values (numeric non-numeric) (partition (λ (t) (eq? mask:number (Type-mask t))) elems))
          (define numeric-sc (numeric-type->static-contract (apply Un numeric)))
          (if numeric-sc
              (apply or/sc numeric-sc (map t->sc non-numeric))
@@ -406,7 +407,7 @@
         [(Intersection: ts)
          (define-values (chaperones/impersonators others)
            (for/fold ([cs/is null] [others null])
-                     ([elem (in-immutable-set ts)])
+                     ([elem (in-list ts)])
              (define c (t->sc elem))
              (if (equal? flat-sym (get-max-contract-kind c))
                  (values cs/is (cons c others))
@@ -839,14 +840,10 @@
 ;; Name type in application position
 (define (has-name-app? type)
   (let/ec escape
-    (let loop ([type type])
-      (type-case
-       (#:Type loop #:Prop (sub-f loop) #:Object (sub-o loop))
-       type
-       [#:App arg _ _
-        (match arg
-          [(Name: _ _ #f) (escape #t)]
-          [_ type])]))
+    (let loop ([rep type])
+      (match rep
+        [(App: (Name: _ _ #f) _ _) (escape #t)]
+        [_ (Rep-walk loop rep)]))
     #f))
 
 ;; True if the arities `arrs` are what we'd expect from a struct predicate
diff --git a/typed-racket-lib/typed-racket/rep/core-rep.rkt b/typed-racket-lib/typed-racket/rep/core-rep.rkt
new file mode 100644
index 00000000..d198279b
--- /dev/null
+++ b/typed-racket-lib/typed-racket/rep/core-rep.rkt
@@ -0,0 +1,234 @@
+#lang racket/base
+
+;;************************************************************
+;; core-rep.rkt
+;;
+;; In this file we define the parent structs that describe most of
+;; Typed Racket's internal forms and define a few variants which are
+;; referenced in many definitions.
+;; ************************************************************
+
+
+(require "../utils/utils.rkt"
+         "rep-utils.rkt"
+         "free-variance.rkt"
+         "type-mask.rkt"
+         (contract-req)
+         racket/match
+         racket/list
+         racket/lazy-require
+         (for-syntax racket/base racket/syntax
+                     syntax/parse))
+
+(provide Type Type-mask Type-subtype-cache Type?
+         Prop Prop?
+         Object Object? OptObject?
+         PathElem PathElem?
+         SomeValues SomeValues?
+         def-type
+         def-values
+         def-prop
+         def-object
+         def-pathelem
+         type-equal?
+         prop-equal?
+         object-equal?)
+
+(define-syntax type-equal? (make-rename-transformer #'eq?))
+(define-syntax prop-equal? (make-rename-transformer #'eq?))
+(define-syntax object-equal? (make-rename-transformer #'eq?))
+
+(provide-for-cond-contract name-ref/c)
+
+;; A Name-Ref is any value that represents an object.
+;; As an identifier, it represents a free variable in the environment
+;; As a pair, it represents a De Bruijn indexed bound variable (cons lvl arg-num)
+(define-for-cond-contract name-ref/c
+  (or/c identifier? (cons/c natural-number/c natural-number/c)))
+
+;;************************************************************
+;; Custom Printing Tools
+;;************************************************************
+
+(lazy-require
+ ["../types/printer.rkt" (print-type
+                          print-prop print-object print-pathelem
+                          print-values print-propset print-result)])
+
+;; Note: We eta expand the printer so it is not evaluated until needed.
+(define-syntax (struct/printer stx)
+  (syntax-parse stx
+    [(_ name:id
+        (flds:id ...)
+        printer:id)
+     (with-syntax ([mk (generate-temporary 'dont-use-me)])
+       (syntax/loc
+           stx
+         (struct name Rep (flds ...)
+           #:constructor-name mk
+           #:transparent
+           #:property prop:custom-print-quotable 'never
+           #:methods gen:custom-write
+           [(define (write-proc v port write?) (printer v port write?))])))]))
+
+
+(define-syntax (build-rep-definer syntax)
+  (syntax-parse syntax
+    [(_ class:id def-id:id)
+     (syntax/loc syntax
+       (define-syntax (def-id stx)
+         (syntax-parse stx
+           [(_ variant:id flds:expr . rst)
+            (syntax/loc stx
+              (def-rep variant flds [#:parent class] . rst))])))]))
+
+;;
+;; These structs are the 'meta-variables' of TR's internal grammar,
+;; if you will. For reference, see the following two papers which
+;; discuss Typed Racket's metatheory:
+;;
+;; 1. Logical Types for Untyped Languages, Tobin-Hochstadt &
+;; Felleisen, ICFP 2010
+;;
+;; 2. Occurrence Typing Modulo Theories, Kent et al., PLDI 2016
+
+;;************************************************************
+;; Types
+;;************************************************************
+;;
+;;
+;; The 'mask' field that is used for quick-checking of certain
+;; properties. See type-mask.rkt for details.
+
+;; subtype-cache - for a given type τ, the subtype-cache
+;;    is a mapping from Type -> boolean, s.t. if
+;;    τ.subtype-cache[σ] = #t then τ <: σ holds, otherwise
+;;    if τ.subtype-cache[σ] = #f, then τ <: σ does not hold
+;; mask - the type mask for this type
+(struct/printer Type (subtype-cache mask) print-type)
+(build-rep-definer Type def-type)
+
+;;-----------------
+;; Universal Type
+;;-----------------
+
+;; the type of all well-typed terms
+;; (called Any in user programs)
+(def-type Univ () #:base
+  [#:type-mask mask:unknown])
+
+;;-----------------
+;; Bottom Type
+;;-----------------
+
+(def-type Bottom () #:base
+  [#:type-mask mask:bottom])
+
+;;************************************************************
+;; Prop
+;;************************************************************
+;;
+;; These convey learned information about program terms while
+;; typechecking.
+
+(struct/printer Prop () print-prop)
+(build-rep-definer Prop def-prop)
+
+(def-prop TrueProp () #:base)
+
+(def-prop FalseProp () #:base)
+
+;;************************************************************
+;; Fields and Symbolic Objects
+;;************************************************************
+;;
+;; These are used to represent the class of canonical program terms
+;; that can be lifted to the type level while typechecking.
+
+
+;;--------------
+;; PathElements
+;;--------------
+
+;; e.g. car, cdr, etc
+(struct/printer PathElem () print-pathelem)
+(build-rep-definer PathElem def-pathelem)
+
+
+;;----------
+;; Objects
+;;----------
+
+(struct/printer Object () print-object)
+(build-rep-definer Object def-object)
+
+;; empty object
+(def-rep Empty () #:base
+  [#:extras
+   #:property prop:custom-print-quotable 'never
+   #:methods gen:custom-write
+   [(define (write-proc v port write?)
+      (when write?
+        (write-string "-" port)))]])
+
+(define/provide (OptObject? x)
+  (or (Object? x) (Empty? x)))
+
+
+;;************************************************************
+;; SomeValues
+;;************************************************************
+;;
+;; Racket expressions can produce 0 or more values, 'SomeValues'
+;; represents the general class of all these possibilities
+
+(struct/printer SomeValues () print-values)
+(build-rep-definer SomeValues def-values)
+
+
+;;************************************************************
+;; PropSets
+;;************************************************************
+;; These are a convenient way to pair 'then' and 'else' propositions
+;; together, which appear in typechecking results and in function
+;; types.
+;;
+;; Since there is only one form, we do not define an empty parent
+;; struct that other structs inherit from.
+
+
+(def-rep PropSet ([thn Prop?] [els Prop?])
+  [#:intern-key (cons (Rep-seq thn) (Rep-seq els))]
+  [#:frees (f) (combine-frees (list (f thn) (f els)))]
+  [#:fold (f) (make-PropSet (f thn) (f els))]
+  [#:walk (f) (begin (f thn) (f els))]
+  [#:extras
+   #:property prop:custom-print-quotable 'never
+   #:methods gen:custom-write
+   [(define (write-proc v port write?) (print-propset v port write?))]])
+
+
+
+;;************************************************************
+;; Results
+;;************************************************************
+;;
+;; These represent all the relevant info derived from typechecking a
+;; term which produces one value, namely it's type (t), what is learned
+;; if it is used as an 'if' test expression (ps), and what, if any, symbolic
+;; object the value would correspond to (o).
+;;
+;; Since there is only one form, we do not define an empty parent
+;; struct that other structs inherit from.
+
+
+(def-rep Result ([t Type?] [ps PropSet?] [o OptObject?])
+  [#:intern-key (list* (Rep-seq t) (Rep-seq ps) (Rep-seq o))]
+  [#:frees (f) (combine-frees (list (f t) (f ps) (f o)))]
+  [#:fold (f) (make-Result (f t) (f ps) (f o))]
+  [#:walk (f) (begin (f t) (f ps) (f o))]
+  [#:extras
+   #:property prop:custom-print-quotable 'never
+   #:methods gen:custom-write
+   [(define (write-proc v port write?) (print-result v port write?))]])
+
diff --git a/typed-racket-lib/typed-racket/rep/free-variance.rkt b/typed-racket-lib/typed-racket/rep/free-variance.rkt
index 08ca3088..e2ae489b 100644
--- a/typed-racket-lib/typed-racket/rep/free-variance.rkt
+++ b/typed-racket-lib/typed-racket/rep/free-variance.rkt
@@ -75,57 +75,58 @@
 ;; frees -> frees
 (define (flip-variances frees)
   (match frees
-   ((combined-frees hash computed)
-    (combined-frees
+    [(combined-frees hash computed)
+     (combined-frees
       (for/hasheq (((k v) hash))
         (values k (flip-variance v)))
-      (map flip-variances computed)))
-   ((app-frees name args)
-    (app-frees name (map flip-variances args)))
-   ((remove-frees inner name)
-    (remove-frees (flip-variances inner) name))))
+      (map flip-variances computed))]
+    [(app-frees name args)
+     (app-frees name (map flip-variances args))]
+    [(remove-frees inner name)
+     (remove-frees (flip-variances inner) name)]))
 
 
 (define (make-invariant frees)
   (combined-frees
-    (for/hasheq ((name (free-vars-names frees)))
+    (for/hasheq ([name (free-vars-names frees)])
       (values name Invariant))
     null))
 
 (define (make-constant frees)
   (combined-frees
-    (for/hasheq ((name (free-vars-names frees)))
+    (for/hasheq ([name (free-vars-names frees)])
       (values name Constant))
     null))
 
 ;; Listof[frees] -> frees
 (define (combine-frees freess)
   (define-values (hash computed)
-    (for/fold ((hash (hasheq)) (computed null))
-              ((frees freess))
+    (for/fold ([hash (hasheq)]
+               [computed null])
+              ([frees (in-list freess)])
       (match frees
-       ((combined-frees new-hash new-computed)
-        (values (combine-hashes (list hash new-hash))
-                (append new-computed computed))))))
+        [(combined-frees new-hash new-computed)
+         (values (combine-hashes (list hash new-hash))
+                 (append new-computed computed))])))
   (combined-frees hash computed))
 
 
 (define (free-vars-remove frees name)
   (match frees
-   ((combined-frees hash computed)
-    (combined-frees (hash-remove hash name)
-                    (map (λ (v) (remove-frees v name)) computed)))))
+    [(combined-frees hash computed)
+     (combined-frees (hash-remove hash name)
+                     (map (λ (v) (remove-frees v name)) computed))]))
 
 ;;
 (define (free-vars-names vars)
   (match vars
-    ((combined-frees hash computed)
+    [(combined-frees hash computed)
      (apply set-union
             (list->seteq (hash-keys hash))
-            (map free-vars-names computed)))
-    ((remove-frees inner name) (set-remove (free-vars-names inner) name))
-    ((app-frees name args)
-     (apply set-union (map free-vars-names args)))))
+            (map free-vars-names computed))]
+    [(remove-frees inner name) (set-remove (free-vars-names inner) name)]
+    [(app-frees name args)
+     (apply set-union (map free-vars-names args))]))
 
 (define (free-vars-has-key? vars key)
   (set-member? (free-vars-names vars) key))
@@ -133,18 +134,18 @@
 ;; Only valid after full type resolution
 (define (free-vars-hash vars)
   (match vars
-    ((combined-frees hash computed)
-     (combine-hashes (cons hash (map free-vars-hash computed))))
-    ((remove-frees inner name) (hash-remove (free-vars-hash inner) name))
-    ((app-frees name args)
+    [(combined-frees hash computed)
+     (combine-hashes (cons hash (map free-vars-hash computed)))]
+    [(remove-frees inner name) (hash-remove (free-vars-hash inner) name)]
+    [(app-frees name args)
      (combine-hashes
-       (for/list ((var (lookup-type-variance name)) (arg args))
+      (for/list ((var (lookup-type-variance name)) (arg args))
         (free-vars-hash
          (cond
-          ((eq? var Covariant) arg)
-          ((eq? var Contravariant) (flip-variances arg))
-          ((eq? var Invariant) (make-invariant arg))
-          ((eq? var Constant) (make-constant arg)))))))))
+           [(eq? var Covariant) arg]
+           [(eq? var Contravariant) (flip-variances arg)]
+           [(eq? var Invariant) (make-invariant arg)]
+           [(eq? var Constant) (make-constant arg)]))))]))
 
 
 ;; frees = HT[Idx,Variance] where Idx is either Symbol or Number
diff --git a/typed-racket-lib/typed-racket/rep/interning.rkt b/typed-racket-lib/typed-racket/rep/interning.rkt
deleted file mode 100644
index 79fafd25..00000000
--- a/typed-racket-lib/typed-racket/rep/interning.rkt
+++ /dev/null
@@ -1,45 +0,0 @@
-#lang racket/base
-
-(require syntax/id-table racket/dict (for-syntax racket/base syntax/parse))
-
-(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 ...)
-     #'(defintern name+args (lambda () (make-hash)) make-name key #:extra-args e ...)]
-    [(_ (*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])
-    (lambda () (begin0 state (set! state (add1 state))))))
-
-(define count! (make-count!))
-(define id-count! (make-count!))
-
-(define identifier-table (make-free-id-table))
-
-(define (hash-id id)
-  (dict-ref
-   identifier-table
-   id
-   (lambda () (let ([c (id-count!)])
-                (dict-set! identifier-table id c)
-                c))))
diff --git a/typed-racket-lib/typed-racket/rep/object-rep.rkt b/typed-racket-lib/typed-racket/rep/object-rep.rkt
index cc93659f..70974a88 100644
--- a/typed-racket-lib/typed-racket/rep/object-rep.rkt
+++ b/typed-racket-lib/typed-racket/rep/object-rep.rkt
@@ -5,24 +5,38 @@
 ;;
 ;; See "Logical Types for Untyped Languages" pg.3
 
-(require "rep-utils.rkt" "free-variance.rkt" "prop-rep.rkt" "../utils/utils.rkt" (contract-req))
-(provide object-equal?)
+(require "../utils/utils.rkt"
+         "rep-utils.rkt"
+         "core-rep.rkt"
+         "free-variance.rkt"
+         (env mvar-env)
+         (contract-req))
 
-(def-pathelem CarPE () [#:fold-rhs #:base])
-(def-pathelem CdrPE () [#:fold-rhs #:base])
-(def-pathelem SyntaxPE () [#:fold-rhs #:base])
-(def-pathelem ForcePE () [#:fold-rhs #:base])
+(provide -id-path)
+
+(def-pathelem CarPE () #:base)
+(def-pathelem CdrPE () #:base)
+(def-pathelem SyntaxPE () #:base)
+(def-pathelem ForcePE () #:base)
 ;; t is always a Name (can't put that into the contract b/c of circularity)
 (def-pathelem StructPE ([t Type?] [idx natural-number/c])
-  [#:frees (λ (f) (f t))]
-  [#:fold-rhs (*StructPE (type-rec-id t) idx)])
-(def-pathelem FieldPE () [#:fold-rhs #:base])
+  [#:intern-key (cons (Rep-seq t) idx)]
+  [#:frees (f) (f t)]
+  [#:fold (f) (make-StructPE (f t) idx)]
+  [#:walk (f) (f t)])
+(def-pathelem FieldPE () #:base)
 
-(def-object Empty () [#:fold-rhs #:base])
+(def-object Path ([elems (listof PathElem?)] [name name-ref/c])
+  [#:intern-key (cons (hash-name name) (map Rep-seq elems))]
+  [#:frees (f)  (combine-frees (map f elems))]
+  [#:fold (f) (make-Path (map f elems) name)]
+  [#:walk (f) (for-each f elems)])
 
-(def-object Path ([p (listof PathElem?)] [v name-ref/c])
-  [#:intern (list (map Rep-seq p) (hash-name v))]
-  [#:frees (λ (f) (combine-frees (map f p)))]
-  [#:fold-rhs (*Path (map pathelem-rec-id p) v)])
-
-(define (object-equal? o1 o2) (= (Rep-seq o1) (Rep-seq o2)))
+(define (-id-path id)
+  (cond
+    [(identifier? id)
+     (if (is-var-mutated? id)
+         (make-Empty)
+         (make-Path null id))]
+    [else
+     (make-Path null id)]))
diff --git a/typed-racket-lib/typed-racket/rep/prop-rep.rkt b/typed-racket-lib/typed-racket/rep/prop-rep.rkt
index c904e215..5dd6a143 100644
--- a/typed-racket-lib/typed-racket/rep/prop-rep.rkt
+++ b/typed-racket-lib/typed-racket/rep/prop-rep.rkt
@@ -1,56 +1,101 @@
 #lang racket/base
 
-(require "../utils/utils.rkt" "rep-utils.rkt" "free-variance.rkt")
+(require "../utils/utils.rkt"
+         (contract-req)
+         "rep-utils.rkt"
+         "free-variance.rkt"
+         "core-rep.rkt"
+         "object-rep.rkt"
+         racket/match
+         racket/lazy-require)
 
-(provide hash-name prop-equal?)
+(lazy-require
+ ["../types/prop-ops.rkt" (-and -or)])
 
-(begin-for-cond-contract
-  (require racket/contract/base racket/lazy-require)
-  (lazy-require ["type-rep.rkt" (Type/c Univ? Bottom?)]
-                ["object-rep.rkt" (Path?)]))
-
-(provide-for-cond-contract name-ref/c)
+(provide hash-name
+         -is-type
+         -not-type
+         AndProp?
+         AndProp:
+         AndProp-ps
+         OrProp?
+         OrProp:
+         OrProp-ps
+         (rename-out [make-OrProp* make-OrProp]
+                     [make-AndProp* make-AndProp]))
 
 
-;; A Name-Ref is any value that represents an object.
-;; As an identifier, it represents a free variable in the environment
-;; As a list, it represents a De Bruijn indexed bound variable
-(define-for-cond-contract name-ref/c
-  (or/c identifier? (list/c integer? integer?)))
-(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
+(def-prop TypeProp ([obj Object?] [type (and/c Type? (not/c Univ?) (not/c Bottom?))])
+  [#:intern-key (cons (Rep-seq obj) (Rep-seq type))]
+  [#:frees (f) (combine-frees (list (f obj) (f type)))]
+  [#:fold (f) (-is-type (f obj) (f type))]
+  [#:walk (f) (begin (f obj) (f type))])
 
-(define-for-cond-contract ((length>=/c len) l)
-  (and (list? l)
-       (>= (length l) len)))
+;; Abbreviation for props
+;; `i` can be an integer or name-ref/c for backwards compatibility
+;; FIXME: Make all callers pass in an object and remove backwards compatibility
+(define/cond-contract (-is-type i t)
+  (-> (or/c integer? name-ref/c OptObject?) Type? Prop?)
+  (define o
+    (cond
+      [(OptObject? i) i]
+      [(exact-integer? i) (make-Path null (cons 0 i))]
+      [(pair? i) (make-Path null i)]
+      [else (-id-path i)]))
+  (cond
+    [(Empty? o) (make-TrueProp)]
+    [(Univ? t) (make-TrueProp)]
+    [(Bottom? t) (make-FalseProp)]
+    [else (make-TypeProp o t)]))
 
-;; the trivially "true" proposition
-(def-prop TrueProp () [#:fold-rhs #:base])
-;; the absurd, "false" proposition
-(def-prop FalseProp () [#:fold-rhs #:base])
+(def-prop NotTypeProp ([obj Object?] [type (and/c Type? (not/c Univ?) (not/c Bottom?))])
+  [#:intern-key (cons (Rep-seq obj) (Rep-seq type))]
+  [#:frees (f) (combine-frees (list (f obj) (f type)))]
+  [#:fold (f) (-not-type (f obj) (f type))]
+  [#:walk (f) (begin (f obj) (f type))])
 
-(def-prop TypeProp ([p Path?] [t (and/c Type/c (not/c Univ?) (not/c Bottom?))])
-  [#:intern (list (Rep-seq t) (Rep-seq p))]
-  [#:frees (λ (f) (combine-frees (map f (list t p))))]
-  [#:fold-rhs (*TypeProp (object-rec-id p) (type-rec-id t))])
 
-(def-prop NotTypeProp ([p Path?] [t (and/c Type/c (not/c Univ?) (not/c Bottom?))])
-  [#:intern (list (Rep-seq t) (Rep-seq p))]
-  [#:frees (λ (f) (combine-frees (map f (list t p))))]
-  [#:fold-rhs (*NotTypeProp (object-rec-id p) (type-rec-id t))])
+;; Abbreviation for not props
+;; `i` can be an integer or name-ref/c for backwards compatibility
+;; FIXME: Make all callers pass in an object and remove backwards compatibility
+(define/cond-contract (-not-type i t)
+  (-> (or/c integer? name-ref/c OptObject?) Type? Prop?)
+  (define o
+    (cond
+      [(OptObject? i) i]
+      [(exact-integer? i) (make-Path null (cons 0 i))]
+      [(pair? i) (make-Path null i)]
+      [else (-id-path i)]))
+  (cond
+    [(Empty? o) (make-TrueProp)]
+    [(Bottom? t) (make-TrueProp)]
+    [(Univ? t) (make-FalseProp)]
+    [else (make-NotTypeProp o t)]))
 
-(def-prop OrProp ([fs (and/c (length>=/c 2)
-                           (listof (or/c TypeProp? NotTypeProp?)))])
-  [#:intern (map Rep-seq fs)]
-  [#:fold-rhs (*OrProp (map prop-rec-id fs))]
-  [#:frees (λ (f) (combine-frees (map f fs)))])
+(def-prop OrProp ([ps (and/c (length>=/c 2)
+                             (listof (or/c TypeProp? NotTypeProp?)))])
+  #:no-provide
+  [#:intern-key (for/hash ([p (in-list ps)]) (values p #t))]
+  [#:frees (f) (combine-frees (map f ps))]
+  [#:fold (f) (apply -or (map f ps))]
+  [#:walk (f) (for-each f ps)])
 
-(def-prop AndProp ([fs (and/c (length>=/c 2)
-                          (listof (or/c OrProp? TypeProp? NotTypeProp?)))])
-  [#:intern (map Rep-seq fs)]
-  [#:fold-rhs (*AndProp (map prop-rec-id fs))]
-  [#:frees (λ (f) (combine-frees (map f fs)))])
+(define (make-OrProp* ps)
+  (match ps
+    [(list) (make-FalseProp)]
+    [(list p) p]
+    [ps (make-OrProp ps)]))
 
-(def-prop PropSet ([thn Prop?] [els Prop?])
-  [#:fold-rhs (*PropSet (prop-rec-id thn) (prop-rec-id els))])
+(def-prop AndProp ([ps (and/c (length>=/c 2)
+                              (listof (or/c OrProp? TypeProp? NotTypeProp?)))])
+  #:no-provide
+  [#:intern-key (for/hash ([p (in-list ps)]) (values p #t))]
+  [#:frees (f) (combine-frees (map f ps))]
+  [#:fold (f) (apply -and (map f ps))]
+  [#:walk (f) (for-each f ps)])
 
-(define (prop-equal? a b) (= (Rep-seq a) (Rep-seq b)))
+(define (make-AndProp* ps)
+  (match ps
+    [(list) (make-TrueProp)]
+    [(list p) p]
+    [ps (make-AndProp ps)]))
diff --git a/typed-racket-lib/typed-racket/rep/rep-utils.rkt b/typed-racket-lib/typed-racket/rep/rep-utils.rkt
index 38733acd..62de23f0 100644
--- a/typed-racket-lib/typed-racket/rep/rep-utils.rkt
+++ b/typed-racket-lib/typed-racket/rep/rep-utils.rkt
@@ -1,393 +1,473 @@
 #lang racket/base
 (require "../utils/utils.rkt"
          "../utils/print-struct.rkt"
+         
          racket/match
+         racket/generic
          (contract-req)
          "free-variance.rkt"
-         "interning.rkt"
-         racket/lazy-require
+         "type-mask.rkt"
          racket/stxparam
+         syntax/parse/define
+         syntax/id-table
+         racket/unsafe/ops
          (for-syntax
           racket/match
+          racket/list
+          racket/sequence
           (except-in syntax/parse id identifier keyword)
           racket/base
           syntax/struct
+          syntax/id-table
           (contract-req)
-          racket/syntax
-          (rename-in (except-in (utils stxclass-util) bytes byte-regexp regexp byte-pregexp pregexp)
-                     [id* id]
-                     [keyword* keyword])))
+          racket/syntax))
 
 
-(lazy-require
-  ["../types/printer.rkt" (print-type print-prop print-object print-pathelem)])
+(provide (all-defined-out)
+         (for-syntax var-name))
 
+(provide-for-cond-contract length>=/c)
 
-(provide == defintern hash-id (for-syntax fold-target))
+(define-for-cond-contract ((length>=/c len) l)
+  (and (list? l)
+       (>= (length l) len)))
 
-;; seq: interning-generated count that is used to compare types (type<).
+;; seq: interning-generated serial number used to compare Reps (type<).
 ;; free-vars: cached free type variables
 ;; free-idxs: cached free dot sequence variables
 ;; stx: originating syntax for error-reporting
-(define-struct Rep (seq free-vars free-idxs stx) #:transparent
-               #:methods gen:equal+hash
-               [(define (equal-proc x y recur)
-                  (eq? (Rep-seq x) (Rep-seq y)))
-                (define (hash-proc x recur) (Rep-seq x))
-                (define (hash2-proc x recur) (Rep-seq x))])
+(struct Rep (seq free-vars free-idxs) #:transparent
+  #:methods gen:equal+hash
+  [(define (equal-proc x y recur)
+     (unsafe-fx= (Rep-seq x) (Rep-seq y)))
+   (define (hash-proc x recur) (Rep-seq x))
+   (define (hash2-proc x recur) (Rep-seq x))])
 
-;; evil tricks for hygienic yet unhygienic-looking reference
-;; in say def-type for type-ref-id
-(define-for-syntax fold-target #'fold-target)
-(define-for-syntax default-fields (list #'seq #'free-vars #'free-idxs #'stx))
+(define (Rep<? x y)
+  (unsafe-fx< (Rep-seq x) (Rep-seq y)))
 
-;; parent is for struct inheritance.
-;; ht-stx is the identifier of the intern-table
-;; key? is #f iff the kind generated should not be interned.
-(define-for-syntax (mk parent ht-stx key? the-rec-id)
-  (define-syntax-class opt-contract-id
-    #:attributes (i contract)
-    (pattern i:id
-             #:with contract #'any/c)
-    (pattern [i:id contract]))
-  ;; unhygienic struct function generation
-  (define-syntax-class (idlist name)
-    #:attributes ((i 1) (contract 1) fields maker pred (accessor 1))
-    (pattern (oci:opt-contract-id ...)
-             #:with (i ...) #'(oci.i ...)
-             #:with (contract ...) #'(oci.contract ...)
-             #:with fields #'(i ...)
-             #:with (_ maker pred accessor ...) (build-struct-names name (syntax->list #'fields) #f #t name)))
+;; prop:get-values
+(define-values (prop:Rep-name Rep-name)
+  (let-values ([(prop _ accessor) (make-struct-type-property 'named)])
+    (values prop accessor)))
 
-  ;; applies f to all fields and combines the results.
-  ;; (construction prevents duplicates)
-  (define (combiner f flds)
-    (syntax-parse flds
-      [() #'empty-free-vars]
-      [(e) #`(#,f e)]
-      [(e ...) #`(combine-frees (list (#,f e) ...))]))
 
-  (define-splicing-syntax-class frees-pat
-    #:transparent
-    #:attributes (f1 f2)
-    (pattern (~seq f1:expr f2:expr))
-    ;; [#:frees #f] pattern in e.g. def-type means no free vars or idxs.
-    (pattern #f
-             #:with f1 #'empty-free-vars
-             #:with f2 #'empty-free-vars)
-    ;; [#:frees (λ (f) ...)] should combine free variables or idxs accordingly
-    ;; (given the respective accessor functions)
-    (pattern e:expr
-             #:with f1 #'(e Rep-free-vars)
-             #:with f2 #'(e Rep-free-idxs)))
+;; prop:get-values
+(define-values (prop:values-fun values-fun)
+  (let-values ([(prop _ accessor) (make-struct-type-property 'values)])
+    (values prop accessor)))
 
-  ;; fold-pat takes fold-name (e.g. App-fold) and produces the
-  ;; pattern for the match as
-  (define-syntax-class (fold-pat fold-name)
-    #:transparent
-    #:attributes (proc)
-    (pattern #:base
-             #:with proc #`(procedure-rename
-                            (lambda () #,fold-target)
-                            '#,fold-name))
-    (pattern match-expander:expr
-             #:with proc #`(procedure-rename
-                            ;; double quote expander. First unquote below
-                            ;; Second unquote at expansion.
-                            (lambda () #'match-expander)
-                            '#,fold-name)))
+;; Rep-values
+(define (Rep-values x)
+  ((values-fun x) x))
 
-  (define-syntax-class form-name
+;; prop:get-constructor
+(define-values (prop:constructor-fun Rep-constructor)
+  (let-values ([(prop _ accessor) (make-struct-type-property 'constructor)])
+    (values prop accessor)))
+
+;; structural type info for simple/straightforward types
+;; (i.e. we store the list of field variances)
+(define-values (prop:structural structural? Type-variances)
+  (make-struct-type-property 'structural))
+
+;; top type predicates
+(define-values (prop:top-type has-top-type? top-type-pred)
+  (make-struct-type-property 'top-type))
+
+;; prop:walk-fun
+(define-values (prop:walk-fun walkable? walk-fun)
+  (make-struct-type-property 'walk))
+;; Rep-walk
+(define (Rep-walk f x)
+  (define fun (walk-fun x))
+  (when (procedure? fun)
+    (fun f x)))
+
+;; prop:fold-fun
+(define-values (prop:fold-fun foldable? fold-fun)
+  (make-struct-type-property 'fold))
+
+;; Rep-fold
+(define (Rep-fold f x)
+  (define fun (fold-fun x))
+  (if (procedure? fun)
+      (fun f x)
+      x))
+
+
+;; Is this a type that can be a 'back-edge' into the type graph?
+;; (i.e. could blindly following this type lead to infinite recursion?)
+(define-values (prop:resolvable resolvable?)
+  (let-values ([(prop predicate _) (make-struct-type-property 'resolvable)])
+    (values prop predicate)))
+
+
+;;************************************************************
+;; Rep Declaration Syntax Classes
+;;************************************************************
+(define (make-counter!)
+  (let ([state 0])
+    (λ () (begin0 state (set! state (unsafe-fx+ 1 state))))))
+
+(define count! (make-counter!))
+(define id-count! (make-counter!))
+
+(define identifier-table (make-free-id-table))
+
+(define (hash-id id)
+  (free-id-table-ref!
+   identifier-table
+   id
+   (λ () (let ([c (id-count!)])
+           (free-id-table-set! identifier-table id c)
+           c))))
+
+(define (hash-name name)
+  (if (identifier? name)
+      (hash-id name)
+      name))
+
+(begin-for-syntax
+  ;; #:frees definition parsing
+  (define-syntax-class freesspec
+    #:attributes (free-vars free-idxs)
+    (pattern ([#:vars (f1) . vars-body]
+              [#:idxs (f2) . idxs-body])
+             #:with free-vars #'(let ([f1 Rep-free-vars]) . vars-body)
+             #:with free-idxs #'(let ([f2 Rep-free-idxs]) . idxs-body))
+    (pattern ((f:id) . body)
+             #:with free-vars #'(let ([f Rep-free-vars]) . body)
+             #:with free-idxs #'(let ([f Rep-free-idxs]) . body)))
+  ;; #:fold definition parsing
+  (define-syntax-class (walkspec name match-expdr struct-fields)
+    #:attributes (def)
+    (pattern ((f:id) . body)
+             #:with def
+             (with-syntax ([name name]
+                           [(flds ...) struct-fields]
+                           [mexpdr match-expdr])
+               #'(λ (f self)
+                   (match self
+                     [(mexpdr flds ...) . body]
+                     [_ (error 'Rep-walk "bad match in ~a's walk" (quote name))])))))
+  ;; #:map definition parsing
+  (define-syntax-class (foldspec name match-expdr struct-fields)
+    #:attributes (def)
+    (pattern ((f:id (~optional (~seq #:self self:id)
+                               #:defaults ([self (generate-temporary 'self)])))
+              . body)
+             #:with def
+             (with-syntax ([name name]
+                           [(flds ...) struct-fields]
+                           [mexpdr match-expdr])
+               #'(λ (f self)
+                   (match self
+                     [(mexpdr flds ...) . body]
+                     [_ (error 'Rep-fold "bad match in ~a's fold" (quote name))])))))
+  ;; variant name parsing
+  (define-syntax-class var-name
+    #:attributes (name raw-constructor constructor mexpdr pred)
     (pattern name:id
-             ;; Type -> Type:
-             #:with match-expander (format-id #'name "~a:" #'name)
-             ;; Type -> Type-fold
-             #:with fold (format-id #f "~a-fold" #'name)
-             ;; symbol made keyword of given type's name (e.g. Type -> #:Type)
-             #:with kw (string->keyword (symbol->string (syntax-e #'name)))
-             ;; Type -> *Type
-             #:with *maker (format-id #'name "*~a" #'name)))
+             #:with raw-constructor
+             ;; raw constructor should only be used by macros (hence the gensym)
+             (format-id #'name "raw-make-~a" (gensym (syntax-e #'name)))
+             #:with constructor
+             (format-id #'name "make-~a" (syntax-e #'name))
+             #:with mexpdr
+             (format-id #'name "~a:" (syntax-e #'name))
+             #:with pred
+             (format-id #'name "~a?" (syntax-e #'name))))
+  ;; structure accessor parsing
+  (define-syntax-class (fld-id struct-name)
+    #:attributes (name accessors)
+    (pattern name:id
+             #:with accessors
+             (format-id #'name "~a-~a" (syntax-e struct-name) (syntax-e #'name))))
+  ;; struct field name parsing
+  (define-syntax-class (var-fields name)
+    #:attributes ((ids 1)
+                  (contracts 1)
+                  (accessors 1))
+    (pattern ([(~var ids (fld-id name))
+               contracts:expr] ...)
+             #:with (accessors ...) #'(ids.accessors ...))))
 
-  (define (key->list key? v) (if key? (list v) (list)))
-  (lambda (stx)
-    (syntax-parse stx
-      [(dform name:form-name ;; e.g. Function
-              ;; field/contract pairs e.g. ([rator Type/c] [rand Type/c])
-              (~var flds (idlist #'name))
-              (~or
-               (~optional (~and (~fail #:unless key? "#:key not allowed")
-                                ;; expression evaluates to intern key.
-                                ;; e.g. (list rator rand)
-                                [#:key key-expr:expr])
-                          #:defaults ([key-expr #'#f]))
-               ;; intern? is explicitly given when other fields of the type
-               ;; shouldn't matter. (e.g. Opaque)
-               ;; or need further processing (e.g. fld)
-               (~optional [#:intern intern?:expr]
-                          #:defaults
-                          ([intern? (syntax-parse #'flds.fields
-                                      [() #'#f]
-                                      [(f) #'(if (Rep? f) (Rep-seq f) f)]
-                                      [(fields ...) #'(list (if (Rep? fields) (Rep-seq fields) fields) ...)])]))
-               ;; expression that when given a "get free-variables"
-               ;; function, combines the results in the expected fashion.
-               (~optional [#:frees frees:frees-pat]
-                          #:defaults
-                          ([frees.f1 (combiner #'Rep-free-vars #'flds.fields)]
-                           [frees.f2 (combiner #'Rep-free-idxs #'flds.fields)]))
-               ;; This tricky beast is for defining the type/prop/etc.'s
-               ;; part of the fold. The make-prim-type's given
-               ;; rec-ids are bound in this expression's context.
-               (~optional [#:fold-rhs (~var fold-rhs (fold-pat #'name.fold))]
-                          #:defaults ;; defaults to folding down all fields.
-                          ([fold-rhs.proc
-                            ;; This quote makes the inner quasiquote be
-                            ;; evaluated later (3rd element of the hashtable)
-                            ;; in mk-fold.
-                            ;; Thus only def-type'd entities will be properly
-                            ;; folded down.
-                            #`(procedure-rename
-                               (lambda ()
-                                 #'(name.*maker (#,the-rec-id flds.i) ...))
-                               ;; rename to fold name for better error messages
-                               'name.fold)]))
-               ;; how do we contract a value of this type?
-               (~optional [#:contract contract:expr]
-                          ;; defaults to folding down all fields.
-                          #:defaults ([contract
-                                       #'(->* (flds.contract ...)
-                                              (#:syntax (or/c syntax? #f))
-                                              flds.pred)]))
-               (~optional (~and #:no-provide no-provide?))) ...)
-       (with-syntax
-         ;; makes as many underscores as default fields (+1 for key? if provided)
-        ([(ign-pats ...) (let loop ([fs default-fields])
-                           (if (null? fs)
-                               (key->list key? #'_)
-                               (cons #'_ (loop (cdr fs)))))]
-         ;; has to be down here to refer to #'contract
-         [provides (if (attribute no-provide?)
-                       #'(begin)
-                       #'(begin
-                           (provide name.match-expander flds.pred flds.accessor ...)
-                           (provide/cond-contract (rename name.*maker flds.maker contract))))])
-        #`(begin
-            ;; struct "name" defined here.
-            (define-struct (name #,parent) flds.fields #:inspector #f)
-            (define-match-expander name.match-expander
-              (lambda (s)
-                (syntax-parse s
-                  [(_ . fields)
-                   ;; skips past ignores and binds fields for struct "name"
-                   #:with pat (syntax/loc s (ign-pats ... . fields))
-                   ;; This is the match (struct struct-id (pat ...)) form.
-                   (syntax/loc s (struct name pat))])))
-            ;; set the type's keyword in the hashtable to its
-            ;; match expander, fields and fold-rhs's for further construction.
-            (begin-for-syntax
-             (hash-set! #,ht-stx
-                        'name.kw
-                        (list #'name.match-expander
-                              #'flds.fields
-                              ;; first unquote for match-expander
-                              fold-rhs.proc
-                              #f)))
-            #,(quasisyntax/loc stx
-                (with-cond-contract name ([name.*maker contract])
-                     #,(quasisyntax/loc #'name
-                         (defintern (name.*maker . flds.fields)
-                           flds.maker intern?
-                           #:extra-args
-                           frees.f1 frees.f2
-                           #:syntax [orig-stx #f]
-                           #,@(key->list key? #'key-expr)))))
-            provides))])))
-
-;; rec-ids are identifiers that are of the folded type, so we recur on them.
-;; kws is e.g. '(#:Type #:Prop #:Object #:PathElem)
-(define-for-syntax (mk-fold hashtable rec-ids kws)
-  (lambda (stx)
-    (define new-hashtable (make-hasheq))
-    (define-syntax-class clause
-      (pattern
-       ;; Given name, matcher.
-       (k:keyword #:matcher matcher pats ... e:expr)
-       #:attr kw (attribute k.datum)
-       #:attr val (list #'matcher
-                        (syntax/loc this-syntax (pats ...))
-                        (lambda () #'e)
-                        this-syntax))
-      ;; Match on a type (or prop etc) case with keyword k
-      ;; pats are the unignored patterns (say for rator rand)
-      ;; and e is the expression that will run as fold-rhs.
-      (pattern
-       (k:keyword pats ... e:expr)
-       #:attr kw (syntax-e #'k)
-        ;; no given name. Use "keyword:"
-       #:attr val (list (format-id stx "~a:" (attribute kw))
-                        (syntax/loc this-syntax (pats ...))
-                        (lambda () #'e)
-                        this-syntax)))
-    #|
-    e.g. #:App (list #'App: (list #'rator #'rand)
-                     (lambda () #'(*App (type-rec-id rator)
-                                        (map type-rec-id rands)
-                                        stx))
-                     <stx>)
-    |#
-    (define (gen-clause k v)
-      (match v
-        [(list match-expander pats body-f src)
-         ;; makes [(Match-name all-patterns ...) body]
-         (define pat (quasisyntax/loc (or src stx)
-                                      (#,match-expander  . #,pats)))
-         (quasisyntax/loc (or src stx) (#,pat
-                                        ;; evaluate thunk containing rhs syntax
-                                        #,(body-f)))]))
-
-    (define (no-duplicates? lst)
-      (cond [(null? lst) #t]
-            [(member (car lst) (cdr lst)) #f]
-            [else (no-duplicates? (cdr lst))]))
-
-    ;; Accept only keywords in the given list.
-    (define-syntax-class (keyword-in kws)
-      #:attributes (datum)
-      (pattern k:keyword
-               #:fail-unless (memq (attribute k.datum) kws) (format "expected keyword in ~a" kws)
-               #:attr datum (attribute k.datum)))
-    ;; makes a keyword to expr hash table out of given keyword expr pairs.
-    (define-syntax-class (sized-list kws)
-      #:description (format "keyword expr pairs matching with keywords in the list ~a" kws)
-      (pattern ((~seq (~var k (keyword-in kws)) e:expr) ...)
-               #:when (no-duplicates? (attribute k.datum))
-               #:attr mapping (for/hash ([k* (attribute k.datum)]
-                                         [e* (attribute e)])
-                                (values k* e*))))
-    (syntax-parse stx
-      [(tc (~var recs (sized-list kws)) ty clauses:clause ...)
-       ;; map defined types' keywords to their given fold-rhs's.
-       ;; we will then combine this with the default hash table to generate
-       ;; the full match expression
-       (for ([k (attribute clauses.kw)]
-             [v (attribute clauses.val)])
-         (hash-set! new-hashtable k v))
-       ;; bind given expressions for #:Type etc to local ids
-       (define rec-ids* (generate-temporaries rec-ids))
-       (with-syntax ([(let-clauses ...)
-                      (for/list ([rec-id* rec-ids*]
-                                 [k kws])
-                        ;; Each rec-id binds to their corresponding given exprs
-                        ;; rec-ids and kws correspond pointwise.
-                        #`[#,rec-id* #,(hash-ref (attribute recs.mapping) k
-                                                 #'values)])]
-                     [(parameterize-clauses ...)
-                      (for/list ([rec-id rec-ids]
-                                 [rec-id* rec-ids*])
-                        #`[#,rec-id (make-rename-transformer #'#,rec-id*)])]
-                     [(match-clauses ...)
-                      ;; create all clauses we fold on, with keyword/body
-                      (append
-                       (hash-map new-hashtable gen-clause)
-                       (hash-map hashtable gen-clause))]
-                     [error-msg (quasisyntax/loc stx (error 'tc "no pattern for ~a" #,fold-target))])
-         #`(let (let-clauses ...
-                 ;; binds #'fold-target to the given element to fold down.
-                 ;; e.g. In a type-case, this is commonly "ty." Others perhaps "e".
-                 [#,fold-target ty])
-             (syntax-parameterize (parameterize-clauses ...)
-               ;; then generate the fold
-               #,(quasisyntax/loc stx
-                   (match #,fold-target
-                     match-clauses ...
-                     [_ error-msg])))))])))
-
-
-(define-syntax (make-prim-type stx)
-  (define-syntax-class type-name
-    #:attributes (name define-id key? (field-names 1) case printer hashtable rec-id kw pred? (accessors 1))
-    #:transparent
-    (pattern [name:id ;; e.g. Type
-              define-id:id ;; e.g. def-type
-              kw:keyword ;; e.g. #:Type
-              case:id ;; e.g. type-case
-              printer:id ;; e.g. print-type
-              hashtable:id ;; e.g. type-name-ht
-              rec-id:id ;; e.g. type-rec-id
-              (~optional (~and #:key ;; only given for Type.
-                               (~bind [key? #'#t]
-                                      [(field-names 1) (list #'key)]))
-                         #:defaults ([key? #'#f]
-                                     [(field-names 1) null]))]
-             #:with (_ _ pred? accessors ...)
-             (build-struct-names #'name (syntax->list #'(field-names ...)) #f #t #'name)))
+;;************************************************************
+;; def-rep
+;;************************************************************
+;;
+;; Declaration macro for Rep structures
+(define-syntax (def-rep stx)
   (syntax-parse stx
-    [(_ i:type-name ...)
-     #'(begin
-         (provide i.define-id ...
-                  i.name ...
-                  i.pred? ...
-                  i.rec-id ...
-                  i.accessors ... ... ;; several accessors per type.
-                  (for-syntax i.hashtable ... ))
-         ;; make type name and populate hashtable with
-         ;; keyword to (list match-expander-stx fields fold-rhs.proc #f)
-         ;; e.g. def-type type-name-ht #t
-         (define-syntax i.define-id
-           (mk #'i.name #'i.hashtable i.key? #'i.rec-id)) ...
-         (define-for-syntax i.hashtable (make-hasheq)) ...
-         (define-struct/printer (i.name Rep) (i.field-names ...) i.printer) ...
-         (define-syntax-parameter i.rec-id
-           (λ (stx)
-              (raise-syntax-error #f
-                                  (format "used outside ~a" 'i.define-id)
-                                  stx))) ...
-         (provide i.case ...)
-         (define-syntaxes (i.case ...) ;; each fold case gets its own macro.
-           (let ([rec-ids (list #'i.rec-id ...)])
-             (apply values
-                    (map (lambda (ht) ;; each type has a hashtable. For each type...
-                           ;; make its fold function using populated hashtable.
-                           ;; [unsyntax (*1)]
-                           (mk-fold ht
-                                    rec-ids
-                                    ;; '(#:Type #:Prop #:Object #:PathElem)
-                                    '(i.kw ...)))
-                         (list i.hashtable ...))))))]))
+    [(_
+      ;; variant name
+      var:var-name
+      ;; fields and field contracts
+      (~var flds (var-fields #'var.name))
+      ;; options
+      (~or
+       ;; parent struct (if any)
+       (~optional (~optional [#:parent parent:id])
+                  #:defaults ([parent #'Rep]))
+       ;; base declaration (i.e. no fold/map)
+       (~optional (~and #:base base?))
+       ;; All Reps are interned
+       (~optional [#:intern-key provided-intern-key])
+       ;; #:frees spec (how to compute this Rep's free type variables)
+       (~optional [#:frees . frees-spec:freesspec])
+       ;; #:walk spec (how to traverse this structure for effect)
+       (~optional [#:walk . (~var walk-spec (walkspec #'var.name
+                                                      #'var.mexpdr
+                                                      #'(flds.ids ...)))])
+       ;; #:fold spec (how to transform & fold this structure)
+       (~optional [#:fold . (~var fold-spec (foldspec #'var.name
+                                                      #'var.mexpdr
+                                                      #'(flds.ids ...)))])
+       (~optional [#:type-mask . type-mask-body])
+       ;; is this a Type w/ a Top type? (e.g. Vector --> VectorTop)
+       (~optional [#:top top-pred:id])
+       ;; #:no-provide option (i.e. don't provide anything automatically)
+       (~optional (~and #:needs-resolving needs-resolving?))
+       ;; #:no-provide option (i.e. don't provide anything automatically)
+       (~optional (~and #:no-provide no-provide?))
+       ;; field variances (e.g. covariant/contravariant/etc) declarations
+       (~optional (~and [#:variances variances ...] structural))
+       ;; #:extras to specify other struct properties in a per-definition manner
+       (~optional [#:extras . extras]))
+      ...)
 
-(make-prim-type [Type def-type #:Type type-case print-type type-name-ht type-rec-id #:key]
-                [Prop def-prop #:Prop prop-case print-prop prop-name-ht prop-rec-id]
-                [Object def-object #:Object object-case print-object object-name-ht object-rec-id]
-                [PathElem def-pathelem #:PathElem pathelem-case print-pathelem pathelem-name-ht pathelem-rec-id])
+     ;; - - - - - - - - - - - - - - -
+     ;; Error checking
+     ;; - - - - - - - - - - - - - - -
+     
+     ;; build convenient boolean flags
+     (define is-a-type? (eq? 'Type (syntax-e #'parent)))
+     (define intern-key (if (attribute provided-intern-key)
+                            #'provided-intern-key
+                            #'#t))
+     ;; intern-key is required (when the number of fields is > 0)
+     (when (and (not (attribute provided-intern-key))
+                (> (length (syntax->list #'flds)) 0))
+       (raise-syntax-error 'def-rep "intern key specification required when the number of fields > 0"
+                           #'var))
+     ;; no frees, walk, or fold for #:base Reps
+     (when (and (attribute base?) (or (attribute frees-spec)
+                                      (attribute walk-spec)
+                                      (attribute fold-spec)))
+       (raise-syntax-error 'def-rep "base reps cannot have #:frees, #:walk, or #:fold"
+                           #'var))
+     ;; if non-base, frees, walk, and fold are required
+     (when (and (not (attribute base?))
+                (or (not (attribute frees-spec))
+                    (not (attribute walk-spec))
+                    (not (attribute fold-spec))))
+       (raise-syntax-error 'def-rep "non-base reps require #:frees, #:walk, and #:fold"
+                           #'var))
+     ;; can't be structural and not a type
+     (when (and (not is-a-type?) (attribute structural))
+       (raise-syntax-error 'def-rep "only types can be structural" #'structural))
 
-(define (Rep-values rep)
-  (match rep
-    [(? (lambda (e) (or (Prop? e)
-                        (Object? e)
-                        (PathElem? e)))
-        (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx vals)))
-     vals]
-    [(? Type?
-        (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals)))
-     vals]))
+     ;; - - - - - - - - - - - - - - -
+     ;; Let's build the definitions!
+     ;; - - - - - - - - - - - - - - -
+     
+     (with-syntax*
+       ([intern-key intern-key]
+        ;; contract for constructor
+        [constructor-contract #'(-> flds.contracts ... var.pred)]
+        ;; match expander (skips 'meta' fields)
+        [mexpdr-def
+         #`(define-match-expander var.mexpdr
+             (λ (s)
+               (syntax-parse s
+                 [(_ . pats)
+                  #,(if is-a-type? ;; skip Type-mask and subtype cache
+                        #'(syntax/loc s (var.name _ _ _ _ _ . pats))
+                        #'(syntax/loc s (var.name _ _ _ . pats)))])))]
+        ;; free var/idx defs
+        [free-vars-def (cond
+                         [(attribute base?) #'empty-free-vars]
+                         [else #'frees-spec.free-vars])]
+        [free-idxs-def (cond
+                         [(attribute base?) #'empty-free-vars]
+                         [else #'frees-spec.free-idxs])]
+        ;; top type info
+        [(maybe-top-type-spec ...)
+         (if (attribute top-pred)
+             #'(#:property prop:top-type top-pred)
+             #'())]
+        ;; if it's a structural type, save its field variances
+        [(maybe-structural ...)
+         (if (attribute structural)
+             #'(#:property prop:structural (list variances ...))
+             #'())]
+        ;; an argument if we accept a type mask
+        [mask-arg (generate-temporary 'mask)]
+        ;; constructor w/ interning and Type-mask handeling if necessary
+        [constructor-def
+         (cond
+           ;; non-Types don't need masks
+           [(not is-a-type?)
+            #'(define var.constructor
+                (let ([intern-table (make-hash)])
+                  (λ (flds.ids ...)
+                    (let ([key intern-key]
+                          [fail (λ () (let ([fvs free-vars-def]
+                                            [fis free-idxs-def])
+                                        (var.raw-constructor (count!) fvs fis flds.ids ...)))])
+                      (hash-ref! intern-table key fail)))))]
+           [else
+            ;; Types have to provide Type-masks and subtype caches
+            #`(define var.constructor
+                (let ([intern-table (make-hash)])
+                  (λ (flds.ids ...)
+                    (let ([key intern-key]
+                          [fail (λ () (let ([fvs free-vars-def]
+                                            [fis free-idxs-def]
+                                            [mask-val #,(if (attribute type-mask-body)
+                                                            #'(let () . type-mask-body)
+                                                            #'mask:unknown)])
+                                        (var.raw-constructor (count!) fvs fis (make-hash) mask-val flds.ids ...)))])
+                      (hash-ref! intern-table key fail)))))])]
+        ;; walk def
+        [walk-def (cond
+                    [(attribute base?) #'#f]
+                    [else #'walk-spec.def])]
+        ;; fold def
+        [fold-def (cond
+                    [(attribute base?) #'#f]
+                    [else #'fold-spec.def])]
+        ;; is this a type that needs resolving (e.g. Mu)
+        [(maybe-needs-resolving ...)
+         (if (attribute needs-resolving?)
+             #'(#:property prop:resolvable #t)
+             #'())]
+        ;; how do we pull out the values required to fold this Rep?
+        [values-def #'(match-lambda
+                        [(var.mexpdr flds.ids ...) (list flds.ids ...)])]
+        ;; module provided defintions, if any
+        [(provides ...)
+         (cond
+           [(attribute no-provide?) #'()]
+           [else
+            #'((provide var.mexpdr var.pred flds.accessors ...)
+               (provide/cond-contract (var.constructor constructor-contract)))])]
+        [(extra-defs ...) (if (attribute extras) #'extras #'())])
+       ;; - - - - - - - - - - - - - - -
+       ;; macro output
+       ;; - - - - - - - - - - - - - - -
+       #'(begin
+           (struct var.name parent (flds.ids ...) #:transparent
+             #:constructor-name
+             var.raw-constructor
+             #:property prop:Rep-name (quote var.name)
+             #:property prop:constructor-fun
+             (λ (flds.ids ...) (var.constructor flds.ids ...))
+             #:property prop:values-fun
+             values-def
+             #:property prop:walk-fun
+             walk-def
+             #:property prop:fold-fun
+             fold-def
+             maybe-top-type-spec ...
+             maybe-structural ...
+             maybe-needs-resolving ...
+             extra-defs ...)
+           constructor-def
+           mexpdr-def
+           provides ...))]))
+
+
+;; macro for easily defining sets of types represented by fixnum bitfields
+(define-syntax (define-type-bitfield stx)
+  (define-syntax-class atoms-spec
+    (pattern [abbrev:id
+              name:id
+              contract:expr
+              predicate:expr]
+             #:with bits (format-id #'name "bits:~a" (syntax-e #'name))
+             #:with provide #'(provide bits)))
+  (define-syntax-class union-spec
+    (pattern [abbrev:id
+              name:id
+              contract:expr
+              predicate:expr
+              (elements:id ...)
+              (~optional (~and #:no-provide no-provide?))]
+             #:with bits (format-id #'name "bits:~a" (syntax-e #'name))
+             #:with provide #'(provide bits)))
+  (syntax-parse stx
+    [(_ #:atom-count atomic-type-count:id
+        #:atomic-type-vector atomic-type-vector:id
+        #:atomic-name-vector atomic-name-vector:id
+        #:name-hash name-hash:id
+        #:atomic-contract-vector atomic-contract-vector:id
+        #:contract-hash contract-hash:id
+        #:atomic-predicate-vector atomic-predicate-vector:id
+        #:predicate-hash predicate-hash:id
+        #:constructor-template (mk-bits:id) mk-expr:expr
+        #:atoms
+        atoms:atoms-spec ...
+        #:unions
+        unions:union-spec ...)
+     (define max-base-atomic-count 31) ;; this way we can do unsafe fx ops on any machine
+     (define atom-list (syntax->datum #'(atoms.name ...)))
+     (define atom-count (length atom-list))
+     (unless (<= atom-count max-base-atomic-count)
+       (raise-syntax-error
+        'define-type-bitfield
+        (format "too many atomic base types (~a is the max)"
+                max-base-atomic-count)
+        stx))
+     (with-syntax ([(n ... ) (range atom-count)]
+                   [(2^n ...)
+                    (build-list atom-count (λ (n) (arithmetic-shift 1 n)))])
+       #`(begin
+           ;; how many atomic types?
+           (define atomic-type-count #,atom-count)
+           ;; define the atomic types' bit identifiers (e.g. bits:Null)
+           (begin (define atoms.bits 2^n) ...)
+           ;; define the union types' bit identifiers
+           (begin (define unions.bits
+                    (bitwise-ior unions.elements ...))
+                  ...)
+           ;; define the actual type references (e.g. -Null)
+           (begin (define/decl atoms.abbrev
+                    (let ([mk-bits atoms.bits]) mk-expr)) ...)
+           (begin (define/decl unions.abbrev
+                    (let ([mk-bits unions.bits]) mk-expr)) ...)
+           ;; define the various vectors and hashes
+           (define atomic-type-vector
+             (vector-immutable atoms.abbrev ...))
+           (define atomic-name-vector
+             (vector-immutable (quote atoms.name) ...))
+           (define name-hash
+             (make-immutable-hasheqv
+              (list (cons atoms.bits (quote atoms.name)) ...
+                    (cons unions.bits (quote unions.name)) ...)))
+           (define atomic-contract-vector
+             (vector-immutable atoms.contract ...))
+           (define contract-hash
+             (make-immutable-hasheqv
+              (list
+               (cons atoms.bits atoms.contract)
+              ...
+              (cons unions.bits unions.contract)
+              ...)))
+           (define atomic-predicate-vector
+             (vector-immutable atoms.predicate ...))
+           (define predicate-hash
+             (make-immutable-hasheqv
+              (list
+               (cons atoms.bits atoms.predicate) ...
+               (cons unions.bits unions.predicate) ...)))
+           ;; provide the bit variables (e.g. bits:Null)
+           atoms.provide ...
+           unions.provide ...))]))
 
-;; Rep equality and inequality
-(define (rep-equal? s t)
-  (eq? (Rep-seq s) (Rep-seq t)))
-(define (rep<? s t)
-  (< (Rep-seq s) (Rep-seq t)))
 
 (provide
   Rep-values
-  (rename-out [Rep-seq Type-seq]
-              [Rep-free-vars free-vars*]
+  (rename-out [Rep-free-vars free-vars*]
               [Rep-free-idxs free-idxs*]))
-
-(provide/cond-contract
-  [rename rep-equal? type-equal? (Type? Type? . -> . boolean?)]
-  [rename rep<? type<? (Type? Type? . -> . boolean?)]
-  [rename rep<? prop<? (Prop? Prop? . -> . boolean?)]
-  [struct Rep ([seq exact-nonnegative-integer?]
-               [free-vars (hash/c symbol? variance?)]
-               [free-idxs (hash/c symbol? variance?)]
-               [stx (or/c #f syntax?)])])
diff --git a/typed-racket-lib/typed-racket/rep/type-mask.rkt b/typed-racket-lib/typed-racket/rep/type-mask.rkt
new file mode 100644
index 00000000..8112ef93
--- /dev/null
+++ b/typed-racket-lib/typed-racket/rep/type-mask.rkt
@@ -0,0 +1,156 @@
+#lang racket/base
+
+;;************************************************************
+;; Type Masks
+;;
+;; - - Purpose - -
+;; 
+;; Type masks allow us to identify disjoint base types and unions of
+;; base types. This allows us to short-circuit certain subtype and
+;; overlap checks.
+;;
+;; - - Details - -
+;;
+;; Type masks are represented with a simple 31-bit fixnum.
+;;
+;; If a bit flag in a Type's bitmask is set to 1, it means the Type
+;; _may_ overlap with the values described by that bit flag.
+;;
+;; If a bit flag in a Type's bitmask is set to 0, it means the Type
+;; _cannot_ overlap with values described by that bit flag.
+;;************************************************************
+
+(require (for-syntax racket/base syntax/parse)
+         racket/unsafe/ops
+         racket/fixnum)
+
+(provide type-mask?
+         mask-union
+         mask-intersect
+         disjoint-masks?
+         sub-mask?
+         mask:bottom
+         mask:unknown)
+
+(define-syntax OR (make-rename-transformer #'unsafe-fxior))
+(define-syntax AND (make-rename-transformer #'unsafe-fxand))
+(define-syntax NOT (make-rename-transformer #'unsafe-fxnot))
+(define-syntax EQUALS? (make-rename-transformer #'unsafe-fx=))
+(define-syntax mask-union (make-rename-transformer #'unsafe-fxior))
+(define-syntax mask-intersect (make-rename-transformer #'unsafe-fxand))
+
+;; debugging safe versions
+;; (define-syntax OR (make-rename-transformer #'fxior))
+;; (define-syntax AND (make-rename-transformer #'fxand))
+;; (define-syntax NOT (make-rename-transformer #'fxnot))
+;; (define-syntax EQUALS? (make-rename-transformer #'fx=))
+;; (define-syntax mask-union (make-rename-transformer #'fxior))
+;; (define-syntax mask-intersect (make-rename-transformer #'fxand))
+
+;; type mask predicate
+(define-syntax type-mask? (make-rename-transformer #'fixnum?))
+
+;; define the max size of type  masks
+(module const racket/base
+  (provide max-mask-size)
+  (define max-mask-size 31))
+(require 'const (for-syntax 'const))
+
+
+;;************************************************************
+;; Mask Operations
+;;************************************************************
+
+(define-syntax-rule (ZERO? n)
+  (EQUALS? 0 n))
+
+;; disjoint-masks?
+;; returns #t if the two masks could not
+;; possibly have overlapping values
+(define (disjoint-masks? m1 m2)
+  (ZERO? (mask-intersect m1 m2)))
+
+;; sub-mask?
+;; returns #t if it is possible that m1 ⊆ m2
+;; (i.e. values represented by m1 are also
+;;  described by m2)
+(define (sub-mask? m1 m2)
+  (ZERO? (AND m1 (NOT m2))))
+
+
+;;************************************************************
+;; Masks
+;;************************************************************
+
+;;---------------------
+;; declare-type-flags
+;;---------------------
+
+;; macro for easily defining the type mask flags
+(define-syntax (declare-type-flags stx)
+  (syntax-parse stx
+    [(_ name:id ...)
+     (define name-list (syntax->datum #'(name ...)))
+     (define count (length name-list))
+     (unless (<= count max-mask-size)
+       (raise-syntax-error 'declare-type-flags
+                           (format "too many type flags (~a is the max)"
+                                   max-mask-size)
+                           stx))
+     (with-syntax ([(n ...) (build-list count (λ (n) (arithmetic-shift 1 n)))])
+       #`(begin (begin (define name n)
+                       (provide name))
+                ...))]))
+
+;;-------------------
+;; Top/Bottom Masks
+;;-------------------
+
+;; bottom mask - no value inhabits this mask
+(define mask:bottom 0)
+;; unknown/top mask - this mask says the value may inhabit any type
+(define mask:unknown
+  (sub1 (expt 2 max-mask-size)))
+
+;;----------------------
+;; Specific Type Flags
+;;----------------------
+
+;; Note:  mask:other is for values which are
+;; disjoint from all other specified values,
+;; but which we are not specifically tracking
+
+(declare-type-flags
+ ;; a few common base types have their own masks
+ mask:null
+ mask:true
+ mask:false
+ mask:char
+ mask:symbol
+ mask:void
+ mask:string
+ ;; the other base types use this catch-all
+ mask:base-other
+ mask:number
+ mask:pair
+ mask:mpair
+ mask:vector
+ mask:hash
+ mask:box
+ mask:channel
+ mask:thread-cell
+ mask:promise ;; huh? (structs can be promises)
+ mask:ephemeron
+ mask:future
+ mask:other-box
+ mask:set
+ mask:procedure
+ mask:prompt-tag
+ mask:continuation-mark-key
+ mask:struct
+ mask:prefab
+ mask:struct-type
+ mask:syntax
+ mask:class
+ mask:instance
+ mask:unit)
diff --git a/typed-racket-lib/typed-racket/rep/type-rep.rkt b/typed-racket-lib/typed-racket/rep/type-rep.rkt
index 19c8cb92..6fbef055 100644
--- a/typed-racket-lib/typed-racket/rep/type-rep.rkt
+++ b/typed-racket-lib/typed-racket/rep/type-rep.rkt
@@ -7,35 +7,43 @@
 
 ;; TODO use contract-req
 (require (utils tc-utils)
-         "rep-utils.rkt" "object-rep.rkt" "prop-rep.rkt" "free-variance.rkt"
+         "rep-utils.rkt"
+         "core-rep.rkt"
+         "values-rep.rkt"
+         "type-mask.rkt"
+         "object-rep.rkt"
+         "free-variance.rkt"
          racket/match racket/list racket/set
          racket/contract
          racket/lazy-require
          racket/promise
-         (for-syntax racket/base syntax/parse))
+         syntax/parse/define
+         (for-syntax racket/base
+                     racket/syntax
+                     syntax/parse))
 
-(provide Mu-name:
+(provide (all-from-out "core-rep.rkt")
+         Type?
+         Mu-name:
          Poly-names: Poly-fresh:
          PolyDots-names:
          PolyRow-names: PolyRow-fresh:
-         Type-seq
          -unsafe-intersect
          Mu-unsafe: Poly-unsafe:
          PolyDots-unsafe:
          Mu? Poly? PolyDots? PolyRow?
-         Prop? Object?
-         Type/c Type/c?
-         Values/c SomeValues/c
-         Bottom?
          Poly-n
          PolyDots-n
          Class? Row? Row:
          free-vars*
          type-equal?
-         remove-dups
-         sub-t sub-f sub-o sub-pe
          Name/simple: Name/struct:
-         (rename-out [Class:* Class:]
+         unfold
+         Union?
+         Union:
+         Union-elems
+         (rename-out [make-Union* make-Union]
+                     [Class:* Class:]
                      [Class* make-Class]
                      [Row* make-Row]
                      [Mu:* Mu:]
@@ -52,7 +60,6 @@
                      [PolyRow-body* PolyRow-body]))
 
 
-;; Ugly hack - should use units
 (lazy-require
  ("../types/union.rkt" (Un))
  ("../types/overlap.rkt" (overlap?))
@@ -60,51 +67,28 @@
 
 (define name-table (make-weak-hasheq))
 
-(define Type/c?
-   (λ (e)
-     (and (Type? e)
-          (not (arr? e))
-          (not (fld? e))
-          (not (Values? e))
-          (not (ValuesDots? e))
-          (not (AnyValues? e))
-          (not (Result? e))
-          (not (Signature? e)))))
-
-;; (or/c Type/c Values? Results?)
-;; Anything that can be treated as a Values by sufficient expansion
-(define Values/c?
-   (λ (e)
-     (and (Type? e)
-          (not (arr? e))
-          (not (fld? e))
-          (not (ValuesDots? e))
-          (not (AnyValues? e))
-          (not (Signature? e)))))
-
-(define Type/c (flat-named-contract 'Type Type/c?))
-(define Values/c (flat-named-contract 'Values Values/c?))
-(define Bottom?
-  (match-lambda
-    [(Union: (list)) #t]
-    [else #f]))
-
 ;; Name = Symbol
 
 ;; Type is defined in rep-utils.rkt
 
 ;; this is ONLY used when a type error ocurrs
-(def-type Error () [#:frees #f] [#:fold-rhs #:base])
+(def-type Error () #:base)
 
 ;; de Bruijn indexes - should never appear outside of this file
 ;; bound type variables
 ;; i is an nat
-(def-type B ([i natural-number/c]) [#:frees #f] [#:fold-rhs #:base])
+(def-type B ([i natural-number/c]) #:base
+  [#:intern-key i])
 
 ;; free type variables
 ;; n is a Name
-(def-type F ([n symbol?]) [#:frees (single-free-var n) empty-free-vars]
-  [#:fold-rhs #:base])
+(def-type F ([n symbol?])
+  [#:intern-key n]
+  [#:frees
+   [#:vars (_) (single-free-var n)]
+   [#:idxs (_) empty-free-vars]]
+  [#:fold (_ #:self self) self]
+  [#:walk (_) (void)])
 
 ;; Name, an indirection of a type through the environment
 ;;
@@ -117,97 +101,32 @@
 (def-type Name ([id identifier?]
                 [args exact-nonnegative-integer?]
                 [struct? boolean?])
-  [#:intern (hash-id id)] [#:frees #f] [#:fold-rhs #:base])
+  [#:intern-key (hash-id id)]
+  [#:frees (f) empty-free-vars]
+  [#:fold (_ #:self self) self]
+  [#:walk (_) (void)]
+  #:needs-resolving)
 
 ;; rator is a type
 ;; rands is a list of types
 ;; stx is the syntax of the pair of parens
-(def-type App ([rator Type/c] [rands (listof Type/c)] [stx (or/c #f syntax?)])
-  [#:intern (cons (Rep-seq rator) (map Rep-seq rands))]
-  [#:frees (λ (f)
-              (match rator 
-                ((Name: n _ _)
-                 (instantiate-frees n (map f rands)))
-                (else (f (resolve-app rator rands stx)))))]
+(def-type App ([rator Type?]
+               [rands (listof Type?)]
+               [stx (or/c #f syntax?)])
+  [#:intern-key (cons (Rep-seq rator) (map Rep-seq rands))]
+  [#:frees (f)
+   (match rator 
+     [(Name: n _ _)
+      (instantiate-frees n (map f rands))]
+     [_ (f (resolve-app rator rands stx))])]
+  [#:fold (f) (make-App (f rator)
+                        (map f rands)
+                        stx)]
+  [#:walk (f)
+   (f rator)
+   (for-each f rands)]
+  #:needs-resolving)
 
-  [#:fold-rhs (*App (type-rec-id rator)
-                    (map type-rec-id rands)
-                    stx)])
-
-;; left and right are Types
-(def-type Pair ([left Type/c] [right Type/c]) [#:key 'pair])
-
-;; dotted list -- after expansion, becomes normal Pair-based list type
-(def-type ListDots ([dty Type/c] [dbound (or/c symbol? natural-number/c)])
-  [#:frees (if (symbol? dbound)
-               (free-vars-remove (free-vars* dty) dbound)
-               (free-vars* dty))
-           (if (symbol? dbound)
-               (combine-frees (list (single-free-var dbound) (free-idxs* dty)))
-               (free-idxs* dty))]
-  [#:fold-rhs (*ListDots (type-rec-id dty) dbound)])
-
-;; *mutable* pairs - distinct from regular pairs
-;; left and right are Types
-(def-type MPair ([left Type/c] [right Type/c])
-  [#:frees (λ (f) (make-invariant (combine-frees (list (f left) (f right)))))]
-  [#:key 'mpair])
-
-;; elem is a Type
-(def-type Vector ([elem Type/c])
-  [#:frees (λ (f) (make-invariant (f elem)))]
-  [#:key 'vector])
-
-;; elems are all Types
-(def-type HeterogeneousVector ([elems (listof Type/c)])
-  [#:intern (map Rep-seq elems)]
-  [#:frees (λ (f) (make-invariant (combine-frees (map f elems))))]
-  [#:key 'vector]
-  [#:fold-rhs (*HeterogeneousVector (map type-rec-id elems))])
-
-;; elem is a Type
-(def-type Box ([elem Type/c])
-  [#:frees (λ (f) (make-invariant (f elem)))]
-  [#:key 'box])
-
-;; elem is a Type
-(def-type Channel ([elem Type/c])
-  [#:frees (λ (f) (make-invariant (f elem)))]
-  [#:key 'channel])
-
-;; elem is a Type
-(def-type Async-Channel ([elem Type/c])
-  [#:frees (λ (f) (make-invariant (f elem)))]
-  [#:key 'async-channel])
-
-;; elem is a Type
-(def-type ThreadCell ([elem Type/c])
-  [#:frees (λ (f) (make-invariant (f elem)))]
-  [#:key 'thread-cell])
-
-;; elem is a Type
-(def-type Promise ([elem Type/c])
-  [#:key 'promise])
-
-;; elem is a Type
-(def-type Ephemeron ([elem Type/c])
-  [#:key 'ephemeron])
-
-;; elem is a Type
-(def-type Weak-Box ([elem Type/c])
-  [#:key 'weak-box])
-
-;; elem is a Type
-(def-type CustodianBox ([elem Type/c])
-  [#:key 'custodian-box])
-
-;; elem is a Type
-(def-type Set ([elem Type/c])
-  [#:key 'set])
-
-;; result is a Type
-(def-type Evt ([result Type/c])
-  [#:key #f])
 
 ;; name is a Symbol (not a Name)
 ;; contract is used when generating contracts from types
@@ -215,145 +134,402 @@
 ;; to that base type. This is used to check for subtyping between value
 ;; types and base types.
 ;; numeric determines if the type is a numeric type
-(def-type Base ([name symbol?] [contract syntax?] [predicate procedure?] [numeric? boolean?])
-  [#:frees #f] [#:fold-rhs #:base] [#:intern name]
-  [#:key (if numeric?
-             'number
-             (case name
-               [(Boolean) 'boolean]
-               [(String) 'string]
-               [(Symbol) 'symbol]
-               [(Keyword) 'keyword]
-               [else #f]))])
+(def-type Base ([name symbol?]
+                [contract syntax?]
+                [predicate procedure?]
+                [numeric? boolean?])
+  #:base
+  [#:intern-key name] 
+  [#:type-mask
+   (if numeric?
+       mask:number
+       (case name
+         [(Char) mask:char]
+         [(String) mask:string]
+         [(Void) mask:void]
+         [(Symbol) mask:symbol]
+         [else mask:base-other]))])
 
-(def-type Mu ([body Type/c]) #:no-provide [#:frees (λ (f) (f body))]
-  [#:fold-rhs (*Mu (type-rec-id body))]
-  [#:key (Type-key body)])
+
+;;************************************************************
+;; Structural Types
+;;************************************************************
+
+;; structural types
+;; these have only Type? fields, for which they specify their variance
+;; (either #:covariant, #:contravariant, or #:invariant for Covariant, Contravariant, or Invariant)
+;; instead of specifying a contract for the fields
+(define-syntax (def-structural stx)
+  (define-syntax-class (structural-flds frees)
+    #:attributes (name variance fld-frees)
+    (pattern [name:id #:covariant]
+             #:with variance #'Covariant
+             #:with fld-frees #'(frees name))
+    (pattern [name:id #:contravariant]
+             #:with variance #'Contravariant
+             #:with fld-frees #'(flip-variances (frees name)))
+    (pattern [name:id #:invariant]
+             #:with variance #'Invariant
+             #:with fld-frees #'(make-invariant (frees name))))
+  (syntax-parse stx
+    [(_ name:var-name ((~var flds (structural-flds #'frees)) ...) . rst)
+     #'(def-rep name ([flds.name Type?] ...)
+         [#:parent Type]
+         [#:intern-key (list* (Rep-seq flds.name) ...)]
+         [#:variances flds.variance ...]
+         [#:frees (frees) (combine-frees (list flds.fld-frees ...))]
+         [#:fold (f) (name.constructor (f flds.name) ...)]
+         [#:walk (f) (f flds.name) ...]
+         . rst)]))
+
+
+;;--------
+;; Pairs
+;;--------
+
+;; left and right are Types
+(def-structural Pair ([left #:covariant]
+                      [right #:covariant])
+  [#:type-mask mask:pair])
+
+;;----------------
+;; Mutable Pairs
+;;----------------
+
+(def-type MPairTop () [#:type-mask mask:mpair] #:base)
+
+;; *mutable* pairs - distinct from regular pairs
+;; left and right are Types
+(def-structural MPair ([left #:invariant] [right #:invariant])
+  [#:type-mask mask:mpair]
+  [#:top MPairTop?])
+
+;;----------
+;; Vectors
+;;----------
+
+(def-type VectorTop () [#:type-mask mask:vector] #:base)
+
+;; elem is a Type
+(def-structural Vector ([elem #:invariant])
+  [#:type-mask mask:vector]
+  [#:top VectorTop?])
+
+;;------
+;; Box
+;;------
+
+(def-type BoxTop ()
+  [#:type-mask mask:box] #:base)
+
+(def-structural Box ([elem #:invariant])
+  [#:type-mask mask:box]
+  [#:top BoxTop?])
+
+;;----------
+;; Channel
+;;----------
+
+(def-type ChannelTop ()
+  [#:type-mask mask:channel] #:base)
+
+(def-structural Channel ([elem #:invariant])
+  [#:type-mask mask:channel]
+  [#:top ChannelTop?])
+
+;;----------------
+;; Async-Channel
+;;----------------
+
+(def-type Async-ChannelTop ()
+  [#:type-mask mask:channel] #:base)
+
+(def-structural Async-Channel ([elem #:invariant])
+  [#:type-mask mask:channel]
+  [#:top Async-ChannelTop?])
+
+;;-------------
+;; ThreadCell
+;;-------------
+
+(def-type ThreadCellTop ()
+  [#:type-mask mask:thread-cell] #:base)
+
+(def-structural ThreadCell ([elem #:invariant])
+  [#:type-mask mask:thread-cell]
+  [#:top ThreadCellTop?])
+
+;;----------
+;; Promise
+;;----------
+
+(def-structural Promise ([elem #:covariant])
+  [#:type-mask mask:promise])
+
+;;------------
+;; Ephemeron
+;;------------
+
+(def-structural Ephemeron ([elem #:covariant])
+  [#:type-mask mask:ephemeron])
+
+
+;;-----------
+;; Weak-Box
+;;-----------
+
+(def-type Weak-BoxTop ()
+  [#:type-mask mask:other-box] #:base)
+
+(def-structural Weak-Box ([elem #:invariant])
+  [#:type-mask mask:other-box]
+  [#:top Weak-BoxTop?])
+
+
+;;---------------
+;; CustodianBox
+;;---------------
+
+(def-structural CustodianBox ([elem #:covariant])
+  [#:type-mask mask:other-box])
+
+;;------
+;; Set
+;;------
+
+;; TODO separate mutable/immutable set types
+(def-structural Set ([elem #:covariant])
+  [#:type-mask mask:set])
+
+;;------------
+;; Hashtable
+;;------------
+
+(def-type HashtableTop ()
+  [#:type-mask mask:hash] #:base)
+
+;; TODO separate mutable/immutable Hashtables
+(def-structural Hashtable ([key #:invariant] [value #:invariant])
+  [#:type-mask mask:hash]
+  [#:top HashtableTop?])
+
+
+;;------
+;; Evt
+;;------
+
+(def-structural Evt ([result #:covariant]))
+
+;;--------
+;; Param
+;;--------
+
+(def-structural Param ([in #:contravariant]
+                       [out #:covariant])
+  [#:type-mask mask:procedure])
+
+
+;;---------
+;; Syntax
+;;---------
+
+;; t is the type of the result of syntax-e, not the result of syntax->datum
+(def-structural Syntax ([t #:covariant])
+  [#:type-mask mask:syntax])
+
+;;---------
+;; Future
+;;---------
+
+(def-structural Future ([t #:covariant])
+  [#:type-mask mask:future])
+
+
+;;---------------
+;; Prompt-Tagof
+;;---------------
+
+(def-type Prompt-TagTop ()
+  [#:type-mask mask:prompt-tag] #:base)
+
+;; body: the type of the body
+;; handler: the type of the prompt handler
+;;   prompts with this tag will return a union of `body` 
+;;   and the codomains of `handler`
+(def-structural Prompt-Tagof ([body #:invariant]
+                              [handler #:invariant])
+  [#:type-mask mask:prompt-tag]
+  [#:top Prompt-TagTop?])
+
+;;--------------------------
+;; Continuation-Mark-Keyof
+;;--------------------------
+
+(def-type Continuation-Mark-KeyTop ()
+  [#:type-mask mask:continuation-mark-key] #:base)
+
+;; value: the type of allowable values
+(def-structural Continuation-Mark-Keyof ([value #:invariant])
+  [#:type-mask mask:continuation-mark-key]
+  [#:top Continuation-Mark-KeyTop?])
+
+;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
+;; List/Vector Types (that are not simple structural types)
+;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
+
+;; dotted list -- after expansion, becomes normal Pair-based list type
+(def-type ListDots ([dty Type?] [dbound (or/c symbol? natural-number/c)])
+  [#:intern-key (cons (Rep-seq dty) dbound)]
+  [#:frees
+   [#:vars (f)
+    (if (symbol? dbound)
+        (free-vars-remove (f dty) dbound)
+        (f dty))]
+   [#:idxs (f)
+    (if (symbol? dbound)
+        (combine-frees (list (single-free-var dbound) (f dty)))
+        (f dty))]]
+  [#:fold (f) (make-ListDots (f dty) dbound)]
+  [#:walk (f) (f dty)])
+
+
+
+;; elems are all Types
+(def-type HeterogeneousVector ([elems (listof Type?)])
+  [#:intern-key (map Rep-seq elems)]
+  [#:frees (f) (make-invariant (combine-frees (map f elems)))]
+  [#:fold (f) (make-HeterogeneousVector (map f elems))]
+  [#:walk (f) (for-each f elems)]
+  [#:type-mask mask:vector]
+  [#:top VectorTop?])
+
+
+;; * * * * * * *
+;; Type Binders
+;; * * * * * * *
+
+
+(def-type Mu ([body Type?])
+  #:no-provide
+  [#:intern-key (Rep-seq body)]
+  [#:frees (f) (f body)]
+  [#:fold (f) (make-Mu (f body))]
+  [#:walk (f) (f body)]
+  [#:type-mask (Type-mask body)]
+  #:needs-resolving)
 
 ;; n is how many variables are bound here
 ;; body is a type
-(def-type Poly (n body) #:no-provide
-   [#:contract (->i ([n natural-number/c]
-                    [body Type/c])
-                   (#:syntax [stx (or/c #f syntax?)])
-                   [result Poly?])]
-  [#:frees (λ (f) (f body))]
-  [#:fold-rhs (*Poly n (type-rec-id body))]
-  [#:key (Type-key body)])
+(def-type Poly ([n exact-nonnegative-integer?]
+                [body Type?])
+  #:no-provide
+  [#:intern-key (cons n (Rep-seq body))]
+  [#:frees (f) (f body)]
+  [#:fold (f) (make-Poly n (f body))]
+  [#:walk (f) (f body)]
+  [#:type-mask (Type-mask body)])
 
 ;; n is how many variables are bound here
 ;; there are n-1 'normal' vars and 1 ... var
-(def-type PolyDots (n body) #:no-provide
-  [#:contract (->i ([n natural-number/c]
-                    [body Type/c])
-                   (#:syntax [stx (or/c #f syntax?)])
-                   [result PolyDots?])]
-  [#:key (Type-key body)]
-  [#:frees (λ (f) (f body))]
-  [#:fold-rhs (*PolyDots n (type-rec-id body))])
+(def-type PolyDots ([n exact-nonnegative-integer?]
+                    [body Type?])
+  #:no-provide
+  [#:intern-key (cons n (Rep-seq body))]
+  [#:frees (f) (f body)]
+  [#:fold (f) (make-PolyDots n (f body))]
+  [#:walk (f) (f body)]
+  [#:type-mask (Type-mask body)])
 
 ;; interp. A row polymorphic function type
 ;; constraints are row absence constraints, represented
 ;; as a set for each of init, field, methods
-(def-type PolyRow (constraints body) #:no-provide
-  [#:contract (->i ([constraints (list/c list? list? list? list?)]
-                    [body Type/c])
-                   (#:syntax [stx (or/c #f syntax?)])
-                   [result PolyRow?])]
-  [#:frees (λ (f) (f body))]
-  [#:fold-rhs (*PolyRow constraints
-                        (type-rec-id body))]
-  [#:key (Type-key body)])
+(def-type PolyRow ([constraints (list/c list? list? list? list?)]
+                   [body Type?])
+  #:no-provide
+  [#:intern-key (cons (Rep-seq body) constraints)]
+  [#:frees (f) (f body)]
+  [#:fold (f) (make-PolyRow constraints (f body))]
+  [#:walk (f) (f body)]
+  [#:type-mask (Type-mask body)])
 
 ;; pred : identifier
-(def-type Opaque ([pred identifier?])
-  [#:intern (hash-id pred)] [#:frees #f] [#:fold-rhs #:base] [#:key pred])
+(def-type Opaque ([pred identifier?]) #:base
+  [#:intern-key (hash-id pred)])
+
+
 
 ;; kw : keyword?
 ;; ty : Type
 ;; required? : Boolean
-(def-type Keyword ([kw keyword?] [ty Type/c] [required? boolean?])
-  [#:frees (λ (f) (f ty))]
-  [#:fold-rhs (*Keyword kw (type-rec-id ty) required?)])
+(def-rep Keyword ([kw keyword?] [ty Type?] [required? boolean?])
+  [#:intern-key (vector-immutable kw (Rep-seq ty) required?)]
+  [#:frees (f) (f ty)]
+  [#:fold (f) (make-Keyword kw (f ty) required?)]
+  [#:walk (f) (f ty)])
 
-(def-type Result ([t Type/c] [f PropSet?] [o Object?])
-  [#:frees (λ (frees) (combine-frees (map frees (list t f o))))]
-  [#:fold-rhs (*Result (type-rec-id t) (prop-rec-id f) (object-rec-id o))])
-
-(def-type Values ([rs (listof Result?)])
-  [#:intern (map Rep-seq rs)]
-  [#:frees (λ (f) (combine-frees (map f rs)))]
-  [#:fold-rhs (*Values (map type-rec-id rs))])
-
-
-(def-type AnyValues ([f Prop?])
-  [#:fold-rhs #:base])
-
-(def-type ValuesDots ([rs (listof Result?)] [dty Type/c] [dbound (or/c symbol? natural-number/c)])
-  [#:intern (list (map Rep-seq rs) (Rep-seq dty) dbound)]
-  [#:frees (if (symbol? dbound)
-               (free-vars-remove (combine-frees (map free-vars* (cons dty rs))) dbound)
-               (combine-frees (map free-vars* (cons dty rs))))
-           (if (symbol? dbound)
-               (combine-frees (cons (single-free-var dbound) 
-                                    (map free-idxs* (cons dty rs))))
-               (combine-frees (map free-idxs* (cons dty rs))))]
-  [#:fold-rhs (*ValuesDots (map type-rec-id rs) (type-rec-id dty) dbound)])
-
-(define SomeValues/c (or/c Values? AnyValues? ValuesDots?))
-
-;; arr is NOT a Type
-(def-type arr ([dom (listof Type/c)]
-               [rng SomeValues/c]
-               [rest (or/c #f Type/c)]
-               [drest (or/c #f (cons/c Type/c (or/c natural-number/c symbol?)))]
-               [kws (listof Keyword?)])
-  [#:intern (list (map Rep-seq dom) (Rep-seq rng) (and rest (Rep-seq rest))
-                  (and drest (cons (Rep-seq (car drest)) (cdr drest)))
-                  (map Rep-seq kws))]
-  [#:frees (combine-frees
-            (append (map (compose flip-variances free-vars*)
-                         (append (if rest (list rest) null)
-                                 (map Keyword-ty kws)
-                                 dom))
-                    (match drest
-                      [(cons t (? symbol? bnd))
-                       (list (free-vars-remove (flip-variances (free-vars* t)) bnd))]
-                      [(cons t _)
-                       (list (flip-variances (free-vars* t)))]
-                      [_ null])
-                    (list (free-vars* rng))))
-           (combine-frees
-            (append (map (compose flip-variances free-idxs*)
-                         (append (if rest (list rest) null)
-                                 (map Keyword-ty kws)
-                                 dom))
-                    (match drest
-                      [(cons t (? symbol? bnd))
-                       (list (single-free-var bnd Contravariant)
-                             (flip-variances (free-idxs* t)))]
-                      [(cons t _)
-                       (list (flip-variances (free-idxs* t)))]
-                      [_ null])
-                    (list (free-idxs* rng))))]
-  [#:fold-rhs (*arr (map type-rec-id dom)
-                    (type-rec-id rng)
-                    (and rest (type-rec-id rest))
-                    (and drest (cons (type-rec-id (car drest)) (cdr drest)))
-                    (map type-rec-id kws))])
+(def-rep arr ([dom (listof Type?)]
+              [rng SomeValues?]
+              [rest (or/c #f Type?)]
+              [drest (or/c #f (cons/c Type? (or/c natural-number/c symbol?)))]
+              [kws (listof Keyword?)])
+  [#:intern-key (vector-immutable
+                 (map Rep-seq dom) (Rep-seq rng) (and rest (Rep-seq rest))
+                 (and drest (cons (Rep-seq (car drest)) (cdr drest)))
+                 (map Rep-seq kws))]
+  [#:frees
+   [#:vars (f)
+    (combine-frees
+     (append (map (compose flip-variances f)
+                  (append (if rest (list rest) null)
+                          (map Keyword-ty kws)
+                          dom))
+             (match drest
+               [(cons t (? symbol? bnd))
+                (list (free-vars-remove (flip-variances (f t)) bnd))]
+               [(cons t _)
+                (list (flip-variances (f t)))]
+               [_ null])
+             (list (f rng))))]
+   [#:idxs (f)
+    (combine-frees
+     (append (map (compose flip-variances f)
+                  (append (if rest (list rest) null)
+                          (map Keyword-ty kws)
+                          dom))
+             (match drest
+               [(cons t (? symbol? bnd))
+                (list (single-free-var bnd Contravariant)
+                      (flip-variances (f t)))]
+               [(cons t _)
+                (list (flip-variances (f t)))]
+               [_ null])
+             (list (f rng))))]]
+  [#:fold (f) (make-arr (map f dom)
+                        (f rng)
+                        (and rest (f rest))
+                        (and drest (cons (f (car drest)) (cdr drest)))
+                        (map f kws))]
+  [#:walk (f)
+   (for-each f dom)
+   (f rng)
+   (when drest (f (car drest)))
+   (when rest (f rest))
+   (for-each f kws)])
 
 ;; arities : Listof[arr]
 (def-type Function ([arities (listof arr?)])
-  [#:intern (map Rep-seq arities)]
-  [#:key 'procedure]
-  [#:frees (λ (f) (combine-frees (map f arities)))]
-  [#:fold-rhs (*Function (map type-rec-id arities))])
+  [#:intern-key (map Rep-seq arities)]
+  [#:type-mask mask:procedure]
+  [#:frees (f) (combine-frees (map f arities))]
+  [#:fold (f) (make-Function (map f arities))]
+  [#:walk (f) (for-each f arities)])
 
 
-(def-type fld ([t Type/c] [acc identifier?] [mutable? boolean?])
-  [#:frees (λ (f) (if mutable? (make-invariant (f t)) (f t)))]
-  [#:fold-rhs (*fld (type-rec-id t) acc mutable?)]
-  [#:intern (list (Rep-seq t) (hash-id acc) mutable?)])
+(def-rep fld ([t Type?] [acc identifier?] [mutable? boolean?])
+  [#:intern-key (cons (hash-id acc) (Rep-seq t))]
+  [#:frees (f) (if mutable? (make-invariant (f t)) (f t))]
+  [#:fold (f) (make-fld (f t) acc mutable?)]
+  [#:walk (f) (f t)])
 
 ;; name : identifier
 ;; parent : Struct
@@ -370,109 +546,103 @@
                   [proc (or/c #f Function?)]
                   [poly? boolean?]
                   [pred-id identifier?])
-  [#:intern (list (hash-id name)
-                  (hash-id pred-id)
-                  (and parent (Rep-seq parent))
-                  (map Rep-seq flds)
-                  (and proc (Rep-seq proc)))]
-  [#:frees (λ (f) (combine-frees (map f (append (if proc (list proc) null)
-                                                (if parent (list parent) null)
-                                                flds))))]
-  [#:fold-rhs (*Struct name
-                       (and parent (type-rec-id parent))
-                       (map type-rec-id flds)
-                       (and proc (type-rec-id proc))
-                       poly?
-                       pred-id)]
+  [#:intern-key (cons (hash-id name) (map Rep-seq flds))]
+  [#:frees (f) (combine-frees (map f (append (if proc (list proc) null)
+                                             (if parent (list parent) null)
+                                             flds)))]
+  [#:fold (f) (make-Struct name
+                           (and parent (f parent))
+                           (map f flds)
+                           (and proc (f proc))
+                           poly?
+                           pred-id)]
+  [#:walk (f)
+   (f parent)
+   (for-each f flds)
+   (f proc)]
   ;; This should eventually be based on understanding of struct properties.
-  [#:key '(struct procedure)])
+  [#:type-mask (mask-union mask:struct mask:procedure)])
 
 ;; Represents prefab structs
 ;; key  : prefab key encoding mutability, auto-fields, etc.
 ;; flds : the types of all of the prefab fields
 (def-type Prefab ([key prefab-key?]
-                  [flds (listof Type/c)])
-  [#:frees (λ (f) (combine-frees (map f flds)))]
-  [#:fold-rhs (*Prefab key (map type-rec-id flds))]
-  [#:key 'prefab])
+                  [flds (listof Type?)])
+  [#:intern-key (cons key (map Rep-seq flds))]
+  [#:frees (f) (combine-frees (map f flds))]
+  [#:fold (f) (make-Prefab key (map f flds))]
+  [#:walk (f) (for-each f flds)]
+  [#:type-mask mask:prefab])
+
+(def-type StructTypeTop ()
+  #:base
+  [#:type-mask mask:struct-type])
 
 ;; A structure type descriptor
-(def-type StructTypeTop () [#:fold-rhs #:base] [#:key 'struct-type])
-(def-type StructType ([s (or/c F? B? Struct? Prefab?)]) [#:key 'struct-type])
+(def-type StructType ([s (or/c F? B? Struct? Prefab?)])
+  [#:intern-key (Rep-seq s)]
+  [#:frees (f) (f s)]
+  [#:fold (f) (make-StructType (f s))]
+  [#:walk (f) (f s)]
+  [#:type-mask mask:struct-type]
+  [#:top StructTypeTop?])
+
+(def-type StructTop ([name Struct?])
+  [#:intern-key (Rep-seq name)]
+  [#:frees (f) (f name)]
+  [#:fold (f) (make-StructTop (f name))]
+  [#:walk (f) (f name)]
+  [#:type-mask (mask-union mask:struct mask:procedure)])
+
+
 
-;; the supertype of all of these values
-(def-type BoxTop () [#:fold-rhs #:base] [#:key 'box])
-(def-type Weak-BoxTop () [#:fold-rhs #:base] [#:key 'weak-box])
-(def-type ChannelTop () [#:fold-rhs #:base] [#:key 'channel])
-(def-type Async-ChannelTop () [#:fold-rhs #:base] [#:key 'async-channel])
-(def-type VectorTop () [#:fold-rhs #:base] [#:key 'vector])
-(def-type HashtableTop () [#:fold-rhs #:base] [#:key 'hash])
-(def-type MPairTop () [#:fold-rhs #:base] [#:key 'mpair])
-(def-type StructTop ([name Struct?]) [#:key 'struct])
-(def-type ThreadCellTop () [#:fold-rhs #:base] [#:key 'thread-cell])
-(def-type Prompt-TagTop () [#:fold-rhs #:base] [#:key 'prompt-tag])
-(def-type Continuation-Mark-KeyTop ()
-  [#:fold-rhs #:base] [#:key 'continuation-mark-key])
 
 ;; v : Racket Value
-(def-type Value (v) [#:frees #f] [#:fold-rhs #:base]
-  [#:key (cond [(or (eq? v 0) (eq? v 1)) 'number]
-               ;; other numbers don't work with the optimizations in subtype.rkt
-               ;; which assume that unions of numbers are subtyped in simple ways
-               [(boolean? v) 'boolean]
-               [(null? v) 'null]
-               [else #f])])
+;; contract will change to the following after
+;; base types are redone:
+(def-type Value ([val any/c])
+  #:base
+  [#:intern-key val]
+  [#:type-mask
+   (match val
+     [(? number?) mask:number]
+     [#t mask:true]
+     [#f mask:false]
+     [(? symbol?) mask:symbol]
+     [(? string?) mask:string]
+     [(? char?) mask:char]
+     [(? null?) mask:null]
+     [(? void?) mask:void]
+     [_ mask:unknown])])
 
 ;; elems : Listof[Type]
-(def-type Union ([elems (and/c (listof Type/c)
-                               (lambda (es)
-                                 (or (null? es)
-                                     (let-values ([(sorted? k)
-                                                   (for/fold ([sorted? #t]
-                                                              [last (car es)])
-                                                       ([e (cdr es)])
-                                                     (values
-                                                      (and sorted? (type<? last e))
-                                                      e))])
-                                       sorted?))))])
-  [#:intern (map Rep-seq elems)]
-  [#:frees (λ (f) (combine-frees (map f elems)))]
-  [#:fold-rhs (apply Un (map type-rec-id elems))]
-  [#:key 
-   (let ()
-     (define d
-       (let loop ([ts elems] [res null])
-         (cond [(null? ts) res]
-               [else
-                (define k (Type-key (car ts)))
-                (cond [(not k) (list #f)]
-                      [(pair? k) (loop (cdr ts) (append k res))]
-                      [else (loop (cdr ts) (cons k res))])])))
-     (define d* (remove-duplicates d))
-     (if (and (pair? d*) (null? (cdr d*))) (car d*) d*))])
+(def-type Union ([elems (and/c (listof Type?) (length>=/c 2))])
+  #:no-provide
+  [#:intern-key (for/hash ([elem (in-list elems)]) (values elem #t))]
+  [#:frees (f) (combine-frees (map f elems))]
+  [#:fold (f) (apply Un (map f elems))]
+  [#:walk (f) (for-each f elems)]
+  [#:type-mask
+   (for/fold ([mask mask:bottom])
+             ([elem (in-list elems)])
+     (mask-union mask (Type-mask elem)))])
 
+(define (make-Union* elems)
+  (match elems
+    [(list) (make-Bottom)]
+    [(list t) t]
+    [_ (make-Union elems)]))
 
 ;; Intersection
-(def-type Intersection ([elems (and/c (set/c Type/c)
-                                      (λ (s) (>= (set-count s) 2)))])
-  [#:intern (for/set ([e (in-immutable-set elems)])
-              (Rep-seq e))]
-  [#:frees (λ (f) (combine-frees (for/list ([elem (in-immutable-set elems)])
-                                   (f elem))))]
-  [#:fold-rhs (let ([elems (for/list ([elem (in-immutable-set elems)])
-                             (type-rec-id elem))])
-                (apply -unsafe-intersect elems))]
-  [#:key (let ()
-           (define d
-             (let loop ([ts (set->list elems)] [res null])
-               (cond [(null? ts) res]
-                     [else
-                      (define k (Type-key (car ts)))
-                      (cond [(not k) (list #f)]
-                            [(pair? k) (loop (cdr ts) (append k res))]
-                            [else (loop (cdr ts) (cons k res))])])))
-           (define d* (remove-duplicates d))
-           (if (and (pair? d*) (null? (cdr d*))) (car d*) d*))])
+(def-type Intersection ([elems (and/c (listof Type?) (length>=/c 2))])
+  [#:intern-key (for/hash ([elem (in-list elems)]) (values elem #t))]
+  [#:frees (f) (combine-frees (map f elems))]
+  [#:fold (f) (apply -unsafe-intersect (map f elems))]
+  [#:walk (f) (for-each f elems)]
+  [#:type-mask
+   (for/fold ([mask mask:unknown])
+             ([elem (in-list elems)])
+     (mask-intersect mask (Type-mask elem)))])
 
 ;;  constructor for intersections
 ;; in general, intersections should be built
@@ -484,46 +654,28 @@
     (match ts
       [(list)
        (cond
-         [(set-empty? elems) (Univ)]
+         [(set-empty? elems) (make-Univ)]
          ;; size = 1 ?
          [(= 1 (set-count elems)) (set-first elems)]
          ;; size > 1, build an intersection
-         [else (*Intersection elems)])]
+         [else (make-Intersection (set->list elems))])]
       [(cons t ts)
        (match t
          [(? Bottom?) t]
          [(Univ:) (loop elems ts)]
-         [(Intersection: ts*) (loop (set-union elems ts*) ts)]
+         [(Intersection: ts*) (loop elems (append ts* ts))]
          [t (cond
               [(for/or ([elem (in-immutable-set elems)]) (not (overlap? elem t)))
-               (*Union (list))]
+               (make-Bottom)]
               [else (loop (set-add elems t) ts)])])])))
 
 
-(def-type Univ () [#:frees #f] [#:fold-rhs #:base])
-
-;; in : Type
-;; out : Type
-(def-type Param ([in Type/c] [out Type/c])
-  [#:key 'procedure]
-  [#:frees (λ (f) (combine-frees (list (f out) (flip-variances (f in)))))])
-
-;; key : Type
-;; value : Type
-(def-type Hashtable ([key Type/c] [value Type/c]) [#:key 'hash]
-  [#:frees (λ (f) (combine-frees (list (make-invariant (f key)) (make-invariant (f value)))))])
-
-(def-type Refinement ([parent Type/c] [pred identifier?])
-  [#:key (Type-key parent)]
-  [#:intern (list (Rep-seq parent) (hash-id pred))]
-  [#:fold-rhs (*Refinement (type-rec-id parent) pred)]
-  [#:frees (λ (f) (f parent))])
-
-
-;; Syntax
-;; t : Type
-;; t is the type of the result of syntax-e, not the result of syntax->datum
-(def-type Syntax ([t Type/c]) [#:key 'syntax])
+(def-type Refinement ([parent Type?] [pred identifier?])
+  [#:intern-key (cons (hash-id pred) (Rep-seq parent))]
+  [#:frees (f) (f parent)]
+  [#:fold (f) (make-Refinement (f parent) pred)]
+  [#:walk (f) (f parent)]
+  [#:type-mask (Type-mask parent)])
 
 ;; A Row used in type instantiation
 ;; For now, this should not appear in user code. It's used
@@ -531,38 +683,45 @@
 ;; class types.
 ;;
 ;; invariant: all clauses are sorted by the key name
-(def-type Row ([inits (listof (list/c symbol? Type/c boolean?))]
-               [fields (listof (list/c symbol? Type/c))]
-               [methods (listof (list/c symbol? Type/c))]
-               [augments (listof (list/c symbol? Type/c))]
-               [init-rest (or/c Type/c #f)])
+(def-rep Row ([inits (listof (list/c symbol? Type? boolean?))]
+              [fields (listof (list/c symbol? Type?))]
+              [methods (listof (list/c symbol? Type?))]
+              [augments (listof (list/c symbol? Type?))]
+              [init-rest (or/c Type? #f)])
   #:no-provide
-  [#:frees (λ (f) (combine-frees
-                   (map f (append (map cadr inits)
-                                  (map cadr fields)
-                                  (map cadr methods)
-                                  (map cadr augments)
-                                  (if init-rest (list init-rest) null)))))]
-  [#:fold-rhs (match (list inits fields methods augments init-rest)
-                [(list
-                  (list (list init-names init-tys reqd) ___)
-                  (list (list fname fty) ___)
-                  (list (list mname mty) ___)
-                  (list (list aname aty) ___)
-                  init-rest)
-                 (*Row
-                  (map list
-                       init-names
-                       (map type-rec-id init-tys)
-                       reqd)
-                  (map list fname (map type-rec-id fty))
-                  (map list mname (map type-rec-id mty))
-                  (map list aname (map type-rec-id aty))
-                  (if init-rest (type-rec-id init-rest) #f))])])
+  [#:intern-key
+   (let ([intern (λ (l) (list-update l 1 Rep-seq))])
+     (list (map intern inits)
+           (map intern fields)
+           (map intern methods)
+           (map intern augments)
+           (and init-rest (Rep-seq init-rest))))]
+  [#:frees (f)
+   (let ([extract-frees (λ (l) (f (second l)))])
+     (combine-frees
+      (append (map extract-frees inits)
+              (map extract-frees fields)
+              (map extract-frees methods)
+              (map extract-frees augments)
+              (if init-rest (list (f init-rest)) null))))]
+  [#:fold (f)
+   (let ([update (λ (l) (list-update l 1 f))])
+     (make-Row (map update inits)
+               (map update fields)
+               (map update methods)
+               (map update augments)
+               (and init-rest (f init-rest))))]
+  [#:walk (f)
+   (let ([walk (λ (l) (f (second l)))])
+     (for-each walk inits)
+     (for-each walk fields)
+     (for-each walk methods)
+     (for-each walk augments)
+     (when init-rest (f init-rest)))])
 
-;; Supertype of all Class types, cannot instantiate
-;; or subclass these
-(def-type ClassTop () [#:fold-rhs #:base] [#:key 'class])
+(def-type ClassTop ()
+  #:base
+  [#:type-mask mask:class])
 
 ;; row-ext : Option<(U F B Row)>
 ;; row     : Row
@@ -574,35 +733,58 @@
 (def-type Class ([row-ext (or/c #f F? B? Row?)]
                  [row Row?])
   #:no-provide
-  [#:frees (λ (f) (combine-frees
-                   ;; FIXME: is this correct?
-                   `(,@(or (and (F? row-ext) (list (f row-ext)))
-                           '())
-                     ,(f row))))]
-  [#:key 'class]
-  [#:fold-rhs (match (list row-ext row)
-                [(list row-ext row)
-                 (*Class
-                  (and row-ext (type-rec-id row-ext))
-                  (type-rec-id row))])])
+  [#:intern-key (cons (and row-ext (Rep-seq row-ext)) (Rep-seq row))]
+  [#:frees (f)
+   (combine-frees
+    (append (if row-ext (list (f row-ext)) null)
+            (list (f row))))]
+  [#:fold (f) (make-Class (and row-ext (f row-ext))
+                          (f row))]
+  [#:walk (f)
+   (when row-ext (f row-ext))
+   (f row)]
+  [#:type-mask mask:class]
+  [#:top ClassTop?])
 
-;; cls : Class
-(def-type Instance ([cls Type/c]) [#:key 'instance])
+
+;;--------------------------
+;; Instance (of a class)
+;;--------------------------
+
+
+;; not structural because it has special subtyping,
+; not just simple structural subtyping
+(def-type Instance ([cls Type?])
+  [#:intern-key (Rep-seq cls)]
+  [#:frees (f) (f cls)]
+  [#:fold (f) (make-Instance (f cls))]
+  [#:walk (f) (f cls)]
+  [#:type-mask mask:instance])
 
 ;; interp:
 ;; name is the id of the signature
 ;; extends is the extended signature or #f
 ;; mapping maps variables in a signature to their types
-;; This is not a type because signatures are not values
-(def-type Signature ([name identifier?]
-                     [extends (or/c identifier? #f)]
-                     [mapping (listof (cons/c identifier? (or/c promise? Type/c)))])
-  [#:frees (lambda (f) null)]
-  [#:fold-rhs (*Signature name extends mapping)])
+;; This is not a type because signatures do not correspond to any values
+(def-rep Signature ([name identifier?]
+                    [extends (or/c identifier? #f)]
+                    [mapping (listof (cons/c identifier? Type?))])
+  [#:intern-key (hash-id name)]
+  [#:frees (f) (combine-frees (map (match-lambda
+                                     [(cons _ t) (f t)])
+                                   mapping))]
+  [#:fold (f) (make-Signature name extends (map (match-lambda
+                                                  [(cons id t) (cons id (f t))])
+                                                mapping))]
+  [#:walk (f) (for-each (match-lambda
+                          [(cons _ t) (f t)])
+                        mapping)])
+
+
+(def-type UnitTop ()
+  #:base
+  [#:type-mask mask:unit])
 
-;; The supertype of all units, ie values recognized by the
-;; predicate unit?
-(def-type UnitTop () [#:fold-rhs #:base] [#:key 'unit])
 
 ;; interp: imports is the list of imported signatures
 ;;         exports is the list of exported signatures
@@ -611,191 +793,142 @@
 (def-type Unit ([imports (listof Signature?)]
                 [exports (listof Signature?)]
                 [init-depends (listof Signature?)]
-                [result SomeValues/c])
-  [#:frees (lambda (f) (f result))]
-  [#:fold-rhs (*Unit (map type-rec-id imports)
-                     (map type-rec-id exports)
-                     (map type-rec-id init-depends)
-                     (type-rec-id result))])
+                [result SomeValues?])
+  [#:intern-key (list* (Rep-seq result)
+                       (map Rep-seq imports)
+                       (map Rep-seq exports)
+                       (map Rep-seq init-depends))]
+  [#:frees (f) (f result)]
+  [#:fold (f) (make-Unit (map f imports)
+                         (map f exports)
+                         (map f init-depends)
+                         (f result))]
+  [#:walk (f)
+   (for-each f imports)
+   (for-each f exports)
+   (for-each f init-depends)
+   (f result)]
+  [#:type-mask mask:unit]
+  [#:top UnitTop?])
 
 ;; sequences
 ;; includes lists, vectors, etc
 ;; tys : sequence produces this set of values at each step
-(def-type Sequence ([tys (listof Type/c)])
-  [#:intern (map Rep-seq tys)]
-  [#:frees (λ (f) (combine-frees (map f tys)))]
-  [#:key #f] [#:fold-rhs (*Sequence (map type-rec-id tys))])
-
-(def-type Future ([t Type/c]) [#:key 'future])
-
-;; body: the type of the body
-;; handler: the type of the prompt handler
-;;   prompts with this tag will return a union of `body` 
-;;   and the codomains of `handler`
-(def-type Prompt-Tagof ([body Type/c] [handler Type/c])
-  [#:frees (λ (f) (combine-frees (list (make-invariant (f body))
-                                       (make-invariant (f handler)))))]
-  [#:key 'prompt-tag])
-
-;; value: the type of allowable values
-(def-type Continuation-Mark-Keyof ([value Type/c])
-  [#:frees (λ (f) (make-invariant (f value)))]
-  [#:key 'continuation-mark-key])
+(def-type Sequence ([tys (listof Type?)])
+  [#:intern-key (map Rep-seq tys)]
+  [#:frees (f) (combine-frees (map f tys))]
+  [#:fold (f) (make-Sequence (map f tys))]
+  [#:walk (f) (for-each f tys)])
 
 ;; Distinction
 ;; comes from define-new-subtype
 ;; nm: a symbol representing the name of the type
 ;; id: a symbol created with gensym
-;; ty: a type for the representation, where this will be a subtype of ty
-(def-type Distinction ([nm symbol?] [id symbol?] [ty Type/c])
-  [#:frees (λ (f) (f ty))]
-  [#:intern (list (Rep-seq ty) nm id)]
-  [#:fold-rhs (*Distinction nm id (type-rec-id ty))]
-  [#:key (Type-key ty)])
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; remove-dups: List[Type] -> List[Type]
-;; removes duplicate types from a SORTED list
-(define/cond-contract (remove-dups types)
-  ((listof Rep?) . -> . (listof Rep?))
-  (cond [(null? types) types]
-        [(null? (cdr types)) types]
-        [(type-equal? (car types) (cadr types)) (remove-dups (cdr types))]
-        [else (cons (car types) (remove-dups (cdr types)))]))
+;; ty: a type for the representation (i.e. each distinction
+;;     is a subtype of its ty)
+(def-type Distinction ([nm symbol?] [id symbol?] [ty Type?])
+  [#:intern-key (list* nm id (Rep-seq ty))]
+  [#:frees (f) (f ty)]
+  [#:fold (f) (make-Distinction nm id (f ty))]
+  [#:walk (f) (f ty)]
+  [#:type-mask (Type-mask ty)])
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
-(define ((sub-f st) e)
-  (prop-case (#:Type st
-              #:Prop (sub-f st)
-              #:PathElem (sub-pe st))
-             e))
+;;************************************************************
+;; Helpers: Type Variable Abstraction/Instantiation
+;;************************************************************
 
+;; used for abstracting/instantiating type variables
+;; it recursively folds over the 'start' Rep, and as it
+;; passes structs which introduce type variables it increments
+;; the depth being tracked (the 'lvl'). When it raches type variables
+;; or DeBruijns (dependending on whether we are abstracting or instantiating)
+;; it transforms them with f
+(define (type-binder-transform f start abstracting?)
+  (define dbound-fn (if abstracting? values F-n))
+  (define not-abstracting? (not abstracting?))
+  (let rec/lvl ([cur start] [lvl 0])
+    (let rec ([cur cur])
+      (match cur
+        [(F: name*) #:when abstracting? (f name* make-B lvl cur)]
+        [(B: idx) #:when not-abstracting? (f idx (λ (x) x) lvl cur)]
+        [(Union: elems)
+         ;; prevents duplicates, which apparently is needed to avoid
+         ;; infinite loops here...?
+         (define seen (make-hasheq))
+         (define ts
+           (for*/fold ([ts null])
+                      ([elem (in-list elems)]
+                       [elem (in-value (rec elem))]
+                       [seq (in-value (Rep-seq elem))])
+             (cond
+               [(hash-ref seen seq #f) ts]
+               [else (hash-set! seen seq #t)
+                     (cons elem ts)])))
+         (match ts
+           [(list) (make-Bottom)]
+           [(list t) t]
+           [_ (make-Union ts)])]
+        [(arr: dom rng rest drest kws)
+         (make-arr (map rec dom)
+                   (rec rng)
+                   (and rest (rec rest))
+                   (if drest
+                       (cons (rec (car drest))
+                             (let ([c (cdr drest)])
+                               (f c dbound-fn lvl c)))
+                       #f)
+                   (map rec kws))]
+        [(Mu: body) (make-Mu (rec/lvl body (add1 lvl)))]
+        [(ValuesDots: rs dty dbound)
+         (make-ValuesDots (map rec rs)
+                          (rec dty)
+                          (f dbound dbound-fn lvl dbound))]
+        [(ListDots: dty dbound)
+         (make-ListDots (rec dty)
+                        (f dbound dbound-fn lvl dbound))]
+        [(PolyRow: constraints body)
+         (make-PolyRow constraints (rec/lvl body (add1 1 lvl)))]
+        [(PolyDots: n body)
+         (make-PolyDots n (rec/lvl body (+ n lvl)))]
+        [(Poly: n body)
+         (make-Poly n (rec/lvl body (+ n lvl)))]
+        [_ (Rep-fold rec cur)]))))
 
-(define ((sub-o st) e)
-  (object-case (#:Type st
-                #:Object (sub-o st)
-                #:PathElem (sub-pe st))
-               e))
-
-(define ((sub-pe st) e)
-  (pathelem-case (#:Type st
-                         #:PathElem (sub-pe st))
-                 e))
-
-(define ((sub-t st) e)
-  (type-case (#:Type st
-              #:Prop (sub-f st))
-              e))
-
-
-;; abstract-many : Names Type -> Type
-;; where n is the length of names
-(define (abstract-many names ty)
-  ;; mapping : dict[Type -> Natural]
-  (define (nameTo mapping type)
-    (let loop ([outer 0] [ty type])
-      (define (sb t) (loop outer t))
-      ;; transform : Name (Integer -> a) a -> a
-      ;; apply `mapping` to `name*`, returning `default` if it's not there
-      ;; use `f` to wrap the result
-      ;; note that this takes into account the value of `outer`
-      (define (transform name* f default)
-        (cond [(assq name* mapping)
-               => (λ (pr)
-                    (f (+ (cdr pr) outer)))]
-              [else default]))
-      (type-case
-        (#:Type sb #:Prop (sub-f sb) #:Object (sub-o sb))
-       ty
-       [#:F name* (transform name* *B ty)]
-       ;; necessary to avoid infinite loops
-       [#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
-       ;; functions
-       [#:arr dom rng rest drest kws
-              (*arr (map sb dom)
-                    (sb rng)
-                    (if rest (sb rest) #f)
-                    (if drest
-                        (cons (sb (car drest))
-                              (let ([c (cdr drest)])
-                                 (transform c values c)))
-                        #f)
-                    (map sb kws))]
-       [#:ValuesDots rs dty dbound
-              (*ValuesDots (map sb rs)
-                           (sb dty)
-                           (transform dbound values dbound))]
-       [#:ListDots dty dbound
-                   (*ListDots (sb dty)
-                              (transform dbound values dbound))]
-       [#:Mu body (*Mu (loop (add1 outer) body))]
-       [#:PolyRow constraints body
-                  (*PolyRow constraints (loop (+ 1 outer) body))]
-       [#:PolyDots n body
-                   (*PolyDots n (loop (+ n outer) body))]
-       [#:Poly n body
-               (*Poly n (loop (+ n outer) body))])))
+(define/cond-contract (abstract-many names ty)
+  (-> (listof symbol?) Type? Type?)
   (define n (length names))
   (define mapping (for/list ([nm (in-list names)]
                              [i (in-range n 0 -1)])
                     (cons nm (sub1 i))))
-  (nameTo mapping ty))
+  ;; transform : symbol (Integer -> a) a -> a
+  ;; apply `mapping` to `name*`, returning `default` if it's not there
+  ;; use `f` to wrap the result
+  ;; note that this takes into account the value of the outer lvl
+  (define (transform name* fn lvl default)
+    (cond [(assq name* mapping)
+           => (λ (pr) (fn (+ (cdr pr) lvl)))]
+          [else default]))
+  (type-binder-transform transform ty #t))
 
-;; instantiate-many : List[Type] Type -> Type
-;; where n is the length of types
-;; all of the types MUST be Fs
-(define (instantiate-many images ty)
-  ;; mapping : dict[Natural -> Type]
-  (define (replace mapping type)
-    (let loop ([outer 0] [ty type])
-      ;; transform : Integer (Name -> a) a -> a
-      ;; apply `mapping` to `idx`, returning `default` if it's not there
-      ;; use `f` to wrap the result
-      ;; note that this takes into account the value of `outer`
-      (define (transform idx f default)
-        (cond [(assf (lambda (v) (eqv? (+ v outer) idx)) mapping)
-               => (lambda (pr) (f (cdr pr)))]
-              [else default]))
-      (define (sb t) (loop outer t))
-      (define sf (sub-f sb))
-      (type-case
-       (#:Type sb #:Prop sf #:Object (sub-o sb))
-       ty
-       [#:B idx (transform idx values ty)]
-       ;; necessary to avoid infinite loops
-       [#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
-       ;; functions
-       [#:arr dom rng rest drest kws
-              (*arr (map sb dom)
-                    (sb rng)
-                    (if rest (sb rest) #f)
-                    (if drest
-                        (cons (sb (car drest))
-                              (transform (cdr drest) F-n (cdr drest)))
-                        #f)
-                    (map sb kws))]
-       [#:ValuesDots rs dty dbound
-                     (*ValuesDots (map sb rs)
-                                  (sb dty)
-                                  (transform dbound F-n dbound))]
-       [#:ListDots dty dbound
-                   (*ListDots (sb dty)
-                              (transform dbound F-n dbound))]
-       [#:Mu body (*Mu (loop (add1 outer) body))]
-       [#:PolyRow constraints body
-                  (*PolyRow constraints (loop (+ 1 outer) body))]
-       [#:PolyDots n body
-                   (*PolyDots n (loop (+ n outer) body))]
-       [#:Poly n body
-               (*Poly n (loop (+ n outer) body))])))
+
+(define/cond-contract (instantiate-many images ty)
+  (-> (listof Type?) Type? Type?)
   (define n (length images))
   (define mapping (for/list ([img (in-list images)]
                              [i (in-range n 0 -1)])
                     (cons (sub1 i) img)))
-  (replace mapping ty))
+  ;; transform : Integer (Name -> a) a -> a
+  ;; apply `mapping` to `n`, returning `default` if it's not there
+  ;; use `f` to wrap the result
+  ;; note that this takes into account the value of the outer `lvl`
+  (define (transform n fn lvl default)
+    (cond [(assf (λ (v) (eqv? (+ v lvl) n)) mapping)
+           => (λ (pr) (fn (cdr pr)))]
+          [else default]))
+  (type-binder-transform transform ty #f))
 
 (define (abstract name ty)
   (abstract-many (list name) ty))
@@ -805,7 +938,7 @@
 
 ;; the 'smart' constructor
 (define (Mu* name body)
-  (let ([v (*Mu (abstract name body))])
+  (let ([v (make-Mu (abstract name body))])
     (hash-set! name-table v name)
     v))
 
@@ -813,7 +946,7 @@
 (define (Mu-body* name t)
   (match t
     [(Mu: body)
-     (instantiate (*F name) body)]))
+     (instantiate (make-F name) body)]))
 
 ;; the 'smart' constructor
 ;;
@@ -829,7 +962,7 @@
 ;;
 (define (Poly* names body #:original-names [orig names])
   (if (null? names) body
-      (let ([v (*Poly (length names) (abstract-many names body))])
+      (let ([v (make-Poly (length names) (abstract-many names body))])
         (hash-set! name-table v orig)
         v)))
 
@@ -839,12 +972,12 @@
     [(Poly: n body)
      (unless (= (length names) n)
        (int-err "Wrong number of names: expected ~a got ~a" n (length names)))
-     (instantiate-many (map *F names) body)]))
+     (instantiate-many (map make-F names) body)]))
 
 ;; the 'smart' constructor
 (define (PolyDots* names body)
   (if (null? names) body
-      (let ([v (*PolyDots (length names) (abstract-many names body))])
+      (let ([v (make-PolyDots (length names) (abstract-many names body))])
         (hash-set! name-table v names)
         v)))
 
@@ -854,7 +987,7 @@
     [(PolyDots: n body)
      (unless (= (length names) n)
        (int-err "Wrong number of names: expected ~a got ~a" n (length names)))
-     (instantiate-many (map *F names) body)]))
+     (instantiate-many (map make-F names) body)]))
 
 ;; Constructor and destructor for row polymorphism
 ;;
@@ -863,14 +996,14 @@
 ;; a time. This may change in the future.
 ;;
 (define (PolyRow* names constraints body #:original-names [orig names])
-  (let ([v (*PolyRow constraints (abstract-many names body))])
+  (let ([v (make-PolyRow constraints (abstract-many names body))])
     (hash-set! name-table v orig)
     v))
 
 (define (PolyRow-body* names t)
   (match t
     [(PolyRow: constraints body)
-     (instantiate-many (map *F names) body)]))
+     (instantiate-many (map make-F names) body)]))
 
 (print-struct #t)
 
@@ -1023,24 +1156,24 @@
 ;; This is a custom constructor for Row types
 ;; Sorts all clauses by the key (the clause name)
 (define (Row* inits fields methods augments init-rest)
-  (*Row inits
-        (sort-row-clauses fields)
-        (sort-row-clauses methods)
-        (sort-row-clauses augments)
-        init-rest))
+  (make-Row inits
+            (sort-row-clauses fields)
+            (sort-row-clauses methods)
+            (sort-row-clauses augments)
+            init-rest))
 
 ;; Class*
 ;; This is a custom constructor for Class types that
 ;; doesn't require writing make-Row everywhere
 (define/cond-contract (Class* row-var inits fields methods augments init-rest)
   (-> (or/c F? B? Row? #f)
-      (listof (list/c symbol? Type/c boolean?))
-      (listof (list/c symbol? Type/c))
-      (listof (list/c symbol? Type/c))
-      (listof (list/c symbol? Type/c))
-      (or/c Type/c #f)
+      (listof (list/c symbol? Type? boolean?))
+      (listof (list/c symbol? Type?))
+      (listof (list/c symbol? Type?))
+      (listof (list/c symbol? Type?))
+      (or/c Type? #f)
       Class?)
-  (*Class row-var (Row* inits fields methods augments init-rest)))
+  (make-Class row-var (Row* inits fields methods augments init-rest)))
 
 ;; Class:*
 ;; This match expander replaces the built-in matching with
@@ -1082,7 +1215,7 @@
 
 ;; sorts the given field of a Row by the member name
 (define (sort-row-clauses clauses)
-  (sort clauses symbol<? #:key car))
+  (sort clauses (λ (x y) (symbol<? (car x) (car y)))))
 
 (define-match-expander Class:*
   (λ (stx)
@@ -1105,3 +1238,12 @@
     (syntax-parse stx
       [(_) #'(Name: _ _ #t)]
       [(_ name-pat) #'(Name: name-pat _ #t)])))
+
+
+;; unfold : Type -> Type
+;; must be applied to a Mu
+(define/cond-contract (unfold t)
+  (Mu? . -> . Type?)
+  (match t
+    [(Mu-unsafe: body) (instantiate t body)]
+    [t (error 'unfold "not a mu! ~a" t)]))
diff --git a/typed-racket-lib/typed-racket/rep/values-rep.rkt b/typed-racket-lib/typed-racket/rep/values-rep.rkt
new file mode 100644
index 00000000..0829046c
--- /dev/null
+++ b/typed-racket-lib/typed-racket/rep/values-rep.rkt
@@ -0,0 +1,62 @@
+#lang racket/base
+
+(require "../utils/utils.rkt"
+         "rep-utils.rkt"
+         "free-variance.rkt"
+         "core-rep.rkt"
+         (contract-req)
+         racket/match
+         syntax/parse/define
+         racket/lazy-require)
+
+(provide SomeValues?)
+(provide-for-cond-contract Values/c)
+
+;;**************************************************************
+;; SomeValues (i.e. the things that can returned from functions)
+;;**************************************************************
+
+;;---------
+;; Values
+;;---------
+
+(def-values Values ([results (listof Result?)])
+  [#:intern-key (map Rep-seq results)]
+  [#:frees (f) (combine-frees (map f results))]
+  [#:fold (f) (make-Values (map f results))]
+  [#:walk (f) (for-each f results)])
+
+;; Anything that can be treated as a _simple_
+;; Values by sufficient expansion
+(define/provide (Values/c? x)
+  (or (Type? x) (Values? x) (Result? x)))
+
+(define-for-cond-contract Values/c (flat-named-contract 'Values Values/c?))
+
+;;------------
+;; AnyValues
+;;------------
+
+
+;; A Type that corresponds to the any contract for the
+;; return type of functions
+
+(def-values AnyValues ([p Prop?])
+  [#:intern-key (Rep-seq p)]
+  [#:frees (f) (f p)]
+  [#:fold (f) (make-AnyValues (f p))]
+  [#:walk (f) (f p)])
+
+;;-------------
+;; ValuesDots
+;;-------------
+
+
+(def-values ValuesDots ([results (listof Result?)]
+                        [dty Type?]
+                        [dbound (or/c symbol? natural-number/c)])
+  [#:intern-key (list* (Rep-seq dty) dbound (map Rep-seq results))]
+  [#:frees (f) (combine-frees (map f results))]
+  [#:fold (f) (make-ValuesDots (map f results) (f dty) dbound)]
+  [#:walk (f) (begin (f dty)
+                     (for-each f results))])
diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
index 15a85efb..359a3ff1 100644
--- a/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
+++ b/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
@@ -30,8 +30,8 @@
                                static-contract?
                                static-contract?
                                static-contract?)))]
-          [lookup-name-sc (-> Type/c symbol? (or/c #f static-contract?))]
-          [register-name-sc (-> Type/c
+          [lookup-name-sc (-> Type? symbol? (or/c #f static-contract?))]
+          [register-name-sc (-> Type?
                                 (-> static-contract?)
                                 (-> static-contract?)
                                 (-> static-contract?)
diff --git a/typed-racket-lib/typed-racket/typecheck/check-below.rkt b/typed-racket-lib/typed-racket/typecheck/check-below.rkt
index 02a7d704..a167f35b 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-below.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-below.rkt
@@ -9,12 +9,12 @@
          (typecheck error-message))
 
 (provide/cond-contract
- [check-below (-->i ([s (-or/c Type/c full-tc-results/c)]
-                     [t (s) (if (Type/c? s) Type/c tc-results/c)])
-                    [_ (s) (if (Type/c? s) Type/c full-tc-results/c)])]
- [cond-check-below (-->i ([s (-or/c Type/c full-tc-results/c)]
-                          [t (s) (-or/c #f (if (Type/c? s) Type/c tc-results/c))])
-                         [_ (s) (-or/c #f (if (Type/c? s) Type/c full-tc-results/c))])]
+ [check-below (-->i ([s (-or/c Type? full-tc-results/c)]
+                     [t (s) (if (Type? s) Type? tc-results/c)])
+                    [_ (s) (if (Type? s) Type? full-tc-results/c)])]
+ [cond-check-below (-->i ([s (-or/c Type? full-tc-results/c)]
+                          [t (s) (-or/c #f (if (Type? s) Type? tc-results/c))])
+                         [_ (s) (-or/c #f (if (Type? s) Type? full-tc-results/c))])]
  [fix-results (--> tc-results/c full-tc-results/c)])
 
 (provide type-mismatch)
@@ -198,7 +198,7 @@
      (value-mismatch expected tr1)
      (fix-results expected)]
 
-    [((? Type/c? t1) (? Type/c? t2))
+    [((? Type? t1) (? Type? t2))
      (unless (subtype t1 t2)
        (expected-but-got t2 t1))
      expected]
diff --git a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
index d9d01911..e4ff8525 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
@@ -16,7 +16,7 @@
          (types utils abbrev union subtype resolve generalize)
          (typecheck check-below internal-forms)
          (utils tc-utils mutated-vars)
-         (rep object-rep type-rep)
+         (rep object-rep type-rep values-rep)
          (for-syntax racket/base)
          (for-template racket/base
                        (submod "internal-forms.rkt" forms)
diff --git a/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
index 5d592e52..c46f0051 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
@@ -41,7 +41,8 @@
   (define body-results #f)
 
   ;; syntax tc-result1 type -> tc-results
-  ;; The result of applying the function to a single argument of the type of its first argument
+  ;; The result of applying the function to a single argument of the type of its first argument.
+  ;; Is used when checking forms like with-handlers, for example.
   (define (get-range-result stx t prop-type)
     (let loop ((t t))
       (match t
@@ -51,7 +52,7 @@
         [(Function: (list _ ... (arr: '() _ (? values rest) #f (list (Keyword: _ _ #f) ...)) _ ...))
          #:when (subtype prop-type rest)
          (tc/funapp #'here #'(here) t (list (ret rest)) #f)]
-        [(? needs-resolving? t)
+        [(? resolvable? t)
          (loop (resolve t))]
         [(or (Poly: ns _) (PolyDots: (list ns ... _) _))
          (loop (instantiate-poly t (map (λ (n) Univ) ns)))]
@@ -72,7 +73,7 @@
     (cond [;; make sure the predicate has an appropriate type
            (subtype pred-type (-> Univ Univ))
            (define fun-type
-             (if (needs-resolving? pred-type)
+             (if (resolvable? pred-type)
                  (resolve pred-type)
                  pred-type))
            (match fun-type
@@ -80,7 +81,7 @@
              ;;        be worth being more precise here for some rare code.
              [(PredicateProp: ps)
               (match ps
-                [(PropSet: (TypeProp: (Path: '() '(0 0)) ft) _) ft]
+                [(PropSet: (TypeProp: (Path: '() (cons 0 0)) ft) _) ft]
                 [(FalseProp:) (Un)]
                 [_ Univ])]
              [_ Univ])]
diff --git a/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
index c18abe8f..04617bb3 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
@@ -74,7 +74,7 @@
          (types utils abbrev union subtype resolve generalize signatures)
          (typecheck check-below internal-forms)
          (utils tc-utils)
-         (rep type-rep)
+         (rep type-rep values-rep)
          (for-syntax racket/base racket/unit-exptime syntax/parse)
          (for-template racket/base
                        racket/unsafe/undefined
diff --git a/typed-racket-lib/typed-racket/typecheck/error-message.rkt b/typed-racket-lib/typed-racket/typecheck/error-message.rkt
index fb630947..22bb22b2 100644
--- a/typed-racket-lib/typed-racket/typecheck/error-message.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/error-message.rkt
@@ -11,15 +11,15 @@
          (types utils subtype resolve)
          (utils tc-utils)
          (rep type-rep)
-         (only-in (types printer) pretty-format-type))
+         (only-in (types printer) pretty-format-rep))
 
 (provide/cond-contract [expected-but-got
-                        (--> (-or/c Type/c string?)
-                             (-or/c Type/c string?)
+                        (--> (-or/c Type? string?)
+                             (-or/c Type? string?)
                              -any)]
                        [type-mismatch
-                        (-->* ((-or/c Type/c Prop? string?)
-                               (-or/c Type/c Prop? string?))
+                        (-->* ((-or/c Type? Prop? PropSet? string?)
+                               (-or/c Type? Prop? PropSet? string?))
                               ((-or/c string? #f))
                               -any)])
 
@@ -27,8 +27,8 @@
 ;; Type errors with "type mismatch", arguments may be types or other things
 ;; like the length of a list of types
 (define (type-mismatch t1 t2 [more #f])
-  (define t1* (if (Type/c? t1) (pretty-format-type t1 #:indent 12) t1))
-  (define t2* (if (Type/c? t2) (pretty-format-type t2 #:indent 9) t2))
+  (define t1* (if (Type? t1) (pretty-format-rep t1 #:indent 12) t1))
+  (define t2* (if (Type? t2) (pretty-format-rep t2 #:indent 9) t2))
   (tc-error/fields "type mismatch" #:more more "expected" t1* "given" t2* #:delayed? #t))
 
 ;; expected-but-got : (U Type String) (U Type String) -> Void
diff --git a/typed-racket-lib/typed-racket/typecheck/find-annotation.rkt b/typed-racket-lib/typed-racket/typecheck/find-annotation.rkt
index f425a0c3..1da78d5f 100644
--- a/typed-racket-lib/typed-racket/typecheck/find-annotation.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/find-annotation.rkt
@@ -8,7 +8,7 @@
 
 (require-for-cond-contract (rep type-rep))
 
-(provide/cond-contract [find-annotation (syntax? identifier? . -> . (or/c #f Type/c))])
+(provide/cond-contract [find-annotation (syntax? identifier? . -> . (or/c #f Type?))])
 
 (define-syntax-class lv-clause
   #:transparent
diff --git a/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt b/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt
index f402200a..858fd426 100644
--- a/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt
@@ -4,14 +4,14 @@
          (contract-req)
          racket/list
          racket/match
-         (rep type-rep prop-rep)
+         (rep core-rep type-rep prop-rep values-rep)
          (except-in (types abbrev subtype tc-result)
                     -> ->* one-of/c))
 
 (provide possible-domains)
 
 (provide/cond-contract
-  [cleanup-type ((Type/c) ((or/c #f Type/c) any/c) . ->* . Type/c)])
+  [cleanup-type ((Type?) ((or/c #f Type?) any/c) . ->* . Type?)])
 
 ;; to avoid long and confusing error messages, in the case of functions with
 ;; multiple similar domains (<, >, +, -, etc.), we show only the domains that
diff --git a/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt b/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
index 795ef846..8beb068f 100644
--- a/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
@@ -89,7 +89,7 @@
       ;; otherwise, not defined in this module, not our problem
       [else (mk-ignored-quad internal-id)]))
 
-  ;; mk-struct-syntax-quad : identifier? identifier? struct-info? Type/c -> quad/c
+  ;; mk-struct-syntax-quad : identifier? identifier? struct-info? Type? -> quad/c
   ;; This handles `(provide s)` where `s` was defined with `(struct s ...)`. 
   (define (mk-struct-syntax-quad internal-id new-id si constr-type)
     (define type-is-constructor? #t) ;Conservative estimate (provide/contract does the same)
diff --git a/typed-racket-lib/typed-racket/typecheck/signatures.rkt b/typed-racket-lib/typed-racket/typecheck/signatures.rkt
index cb3781f1..f28d6263 100644
--- a/typed-racket-lib/typed-racket/typecheck/signatures.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/signatures.rkt
@@ -9,10 +9,10 @@
   ([cond-contracted tc-expr (syntax? . -> . full-tc-results/c)]
    [cond-contracted tc-expr/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
    [cond-contracted tc-expr/check? (syntax? (or/c tc-results/c #f) . -> . (or/c full-tc-results/c #f))]
-   [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)]
-   [cond-contracted tc-expr/check/t? (syntax? (or/c tc-results/c #f) . -> . (or/c Type/c #f))]
+   [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type?)]
+   [cond-contracted tc-expr/check/t? (syntax? (or/c tc-results/c #f) . -> . (or/c Type? #f))]
    [cond-contracted tc-body/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
-   [cond-contracted tc-expr/t (syntax? . -> . Type/c)]
+   [cond-contracted tc-expr/t (syntax? . -> . Type?)]
    [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))
 
 (define-signature check-subforms^
@@ -32,7 +32,7 @@
   ([cond-contracted tc/if-twoarm ((syntax? syntax? syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))
 
 (define-signature tc-literal^
-  ([cond-contracted tc-literal (->* (syntax?) ((or/c Type/c #f)) Type/c)]))
+  ([cond-contracted tc-literal (->* (syntax?) ((or/c Type? #f)) Type?)]))
 
 (define-signature tc-send^
   ([cond-contracted tc/send ((syntax? syntax?
@@ -47,7 +47,7 @@
 
 (define-signature tc-lambda^
   ([cond-contracted tc/lambda (syntax? syntax? syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
-   [cond-contracted tc/rec-lambda/check (syntax? syntax? syntax? (listof Type/c) tc-results/c . -> .
+   [cond-contracted tc/rec-lambda/check (syntax? syntax? syntax? (listof Type?) tc-results/c . -> .
                                                  (values full-tc-results/c full-tc-results/c))]))
 
 (define-signature tc-app^
@@ -62,5 +62,5 @@
    [cond-contracted tc/letrec-values ((syntax? syntax? syntax?) ((or/c #f tc-results/c) (-> any)) . ->* . full-tc-results/c)]))
 
 (define-signature tc-dots^
-  ([cond-contracted tc/dots (syntax? . -> . (values Type/c symbol?))]))
+  ([cond-contracted tc/dots (syntax? . -> . (values Type? symbol?))]))
 
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
index 3a5ea3e0..903f12de 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
@@ -6,7 +6,7 @@
          (contract-req)
          (typecheck check-below tc-subst tc-metafunctions possible-domains)
          (utils tc-utils)
-         (rep type-rep prop-rep)
+         (rep type-rep prop-rep values-rep)
          (except-in (types utils abbrev subtype type-table)
                     -> ->* one-of/c))
 (require-for-cond-contract
@@ -24,7 +24,7 @@
     ;; we check that all kw args are optional
     [((arr: dom rng rest #f (and kws (list (Keyword: _ _ #f) ...)))
       (list (tc-result1: t-a phi-a o-a) ...))
-
+     
      (when check?
        (cond [(and (not rest) (not (= (length dom) (length t-a))))
               (tc-error/fields "could not apply function"
@@ -93,9 +93,9 @@
 ;; Generates error messages when operand types don't match operator domains.
 (provide/cond-contract
   [domain-mismatches
-   ((syntax? syntax? Type/c (listof (listof Type/c)) (listof (or/c #f Type/c))
-     (listof (or/c #f (cons/c Type/c (or/c natural-number/c symbol?))))
-     (listof SomeValues/c) (listof tc-results?) (or/c #f Type/c) any/c)
+   ((syntax? syntax? Type? (listof (listof Type?)) (listof (or/c #f Type?))
+     (listof (or/c #f (cons/c Type? (or/c natural-number/c symbol?))))
+     (listof SomeValues?) (listof tc-results?) (or/c #f Type?) any/c)
     (#:expected (or/c #f tc-results/c)
      #:return tc-results?
      #:msg-thunk (-> string? string?))
@@ -170,7 +170,7 @@
                      ;; mode, do the check here. Note that using restrictive mode
                      ;; above results in poor error messages (see PR 14731).
                      (or (not expected)
-                         (subtype (car rngs) (tc-results->values expected))))
+                         (subval (car rngs) (tc-results->values expected))))
                 ;; if we narrowed down the possible cases to a single one, have
                 ;; tc/funapp1 generate a better error message
                 (tc/funapp1 f-stx args-stx
@@ -199,7 +199,7 @@
 
 
 (provide/cond-contract
-  [poly-fail ((syntax? syntax? Type/c (listof tc-results?))
+  [poly-fail ((syntax? syntax? Type? (listof tc-results?))
               (#:name (or/c #f syntax?)
                #:expected (or/c #f tc-results/c))
               . ->* . tc-results/c)])
@@ -260,3 +260,4 @@
   (if name
       (format "function `~a'" (syntax->datum name))
       "function"))
+
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt
index 4369c1e3..38dd850c 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt
@@ -6,7 +6,7 @@
          "utils.rkt"
          (types utils abbrev numeric-tower union resolve type-table generalize)
          (typecheck signatures check-below)
-         (rep type-rep rep-utils)
+         (rep type-rep type-mask rep-utils)
          (for-label racket/unsafe/ops racket/base))
 
 (import tc-expr^ tc-app^ tc-literal^)
@@ -128,7 +128,7 @@
       ;; it like any other expected type.
       [(tc-result1: (app resolve (Union: ts))) (=> continue)
        (define u-ts (for/list ([t (in-list ts)]
-                               #:when (eq? 'vector (Type-key t)))
+                               #:when (eq? mask:vector (Type-mask t)))
                       t))
        (match u-ts
          [(list t0) (tc/app #'(#%plain-app . form) (ret t0))]
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt
index f9361fac..2183ec8a 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt
@@ -118,7 +118,7 @@
        (if (null? new-arities)
            (domain-mismatches
             (car (syntax-e form)) (cdr (syntax-e form))
-            arities doms rests drests rngs
+            (make-Function arities) doms rests drests rngs
             (stx-map tc-expr pos-args)
             #f #f #:expected expected
             #:msg-thunk
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-main.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-main.rkt
index 9bef361d..8f06abf7 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-main.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-main.rkt
@@ -7,7 +7,7 @@
          syntax/parse/experimental/reflect
          "../signatures.rkt" "../tc-funapp.rkt"
          (types utils)
-         (rep type-rep prop-rep object-rep))
+         (rep type-rep prop-rep object-rep values-rep))
 
 (import tc-expr^ tc-app-keywords^
         tc-app-hetero^ tc-app-list^ tc-app-apply^ tc-app-values^
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
index 74bd13de..aa3bd0ea 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
@@ -66,7 +66,7 @@
                                 [arg (in-syntax named-args)])
                        (list (syntax-e name) arg)))
   (match (resolve (tc-expr/t cl))
-    [(Union: '()) (ret (Un))]
+    [(Bottom:) (ret -Bottom)]
     [(and c (Class: _ inits fields _ _ init-rest))
      (cond [;; too many positional arguments, fail
             (and (> (length pos-args) (length inits)) (not init-rest))
@@ -140,7 +140,7 @@
                                     #:more "the object is missing an expected field"
                                     "field" field-sym
                                     "object type" ty)])]
-      [(Instance: (? needs-resolving? type))
+      [(Instance: (? resolvable? type))
        (check (make-Instance (resolve type)))]
       [type
        (tc-error/expr/fields "type mismatch"
@@ -176,7 +176,7 @@
                                     #:more (~a "expected an object with field "
                                                maybe-field-sym)
                                     "given" ty)])]
-      [(Instance: (? needs-resolving? type))
+      [(Instance: (? resolvable? type))
        (check (make-Instance (resolve type)))]
       [type
        (tc-error/expr/fields "type mismatch"
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt b/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
index bf01c273..1fd4e72c 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
@@ -5,7 +5,7 @@
          (typecheck signatures tc-app-helper)
          (types utils abbrev substitute)
          (utils tc-utils)
-         (rep type-rep)
+         (rep type-rep core-rep values-rep)
          (r:infer infer))
 
 (import tc-expr^ tc-lambda^ tc-let^ tc-app^)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt b/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt
index c2cda2b1..b65b7808 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt
@@ -6,8 +6,8 @@
          (contract-req)
          (rep type-rep prop-rep object-rep rep-utils)
          (utils tc-utils)
-         (types tc-result resolve subtype remove update union prop-ops)
-         (env type-env-structs lexical-env)
+         (types tc-result resolve subtype update union prop-ops)
+         (env type-env-structs lexical-env mvar-env)
          (rename-in (types abbrev)
                     [-> -->]
                     [->* -->*]
@@ -18,22 +18,41 @@
 
 ;; Returns #f if anything becomes (U)
 (define (env+ env ps)
-  (let/ec exit*
-    (define (exit) (exit* #f empty))
-    (define-values (props atoms) (combine-props ps (env-props env) exit))
-    (values
-      (for/fold ([Γ (replace-props env props)]) ([p (in-list atoms)])
-        (match p
-          [(or (TypeProp: (Path: lo x) pt) (NotTypeProp: (Path: lo x) pt))
-           (update-type/lexical
-             (lambda (x t)
-               (define new-t (update t pt (TypeProp? p) lo))
-               (when (type-equal? new-t -Bottom)
-                 (exit))
-               new-t)
-             x Γ)]
-          [_ Γ]))
-      atoms)))
+  (define-values (props atoms) (combine-props ps (env-props env)))
+  (cond
+    [props
+     (let loop ([ps atoms]
+                [negs '()]
+                [Γ (replace-props env props)])
+       (match ps
+         [(cons p ps)
+          (match p
+            [(TypeProp: (Path: lo x) pt)
+             #:when (and (not (is-var-mutated? x))
+                         (identifier-binding x))
+             (let* ([t (lookup-type/lexical x Γ #:fail (lambda _ Univ))]
+                    [new-t (update t pt #t lo)])
+               (if (type-equal? new-t -Bottom)
+                   (values #f '())
+                   (loop ps negs (extend Γ x new-t))))]
+            ;; process negative info _after_ positive info so we don't miss anything
+            [(NotTypeProp: (Path: _ x) _)
+             #:when (and (not (is-var-mutated? x))
+                         (identifier-binding x))
+             (loop ps (cons p negs) Γ)]
+            [_ (loop ps negs Γ)])]
+         [_ (let ([Γ (let loop ([negs negs]
+                                [Γ Γ])
+                       (match negs
+                         [(cons (NotTypeProp: (Path: lo x) pt) rst)
+                          (let* ([t (lookup-type/lexical x Γ #:fail (lambda _ Univ))]
+                                 [new-t (update t pt #f lo)])
+                            (if (type-equal? new-t -Bottom)
+                                #f
+                                (loop rst (extend Γ x new-t))))]
+                         [_ Γ]))])
+              (values Γ atoms))]))]
+    [else (values #f '())]))
 
 ;; run code in an extended env and with replaced props. Requires the body to return a tc-results.
 ;; TODO make this only add the new prop instead of the entire environment once tc-id is fixed to
@@ -46,10 +65,12 @@
   (syntax-parse stx
     [(_ ps:expr u:unreachable? . b)
      #'(let-values ([(new-env atoms) (env+ (lexical-env) ps)])
-         (if new-env
-             (with-lexical-env new-env
-               (add-unconditional-prop (let () . b) (apply -and (append atoms (env-props new-env)))))
-             ;; unreachable, bail out
-             (let ()
-               u.form
-               (ret -Bottom))))]))
+         (cond
+           [new-env
+            (with-lexical-env
+             new-env
+             (add-unconditional-prop (let () . b) (apply -and (append atoms (env-props new-env)))))]
+           [else
+            ;; unreachable, bail out
+            u.form
+            (ret -Bottom)]))]))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
index 00de9951..ae0fff6e 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@@ -6,12 +6,12 @@
          "signatures.rkt"
          "check-below.rkt" "../types/kw-types.rkt"
          (types utils abbrev union subtype type-table path-type
-                prop-ops overlap resolve generalize)
-         (private-in syntax-properties)
+                prop-ops overlap resolve generalize tc-result)
+         (private-in syntax-properties parse-type)
          (rep type-rep prop-rep object-rep)
          (only-in (infer infer) intersect)
          (utils tc-utils)
-         (env lexical-env)
+         (env lexical-env scoped-tvar-env)
          racket/list
          racket/private/class-internal
          syntax/parse
@@ -51,8 +51,9 @@
       [(Path: p x) (values p x)]
       [(Empty:) (values (list) id*)]))
   ;; calculate the type, resolving aliasing and paths if necessary
-  (define ty (path-type alias-path (lookup-type/lexical alias-id)))
-  
+  (define ty (or (path-type alias-path (lookup-type/lexical alias-id))
+                 Univ))
+ 
   (ret ty
        (if (overlap? ty (-val #f))
            (-PS (-not-type obj (-val #f)) (-is-type obj (-val #f)))
@@ -72,7 +73,7 @@
 
 ;; typecheck an expression by passing tr-expr/check a tc-results
 (define/cond-contract (tc-expr/check/type form expected)
-  (--> syntax? Type/c tc-results/c)
+  (--> syntax? Type? tc-results/c)
   (tc-expr/check form (ret expected)))
 
 (define (tc-expr/check form expected)
@@ -80,10 +81,16 @@
     ;; the argument must be syntax
     (unless (syntax? form)
       (int-err "bad form input to tc-expr: ~a" form))
-    ;; typecheck form
-    (define t (tc-expr/check/internal form expected))
-    (add-typeof-expr form t)
-    (cond-check-below t expected)))
+    (define result
+      ;; if there is an annotation, use that expected type for internal checking
+      (syntax-parse form
+        [exp:type-ascription^
+         (add-scoped-tvars #'exp (parse-literal-alls (attribute exp.value)))
+         (tc-expr/check/internal #'exp (parse-tc-results (attribute exp.value)))]
+        [_ (reduce-tc-results/subsumption
+            (tc-expr/check/internal form expected))]))
+    (add-typeof-expr form result)
+    (cond-check-below result expected)))
 
 ;; typecheck and return a truth value indicating a typecheck failure (#f)
 ;; or success (any non-#f value)
@@ -115,7 +122,6 @@
 (define/cond-contract (tc-expr/check/internal form expected)
   (--> syntax? (-or/c tc-results/c #f) full-tc-results/c)
   (parameterize ([current-orig-stx form])
-    ;(printf "form: ~a\n" (syntax-object->datum form))
     ;; the argument must be syntax
     (unless (syntax? form)
       (int-err "bad form input to tc-expr: ~a" form))
@@ -361,7 +367,7 @@
                ;; true if execution reaches this point.
                (loop (rest es)))]))]))
 
-;; find-stx-type : Any [(or/c Type/c #f)] -> Type/c
+;; find-stx-type : Any [(or/c Type? #f)] -> Type?
 ;; recursively find the type of either a syntax object or the result of syntax-e
 (define (find-stx-type datum-stx [expected #f])
   (match datum-stx
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt b/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
index ecdf43d5..62b3f9ac 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
@@ -24,9 +24,6 @@
      (do-inst (tc-expr #'e) (attribute exp.value))]
     [(exp:row-inst^ e)
      (do-inst (tc-expr #'e) (attribute exp.value) #t)]
-    [(exp:type-ascription^ e)
-     (add-scoped-tvars #'e (parse-literal-alls (attribute exp.value)))
-     (tc-expr/check #'e (parse-tc-results (attribute exp.value)))]
     [(exp:ignore-some-expr^ e)
      (register-ignored! #'e)
      (check-subforms/ignore #'e)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt b/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
index 477c7365..8159c2b9 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
@@ -6,7 +6,7 @@
          (env tvar-env)
          (for-syntax syntax/parse racket/base)
          (types utils subtype resolve abbrev
-                substitute classes)
+                substitute classes prop-ops)
          (typecheck tc-metafunctions tc-app-helper)
          (rep type-rep)
          (r:infer infer))
@@ -15,7 +15,7 @@
 
 (provide/cond-contract
   [tc/funapp
-   (syntax? stx-list? Type/c (c:listof tc-results1/c)
+   (syntax? stx-list? Type? (c:listof tc-results1/c)
     (c:or/c #f tc-results/c)
     . c:-> . full-tc-results/c)])
 
@@ -35,143 +35,146 @@
                         #:expected expected))))]))
 
 (define (tc/funapp f-stx args-stx f-type args-res expected)
-  (match-define (list (tc-result1: argtys) ...) args-res)
-  (match f-type
-    ;; we special-case this (no case-lambda) for improved error messages
-    ;; tc/funapp1 currently cannot handle drest arities
-    [(Function: (list (and a (arr: _ _ _ #f _))))
-     (tc/funapp1 f-stx args-stx a args-res expected)]
-    [(Function/arrs: doms rngs rests (and drests #f) kws #:arrs arrs)
-     (or
-      ;; find the first function where the argument types match
-      (for/first ([dom (in-list doms)] [rng (in-list rngs)] [rest (in-list rests)] [a (in-list arrs)]
-                  #:when (subtypes/varargs argtys dom rest))
-        ;; then typecheck here
-        ;; we call the separate function so that we get the appropriate
-        ;; props/objects
-        (tc/funapp1 f-stx args-stx a args-res expected #:check #f))
-      ;; if nothing matched, error
-      (domain-mismatches
-       f-stx args-stx f-type doms rests drests rngs args-res #f #f
-       #:expected expected
-       #:msg-thunk (lambda (dom)
-                     (string-append
-                      "No function domains matched in function application:\n"
-                      dom))))]
-    ;; any kind of dotted polymorphic function without mandatory keyword args
-    [(PolyDots: (list fixed-vars ... dotted-var)
-       (Function/arrs: doms rngs rests drests (list (Keyword: _ _ #f) ...) #:arrs arrs))
-     (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)
-        (cond [rest (<= (length dom) (length argtys))]
-              [drest (and (<= (length dom) (length argtys))
-                          (eq? dotted-var (cdr drest)))]
-              [else (= (length dom) (length argtys))]))
-      ;; Only try to infer the free vars of the rng (which includes the vars
-      ;; in props/objects).
-      (λ (dom rng rest drest a)
-        (extend-tvars fixed-vars
-          (cond
-           [drest
-            (infer/dots
-             fixed-vars dotted-var argtys dom (car drest) rng (fv rng)
-             #:expected (and expected (tc-results->values expected)))]
-           [rest
-            (infer/vararg fixed-vars (list dotted-var) argtys dom rest rng
-                          (and expected (tc-results->values expected)))]
-           ;; no rest or drest
-           [else (infer fixed-vars (list dotted-var) argtys dom rng
-                        (and expected (tc-results->values expected)))])))
-      f-type args-res expected)]
-    ;; regular polymorphic functions without dotted rest, 
-    ;; we do not choose any instantiations with mandatory keyword arguments
-    [(Poly: vars (Function/arrs: doms rngs rests #f (list (Keyword: _ _ kw?) ...) #:arrs arrs))
-     (handle-clauses
-      (doms rngs rests kw? arrs) f-stx args-stx
-      ;; only try inference if the argument lengths are appropriate
-      ;; and there's no mandatory kw
-      (λ (dom _ rest kw? a) 
-        (and (andmap not kw?) ((if rest <= =) (length dom) (length argtys))))
-      ;; Only try to infer the free vars of the rng (which includes the vars
-      ;; in props/objects).
-      (λ (dom rng rest kw? a)
-        (extend-tvars vars
-                      (infer/vararg vars null argtys dom rest rng
-                                    (and expected (tc-results->values expected)))))
-      f-type args-res expected)]
-    ;; Row polymorphism. For now we do really dumb inference that only works
-    ;; in very restricted cases, but is probably enough for most cases in
-    ;; the Racket codebase. Eventually this should be extended.
-    [(PolyRow: vars constraints (and f-ty (Function/arrs: doms _ _ #f _)))
-     (define (fail)
-       (poly-fail f-stx args-stx f-type args-res
-                  #:name (and (identifier? f-stx) f-stx)
-                  #:expected expected))
-     ;; there's only one row variable in a PolyRow (for now)
-     (define row-var (car vars))
-     ;; only infer if there is only one argument type that has the relevant
-     ;; row type variable in its free variables in all cases
-     (define row-var-idxs
-       (for/list ([dom doms])
-         (define num-occurs
-           (for/list ([dom-type dom] [idx (in-naturals)]
-                      #:when (member row-var (fv dom-type)))
-             idx))
-         (unless (<= (length num-occurs) 1)
-           (fail))
-         (if (null? num-occurs) 0 (car num-occurs))))
-     (unless (or (< (length row-var-idxs) 2)
-                 (apply = row-var-idxs))
-       ;; row var wasn't in the same position in some cases
-       (fail))
-     (define idx (car row-var-idxs))
-     (define resolved-argty (resolve (list-ref argtys idx)))
-     (cond [(Class? resolved-argty)
-            (define substitution
-              (hash row-var
-                    (t-subst (infer-row constraints resolved-argty))))
-            (tc/funapp f-stx args-stx (subst-all substitution f-ty)
-                       args-res expected)]
-           [else (fail)])]
-    ;; procedural structs
-    [(Struct: _ _ _ (? Function? proc-ty) _ _)
-     (tc/funapp f-stx #`(#,(syntax/loc f-stx dummy) . #,args-stx) proc-ty
-                (cons (ret f-type) args-res) expected)]
-    ;; parameters are functions too
-    [(Param: in out)
-     (match argtys
-      [(list) (ret out)]
-      [(list t)
-       (if (subtype t in)
-           (ret -Void -true-propset)
-           (tc-error/expr
-            #:return (ret -Void -true-propset)
-            "Wrong argument to parameter - expected ~a and got ~a"
-            in t))]
-      [_ (tc-error/expr
-           "Wrong number of arguments to parameter - expected 0 or 1, got ~a"
-           (length argtys))])]
-    [(Distinction: _ _ t)
-     (tc/funapp f-stx args-stx t args-res expected)]
-    ;; resolve names, polymorphic apps, mu, etc
-    [(? needs-resolving?)
-     (tc/funapp f-stx args-stx (resolve-once f-type) args-res expected)]
-    ;; a union of functions can be applied if we can apply all of the elements
-    [(Union: (and ts (list (? Function?) ...)))
-     (merge-tc-results
-      (for/list ([fty ts])
-        (tc/funapp f-stx args-stx fty args-res expected)))]
-    ;; error type is a perfectly good fcn type
-    [(Error:) (ret f-type)]
-    ;; otherwise fail
-    [(Poly: ns (Function: arrs))
-     (tc-error/expr
-      (string-append "Cannot infer type instantiation for type ~a. Please add "
-                     "more type annotations")
-      f-type)]
-    [_
-     (tc-error/expr
-      "Cannot apply expression of type ~a, since it is not a function type"
-      f-type)]))
+  (match-define (list (tc-result1: argtys (PropSet: argps+ argps-) _) ...) args-res)
+  (define result
+    (match f-type
+      ;; we special-case this (no case-lambda) for improved error messages
+      ;; tc/funapp1 currently cannot handle drest arities
+      [(Function: (list (and a (arr: _ _ _ #f _))))
+       (tc/funapp1 f-stx args-stx a args-res expected)]
+      [(Function/arrs: doms rngs rests (and drests #f) kws #:arrs arrs)
+       (or
+        ;; find the first function where the argument types match
+        (for/first ([dom (in-list doms)] [rng (in-list rngs)] [rest (in-list rests)] [a (in-list arrs)]
+                                         #:when (subtypes/varargs argtys dom rest))
+          ;; then typecheck here
+          ;; we call the separate function so that we get the appropriate
+          ;; props/objects
+          (tc/funapp1 f-stx args-stx a args-res expected #:check #f))
+        ;; if nothing matched, error
+        (domain-mismatches
+         f-stx args-stx f-type doms rests drests rngs args-res #f #f
+         #:expected expected
+         #:msg-thunk (lambda (dom)
+                       (string-append
+                        "No function domains matched in function application:\n"
+                        dom))))]
+      ;; any kind of dotted polymorphic function without mandatory keyword args
+      [(PolyDots: (list fixed-vars ... dotted-var)
+                  (Function/arrs: doms rngs rests drests (list (Keyword: _ _ #f) ...) #:arrs arrs))
+       (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)
+          (cond [rest (<= (length dom) (length argtys))]
+                [drest (and (<= (length dom) (length argtys))
+                            (eq? dotted-var (cdr drest)))]
+                [else (= (length dom) (length argtys))]))
+        ;; Only try to infer the free vars of the rng (which includes the vars
+        ;; in props/objects).
+        (λ (dom rng rest drest a)
+          (extend-tvars fixed-vars
+                        (cond
+                          [drest
+                           (infer/dots
+                            fixed-vars dotted-var argtys dom (car drest) rng (fv rng)
+                            #:expected (and expected (tc-results->values expected)))]
+                          [rest
+                           (infer/vararg fixed-vars (list dotted-var) argtys dom rest rng
+                                         (and expected (tc-results->values expected)))]
+                          ;; no rest or drest
+                          [else (infer fixed-vars (list dotted-var) argtys dom rng
+                                       (and expected (tc-results->values expected)))])))
+        f-type args-res expected)]
+      ;; regular polymorphic functions without dotted rest, 
+      ;; we do not choose any instantiations with mandatory keyword arguments
+      [(Poly: vars (Function/arrs: doms rngs rests #f (list (Keyword: _ _ kw?) ...) #:arrs arrs))
+       (handle-clauses
+        (doms rngs rests kw? arrs) f-stx args-stx
+        ;; only try inference if the argument lengths are appropriate
+        ;; and there's no mandatory kw
+        (λ (dom _ rest kw? a) 
+          (and (andmap not kw?) ((if rest <= =) (length dom) (length argtys))))
+        ;; Only try to infer the free vars of the rng (which includes the vars
+        ;; in props/objects).
+        (λ (dom rng rest kw? a)
+          (extend-tvars vars
+                        (infer/vararg vars null argtys dom rest rng
+                                      (and expected (tc-results->values expected)))))
+        f-type args-res expected)]
+      ;; Row polymorphism. For now we do really dumb inference that only works
+      ;; in very restricted cases, but is probably enough for most cases in
+      ;; the Racket codebase. Eventually this should be extended.
+      [(PolyRow: vars constraints (and f-ty (Function/arrs: doms _ _ #f _)))
+       (define (fail)
+         (poly-fail f-stx args-stx f-type args-res
+                    #:name (and (identifier? f-stx) f-stx)
+                    #:expected expected))
+       ;; there's only one row variable in a PolyRow (for now)
+       (define row-var (car vars))
+       ;; only infer if there is only one argument type that has the relevant
+       ;; row type variable in its free variables in all cases
+       (define row-var-idxs
+         (for/list ([dom doms])
+           (define num-occurs
+             (for/list ([dom-type dom] [idx (in-naturals)]
+                                       #:when (member row-var (fv dom-type)))
+               idx))
+           (unless (<= (length num-occurs) 1)
+             (fail))
+           (if (null? num-occurs) 0 (car num-occurs))))
+       (unless (or (< (length row-var-idxs) 2)
+                   (apply = row-var-idxs))
+         ;; row var wasn't in the same position in some cases
+         (fail))
+       (define idx (car row-var-idxs))
+       (define resolved-argty (resolve (list-ref argtys idx)))
+       (cond [(Class? resolved-argty)
+              (define substitution
+                (hash row-var
+                      (t-subst (infer-row constraints resolved-argty))))
+              (tc/funapp f-stx args-stx (subst-all substitution f-ty)
+                         args-res expected)]
+             [else (fail)])]
+      ;; procedural structs
+      [(Struct: _ _ _ (? Function? proc-ty) _ _)
+       (tc/funapp f-stx #`(#,(syntax/loc f-stx dummy) . #,args-stx) proc-ty
+                  (cons (ret f-type) args-res) expected)]
+      ;; parameters are functions too
+      [(Param: in out)
+       (match argtys
+         [(list) (ret out)]
+         [(list t)
+          (if (subtype t in)
+              (ret -Void -true-propset)
+              (tc-error/expr
+               #:return (ret -Void -true-propset)
+               "Wrong argument to parameter - expected ~a and got ~a"
+               in t))]
+         [_ (tc-error/expr
+             "Wrong number of arguments to parameter - expected 0 or 1, got ~a"
+             (length argtys))])]
+      [(Distinction: _ _ t)
+       (tc/funapp f-stx args-stx t args-res expected)]
+      ;; resolve names, polymorphic apps, mu, etc
+      [(? resolvable?)
+       (tc/funapp f-stx args-stx (resolve-once f-type) args-res expected)]
+      ;; a union of functions can be applied if we can apply all of the elements
+      [(Union: (and ts (list (? Function?) ...)))
+       (merge-tc-results
+        (for/list ([fty ts])
+          (tc/funapp f-stx args-stx fty args-res expected)))]
+      ;; bottom or error type is a perfectly good fcn type
+      [(or (Bottom:) (Error:)) (ret f-type)]
+      ;; otherwise fail
+      [(Poly: ns (Function: arrs))
+       (tc-error/expr
+        (string-append "Cannot infer type instantiation for type ~a. Please add "
+                       "more type annotations")
+        f-type)]
+      [_
+       (tc-error/expr
+        "Cannot apply expression of type ~a, since it is not a function type"
+        f-type)]))
+  ;; keep any info learned from the arguments
+  (add-unconditional-prop result (apply -and (map -or argps+ argps-))))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-if.rkt b/typed-racket-lib/typed-racket/typecheck/tc-if.rkt
index a9bdf3cd..bffd06d8 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-if.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-if.rkt
@@ -1,6 +1,6 @@
 #lang racket/unit
 (require "../utils/utils.rkt"
-         (rep prop-rep)
+         (rep core-rep prop-rep)
          (types abbrev utils prop-ops)
          (utils tc-utils)
          (typecheck signatures tc-envops tc-metafunctions)
@@ -15,17 +15,17 @@
 
 (define (tc/if-twoarm tst thn els [expected #f])
   (match (single-value tst)
-    [(tc-result1: _ (PropSet: fs+ fs-) _)
+    [(tc-result1: _ (PropSet: ps+ ps-) _)
      (define expected* (and expected (erase-props expected)))
      (define results-t
-       (with-lexical-env/extend-props (list fs+)
+       (with-lexical-env/extend-props (list ps+)
          #:unreachable (begin
                          (handle-unreachable-casted-exprs thn)
                          (warn-unreachable thn))
          (test-position-add-true tst)
          (tc-expr/check thn expected*)))
      (define results-u
-       (with-lexical-env/extend-props (list fs-)
+       (with-lexical-env/extend-props (list ps-)
          #:unreachable (begin
                          (handle-unreachable-casted-exprs els)
                          (warn-unreachable els))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
index c8bc7d57..88c6df6f 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
@@ -62,8 +62,8 @@
 ;; body: The body of the lambda to typecheck.
 (define/cond-contract
   (tc-lambda-body arg-names arg-types #:rest [raw-rest #f] #:expected [expected #f] body)
-  (->* ((listof identifier?) (listof Type/c) syntax?)
-       (#:rest (or/c #f (list/c identifier? (or/c Type/c (cons/c Type/c symbol?))))
+  (->* ((listof identifier?) (listof Type?) syntax?)
+       (#:rest (or/c #f (list/c identifier? (or/c Type? (cons/c Type? symbol?))))
         #:expected (or/c #f tc-results/c))
        arr?)
   (define-values (rest-id rest)
@@ -100,8 +100,8 @@
 ;; ret-ty: The expected type of the body of the lambda.
 (define/cond-contract (check-clause arg-list rest-id body arg-tys rest-ty drest ret-ty)
      ((listof identifier?)
-      (or/c #f identifier?) syntax? (listof Type/c) (or/c #f Type/c)
-      (or/c #f (cons/c Type/c symbol?)) tc-results/c
+      (or/c #f identifier?) syntax? (listof Type?) (or/c #f Type?)
+      (or/c #f (cons/c Type? symbol?)) tc-results/c
       . -> .
       arr?)
   (let* ([arg-len (length arg-list)]
@@ -149,15 +149,15 @@
 
 ;; typecheck a single lambda, with argument list and body
 ;; drest-ty and drest-bound are both false or not false
-;; tc/lambda-clause/check: formals syntax listof[Type/c] tc-result
-;;                         option[Type/c] option[(cons Type/c symbol)] -> arr?
+;; tc/lambda-clause/check: formals syntax listof[Type?] tc-result
+;;                         option[Type?] option[(cons Type? symbol)] -> arr?
 (define (tc/lambda-clause/check formals body arg-tys ret-ty rest-ty drest)
   (check-clause (formals-positional formals) (formals-rest formals) body arg-tys rest-ty drest ret-ty))
 
 ;; typecheck a single opt-lambda clause with argument list and body
 ;; tc/opt-lambda-clause: listof[identifier] syntax -> listof[arr?]
 (define (tc/opt-lambda-clause arg-list body aux-table flag-table)
-  ;; arg-types: Listof[Type/c]
+  ;; arg-types: Listof[Type?]
   (define arg-types
     (for/list ([a (in-list arg-list)])
       (get-type a #:default (lambda ()
@@ -166,7 +166,7 @@
                                   (get-type id #:default Univ)
                                   Univ)))))
 
-  ;; new-arg-types: Listof[Listof[Type/c]]
+  ;; new-arg-types: Listof[Listof[Type?]]
   (define new-arg-types
     (if (= 0 (dict-count flag-table))
         (list arg-types)
@@ -435,9 +435,9 @@
 ;; tc/plambda syntax tvarss-list syntax-list syntax-list type -> Poly
 ;; formals and bodies must by syntax-lists
 (define/cond-contract (tc/plambda form tvarss-list formals bodies expected)
-  (syntax? (listof list?) syntax? syntax? (or/c tc-results/c #f) . -> . Type/c)
+  (syntax? (listof list?) syntax? syntax? (or/c tc-results/c #f) . -> . Type?)
   (define/cond-contract (maybe-loop form formals bodies expected)
-    (syntax? syntax? syntax? (or/c tc-results/c #f) . -> . Type/c)
+    (syntax? syntax? syntax? (or/c tc-results/c #f) . -> . Type?)
     (match expected
       [(tc-result1: (app resolve (or (? Poly?) (? PolyDots?) (? PolyRow?))))
        (tc/plambda form (remove-poly-layer tvarss-list) formals bodies expected)]
@@ -544,9 +544,11 @@
 (define (tc/rec-lambda/check formals* body name args return)
   (define formals (syntax->list formals*))
   (define ft (t:->* args (tc-results->values return)))
+  (define names (cons name formals))
+  (define objs (map (λ (_) -empty-obj) names))
   (with-lexical-env/extend-types
-   (cons name formals) 
-   (cons ft args)
-   (values
-     (replace-names (map (λ (f) (list f -empty-obj)) (cons name formals)) (ret ft))
-     (replace-names (map (λ (f) (list f -empty-obj)) (cons name formals)) (tc-body/check body return)))))
+    (cons name formals) 
+    (cons ft args)
+    (values
+     (replace-names names objs (ret ft))
+     (replace-names names objs (tc-body/check body return)))))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
index 0472dd86..5f7f5736 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
@@ -47,62 +47,59 @@
    ((-> any/c))
    . ->* .
    tc-results/c)
-  (with-cond-contract t/p ([expected-types (listof (listof Type/c))]
-                           [objs           (listof (listof Object?))]
+  (with-cond-contract t/p ([expected-types (listof (listof Type?))]
+                           [objs           (listof (listof OptObject?))]
                            [props          (listof (listof Prop?))])
     (define-values (expected-types objs props)
       (for/lists (e o p)
         ([e-r   (in-list expected-results)]
          [names (in-list namess)])
         (match e-r
-          [(list (tc-result: e-ts (PropSet: fs+ fs-) os) ...)
+          [(list (tc-result: e-ts (PropSet: ps+ ps-) os) ...)
            (values e-ts
-                   (map (λ (o n t) (if (or (is-var-mutated? n) (F? t)) -empty-obj o)) os names e-ts)
+                   (map (λ (o n) (if (is-var-mutated? n) -empty-obj o)) os names)
                    (apply append
                           (for/list ([n (in-list names)]
                                      [t (in-list e-ts)]
-                                     [f+ (in-list fs+)]
-                                     [f- (in-list fs-)]
+                                     [p+ (in-list ps+)]
+                                     [p- (in-list ps-)]
                                      [o (in-list os)])
                             (cond
-                              [(not (overlap? t (-val #f)))
-                               (list f+)]
-                              [(is-var-mutated? n)
-                               (list)]
-                              ;; n is being bound to an expression w/ object o, no new info 
-                              ;; is required due to aliasing (note: we currently do not
-                              ;; alias objects typed as type variables)
-                              [(and (Path? o) (not (F? t))) (list)]
-                              ;; n is being bound to an expression w/o an object (or whose
-                              ;; type is a type variable) so create props about n
-                              [else (list (-or (-and (-not-type n (-val #f)) f+)
-                                               (-and (-is-type n (-val #f)) f-)))]))))]
+                              [(not (overlap? t (-val #f))) (list p+)]
+                              [(is-var-mutated? n) (list)]
+                              [else
+                               (define obj (if (Object? o) o n))
+                               (list (-or (-and (-not-type obj (-val #f)) p+)
+                                          (-and (-is-type obj (-val #f)) p-)))]))))]
           ;; amk: does this case ever occur?
           [(list (tc-result: e-ts #f _) ...)
            (values e-ts (make-list (length e-ts) -empty-obj) null)]))))
   ;; extend the lexical environment for checking the body
   ;; with types and potential aliases
-  (with-lexical-env/extend-types+aliases
-    (append* namess)
-    (append* expected-types)
-    (append* objs)
-    (replace-names
-      (get-names+objects namess expected-results)
-      (with-lexical-env/extend-props
-        (apply append props)
-        ;; if a let rhs does not return, the body isn't checked
-        #:unreachable (for ([form (in-list (syntax->list body))])
-                        (register-ignored! form))
-        ;; type-check the rhs exprs
-        (for ([expr (in-list exprs)] [results (in-list expected-results)])
-          (match results
-            [(list (tc-result: ts fs os) ...)
-             (expr->type expr (ret ts fs os))]))
-        ;; Perform additional context-dependent checking that needs to be done
-        ;; in the context of the letrec body
-        (check-thunk)
-        ;; typecheck the body
-        (tc-body/check body (and expected (erase-props expected)))))))
+  (let ([names (append* namess)]
+        [objs (append* objs)])
+    (with-lexical-env/extend-types+aliases
+      names
+      (append* expected-types)
+      objs
+      (replace-names
+       names
+       objs
+       (with-lexical-env/extend-props
+         (apply append props)
+         ;; if a let rhs does not return, the body isn't checked
+         #:unreachable (for ([form (in-list (syntax->list body))])
+                         (register-ignored! form))
+         ;; type-check the rhs exprs
+         (for ([expr (in-list exprs)] [results (in-list expected-results)])
+           (match results
+             [(list (tc-result: ts fs os) ...)
+              (expr->type expr (ret ts fs os))]))
+         ;; Perform additional context-dependent checking that needs to be done
+         ;; in the context of the letrec body
+         (check-thunk)
+         ;; typecheck the body
+         (tc-body/check body (and expected (erase-props expected))))))))
 
 (define (tc-expr/maybe-expected/t e names)
   (syntax-parse names
@@ -111,7 +108,7 @@
     [_ (tc-expr e)]))
 
 
-(define (regsiter-aliases-and-declarations names exprs)
+(define (register-aliases-and-declarations names exprs)
   ;; Collect the declarations, which are represented as expressions.
   ;; We put them back into definitions to reuse the existing machinery
   (define-values (type-aliases declarations signature-forms)
@@ -159,7 +156,7 @@
   (let* ([names (stx-map syntax->list namess)]
          [orig-flat-names (apply append names)]
          [exprs (syntax->list exprs)])
-    (regsiter-aliases-and-declarations names exprs)
+    (register-aliases-and-declarations names exprs)
     
     ;; First look at the clauses that do not bind the letrec names
     (define all-clauses
@@ -270,7 +267,8 @@
            (with-lexical-env/extend-types 
             names 
             ts
-            (replace-names (map list names os)
+            (replace-names names
+                           os
                            (loop (cdr clauses))))])))
 
 ;; this is so match can provide us with a syntax property to
@@ -292,7 +290,7 @@
          ;; all the trailing expressions - the ones actually bound to the names
          [exprs (syntax->list exprs)])
 
-    (regsiter-aliases-and-declarations names exprs)
+    (register-aliases-and-declarations names exprs)
 
     (let* (;; the types of the exprs
            #;[inferred-types (map (tc-expr-t/maybe-expected expected) exprs)]
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt b/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
index d258cbf4..a7d17343 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
@@ -4,7 +4,7 @@
          racket/match racket/list
          (except-in (types abbrev union utils prop-ops tc-result)
                     -> ->* one-of/c)
-         (rep type-rep prop-rep object-rep rep-utils)
+         (rep type-rep prop-rep object-rep values-rep rep-utils)
          (typecheck tc-subst check-below)
          (contract-req))
 
@@ -16,15 +16,16 @@
 ;; Objects representing the rest argument are currently not supported
 (define/cond-contract (abstract-results results arg-names #:rest-id [rest-id #f])
   ((tc-results/c (listof identifier?)) (#:rest-id (or/c #f identifier?))
-   . ->* . SomeValues/c)
+   . ->* . SomeValues?)
   (define positional-arg-objects
-    (for/list ([(nm k) (in-indexed (in-list arg-names))])
-      (list nm (make-Path null (list 0 k)))))
-  (define arg-objects
+    (for/list ([n (in-range (length arg-names))])
+      (make-Path null (cons 0 n))))
+  (define-values (names objects)
     (if rest-id
-        (cons (list rest-id -empty-obj) positional-arg-objects)
-        positional-arg-objects))
-  (tc-results->values (replace-names arg-objects results)))
+        (values (cons rest-id arg-names)
+                (cons -empty-obj positional-arg-objects))
+        (values arg-names positional-arg-objects)))
+  (tc-results->values (replace-names names objects results)))
 
 (define (tc-results->values tc)
   (match (fix-results tc)
@@ -41,16 +42,16 @@
    . -> .
    Prop?)
   (for/fold ([prop prop])
-    ([a (in-list atoms)])
+            ([a (in-list atoms)])
     (match prop
       [(AndProp: ps)
        (let loop ([ps ps] [result null])
-         (if (null? ps)
-             (apply -and result)
-             (let ([p (car ps)])
-               (cond [(contradictory? a p) -ff]
-                     [(implies-atomic? a p) (loop (cdr ps) result)]
-                     [else (loop (cdr ps) (cons p result))]))))]
+         (match ps
+           [(cons p ps)
+            (cond [(contradictory? a p) -ff]
+                  [(implies-atomic? a p) (loop ps result)]
+                  [else (loop ps (cons p result))])]
+           [_ (apply -and result)]))]
       [_ prop])))
 
 (define (flatten-props ps)
@@ -60,40 +61,44 @@
       [(cons (AndProp: ps*) ps) (loop (append ps* ps))]
       [(cons p ps) (cons p (loop ps))])))
 
-(define/cond-contract (combine-props new-props old-props exit)
-  ((listof Prop?) (listof Prop?) (-> none/c)
-   . -> .
-   (values (listof OrProp?) (listof (or/c TypeProp? NotTypeProp?))))
+(define/cond-contract (combine-props new-props old-props)
+  ((listof Prop?) (listof Prop?)
+                  . -> .
+                  (values (or/c #f (listof OrProp?))
+                          (or/c #f (listof (or/c TypeProp? NotTypeProp?)))))
   (define (atomic-prop? p) (or (TypeProp? p) (NotTypeProp? p)))
   (define-values (new-atoms new-formulas) (partition atomic-prop? (flatten-props new-props)))
-  (let loop ([derived-formulas null]
+  (let loop ([derived-ors null]
              [derived-atoms new-atoms]
              [worklist (append old-props new-formulas)])
-    (if (null? worklist)
-        (values derived-formulas derived-atoms)
-        (let* ([p (car worklist)]
-               [p (resolve derived-atoms p)])
-          (match p
-            [(OrProp: ps)
-             (let ([new-or
-                    (let or-loop ([ps ps] [result null])
-                      (cond
-                        [(null? ps) (apply -or result)]
-                        [(for/or ([other-p (in-list (append derived-formulas derived-atoms))])
-                           (contradictory? (car ps) other-p))
-                         (or-loop (cdr ps) result)]
-                        [(for/or ([other-p (in-list derived-atoms)])
-                           (implies-atomic? other-p (car ps)))
-                         -tt]
-                        [else (or-loop (cdr ps) (cons (car ps) result))]))])
-               (if (OrProp? new-or)
-                   (loop (cons new-or derived-formulas) derived-atoms (cdr worklist))
-                   (loop derived-formulas derived-atoms (cons new-or (cdr worklist)))))]
-            [(or (? TypeProp?) (? NotTypeProp?)) (loop derived-formulas (cons p derived-atoms) (cdr worklist))]
+    (match worklist
+      [(cons (app (λ (p) (resolve derived-atoms p)) p)
+             worklist)
+       (match p
+         [(OrProp: qs)
+          (let or-loop ([qs qs] [result null])
+            (match qs
+              [(cons q qs)
+               (let check-loop ([atoms derived-atoms])
+                 (match atoms
+                   [(cons a atoms)
+                    (cond
+                      [(contradictory? q a) (or-loop qs result)]
+                      [(implies-atomic? a q) (loop derived-ors derived-atoms worklist)]
+                      [else (check-loop atoms)])]
+                   [_ (or-loop qs (cons q result))]))]
+              [_ (define new-or (apply -or result))
+                 (if (OrProp? new-or)
+                     (loop (cons new-or derived-ors) derived-atoms worklist)
+                     (loop derived-ors derived-atoms (cons new-or worklist)))]))]
+         [(or (? TypeProp?)
+              (? NotTypeProp?))
+          (loop derived-ors (cons p derived-atoms) worklist)]
 
-            [(AndProp: ps) (loop derived-formulas derived-atoms (append ps (cdr worklist)))]
-            [(TrueProp:) (loop derived-formulas derived-atoms (cdr worklist))]
-            [(FalseProp:) (exit)])))))
+         [(AndProp: qs) (loop derived-ors derived-atoms (append qs worklist))]
+         [(== -tt prop-equal?) (loop derived-ors derived-atoms worklist)]
+         [(== -ff prop-equal?) (values #f #f)])]
+      [_ (values derived-ors derived-atoms)])))
 
 
 (define (unconditional-prop res)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-send.rkt b/typed-racket-lib/typed-racket/typecheck/tc-send.rkt
index f4a6703d..b8b3ab4b 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-send.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-send.rkt
@@ -20,10 +20,10 @@
                  method-var method
                  arg-vars args
                  [expected #f])
-  ;; do-check : Type/c -> tc-results/c
+  ;; do-check : Type? -> tc-results/c
   (define (do-check rcvr-type)
     (match rcvr-type
-      [(Instance: (? needs-resolving? type))
+      [(Instance: (? resolvable? type))
        (do-check (make-Instance (resolve type)))]
       [(and obj (Instance: (Class: _ _ _ methods _ _)))
        (match (tc-expr/t method)
@@ -42,9 +42,7 @@
                      rcvr-type)])]
       ;; union of objects, check pointwise and union the results
       [(Union: (list (and objs (Instance: _)) ...))
-       (merge-tc-results
-        (for/list ([obj (in-list objs)])
-          (do-check obj)))]
+       (merge-tc-results (map do-check objs))]
       [_ (tc-error/expr/fields
           "send: type mismatch"
           "expected" "an object"
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt b/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt
index a9193a8c..9aa2796c 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt
@@ -159,7 +159,7 @@
 
   ;; the base-type, with free type variables
   (define name-type
-    (make-Name (struct-names-type-name names) 0 #t))
+    (make-Name (struct-names-type-name names) (length tvars) #t))
   (define poly-base
     (if (null? tvars)
         name-type
@@ -350,7 +350,7 @@
 ;; FIXME - figure out how to make this lots lazier
 (define/cond-contract (tc/builtin-struct nm parent fld-names tys kernel-maker)
      (c:-> identifier? (c:or/c #f identifier?) (c:listof identifier?)
-           (c:listof Type/c) (c:or/c #f identifier?)
+           (c:listof Type?) (c:or/c #f identifier?)
            c:any/c)
   (define parent-type
     (and parent (resolve-name (make-Name parent 0 #t))))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt b/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt
index 029bff92..640bc28e 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt
@@ -4,179 +4,192 @@
 ;; figure 8, pg 8 of "Logical Types for Untyped Languages"
 
 (require "../utils/utils.rkt"
+         (utils tc-utils)
          racket/match racket/list
          (contract-req)
-         (except-in (types abbrev utils prop-ops path-type)
+         (except-in (types abbrev utils prop-ops path-type subtract overlap)
                     -> ->* one-of/c)
-         (only-in (infer infer) intersect)
-         (rep type-rep object-rep prop-rep rep-utils))
-
-(provide add-scope)
+         (only-in (infer infer) intersect restrict)
+         (types subtype)
+         (rep core-rep type-rep object-rep
+              prop-rep rep-utils values-rep))
 
 (provide/cond-contract
-  [restrict-values (-> SomeValues/c (listof Type/c) SomeValues/c)]
-  [values->tc-results (->* (SomeValues/c (listof Object?)) ((listof Type/c)) full-tc-results/c)]
-  [replace-names (-> (listof (list/c identifier? Object?)) tc-results/c tc-results/c)])
+ [restrict-values (-> SomeValues? (listof Type?) SomeValues?)]
+ [values->tc-results (->* (SomeValues? (listof OptObject?))
+                          ((listof Type?))
+                          full-tc-results/c)]
+ [replace-names (-> (listof identifier?)
+                    (listof OptObject?)
+                    tc-results/c
+                    tc-results/c)])
 
-;; Substitutes the given objects into the values and turns it into a tc-result.
-;; This matches up to the substitutions in the T-App rule from the ICFP paper.
-(define (values->tc-results v os [ts (map (λ (o) Univ) os)])
+
+;; Substitutes the given objects into the values and turns it into a
+;; tc-result.  This matches up to the substitutions in the T-App rule
+;; from the ICFP paper.
+(define (values->tc-results v os [ts (map (λ (_) Univ) os)])
+  (define targets
+    (for/list ([o (in-list os)]
+               [arg (in-naturals)]
+               [t (in-list ts)])
+      (list (cons 0 arg) o t)))
   (define res
     (match v
-      [(AnyValues: f)
-       (tc-any-results f)]
-      [(Results: t f o)
-       (ret t f o)]
-      [(Results: t f o dty dbound)
-       (ret t f o dty dbound)]))
-  (for/fold ([res res]) ([(o arg) (in-indexed (in-list os))]
-                         [t (in-list ts)])
-    (subst-tc-results res (list 0 arg) o #t t)))
+      [(AnyValues: p)
+       (tc-any-results p)]
+      [(Results: t ps o)
+       (ret t ps o)]
+      [(Results: t ps o dty dbound)
+       (ret t ps o dty dbound)]
+      [_ (int-err "invalid res in values->tc-results: ~a" res)]))
+  
+  (subst-tc-results res targets))
 
-;; Restrict the objects in v refering to the current functions arguments to be of the types ts.
+;; Restrict the objects in v refering to the current functions
+;; arguments to be of the types ts. Uses an identity substitution (yuck)
+;; since substitution does this same restriction.
 (define (restrict-values v ts)
-  (for/fold ([v v]) ([t (in-list ts)] [arg (in-naturals)])
-    (subst-type v (list 0 arg) (-arg-path arg) #t t)))
+  (define targets
+    (for/list ([t (in-list ts)]
+               [arg (in-naturals)])
+      (define nm (cons 0 arg))
+      (list nm (-id-path nm) t)))
+  (subst-rep v targets))
 
-;; replace-names: (listof (list/c identifier? Object?) tc-results? -> tc-results?
-;; For each name replaces all uses of it in res with the corresponding object.
-;; This is used so that names do not escape the scope of their definitions
-(define (replace-names names+objects res)
-  (for/fold ([res res]) ([name/object (in-list names+objects)])
-    (subst-tc-results res (first name/object) (second name/object) #t Univ)))
 
-;; Substitution of objects into a tc-results
-;; This is a combination of all of thes substitions from the paper over the different parts of the
-;; results.
-;; t is the type of the object that we are substituting in. This allows for restriction/simplification
-;; of some props if they conflict with the argument type.
-(define/cond-contract (subst-tc-results res k o polarity t)
-  (-> full-tc-results/c name-ref/c Object? boolean? Type? full-tc-results/c)
-  (define (st ty) (subst-type ty k o polarity t))
-  (define (sr ty fs ob) (subst-tc-result ty fs ob k o polarity t))
-  (define (sf f) (subst-prop f k o polarity t))
+;; For each name replaces all uses of it in res with the
+;; corresponding object.  This is used so that names do not escape the
+;; scope of their definitions
+(define (replace-names names objects res)
+  (define targets
+    (for/list ([nm (in-list names)]
+               [o (in-list objects)])
+      (list nm o Univ)))
+  (subst-tc-results res targets))
+
+(define (subst-tc-results res targets)
+  (define (sr t ps o)
+    (subst-tc-result t ps o targets))
+  (define (sub x) (subst-rep x targets))
+  
   (match res
-    [(tc-any-results: f) (tc-any-results (sf f))]
-    [(tc-results: ts fs os)
-     (tc-results (map sr ts fs os) #f)]
-    [(tc-results: ts fs os dt db)
-     (tc-results (map sr ts fs os) (cons (st dt) db))]))
+    [(tc-any-results: p) (tc-any-results (sub p))]
+    [(tc-results: ts ps os)
+     (tc-results (map sr ts ps os) #f)]
+    [(tc-results: ts ps os dt db)
+     (tc-results (map sr ts ps os) (cons (sub dt) db))]
+    [_ (int-err "invalid res in subst-tc-results: ~a" res)]))
 
-
-;; Substitution of objects into a tc-result
-;; This is a combination of the other substitutions, plus a restriction of the returned type
-;; to the arguments type if the returned object corresponds to an argument.
-(define (subst-tc-result r-t r-fs r-o k o polarity t)
-  (define argument-side
+;; Substitution of objects into a tc-result This is a combination of
+;; the other substitutions, plus a restriction of the returned type to
+;; the arguments type if the returned object corresponds to an
+;; argument.
+(define (subst-tc-result r-t r-ps r-o targets)
+  (define type*
     (match r-o
-      [(Path: p (? (lambda (nm) (name-ref=? nm k))))
-       (path-type p t)]
-      [_ Err]))
+      [(Path: flds nm)
+       (cond
+         [(assoc nm targets name-ref=?) =>
+          (match-lambda
+            [(list _ _ t)
+             (or (path-type flds t) Univ)])]
+         [else Univ])]
+      [_ Univ]))
 
   (tc-result
-    (if (equal? argument-side Err)
-        (subst-type r-t k o polarity t)
-        (intersect argument-side
-                   (subst-type r-t k o polarity t)))
-    (subst-prop-set r-fs k o polarity t)
-    (subst-object r-o k o polarity)))
+   (intersect (subst-rep r-t targets)
+              type*)
+   (subst-rep r-ps targets)
+   (subst-rep r-o targets)))
 
-;; Substitution of objects into a prop set
-;; This is essentially ψ+|ψ- [o/x] from the paper
-(define/cond-contract (subst-prop-set pset k o polarity t)
-  (-> (or/c #f PropSet?) name-ref/c Object? boolean? Type/c PropSet?)
-  (define extra-prop (-is-type k t))
-  (define (add-extra-prop p)
-    (define p* (-and p extra-prop))
-    (cond
-      [(prop-equal? p* extra-prop) -tt]
-      [(FalseProp? p*) -ff]
-      [else p]))
-  (match pset
-    [(PropSet: p+ p-)
-     (-PS (subst-prop (add-extra-prop p+) k o polarity t)
-          (subst-prop (add-extra-prop p-) k o polarity t))]
-    [_ -tt-propset]))
 
-;; Substitution of objects into a type
-;; This is essentially t [o/x] from the paper
-(define/cond-contract (subst-type t k o polarity ty)
-  (-> Type? name-ref/c Object? boolean? Type/c Type?)
-  (define (st t) (subst-type t k o polarity ty))
-  (define/cond-contract (sf fs) (PropSet? . -> . PropSet?) (subst-prop-set fs k o polarity ty))
-  (type-case (#:Type st
-              #:Prop sf
-              #:Object (lambda (f) (subst-object f k o polarity)))
-              t
-              [#:arr dom rng rest drest kws
-                     (let* ([st* (λ (t) (subst-type t (add-scope k) (add-scope/object o) polarity ty))])
-                       (make-arr (map st dom)
-                                 (st* rng)
-                                 (and rest (st rest))
-                                 (and drest (cons (st (car drest)) (cdr drest)))
-                                 (map st kws)))]))
+;; inc-lvl
+;; (cons nat nat) -> (cons nat nat)
+;; DeBruijn indexes are represented as a pair of naturals.
+;; This function increments the 'lvl' field of such an index.
+(define (inc-lvl x)
+  (match x
+    [(cons lvl arg) (cons (add1 lvl) arg)]
+    [_ x]))
 
-;; add-scope : name-ref/c -> name-ref/c
-;; Add a scope to an index name-ref
-(define (add-scope key)
-  (match key
-    [(list fun arg) (list (add1 fun) arg)]
-    [(? identifier?) key]))
+;; inc-lvls
+;; This function increments the 'lvl' field in all of the targets
+;; and objects of substitution (see 'inc-lvl' above)
+(define (inc-lvls targets)
+  (for/list ([tgt (in-list targets)])
+    (match tgt
+      [(list nm1 (Path: flds nm2) ty)
+       (list (inc-lvl nm1) (make-Path flds (inc-lvl nm2)) ty)]
+      [(cons nm1 rst)
+       (cons (inc-lvl nm1) rst)])))
 
-;; add-scope/object : Object? -> Object?
-;; Add a scope to an index object
-(define (add-scope/object obj)
-  (match obj
-    [(Empty:) -empty-obj]
-    [(Path: p nm) (make-Path p (add-scope nm))]))
-
-;; Substitution of objects into objects
-;; This is o [o'/x] from the paper
-(define/cond-contract (subst-object t k o polarity)
-  (-> Object? name-ref/c Object? boolean? Object?)
-  (match t
-    [#f t]
-    [(Empty:) t]
-    [(Path: p i)
-     (if (name-ref=? i k)
-         (match o
-           [(Empty:) -empty-obj]
-           ;; the result is not from an annotation, so it isn't a NoObject
-           [#f -empty-obj]
-           [(Path: p* i*) (make-Path (append p p*) i*)])
-         t)]))
-
-;; Substitution of objects into a prop in a prop set
-;; This is ψ+ [o/x] and ψ- [o/x] with the addition that props are restricted to
-;; only those values which are a subtype of the actual argument type (ty).
-(define/cond-contract (subst-prop p k o polarity ty)
-  (-> Prop? name-ref/c Object? boolean? Type/c Prop?)
-  (define (ap q) (subst-prop q k o polarity ty))
-  (define (tprop-matcher pes i t maker)
-    (cond
-      [(name-ref=? i k)
-       (match o
-         [(Empty:)
-          (if polarity -tt -ff)]
-         [_
-          ;; `ty` alone doesn't account for the path, so
-          ;; first traverse it with the path to match `t`
-          (define ty/path (path-type pes ty))
-          (maker
-           (-acc-path pes o)
-           ;; don't intersect if the path doesn't match the type
-           (if (equal? ty/path Err)
-               (subst-type t k o polarity ty)
-               (intersect ty/path
-                          (subst-type t k o polarity ty))))])]
-      [else p]))
-
-  (match p
-    [(AndProp: ps) (apply -and (map ap ps))]
-    [(OrProp: ps) (apply -or (map ap ps))]
-    [(FalseProp:) -ff]
-    [(TrueProp:) -tt]
-    [(TypeProp: (Path: pes i) t)
-     (tprop-matcher pes i t -is-type)]
-    [(NotTypeProp: (Path: pes i) t)
-     (tprop-matcher pes i t -not-type)]))
+;; Simple substitution of objects into a Rep
+;; This is basically 'rep[x ↦ o]'.
+;; If that was the only substitution we were doing,
+;; and the type of 'x' was 'τ', then 'targets'
+;; would equal (list (list x o τ)) (i.e. it's the list of
+;; identifiers being substituted out, the optional object replacing
+;; them, and their type).
+(define/cond-contract (subst-rep rep targets)
+  (-> any/c (listof (list/c name-ref/c OptObject? Type?))
+      any/c)
+  (define (sub/inc rep)
+    (subst-rep rep (inc-lvls targets)))
+  ;; substitution loop
+  (let subst ([rep rep])
+    (match rep
+      ;; Functions
+      ;; increment the level of the substituted object
+      [(arr: dom rng rest drest kws)
+       (make-arr (map subst dom)
+                 (sub/inc rng)
+                 (and rest (subst rest))
+                 (and drest (cons (subst (car drest)) (cdr drest)))
+                 (map subst kws))]
+      [(Path: flds nm)
+       (let ([flds (map subst flds)])
+         (cond
+           [(assoc nm targets name-ref=?) =>
+            (λ (l) (match (second l)
+                     [(Empty:) -empty-obj]
+                     [(Path: flds* nm*)
+                      (make-Path (append flds flds*) nm*)]))]
+           [else (make-Path flds nm)]))]
+      ;; restrict with the type for results and props
+      [(TypeProp: (Path: flds nm) ty-at-flds)
+       (let ([flds (map subst flds)])
+         (cond
+           [(assoc nm targets name-ref=?) =>
+            (match-lambda
+              [(list _ new-obj new-obj-ty)
+               (define arg-ty-at-flds (or (path-type flds new-obj-ty) Univ))
+               (define new-ty-at-flds (intersect ty-at-flds arg-ty-at-flds))
+               (match new-obj
+                 [_ #:when (Bottom? new-ty-at-flds) -ff]
+                 [_ #:when (subtype arg-ty-at-flds ty-at-flds) -tt]
+                 [(Empty:) -tt]
+                 [(Path: flds* nm*)
+                  (define resulting-obj (make-Path (append flds flds*) nm*))
+                  (-is-type resulting-obj new-ty-at-flds)])])]
+           [else (-is-type (make-Path flds nm) (subst ty-at-flds))]))]
+      [(NotTypeProp: (Path: flds nm) not-ty-at-flds)
+       (let ([flds (map subst flds)])
+         (cond
+           [(assoc nm targets name-ref=?) =>
+            (match-lambda
+              [(list _ new-obj new-obj-ty)
+               (define arg-ty-at-flds (or (path-type flds new-obj-ty) Univ))
+               (define new-ty-at-flds (subtract arg-ty-at-flds not-ty-at-flds))
+               (define new-not-ty-at-flds (restrict not-ty-at-flds arg-ty-at-flds))
+               (match new-obj
+                 [_ #:when (Bottom? new-ty-at-flds) -ff]
+                 [_ #:when (Bottom? new-not-ty-at-flds) -tt]
+                 [(Empty:) -tt]
+                 [(Path: flds* nm*)
+                  (define resulting-obj (make-Path (append flds flds*) nm*))
+                  (-not-type resulting-obj new-not-ty-at-flds)])])]
+           [else
+            (-not-type (make-Path flds nm) (subst not-ty-at-flds))]))]
+      ;; else default fold over subfields
+      [_ (Rep-fold subst rep)])))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
index aade0448..4c4c064d 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
@@ -4,7 +4,7 @@
          racket/syntax syntax/parse syntax/stx syntax/id-table
          racket/list racket/dict racket/match racket/sequence
          (prefix-in c: (contract-req))
-         (rep type-rep)
+         (rep core-rep type-rep values-rep)
          (types utils abbrev type-table struct-table)
          (private parse-type type-annotation syntax-properties type-contract)
          (env global-env init-envs type-name-env type-alias-env
@@ -349,9 +349,10 @@
   ;; Add the struct names to the type table, but not with a type
   (let ((names (map name-of-struct struct-defs))
         (type-vars (map type-vars-of-struct struct-defs)))
-    (for ([name names])
+    (for ([name (in-list names)]
+          [tvars (in-list type-vars)])
       (register-resolved-type-alias
-       name (make-Name name 0 #t)))
+       name (make-Name name (length tvars) #t)))
     (for-each register-type-name names)
     (for-each add-constant-variance! names type-vars))
   (do-time "after adding type names")
diff --git a/typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt b/typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt
index 4ffc9659..710ea3ac 100644
--- a/typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt
@@ -38,7 +38,7 @@
                        syntax/kerncase
                        syntax/parse
                        syntax/stx
-                       (rep type-rep)
+                       (rep type-rep values-rep)
                        (optimizer optimizer)
                        (types utils abbrev printer generalize)
                        (typecheck tc-toplevel possible-domains)
@@ -146,7 +146,7 @@
             (define tc (cleanup-type t))
             (define tg (generalize tc))
             (format "- : ~a~a~a\n"
-                    (pretty-format-type tg #:indent 4)
+                    (pretty-format-rep tg #:indent 4)
                     (cond [(equal? tc tg) ""]
                           [else (format " [more precisely: ~a]" tc)])
                     (cond [(equal? tc t) ""]
@@ -157,14 +157,14 @@
             (define tcs (map cleanup-type t))
             (define tgs (map generalize tcs))
             (define tgs-val (make-Values (map -result tgs)))
-            (define formatted (pretty-format-type tgs-val #:indent 4))
+            (define formatted (pretty-format-rep tgs-val #:indent 4))
             (define indented? (regexp-match? #rx"\n" formatted))
             (format "- : ~a~a~a\n"
                     formatted
                     (cond [(andmap equal? tgs tcs) ""]
                           [indented?
                            (format "\n[more precisely: ~a]"
-                                   (pretty-format-type (make-Values (map -result tcs))
+                                   (pretty-format-rep (make-Values (map -result tcs))
                                                        #:indent 17))]
                           [else (format " [more precisely: ~a]" (cons 'Values tcs))])
                     ;; did any get pruned?
diff --git a/typed-racket-lib/typed-racket/types/abbrev.rkt b/typed-racket-lib/typed-racket/types/abbrev.rkt
index ad2d7561..d26e0752 100644
--- a/typed-racket-lib/typed-racket/types/abbrev.rkt
+++ b/typed-racket-lib/typed-racket/types/abbrev.rkt
@@ -12,7 +12,7 @@
          racket/function
 
          (prefix-in c: (contract-req))
-         (rename-in (rep type-rep prop-rep object-rep)
+         (rename-in (rep type-rep prop-rep object-rep values-rep)
                     [make-Base make-Base*])
          (types union numeric-tower prefab)
          ;; Using this form so all-from-out works
@@ -87,22 +87,20 @@
 ;; Convenient constructor for Values
 ;; (wraps arg types with Result)
 (define/cond-contract (-values args)
-  (c:-> (c:listof Type/c) (c:or/c Type/c Values?))
+  (c:-> (c:listof Type?) (c:or/c Type? Values?))
   (match args
-    ;[(list t) t]
     [_ (make-Values (for/list ([i (in-list args)]) (-result i)))]))
 
 ;; Convenient constructor for ValuesDots
 ;; (wraps arg types with Result)
 (define/cond-contract (-values-dots args dty dbound)
-  (c:-> (c:listof Type/c) Type/c (c:or/c symbol? c:natural-number/c)
+  (c:-> (c:listof Type?) Type? (c:or/c symbol? c:natural-number/c)
         ValuesDots?)
   (make-ValuesDots (for/list ([i (in-list args)]) (-result i))
                    dty dbound))
 
 ;; Basic types
 (define -Listof (-poly (list-elem) (make-Listof list-elem)))
-(define/decl -Boolean (Un -False -True))
 (define/decl -Undefined
   (make-Base 'Undefined
              #'(lambda (x) (eq? x undefined))
@@ -276,16 +274,16 @@
   (make-Function (list (make-arr* (list dom) rng #:props prop))))
 
 (define/cond-contract make-pred-ty
-  (c:case-> (c:-> Type/c Type/c)
-            (c:-> (c:listof Type/c) Type/c Type/c Type/c)
-            (c:-> (c:listof Type/c) Type/c Type/c Object? Type/c))
+  (c:case-> (c:-> Type? Type?)
+            (c:-> (c:listof Type?) Type? Type? Type?)
+            (c:-> (c:listof Type?) Type? Type? Object? Type?))
   (case-lambda
     [(in out t o)
      (->* in out : (-PS (-is-type o t) (-not-type o t)))]
     [(in out t)
-     (make-pred-ty in out t (make-Path null (list 0 0)))]
+     (make-pred-ty in out t (make-Path null (cons 0 0)))]
     [(t)
-     (make-pred-ty (list Univ) -Boolean t (make-Path null (list 0 0)))]))
+     (make-pred-ty (list Univ) -Boolean t (make-Path null (cons 0 0)))]))
 
 (define/decl -true-propset (-PS -tt -ff))
 (define/decl -false-propset (-PS -ff -tt))
diff --git a/typed-racket-lib/typed-racket/types/base-abbrev.rkt b/typed-racket-lib/typed-racket/types/base-abbrev.rkt
index 4ea253a4..b1461d16 100644
--- a/typed-racket-lib/typed-racket/types/base-abbrev.rkt
+++ b/typed-racket-lib/typed-racket/types/base-abbrev.rkt
@@ -6,7 +6,7 @@
 ;; extends it with more types and type abbreviations.
 
 (require "../utils/utils.rkt"
-         (rep type-rep prop-rep object-rep rep-utils)
+         (rep type-rep prop-rep object-rep values-rep rep-utils)
          (env mvar-env)
          racket/match racket/list (prefix-in c: (contract-req))
          (for-syntax racket/base syntax/parse racket/list)
@@ -14,6 +14,9 @@
          (for-template racket/base))
 
 (provide (all-defined-out)
+         -is-type
+         -not-type
+         -id-path
          (rename-out [make-Listof -lst]
                      [make-MListof -mlst]))
 
@@ -34,11 +37,12 @@
 
 ;; Top and error types
 (define/decl Univ (make-Univ))
-(define/decl -Bottom (make-Union null))
+(define/decl -Bottom (make-Bottom))
 (define/decl Err (make-Error))
 
 (define/decl -False (make-Value #f))
 (define/decl -True (make-Value #t))
+(define/decl -Boolean (make-Union (list -False -True)))
 
 (define -val make-Value)
 
@@ -70,25 +74,14 @@
 ;; The input types can be union types, but should not have a complicated
 ;; overlap relationship.
 (define simple-Un
-  (let ()
-    ;; List[Type] -> Type
-    ;; Argument types should not overlap or be union types
-    (define (make-union* types)
-      (match types
-        [(list t) t]
-        [_ (make-Union types)]))
-
-    ;; Type -> List[Type]
-    (define (flat t)
-      (match t
-        [(Union: es) es]
-        [_ (list t)]))
-
+  (let ([flat (match-lambda
+                [(Union: es) es]
+                [t (list t)])])
     (case-lambda
       [() -Bottom]
       [(t) t]
       [args
-       (make-union* (remove-dups (sort (append-map flat args) type<?)))])))
+       (make-Union (remove-duplicates (append-map flat args) type-equal?))])))
 
 ;; Recursive types
 (define-syntax -v
@@ -103,7 +96,7 @@
 
 ;; Results
 (define/cond-contract (-result t [pset -tt-propset] [o -empty-obj])
-  (c:->* (Type/c) (PropSet? Object?) Result?)
+  (c:->* (Type?) (PropSet? OptObject?) Result?)
   (cond
     [(or (equal? t -Bottom) (equal? pset -ff-propset))
      (make-Result -Bottom -ff-propset o)]
@@ -116,16 +109,9 @@
 (define/decl -tt-propset (make-PropSet -tt -tt))
 (define/decl -ff-propset (make-PropSet -ff -ff))
 (define/decl -empty-obj (make-Empty))
-(define (-id-path id)
-  (cond
-    [(identifier? id)
-     (if (is-var-mutated? id)
-         -empty-obj
-         (make-Path null id))]
-    [else
-     (make-Path null id)]))
+
 (define (-arg-path arg [depth 0])
-  (make-Path null (list depth arg)))
+  (make-Path null (cons depth arg)))
 (define (-acc-path path-elems o)
   (match o
     [(Empty:) -empty-obj]
@@ -135,41 +121,6 @@
   (c:-> Prop? Prop? PropSet?)
   (make-PropSet + -))
 
-;; Abbreviation for props
-;; `i` can be an integer or name-ref/c for backwards compatibility
-;; FIXME: Make all callers pass in an object and remove backwards compatibility
-(define/cond-contract (-is-type i t)
-  (c:-> (c:or/c integer? name-ref/c Object?) Type/c Prop?)
-  (define o
-    (cond
-      [(Object? i) i]
-      [(integer? i) (make-Path null (list 0 i))]
-      [(list? i) (make-Path null i)]
-      [else (-id-path i)]))
-  (cond
-    [(Empty? o) -tt]
-    [(equal? Univ t) -tt]
-    [(equal? -Bottom t) -ff]
-    [else (make-TypeProp o t)]))
-
-
-;; Abbreviation for not props
-;; `i` can be an integer or name-ref/c for backwards compatibility
-;; FIXME: Make all callers pass in an object and remove backwards compatibility
-(define/cond-contract (-not-type i t)
-  (c:-> (c:or/c integer? name-ref/c Object?) Type/c Prop?)
-  (define o
-    (cond
-      [(Object? i) i]
-      [(integer? i) (make-Path null (list 0 i))]
-      [(list? i) (make-Path null i)]
-      [else (-id-path i)]))
-  (cond
-    [(Empty? o) -tt]
-    [(equal? -Bottom t) -tt]
-    [(equal? Univ t) -ff]
-    [else (make-NotTypeProp o t)]))
-
 
 ;; A Type that corresponds to the any contract for the
 ;; return type of functions
@@ -180,14 +131,14 @@
 (define/cond-contract (make-arr* dom rng
                                  #:rest [rest #f] #:drest [drest #f] #:kws [kws null]
                                  #:props [props -tt-propset] #:object [obj -empty-obj])
-  (c:->* ((c:listof Type/c) (c:or/c SomeValues/c Type/c))
-         (#:rest (c:or/c #f Type/c)
-          #:drest (c:or/c #f (c:cons/c Type/c symbol?))
+  (c:->* ((c:listof Type?) (c:or/c SomeValues? Type?))
+         (#:rest (c:or/c #f Type?)
+          #:drest (c:or/c #f (c:cons/c Type? symbol?))
           #:kws (c:listof Keyword?)
           #:props PropSet?
-          #:object Object?)
+          #:object OptObject?)
          arr?)
-  (make-arr dom (if (Type/c? rng)
+  (make-arr dom (if (Type? rng)
                     (make-Values (list (-result rng props obj)))
                     rng)
             rest drest (sort #:key Keyword-kw kws keyword<?)))
@@ -197,44 +148,55 @@
     (pattern x:id #:fail-unless (eq? ': (syntax-e #'x)) #f))
   (syntax-parse stx
     [(_ dom rng)
-     #'(make-Function (list (make-arr* dom rng)))]
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng))))]
     [(_ dom rst rng)
-     #'(make-Function (list (make-arr* dom rng #:rest rst)))]
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:rest rst))))]
     [(_ dom rng :c props)
-     #'(make-Function (list (make-arr* dom rng #:props props)))]
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:props props))))]
     [(_ dom rng _:c props _:c object)
-     #'(make-Function (list (make-arr* dom rng #:props props #:object object)))]
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:props props #:object object))))]
     [(_ dom rst rng _:c props)
-     #'(make-Function (list (make-arr* dom rng #:rest rst #:props props)))]
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:rest rst #:props props))))]
     [(_ dom rst rng _:c props : object)
-     #'(make-Function (list (make-arr* dom rng #:rest rst #:props props #:object object)))]))
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:rest rst #:props props #:object object))))]))
 
 (define-syntax (-> stx)
   (define-syntax-class c
     (pattern x:id #:fail-unless (eq? ': (syntax-e #'x)) #f))
   (syntax-parse stx
     [(_ dom ... rng _:c props _:c objects)
-     #'(->* (list dom ...) rng : props : objects)]
+     (syntax/loc stx
+       (->* (list dom ...) rng : props : objects))]
     [(_ dom ... rng :c props)
-     #'(->* (list dom ...) rng : props)]
+     (syntax/loc stx
+       (->* (list dom ...) rng : props))]
     [(_ dom ... rng)
-     #'(->* (list dom ...) rng)]))
+     (syntax/loc stx
+       (->* (list dom ...) rng))]))
 
-(define-syntax ->...
-  (syntax-rules (:)
-    [(_ dom rng)
-     (->* dom rng)]
+(define-syntax (->... stx)
+  (syntax-parse stx
+    [(_ dom rng) (syntax/loc stx (->* dom rng))]
     [(_ dom (dty dbound) rng)
-     (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound))))]
-    [(_ dom rng : props)
-     (->* dom rng : props)]
-    [(_ dom (dty dbound) rng : props)
-     (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound) #:props props)))]))
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound)))))]
+    [(_ dom rng (~datum :) props)
+     (syntax/loc stx
+       (->* dom rng (~datum :) props))]
+    [(_ dom (dty dbound) rng (~datum :) props)
+     (syntax/loc stx
+       (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound) #:props props))))]))
 
 (define (simple-> doms rng)
   (->* doms rng))
 
-(define (->acc dom rng path #:var [var (list 0 0)])
+(define (->acc dom rng path #:var [var (cons 0 0)])
   (define obj (-acc-path path (-id-path var)))
   (make-Function
    (list (make-arr* dom rng
@@ -248,53 +210,57 @@
       [(Function: as) as]))
   (make-Function (apply append (map funty-arities args))))
 
-(define-syntax cl->
-  (syntax-parser
-   [(_ [(dom ...) rng] ...)
-    #'(cl->* (dom ... . -> . rng) ...)]))
+(define-syntax (cl-> stx)
+  (syntax-parse stx
+    [(_ [(dom ...) rng] ...)
+     (syntax/loc stx
+       (cl->* (dom ... . -> . rng) ...))]))
 
 (define-syntax (->key stx)
   (syntax-parse stx
-                [(_ ty:expr ... (~seq k:keyword kty:expr opt:boolean) ... rng)
-                 #'(make-Function
-                    (list
-                     (make-arr* (list ty ...)
-                                rng
-                                #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw])
-                                            (list (make-Keyword 'k kty opt) ...)
-                                            keyword<?))))]))
+    [(_ ty:expr ... (~seq k:keyword kty:expr opt:boolean) ... rng)
+     (syntax/loc stx
+       (make-Function
+        (list
+         (make-arr* (list ty ...)
+                    rng
+                    #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw])
+                                (list (make-Keyword 'k kty opt) ...)
+                                keyword<?)))))]))
 
 (define-syntax (->optkey stx)
   (syntax-parse stx
     [(_ ty:expr ... [oty:expr ...] #:rest rst:expr (~seq k:keyword kty:expr opt:boolean) ... rng)
      (let ([l (syntax->list #'(oty ...))])
        (with-syntax ([((extra ...) ...)
-		      (for/list ([i (in-range (add1 (length l)))])
-				(take l i))]
-		     [(rsts ...) (for/list ([i (in-range (add1 (length l)))]) #'rst)])
-		    #'(make-Function
-		       (list
-			(make-arr* (list ty ... extra ...)
-				   rng
-				   #:rest rsts
-				   #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw])
-					       (list (make-Keyword 'k kty opt) ...)
-					       keyword<?))
-			...))))]
+                      (for/list ([i (in-range (add1 (length l)))])
+                        (take l i))]
+                     [(rsts ...) (for/list ([i (in-range (add1 (length l)))]) #'rst)])
+         (syntax/loc stx
+           (make-Function
+            (list
+             (make-arr* (list ty ... extra ...)
+                        rng
+                        #:rest rsts
+                        #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw])
+                                    (list (make-Keyword 'k kty opt) ...)
+                                    keyword<?))
+             ...)))))]
     [(_ ty:expr ... [oty:expr ...] (~seq k:keyword kty:expr opt:boolean) ... rng)
      (let ([l (syntax->list #'(oty ...))])
        (with-syntax ([((extra ...) ...)
-		      (for/list ([i (in-range (add1 (length l)))])
-				(take l i))])
-		    #'(make-Function
-		       (list
-			(make-arr* (list ty ... extra ...)
-				   rng
-				   #:rest #f
-				   #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw])
-					       (list (make-Keyword 'k kty opt) ...)
-					       keyword<?))
-			...))))]))
+                      (for/list ([i (in-range (add1 (length l)))])
+                        (take l i))])
+         (syntax/loc stx
+           (make-Function
+            (list
+             (make-arr* (list ty ... extra ...)
+                        rng
+                        #:rest #f
+                        #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw])
+                                    (list (make-Keyword 'k kty opt) ...)
+                                    keyword<?))
+             ...)))))]))
 
 (define (make-arr-dots dom rng dty dbound)
   (make-arr* dom rng #:drest (cons dty dbound)))
diff --git a/typed-racket-lib/typed-racket/types/classes.rkt b/typed-racket-lib/typed-racket/types/classes.rkt
index a667f3a6..b41ab192 100644
--- a/typed-racket-lib/typed-racket/types/classes.rkt
+++ b/typed-racket-lib/typed-racket/types/classes.rkt
@@ -130,36 +130,17 @@
 ;; Infer constraints on a row for a row polymorphic function
 (define (infer-row-constraints type)
   (define constraints (list null null null null))
-  ;; Crawl the type tree and mutate constraints when a
-  ;; class type with row variable is found.
-  (define (inf type)
-    (type-case
-     (#:Type inf #:Prop (sub-f inf) #:Object (sub-o inf))
-     type
-     [#:Class row inits fields methods augments init-rest
-      (cond
-       [(and row (F? row))
-        (match-define (list init-cs field-cs method-cs augment-cs)
-                      constraints)
-        (set! constraints
-              (list (append (dict-keys inits) init-cs)
-                    (append (dict-keys fields) field-cs)
-                    (append (dict-keys methods) method-cs)
-                    (append (dict-keys augments) augment-cs)))
-        (make-Class row inits fields methods augments init-rest)]
-       [else
-        (match-define (list (list init-names init-tys init-reqds) ...) inits)
-        (match-define (list (list field-names field-tys) ...) fields)
-        (match-define (list (list method-names method-tys) ...) methods)
-        (match-define (list (list augment-names augment-tys) ...) augments)
-        (make-Class
-         (and row (inf row))
-         (map list init-names (map inf init-tys) init-reqds)
-         (map list field-names (map inf field-tys))
-         (map list method-names (map inf method-tys))
-         (map list augment-names (map inf augment-tys))
-         init-rest)])]))
-  (inf type)
+  (let infer! ([cur type])
+    (match cur
+      [(Class: (? F? row) inits fields methods augments init-rest)
+       (match-define (list init-cs field-cs method-cs augment-cs)
+         constraints)
+       (set! constraints
+             (list (append (dict-keys inits) init-cs)
+                   (append (dict-keys fields) field-cs)
+                   (append (dict-keys methods) method-cs)
+                   (append (dict-keys augments) augment-cs)))]
+      [_ (Rep-walk infer! cur)]))
   (map remove-duplicates constraints))
 
 ;; infer-row : RowConstraints Type -> Row
diff --git a/typed-racket-lib/typed-racket/types/current-seen.rkt b/typed-racket-lib/typed-racket/types/current-seen.rkt
index 2c952245..cad1bf99 100644
--- a/typed-racket-lib/typed-racket/types/current-seen.rkt
+++ b/typed-racket-lib/typed-racket/types/current-seen.rkt
@@ -1,28 +1,38 @@
 #lang racket/base
-(require "../utils/utils.rkt")
-(require (rep type-rep) (contract-req))
 
-(provide (except-out (all-defined-out) current-seen-mark))
+(require "../utils/utils.rkt"
+         (rep rep-utils))
 
-(define current-seen-mark (make-continuation-mark-key 'current-seen))
-(define (current-seen)
-  (continuation-mark-set-first #f current-seen-mark null))
+(provide (except-out (all-defined-out) seen-mark))
+
+
+;;************************************************************
+;; Current Seen Continuation Mark
+;;************************************************************
+;;
+;; Prevents infinite loops when subtyping calls outside
+;; functions that may then call subtyping
+
+;; Type references/indirections that have been seen so far while
+;; subtyping, including the following: Mus, Names, Structs, and Apps
+(define seen-mark (make-continuation-mark-key 'seen))
+(define (seen)
+  (continuation-mark-set-first #f seen-mark null))
 (define (currently-subtyping?)
-  (continuation-mark-set-first #f current-seen-mark))
-(define-syntax-rule (update-current-seen new-value body)
-  (with-continuation-mark current-seen-mark new-value body))
+  (continuation-mark-set-first #f seen-mark))
 
-(define (seen-before s t) (cons (Type-seq s) (Type-seq t)))
+(define-syntax-rule (with-updated-seen A . body)
+  (with-continuation-mark seen-mark A (let () . body)))
 
-(define (remember s t A) 
-  (if (or (Mu? s) (Mu? t)
-          (Name? s) (Name? t)
-          (Instance? s) (Instance? t)
-          (Struct? s) (Struct? t) 
-          (App? s) (App? t))
-      (cons (seen-before s t) A)
-      A))
-(define (seen? ss st cs)
-  (for/or ([i (in-list cs)])
-    (and (eq? ss (car i)) (eq? st (cdr i)))))
+(define-syntax-rule (remember t1 t2 A)
+  (cons (cons t1 t2) A))
 
+(define-syntax-rule (remember* t1s/t2s A)
+  (append t1s/t2s A))
+
+(define-syntax-rule (seen? t1 t2 seen-ts)
+  (let ([seq1 (Rep-seq t1)]
+        [seq2 (Rep-seq t2)])
+    (for/or ([p (in-list seen-ts)])
+      (and (= (Rep-seq (car p)) seq1)
+           (= (Rep-seq (cdr p)) seq2)))))
diff --git a/typed-racket-lib/typed-racket/types/kw-types.rkt b/typed-racket-lib/typed-racket/types/kw-types.rkt
index 164c4d2e..745d47f4 100644
--- a/typed-racket-lib/typed-racket/types/kw-types.rkt
+++ b/typed-racket-lib/typed-racket/types/kw-types.rkt
@@ -1,6 +1,9 @@
 #lang racket/base
 
-(require "abbrev.rkt" "../rep/type-rep.rkt"
+(require "abbrev.rkt"
+         "../rep/core-rep.rkt"
+         "../rep/type-rep.rkt"
+         "../rep/values-rep.rkt"
          "../utils/tc-utils.rkt"
          "../base-env/annotate-classes.rkt"
          "tc-result.rkt"
diff --git a/typed-racket-lib/typed-racket/types/match-expanders.rkt b/typed-racket-lib/typed-racket/types/match-expanders.rkt
index b5357190..aba92208 100644
--- a/typed-racket-lib/typed-racket/types/match-expanders.rkt
+++ b/typed-racket-lib/typed-racket/types/match-expanders.rkt
@@ -3,7 +3,7 @@
 
 (require "../utils/utils.rkt")
 
-(require (rep type-rep rep-utils)
+(require (rep type-rep values-rep rep-utils)
          racket/match
          (types resolve)
          (contract-req)
@@ -18,12 +18,9 @@
   (lambda (stx)
     (syntax-parse stx
       [(_ elem-pat (~optional var-pat #:defaults ([var-pat #'var])))
-       ;; Note: in practice it's unlikely that the second pattern will ever come up
-       ;;       because the sequence number for '() will be low and the union will
-       ;;       be sorted by sequence number. As a paranoid precaution, however,
-       ;;       we will match against both patterns here.
-       (syntax/loc stx (or (Mu: var-pat (Union: (list (Value: '()) (Pair: elem-pat (F: var-pat)))))
-                           (Mu: var-pat (Union: (list (Pair: elem-pat (F: var-pat)) (Value: '()))))))])))
+       (syntax/loc stx
+         (or (Mu: var-pat (Union: (list (Value: '()) (Pair: elem-pat (F: var-pat)))))
+             (Mu: var-pat (Union: (list (Pair: elem-pat (F: var-pat)) (Value: '()))))))])))
 
 (define-match-expander List:
   (lambda (stx)
@@ -33,15 +30,15 @@
       [(_ elem-pats #:tail tail-pat)
        #'(? Type? (app untuple (? values elem-pats) tail-pat))])))
 
-;; Type/c -> (or/c (values/c #f #f) (values/c (listof Type/c) Type/c)))
+;; Type? -> (or/c (values/c #f #f) (values/c (listof Type?) Type?)))
 ;; Returns the prefix of types that are consed on to the last type (a non finite-pair type).
 ;; The last type may contain pairs if it is a list type.
 (define (untuple t)
   (let loop ((t t) (seen (set)))
-    (if (not (set-member? seen (Type-seq t)))
+    (if (not (set-member? seen (Rep-seq t)))
         (match (resolve t)
           [(Pair: a b)
-           (define-values (elems tail) (loop b (set-add seen (Type-seq t))))
+           (define-values (elems tail) (loop b (set-add seen (Rep-seq t))))
            (values (cons a elems) tail)]
           [_ (values null t)])
         (values null t))))
diff --git a/typed-racket-lib/typed-racket/types/overlap.rkt b/typed-racket-lib/typed-racket/types/overlap.rkt
index 7f40ddf1..ebe1373f 100644
--- a/typed-racket-lib/typed-racket/types/overlap.rkt
+++ b/typed-racket-lib/typed-racket/types/overlap.rkt
@@ -1,10 +1,10 @@
 #lang racket/base
 
 (require "../utils/utils.rkt"
-         (rep type-rep rep-utils)
+         (rep type-rep rep-utils type-mask)
          (prefix-in c: (contract-req))
          (types abbrev subtype resolve utils)
-         racket/match racket/set)
+         racket/match)
 
 
 (provide overlap?)
@@ -38,100 +38,99 @@
 ;; a conservative check to see if two types
 ;; have a non-empty intersection
 (define/cond-contract (overlap? t1 t2)
-  (c:-> Type/c Type/c boolean?)
-  (define k1 (Type-key t1))
-  (define k2 (Type-key t2))
+  (c:-> Type? Type? boolean?)
   (cond
     [(type-equal? t1 t2) #t]
-    [(and (symbol? k1) (symbol? k2) (not (eq? k1 k2))) #f]
-    [(and (symbol? k1) (pair? k2) (not (memq k1 k2))) #f]
-    [(and (symbol? k2) (pair? k1) (not (memq k2 k1))) #f]
-    [(and (pair? k1) (pair? k2)
-          (for/and ([i (in-list k1)]) (not (memq i k2))))
-     #f]
+    [(disjoint-masks? (Type-mask t1) (Type-mask t2)) #f]
     [(seen? t1 t2) #t]
     [else
      (with-updated-seen
-      t1 t2
-      (match*/no-order
-       (t1 t2)
-       [((Univ:) _) #:no-order #t]
-       [((or (B: _) (F: _)) _) #:no-order #t]
-       [((Opaque: _) _) #:no-order #t]
-       [((Name/simple: n) (Name/simple: n*))
-        (or (free-identifier=? n n*)
-            (overlap? (resolve-once t1) (resolve-once t2)))]
-       [(t (? Name? s))
-        #:no-order
-        (overlap? t (resolve-once s))]
-       [((? Mu? t) s) #:no-order (overlap? (unfold t) s)]
-       [((Refinement: t _) s) #:no-order (overlap? t s)]
-       [((Union: ts) s)
-        #:no-order
-        (ormap (λ (t) (overlap? t s)) ts)]
-       [((Intersection: ts) s)
-        #:no-order
-        (for/and ([t (in-immutable-set ts)])
-          (overlap? t s))]
-       [((? Poly?) _) #:no-order #t] ;; conservative
-       [((Base: s1 _ _ _) (Base: s2 _ _ _)) (or (subtype t1 t2) (subtype t2 t1))]
-       [((? Base? t) (? Value? s)) #:no-order (subtype s t)] ;; conservative
-       [((Syntax: t) (Syntax: t*)) (overlap? t t*)]
-       [((Syntax: _) _) #:no-order #f]
-       [((Base: _ _ _ _) _) #:no-order #f]
-       [((Value: (? pair?)) (Pair: _ _)) #:no-order #t]
-       [((Pair: a b) (Pair: a* b*)) (and (overlap? a a*)
-                                         (overlap? b b*))]
-       ;; lots of things are sequences, but not values where sequence? produces #f
-       [((Sequence: _) (Value: v)) #:no-order (sequence? v)]
-       ;; hash tables are two-valued sequences
-       [((Sequence: (or (list _) (list _ _ _ ...)))
-         (or (? Hashtable?) (? HashtableTop?)))
-        #:no-order
-        #f]
-       ;; these are single-valued sequences
-       [((Sequence: (list _ _ _ ...))
-         (or (? Pair?) (? Vector?) (? VectorTop?)))
-        #:no-order
-        #f]
-       ;; be conservative about other kinds of sequences
-       [((Sequence: _) _) #:no-order #t]
-       ;; Values where evt? produces #f cannot be Evt
-       [((Evt: _) (Value: v)) #:no-order (evt? v)]
-       [((Pair: _ _) _) #:no-order #f]
-       [((Value: (? simple-datum? v1))
-         (Value: (? simple-datum? v2)))
-        (equal? v1 v2)]
-       [((Value: (? simple-datum?))
-         (or (? Struct?) (? StructTop?) (? Function?)))
-        #:no-order
-        #f]
-       [((Value: (not (? hash?)))
-         (or (? Hashtable?) (? HashtableTop?)))
-        #:no-order
-        #f]
-       [((Struct: n _ flds _ _ _)
-         (Struct: n* _ flds* _ _ _)) 
-        #:when (free-identifier=? n n*)
-        (for/and ([f (in-list flds)] [f* (in-list flds*)])
-          (match* (f f*)
-            [((fld: t _ _) (fld: t* _ _)) (overlap? t t*)]))]
-       [((Struct: n #f _ _ _ _)
-         (StructTop: (Struct: n* #f _ _ _ _))) 
-        #:when (free-identifier=? n n*)
-        #t]
-       ;; n and n* must be different, so there's no overlap
-       [((Struct: n #f flds _ _ _)
-         (Struct: n* #f flds* _ _ _))
-        #f]
-       [((Struct: n #f flds _ _ _)
-         (StructTop: (Struct: n* #f flds* _ _ _)))
-        #f]
-       [((and t1 (Struct: _ _ _ _ _ _))
-         (and t2 (Struct: _ _ _ _ _ _)))
-        (or (subtype t1 t2) (subtype t2 t1)
-            (parent-of? t1 t2) (parent-of? t2 t1))]
-       [(_ _) #t]))]))
+       t1 t2
+       (match*/no-order
+        (t1 t2)
+        [((Univ:) _) #:no-order #t]
+        [((or (B: _) (F: _)) _) #:no-order #t]
+        [((Opaque: _) _) #:no-order #t]
+        [((Name/simple: n) (Name/simple: n*))
+         (or (free-identifier=? n n*)
+             (overlap? (resolve-once t1) (resolve-once t2)))]
+        [(t (or (? Name? s)
+                (? App? s)))
+         #:no-order
+         (overlap? t (resolve-once s))]
+        [((? Mu? t) s) #:no-order (overlap? (unfold t) s)]
+        [((Refinement: t _) s) #:no-order (overlap? t s)]
+        [((Union: ts) s)
+         #:no-order
+         (ormap (λ (t) (overlap? t s)) ts)]
+        [((Intersection: ts) s)
+         #:no-order
+         (for/and ([t (in-list ts)])
+           (overlap? t s))]
+        [((or (Poly-unsafe: _ t1)
+              (PolyDots-unsafe: _ t1))
+          t2)
+         #:no-order
+         (overlap? t1 t2)] ;; conservative
+        [((Base: s1 _ _ _) (Base: s2 _ _ _)) (or (subtype t1 t2) (subtype t2 t1))]
+        [((? Base? t) (? Value? s)) #:no-order (subtype s t)] ;; conservative
+        [((Syntax: t) (Syntax: t*)) (overlap? t t*)]
+        [((Syntax: _) _) #:no-order #f]
+        [((Base: _ _ _ _) _) #:no-order #f]
+        [((Value: (? pair?)) (Pair: _ _)) #:no-order #t]
+        [((Pair: a b) (Pair: a* b*)) (and (overlap? a a*)
+                                          (overlap? b b*))]
+        ;; lots of things are sequences, but not values where sequence? produces #f
+        [((Sequence: _) (Value: v)) #:no-order (sequence? v)]
+        ;; hash tables are two-valued sequences
+        [((Sequence: (or (list _) (list _ _ _ ...)))
+          (or (? Hashtable?) (? HashtableTop?)))
+         #:no-order
+         #f]
+        ;; these are single-valued sequences
+        [((Sequence: (list _ _ _ ...))
+          (or (? Pair?) (? Vector?) (? VectorTop?)))
+         #:no-order
+         #f]
+        ;; be conservative about other kinds of sequences
+        [((Sequence: _) _) #:no-order #t]
+        ;; Values where evt? produces #f cannot be Evt
+        [((Evt: _) (Value: v)) #:no-order (evt? v)]
+        [((Pair: _ _) _) #:no-order #f]
+        [((Value: (? simple-datum? v1))
+          (Value: (? simple-datum? v2)))
+         (equal? v1 v2)]
+        [((Value: (? simple-datum?))
+          (or (? Struct?) (? StructTop?) (? Function?)))
+         #:no-order
+         #f]
+        [((Value: (not (? hash?)))
+          (or (? Hashtable?) (? HashtableTop?)))
+         #:no-order
+         #f]
+        [((Struct: n _ flds _ _ _)
+          (Struct: n* _ flds* _ _ _))
+         #:when (free-identifier=? n n*)
+         (for/and ([f (in-list flds)] [f* (in-list flds*)])
+           (match* (f f*)
+             [((fld: t _ _) (fld: t* _ _)) (overlap? t t*)]))]
+        [((Struct: n #f _ _ _ _)
+          (StructTop: (Struct: n* #f _ _ _ _)))
+         #:when (free-identifier=? n n*)
+         #t]
+        ;; n and n* must be different, so there's no overlap
+        [((Struct: n #f flds _ _ _)
+          (Struct: n* #f flds* _ _ _))
+         #f]
+        [((Struct: n #f flds _ _ _)
+          (StructTop: (Struct: n* #f flds* _ _ _)))
+         #f]
+        [((and t1 (Struct: _ _ _ _ _ _))
+          (and t2 (Struct: _ _ _ _ _ _)))
+         (or (subtype t1 t2) (subtype t2 t1)
+             (parent-of? t1 t2) (parent-of? t2 t1))]
+        [(_ _) #t]))]))
+
 
 ;; Type Type -> Boolean
 ;; Given two struct types, check if the second is a parent struct
diff --git a/typed-racket-lib/typed-racket/types/path-type.rkt b/typed-racket-lib/typed-racket/types/path-type.rkt
index 747b8145..09cb4f10 100644
--- a/typed-racket-lib/typed-racket/types/path-type.rkt
+++ b/typed-racket-lib/typed-racket/types/path-type.rkt
@@ -3,7 +3,7 @@
 (require "../utils/utils.rkt"
          racket/match racket/set
          (contract-req)
-         (rep object-rep type-rep)
+         (rep object-rep type-rep values-rep)
          (utils tc-utils)
          (typecheck renamer)
          (types subtype resolve union)
@@ -12,7 +12,7 @@
 (require-for-cond-contract (rep rep-utils))
 
 (provide/cond-contract
- [path-type ((listof PathElem?) Type/c . -> . Type/c)])
+ [path-type ((listof PathElem?) Type? . -> . (or/c Type? #f))])
 
 
 ;; returns the result of following a path into a type
@@ -24,48 +24,62 @@
 ;; It is intentionally reset each time we decrease the
 ;; paths size on a recursive call, and maintained/extended
 ;; when the path does not decrease on a recursive call.
-(define (path-type path t [resolved (set)])
-  (match* (t path)
-    ;; empty path
-    [(t (list)) t]
+(define (path-type path t)
+  (let path-type ([path (reverse path)]
+                  [t t]
+                  [resolved (hash)])
+    (match* (t path)
+      ;; empty path
+      [(t (list)) t]
     
-    ;; pair ops
-    [((Pair: t s) (list rst ... (CarPE:)))
-     (path-type rst t)]
-    [((Pair: t s) (list rst ... (CdrPE:)))
-     (path-type rst s)]
+      ;; pair ops
+      [((Pair: t s) (cons (CarPE:) rst))
+       (path-type rst t (hash))]
+      [((Pair: t s) (cons (CdrPE:) rst))
+       (path-type rst s (hash))]
 
-    ;; syntax ops
-    [((Syntax: t) (list rst ... (SyntaxPE:)))
-     (path-type rst t)]
+      ;; syntax ops
+      [((Syntax: t) (cons (SyntaxPE:) rst))
+       (path-type rst t (hash))]
 
-    ;; promise op
-    [((Promise: t) (list rst ... (ForcePE:)))
-     (path-type rst t)]
+      ;; promise op
+      [((Promise: t) (cons (ForcePE:) rst))
+       (path-type rst t (hash))]
 
-    ;; struct ops
-    [((Struct: nm par flds proc poly pred)
-      (list rst ... (StructPE: (? (λ (s) (subtype t s)) s) idx)))
-     (match-let ([(fld: ft _ _) (list-ref flds idx)])
-       (path-type rst ft))]
+      ;; struct ops
+      [((Struct: nm par flds proc poly pred) (cons (StructPE: struct-ty idx) rst))
+       #:when  (subtype t struct-ty)
+       (match-let ([(fld: ft _ _) (list-ref flds idx)])
+         (path-type rst ft (hash)))]
+
+      [((Intersection: ts) _)
+       (apply -unsafe-intersect (for*/list ([t (in-list ts)]
+                                            [t (in-value (path-type path t resolved))]
+                                            #:when t)
+                                  t))]
+      [((Union: ts) _)
+       (apply Un (for*/list ([t (in-list ts)]
+                             [t (in-value (path-type path t resolved))]
+                             #:when t)
+                   t))]
     
-    [((Union: ts) _)
-     (apply Un (map (λ (t) (path-type path t resolved)) ts))]
+      ;; paths into polymorphic types
+      ;; TODO can this expose unbound type indices... probably. It should be
+      ;; shielded with a check for type indexes/variables/whatever.
+      [((Poly: _ body-t) _) (path-type path body-t resolved)]
+      [((PolyDots: _ body-t) _) (path-type path body-t resolved)]
+      [((PolyRow: _ _ body-t) _) (path-type path body-t resolved)]
+      [((Distinction: _ _ t) _) (path-type path t resolved)]
     
-    ;; paths into polymorphic types
-    [((Poly: _ body-t) _) (path-type path body-t resolved)]
-    [((PolyDots: _ body-t) _) (path-type path body-t resolved)]
-    [((PolyRow: _ _ body-t) _) (path-type path body-t resolved)]
-    
-    ;; for private fields in classes
-    [((Function: (list (arr: doms (Values: (list (Result: rng _ _))) _ _ _)))
-      (list rst ... (FieldPE:)))
-     (path-type rst rng)]
+      ;; for private fields in classes
+      [((Function: (list (arr: doms (Values: (list (Result: rng _ _))) _ _ _)))
+        (cons (FieldPE:) rst))
+       (path-type rst rng (hash))]
 
-    ;; types which need resolving
-    [((? needs-resolving?) _) #:when (not (set-member? resolved t))
-     (path-type path (resolve-once t) (set-add resolved t))]
+      ;; types which need resolving
+      [((? resolvable?) _) #:when (not (hash-ref resolved t #f))
+                           (path-type path (resolve-once t) (hash-set resolved t #t))]
     
-    ;; type/path mismatch =(
-    [(_ _) Err]))
+      ;; type/path mismatch =(
+      [(_ _) #f])))
 
diff --git a/typed-racket-lib/typed-racket/types/printer.rkt b/typed-racket-lib/typed-racket/types/printer.rkt
index dc4866f7..4e7e90ac 100644
--- a/typed-racket-lib/typed-racket/types/printer.rkt
+++ b/typed-racket-lib/typed-racket/types/printer.rkt
@@ -8,13 +8,15 @@
          racket/list
          racket/set
          (path-up "rep/type-rep.rkt" "rep/prop-rep.rkt" "rep/object-rep.rkt"
-                  "rep/rep-utils.rkt" "types/subtype.rkt"
+                  "rep/core-rep.rkt" "rep/values-rep.rkt"
+                  "rep/rep-utils.rkt" "types/subtype.rkt" "types/overlap.rkt"
                   "types/match-expanders.rkt"
                   "types/kw-types.rkt"
-                  "types/utils.rkt"
+                  "types/utils.rkt" "types/abbrev.rkt"
                   "types/resolve.rkt"
                   "types/prefab.rkt"
                   "utils/utils.rkt"
+                  "utils/primitive-comparison.rkt"
                   "utils/tc-utils.rkt")
          (for-syntax racket/base syntax/parse))
 
@@ -25,11 +27,14 @@
   (if (eq? printer-type 'debug)
       #'(provide (rename-out [debug-printer print-type]
                              [debug-printer print-prop]
+                             [debug-printer print-propset]
+                             [debug-printer print-values]
+                             [debug-printer print-result]
                              [debug-printer print-object]
                              [debug-printer print-pathelem]
-                             [debug-pretty-format-type pretty-format-type]))
-      #'(provide print-type print-prop print-object print-pathelem
-                 pretty-format-type)))
+                             [debug-pretty-format-type pretty-format-rep]))
+      #'(provide print-type print-prop print-propset print-object print-pathelem
+                 pretty-format-rep print-values print-result)))
 (provide-printer)
 
 (provide print-complex-props? type-output-sexpr-tweaker
@@ -76,12 +81,23 @@
 (define (print-pathelem pe port write?)
   (display (pathelem->sexp pe) port))
 
+
 (define (print-prop prop port write?)
   (display (prop->sexp prop) port))
 
+
+(define (print-propset prop port write?)
+  (display (propset->sexp prop) port))
+
 (define (print-object obj port write?)
   (display (object->sexp obj) port))
 
+(define (print-result res port write?)
+  (display (result->sexp res) port))
+
+(define (print-values vals port write?)
+  (display (values->sexp vals) port))
+
 ;; Table for formatting pretty-printed types
 (define type-style-table
   (pretty-print-extend-style-table
@@ -89,28 +105,31 @@
 
 ;; pretty-format-type : Type -> String
 ;; Formats the type using pretty printing
-(define (pretty-format-type type #:indent [indent 0])
+(define (pretty-format-rep rep #:indent [indent 0])
   (define out (open-output-string))
   (port-count-lines! out)
   (write-string (make-string indent #\space) out)
   (parameterize ([pretty-print-current-style-table type-style-table])
-    (pretty-display ((type-output-sexpr-tweaker) (type->sexp type '()))
+    (pretty-display ((type-output-sexpr-tweaker) (match rep
+                                                   [(? Type?) (type->sexp rep '())]
+                                                   [(? SomeValues?) (values->sexp rep)]
+                                                   [(? Result?) (result->sexp rep)]))
                     out))
   (string-trim #:left? #f (substring (get-output-string out) indent)))
 
+(define name-ref->sexp
+  (match-lambda
+    [(? syntax? name-ref) (syntax-e name-ref)]
+    [(cons lvl arg) `(,lvl ,arg)]))
+
 ;; prop->sexp : Prop -> S-expression
 ;; Print a Prop (see prop-rep.rkt) to the given port
-(define (prop->sexp filt)
-  (define (name-ref->sexp name-ref)
-    (if (syntax? name-ref)
-        (syntax-e name-ref)
-        name-ref))
+(define (prop->sexp prop)
   (define (path->sexps path)
     (if (null? path)
         '()
         (list (map pathelem->sexp path))))
-  (match filt
-    [(PropSet: thn els) `(,(prop->sexp thn) \| ,(prop->sexp els))]
+  (match prop
     [(NotTypeProp: (Path: path nm) type)
      `(! ,(type->sexp type) @ ,@(path->sexps path) ,(name-ref->sexp nm))]
     [(TypeProp: (Path: path nm) type)
@@ -119,7 +138,7 @@
     [(FalseProp:) 'Bot]
     [(AndProp: a) `(AndProp ,@(map prop->sexp a))]
     [(OrProp: a) `(OrProp ,@(map prop->sexp a))]
-    [else `(Unknown Prop: ,(struct->vector filt))]))
+    [else `(Unknown Prop: ,(struct->vector prop))]))
 
 ;; pathelem->sexp : PathElem -> S-expression
 ;; Print a PathElem (see object-rep.rkt) to the given port
@@ -137,7 +156,7 @@
 (define (object->sexp object)
   (match object
     [(Empty:) '-]
-    [(Path: pes i) (append (map pathelem->sexp pes) (list i))]
+    [(Path: pes n) (append (map pathelem->sexp pes) (list (name-ref->sexp n)))]
     [else `(Unknown Object: ,(struct->vector object))]))
 
 ;; cover-union : Type LSet<Type> -> Listof<Symbol> Listof<Type>
@@ -218,39 +237,48 @@
       (if rest  `(,(type->sexp rest) *)                       null)
       (if drest `(,(type->sexp (car drest)) ... ,(cdr drest)) null)
       (match rng
-        [(AnyValues: (TrueProp:)) '(AnyValues)]
-        [(AnyValues: f) `(AnyValues : ,(prop->sexp f))]
-        [(Values: (list (Result: t (PropSet: (TrueProp:) (TrueProp:)) (Empty:))))
+        [(AnyValues: (? TrueProp?)) '(AnyValues)]
+        [(AnyValues: p) `(AnyValues : ,(prop->sexp p))]
+        [(Values: (or (list (Result: t (PropSet: (? TrueProp?) (? TrueProp?)) (? Empty?)))
+                      (list (Result: (and (== -False) t) (PropSet: (? FalseProp?) (? TrueProp?)) (? Empty?)))
+                      (list (Result: (and t (app (λ (t) (overlap? t -False)) #f))
+                                     (PropSet: (? TrueProp?) (? FalseProp?))
+                                     (? Empty?)))))
          (list (type->sexp t))]
         [(Values: (list (Result: t
-                                 (PropSet: (TypeProp: (Path: pth (list 0 0)) ft)
-                                             (NotTypeProp: (Path: pth (list 0 0)) ft))
-                                 (Empty:))))
+                                 (PropSet:
+                                  (TypeProp: (Path: pth1 (cons 0 0)) ft1)
+                                  (NotTypeProp: (Path: pth2 (cons 0 0)) ft2))
+                                 (? Empty?))))
          ;; Only print a simple prop for single argument functions,
          ;; since parse-type only accepts simple latent props on single
          ;; argument functions.
-         #:when (= 1 (length dom))
-         (if (null? pth)
-             `(,(type->sexp t) : ,(type->sexp ft))
-             `(,(type->sexp t) : ,(type->sexp ft) @
-               ,@(map pathelem->sexp pth)))]
+         #:when (and (equal? pth1 pth2)
+                     (equal? ft1 ft2)
+                     (= 1 (length dom)))
+         (if (null? pth1)
+             `(,(type->sexp t) : ,(type->sexp ft1))
+             `(,(type->sexp t) : ,(type->sexp ft1) @
+               ,@(map pathelem->sexp pth1)))]
         ;; Print asymmetric props with only a positive prop as a
         ;; special case (even when complex printing is off) because it's
         ;; useful to users who use functions like `prop`.
         [(Values: (list (Result: t
-                                 (PropSet: (TypeProp: (Path: '() (list 0 0)) ft) (TrueProp:))
-                                 (Empty:))))
+                                 (PropSet:
+                                  (TypeProp: (Path: '() (cons 0 0)) ft)
+                                  (? TrueProp?))
+                                 (? Empty?))))
          #:when (= 1 (length dom))
          `(,(type->sexp t) : #:+ ,(type->sexp ft))]
-        [(Values: (list (Result: t fs (Empty:))))
+        [(Values: (list (Result: t ps (? Empty?))))
          (if (print-complex-props?)
-             `(,(type->sexp t) : ,(prop->sexp fs))
+             `(,(type->sexp t) : ,(propset->sexp ps))
              (list (type->sexp t)))]
-        [(Values: (list (Result: t lf lo)))
+        [(Values: (list (Result: t ps o)))
          (if (print-complex-props?)
-             `(,(type->sexp t) : ,(prop->sexp lf) ,(object->sexp lo))
+             `(,(type->sexp t) : ,(propset->sexp ps) ,(object->sexp o))
              (list (type->sexp t)))]
-        [_ (list (type->sexp rng))]))]
+        [_ (list (values->sexp rng))]))]
     [else `(Unknown Function Type: ,(struct->vector arr))]))
 
 ;; format->* : (Listof arr) -> S-Expression
@@ -275,7 +303,7 @@
                    (match-define (Keyword: k t _) opt-kw)
                    (list k (type->sexp t))))
        ,@(if rst (list '#:rest (type->sexp rst)) null)
-       ,(type->sexp rng))]))
+       ,(values->sexp rng))]))
 
 ;; cover-case-lambda : (Listof arr) -> (Listof s-expression)
 ;; Try to cover a case-> type with ->* types
@@ -356,6 +384,49 @@
   `(,(if object? 'Object 'Class)
     ,@row-var* ,@inits* ,@init-rest* ,@fields* ,@methods* ,@augments*))
 
+;; result->sexp : Result -> S-expression
+;; convert a result to an s-expression that can be printed
+(define (result->sexp res)
+  (match res
+    [(Result: t
+              (or 'none (PropSet: (? TrueProp?) (? TrueProp?)))
+              (or 'none (? Empty?)))
+     (type->sexp t)]
+    [(Result: t ps (? Empty?)) `(,(type->sexp t) : ,(propset->sexp ps))]
+    [(Result: t ps lo) `(,(type->sexp t) :
+                         ,(propset->sexp ps) :
+                         ,(object->sexp lo))]
+    [else `(Unknown Result: ,(struct->vector res))]))
+
+;; propset->sexp : Result -> S-expression
+;; convert a prop set to an s-expression that can be printed
+(define (propset->sexp ps)
+  (match ps
+    [(PropSet: thn els) `(,(prop->sexp thn) \| ,(prop->sexp els))]
+    [else `(Unknown PropSet: ,(struct->vector ps))]))
+
+;; values->sexp : SomeValues -> S-expression
+;; convert a values to an s-expression that can be printed
+(define (values->sexp v)
+  (match v
+    [(AnyValues: (? TrueProp?)) 'AnyValues]
+    [(AnyValues: p) `(AnyValues : ,(prop->sexp p))]
+    [(Values: (list v)) v]
+    [(Values: vals) (cons 'values (map result->sexp vals))]
+    [(ValuesDots: v dty dbound)
+     (cons 'values (append (map result->sexp v)
+                           (list (type->sexp dty) '... dbound)))]
+    [else `(Unknown SomeValues: ,(struct->vector v))]))
+
+;; signature->sexp : Signature -> S-expression
+;; convert a values to an s-expression that can be printed
+(define (signature->sexp s)
+  (match s
+    [(Signature: name extends mapping)
+     (syntax->datum name)]
+    [else `(Unknown Signature: ,(struct->vector s))]))
+
+
 ;; type->sexp : Type -> S-expression
 ;; convert a type to an s-expression that can be printed
 (define (type->sexp type [ignored-names '()])
@@ -373,12 +444,8 @@
       [(Pair: a e) (cons a (tuple-elems e))]
       [(Value: '()) null]))
   (match type
-    ;; if we know how it was written, print that
-    [(? Rep-stx a)
-     (if (Error? a)
-         `(Error ,(syntax->datum (Rep-stx a)))
-         (syntax->datum (Rep-stx a)))]
     [(Univ:) 'Any]
+    [(Bottom:) 'Nothing]
     ;; struct names are just printed as the original syntax
     [(Name/struct: id) (syntax-e id)]
     ;; If a type has a name, then print it with that name.
@@ -401,12 +468,15 @@
               (set-box! (current-print-unexpanded)
                         (cons (car names) (unbox (current-print-unexpanded)))))
             (car names)])]
+    [(? Base?) (Base-name type)]
     [(StructType: (Struct: nm _ _ _ _ _)) `(StructType ,(syntax-e nm))]
     ;; this case occurs if the contained type is a type variable
     [(StructType: ty) `(Struct-Type ,(t->s ty))]
     [(StructTypeTop:) 'Struct-TypeTop]
     [(StructTop: (Struct: nm _ _ _ _ _)) `(Struct ,(syntax-e nm))]
-    [(Prefab: key fields) `(Prefab ,(abbreviate-prefab-key key) ,@fields)]
+    [(Prefab: key field-types)
+     `(Prefab ,(abbreviate-prefab-key key)
+              ,@(map t->s field-types))]
     [(BoxTop:) 'BoxTop]
     [(Weak-BoxTop:) 'Weak-BoxTop]
     [(ChannelTop:) 'ChannelTop]
@@ -433,7 +503,6 @@
     [(Value: v) (format "~v" v)]
     [(? tuple? t)
      `(List ,@(map type->sexp (tuple-elems t)))]
-    [(Base: n cnt _ _) n]
     [(Opaque: pred) `(Opaque ,(syntax->datum pred))]
     [(Struct: nm       par (list (fld: t _ _) ...)       proc _ _)
      `#(,(string->symbol (format "struct:~a" (syntax-e nm)))
@@ -459,19 +528,12 @@
     [(Evt: r) `(Evtof ,(t->s r))]
     [(Union: elems)
      (define-values (covered remaining) (cover-union type ignored-names))
-     (cons 'U (append covered (map t->s remaining)))]
+     (cons 'U (sort (append covered (map t->s remaining)) primitive<=?))]
     [(Intersection: elems)
-     (cons '∩ (for/list ([elem (in-immutable-set elems)]) (t->s elem)))]
+     (cons '∩ (sort (map t->s elems) primitive<=?))]
     [(Pair: l r) `(Pairof ,(t->s l) ,(t->s r))]
     [(ListDots: dty dbound) `(List ,(t->s dty) ... ,dbound)]
     [(F: nm) nm]
-    ;; FIXME (Values are not types and shouldn't need to be considered here
-    [(AnyValues: (TrueProp:)) 'AnyValues]
-    [(AnyValues: f) `(AnyValues : ,(prop->sexp f))]
-    [(Values: (list v)) v]
-    [(Values: (list v ...)) (cons 'values (map t->s v))]
-    [(ValuesDots: v dty dbound)
-     (cons 'values (append (map t->s v) (list (t->s dty) '... dbound)))]
     [(Param: in out)
      (if (equal? in out)
          `(Parameterof ,(t->s in))
@@ -488,6 +550,7 @@
     ;; FIXME: should this print constraints too
     [(PolyRow-names: names _ body)
      `(All (,(car names) #:row) ,(t->s body))]
+    ;; x1 --> ()
     [(Mu: x (Syntax: (Union: (list
                               (Base: 'Number _ _ _)
                               (Base: 'Boolean _ _ _)
@@ -510,28 +573,20 @@
     [(? Class?) (class->sexp type)]
     [(Unit: (list imports ...) (list exports ...) (list init-depends ...) body)
      `(Unit
-       (import ,@(map t->s imports))
-       (export ,@(map t->s exports))
-       (init-depend ,@(map t->s init-depends))
-       ,(t->s body))]
-    [(Signature: name extends mapping)
-     (syntax->datum name)]
-    [(Result: t
-              (or #f (PropSet: (TrueProp:) (TrueProp:)))
-              (or #f (Empty:))) (type->sexp t)]
-    [(Result: t fs (Empty:)) `(,(type->sexp t) : ,(prop->sexp fs))]
-    [(Result: t fs lo) `(,(type->sexp t) : ,(prop->sexp fs) : ,(object->sexp lo))]
+       (import ,@(map signature->sexp imports))
+       (export ,@(map signature->sexp exports))
+       (init-depend ,@(map signature->sexp init-depends))
+       ,(values->sexp body))]
     [(MPair: s t) `(MPairof ,(t->s s) ,(t->s t))]
     [(Refinement: parent p?)
      `(Refinement ,(t->s parent) ,(syntax-e p?))]
     [(Sequence: ts)
      `(Sequenceof ,@(map t->s ts))]
     [(Error:) 'Error]
-    [(fld: t a m) `(fld ,(type->sexp t))]
+    ;[(fld: t a m) `(fld ,(type->sexp t))]
     [(Distinction: name sym ty) ; from define-new-subtype
      name]
-    [else `(Unknown Type: ,(struct->vector type))]
-    ))
+    [else `(Unknown Type: ,(struct->vector type))]))
 
 
 
@@ -540,12 +595,22 @@
     [(_ debug-printer:id)
      #:when (eq? printer-type 'debug)
      #'(begin
-         (require racket/pretty
-                  typed-racket/env/init-envs)
+         (require racket/pretty)
+         (require mzlib/pconvert)
+
+         (define (converter v basic sub)
+           (define (gen-constructor sym)
+             (string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
+           (match v
+             [(? Rep? rep)
+              `(,(gen-constructor (car (vector->list (struct->vector rep))))
+                ,@(map sub (Rep-values rep)))]
+             [_ (basic v)]))
 
          (define (debug-printer v port write?)
            ((if write? pretty-write pretty-print)
-            (syntax->datum (datum->syntax #f (type->sexp v)))
+            (parameterize ((current-print-convert-hook converter))
+              (print-convert v))
             port)))]
     [_ #'(begin)]))
 
@@ -566,4 +631,3 @@
        #'(void))]))
 
 (define-debug-pretty-format-type debug-pretty-format-type)
-
diff --git a/typed-racket-lib/typed-racket/types/prop-ops.rkt b/typed-racket-lib/typed-racket/types/prop-ops.rkt
index 1b5e5fbd..442c2603 100644
--- a/typed-racket-lib/typed-racket/types/prop-ops.rkt
+++ b/typed-racket-lib/typed-racket/types/prop-ops.rkt
@@ -3,9 +3,10 @@
 (require "../utils/utils.rkt"
          racket/list racket/match
          (prefix-in c: (contract-req))
-         (rep type-rep prop-rep object-rep rep-utils)
+         (rep type-rep prop-rep object-rep values-rep rep-utils)
          (only-in (infer infer) intersect)
-         (types union subtype overlap abbrev tc-result))
+         compatibility/mlist
+         (types union subtype overlap subtract abbrev tc-result))
 
 (provide/cond-contract
   [-and (c:->* () #:rest (c:listof Prop?) Prop?)]
@@ -14,37 +15,85 @@
   [negate-prop (c:-> Prop? Prop?)]
   [complementary? (c:-> Prop? Prop? boolean?)]
   [contradictory? (c:-> Prop? Prop? boolean?)]
-  [add-unconditional-prop-all-args (c:-> Function? Type/c Function?)]
+  [add-unconditional-prop-all-args (c:-> Function? Type? Function?)]
   [add-unconditional-prop (c:-> tc-results/c Prop? tc-results/c)]
   [erase-props (c:-> tc-results/c tc-results/c)]
-  [name-ref=? (c:-> name-ref/c name-ref/c boolean?)])
+  [name-ref=? (c:-> name-ref/c name-ref/c boolean?)]
+  [reduce-propset/type (c:-> PropSet? Type? PropSet?)]
+  [reduce-tc-results/subsumption (c:-> tc-results/c tc-results/c)])
+
+;; reduces a PropSet 'ps' with info from the type 't'
+;; so the two are consistent (e.g. if the type is False,
+;; its true proposition is -ff, etc)
+(define (reduce-propset/type ps t)
+  (cond
+    [(type-equal? -Bottom t) -ff-propset]
+    [(type-equal? -False t) (-PS -ff (PropSet-els ps))]
+    [(not (overlap? t -False)) (-PS (PropSet-thn ps) -ff)]
+    [else ps]))
+
+;; reduce-tc-result/subsumption
+;;
+;; tc-result -> tc-result
+;;
+;; Update the tc-result to incorporate the
+;; return type in the proposition (i.e. if it
+;; can't be False, then the else prop should be -ff)
+(define (reduce-tc-results/subsumption res)
+  (define (update-ps t ps obj)
+    (cond
+      [(Bottom? t) (tc-result t -ff-propset -empty-obj)]
+      [else
+       (define p+ (if ps (PropSet-thn ps) -tt))
+       (define p- (if ps (PropSet-els ps) -tt))
+       (define o (if obj obj -empty-obj))
+       (cond
+         [(or (type-equal? -False t)
+              (FalseProp? p+))
+          (tc-result (intersect t -False) (-PS -ff p-) o)]
+         [(not (overlap? t -False))
+          (tc-result t (-PS p+ -ff) o)]
+         [(prop-equal? -ff p-) (tc-result (subtract t -False) (-PS p+ -ff) o)]
+         [else (tc-result t (-PS p+ p-) o)])]))
+  (match res
+    [(tc-any-results: _) res]
+    [(tc-results: ts pss os)
+     (tc-results (map update-ps ts pss os) #f)]
+    [(tc-results: ts pss os dt db)
+     (tc-results (map update-ps ts pss os) (cons dt db))]
+    [_ (error 'reduce-tc-results/subsumption
+              "invalid res in subst-tc-results: ~a"
+              res)]))
 
-(define (atomic-prop? p)
-  (or (TypeProp? p) (NotTypeProp? p)
-      (TrueProp? p) (FalseProp? p)))
 
 ;; contradictory: Prop? Prop? -> boolean?
 ;; Returns true if the AND of the two props is equivalent to FalseProp
-(define (contradictory? f1 f2)
-  (match* (f1 f2)
-    [((TypeProp: o t1) (NotTypeProp: o t2))
+(define (contradictory? p1 p2)
+  (match* (p1 p2)
+    [((TypeProp: o1 t1) (TypeProp: o2 t2))
+     #:when (object-equal? o1 o2)
+     (not (overlap? t1 t2))]
+    [((TypeProp: o1 t1) (NotTypeProp: o2 t2))
+     #:when (object-equal? o1 o2)
      (subtype t1 t2)]
-    [((NotTypeProp: o t2) (TypeProp: o t1))
+    [((NotTypeProp: o2 t2) (TypeProp: o1 t1))
+     #:when (object-equal? o1 o2)
      (subtype t1 t2)]
-    [((FalseProp:) _) #t]
-    [(_ (FalseProp:)) #t]
-    [(_ _) #f]))
+    [(_ _) (or (prop-equal? p1 -ff)
+               (prop-equal? p2 -ff))]))
 
 ;; complementary: Prop? Prop? -> boolean?
 ;; Returns true if the OR of the two props is equivalent to Top
-(define (complementary? f1 f2)
-  (match* (f1 f2)
-    [((TypeProp: o t1) (NotTypeProp: o t2))
+(define (complementary? p1 p2)
+  (match* (p1 p2)
+    [((TypeProp: o1 t1) (NotTypeProp: o2 t2))
+     #:when (object-equal? o1 o2)
      (subtype t2 t1)]
-    [((NotTypeProp: o t2) (TypeProp: o t1))
+    [((NotTypeProp: o2 t2) (TypeProp: o1 t1))
+     #:when (object-equal? o1 o2)
      (subtype t2 t1)]
-    [((TrueProp:) (TrueProp:)) #t]
-    [(_ _) #f]))
+    [(_ _) (or (prop-equal? p1 -tt)
+               (prop-equal? p2 -tt))]))
 
 (define (name-ref=? a b)
   (or (equal? a b)
@@ -56,73 +105,94 @@
 (define (implies-atomic? p q)
   (match* (p q)
     ;; reflexivity
-    [(p p) #t]
-    ;; trivial prop is always satisfied
-    [(_ (TrueProp:)) #t]
-    ;; ex falso quodlibet
-    [((FalseProp:) _) #t]
+    [(_ _) #:when (or (prop-equal? p q)
+                      (prop-equal? q -tt)
+                      (prop-equal? p -ff)) #t]
     ;; ps ⊆ qs ?
     [((OrProp: ps) (OrProp: qs))
      (and (for/and ([p (in-list ps)])
             (member p qs prop-equal?))
           #t)]
     ;; p ∈ qs ?
-    [(p (OrProp: qs))
-     (and (member p qs prop-equal?) #t)]
+    [(p (OrProp: qs)) (and (member p qs prop-equal?) #t)]
     ;; q ∈ ps ?
-    [((AndProp: ps) q)
-     (and (member q ps prop-equal?) #t)]
+    [((AndProp: ps) q) (and (member q ps prop-equal?) #t)]
     ;; t1 <: t2 ?
-    [((TypeProp: o t1) (TypeProp: o t2))
+    [((TypeProp: o1 t1)
+      (TypeProp: o2 t2))
+     #:when (object-equal? o1 o2)
      (subtype t1 t2)]
     ;; t2 <: t1 ?
-    [((NotTypeProp: o t1) (NotTypeProp: o t2))
+    [((NotTypeProp: o1 t1) (NotTypeProp: o2 t2))
+     #:when (object-equal? o1 o2)
      (subtype t2 t1)]
     ;; t1 ∩ t2 = ∅ ?
-    [((TypeProp: o t1) (NotTypeProp: o t2))
+    [((TypeProp: o1 t1) (NotTypeProp: o2 t2))
+     #:when (object-equal? o1 o2)
      (not (overlap? t1 t2))]
     ;; otherwise we give up
     [(_ _) #f]))
 
-(define (hash-name-ref i)
-  (if (identifier? i) (hash-id i) i))
-
-;; compact : (Listof prop) bool -> (Listof prop)
-;; props : propositions to compress
-;; or? : is this an Or (alternative is And)
+;; intersect-update
+;; (mlist (mcons Object Type)) Object Type -> (mlist (mcons Object Type))
 ;;
-;; This combines all the TypeProps at the same path into one TypeProp. If it is an Or the
-;; combination is done using Un, otherwise, intersect. The reverse is done for NotTypeProps. If it is
-;; an Or this simplifies to -tt if any of the atomic props simplified to -tt, and removes
-;; any -ff values. The reverse is done if this is an And.
-;;
-(define/cond-contract (compact props or?)
-     ((c:listof Prop?) boolean? . c:-> . (c:listof Prop?))
-  (define tf-map (make-hash))
-  (define ntf-map (make-hash))
-  (define (intersect-update dict t1 p)
-    (hash-update! dict p (λ (t2) (intersect t1 t2)) Univ))
-  (define (union-update dict t1 p)
-    (hash-update! dict p (λ (t2) (Un t1 t2)) -Bottom))
+;; updates mutable association list 'dict' entry for 'o' w/ type t
+;; if no entry for 'o' is found, else if some previous type s is present
+;; update the type to t ∩ s
+(define (intersect-update dict o t)
+  (cond
+    [(massq o dict) => (λ (p)
+                         (set-mcdr! p (intersect t (mcdr p)))
+                         dict)]
+    [else (mcons (mcons o t) dict)]))
 
-  (define-values (atomics others) (partition atomic-prop? props))
-  (for ([prop (in-list atomics)])
-    (match prop
-      [(TypeProp: o t1)
-       ((if or? union-update intersect-update) tf-map t1 o) ]
-      [(NotTypeProp: o t1)
-       ((if or? intersect-update union-update) ntf-map t1 o) ]))
-  (define raw-results
-    (append others
-            (for/list ([(k v) (in-hash tf-map)]) (-is-type k v))
-            (for/list ([(k v) (in-hash ntf-map)]) (-not-type k v))))
-  (if or?
-      (if (member -tt raw-results)
-          (list -tt)
-          (filter-not FalseProp? raw-results))
-      (if (member -ff raw-results)
-          (list -ff)
-          (filter-not TrueProp? raw-results))))
+
+;; union-update
+;; (mlist (mcons Object Type)) Object Type -> (mlist (mcons Object Type))
+;;
+;; updates mutable association list 'dict' entry for 'o' w/ type t
+;; if no entry for 'o' is found, else if some previous type s is present
+;; update the type to t ∪ s
+(define (union-update dict o t)
+  (cond
+    [(massq o dict) => (λ (p)
+                         (set-mcdr! p (Un t (mcdr p)))
+                         dict)]
+    [else (mcons (mcons o t) dict)]))
+
+
+;; compact-or-props : (Listof prop) -> (Listof prop)
+;;
+;; This combines all the TypeProps at the same path into one TypeProp with Un, and
+;; all of the NotTypeProps at the same path into one NotTypeProp with intersect.
+;; The Or then simplifies to -tt if any of the atomic props simplified to -tt, and
+;; any values of -ff are removed.
+(define/cond-contract (compact-or-props props)
+  ((c:listof Prop?) . c:-> . (c:listof Prop?))
+  
+  (define-values (pos neg others)
+    (for/fold ([pos '()] [neg '()] [others '()])
+              ([prop (in-list props)])
+      (match prop
+        [(TypeProp: o t)
+         (values (union-update pos o t) neg others)]
+        [(NotTypeProp: o t)
+         (values pos (intersect-update neg o t) others)]
+        [_ (values pos neg (cons prop others))])))
+
+  
+  (let ([pos (for*/list ([p (in-mlist pos)]
+                         [p (in-value (-is-type (mcar p) (mcdr p)))]
+                         #:when (not (FalseProp? p)))
+               p)]
+        [neg (for*/list ([p (in-mlist neg)]
+                         [p (in-value (-not-type (mcar p) (mcdr p)))]
+                         #:when (not (FalseProp? p)))
+               p)])
+    (if (or (member -tt pos prop-equal?)
+            (member -tt neg prop-equal?))
+        (list -tt)
+        (append pos neg others))))
 
 
 
@@ -130,76 +200,94 @@
 ;; Logically inverts a prop.
 (define (negate-prop p)
   (match p
-    [(FalseProp:) -tt]
-    [(TrueProp:) -ff]
+    [(? FalseProp?) -tt]
+    [(? TrueProp?) -ff]
     [(TypeProp: o t) (-not-type o t)]
     [(NotTypeProp: o t) (-is-type o t)]
     [(AndProp: ps) (apply -or (map negate-prop ps))]
     [(OrProp: ps) (apply -and (map negate-prop ps))]))
 
+;; -or
+;; (listof Prop?) -> Prop?
+;;
+;; Smart 'normalizing' constructor for disjunctions. The result
+;; will be a disjunction of only atomic propositions (i.e. a clause
+;; in a CNF formula)
 (define (-or . args)
-  (define mk
-    (case-lambda [() -ff]
-                 [(f) f]
-                 [ps (make-OrProp (sort ps prop<?))]))
   (define (distribute args)
     (define-values (ands others) (partition AndProp? args))
-    (if (null? ands)
-        (apply mk others)
-        (match-let ([(AndProp: elems) (car ands)])
-          (apply -and (for/list ([a (in-list elems)])
-                        (apply -or a (append (cdr ands) others)))))))
+    (match ands
+      [(cons (AndProp: elems) ands)
+       (apply -and (for/list ([elem (in-list elems)])
+                     (apply -or elem (append ands others))))]
+      [_ (make-OrProp others)]))
   (let loop ([ps args] [result null])
-    (if (null? ps)
-        (distribute (compact result #t))
-        (match (car ps)
-          [(and t (TrueProp:)) t]
-          [(OrProp: ps*) (loop (append ps* (cdr ps)) result)]
-          [(FalseProp:) (loop (cdr ps) result)]
-          [t
-           (cond [(for/or ([f (in-list (append (cdr ps) result))])
-                    (complementary? f t))
-                  -tt]
-                 [(let ([t-seq (Rep-seq t)])
-                    (for/or ([f (in-list result)])
-                      (or (= (Rep-seq f) t-seq) (implies-atomic? t f))))
-                  (loop (cdr ps) result)]
-                 [else
-                  (loop (cdr ps) (cons t result))])]))))
+    (match ps
+      [(cons p ps)
+       (match p
+         [(OrProp: ps*) (loop (append ps* ps) result)]
+         [(? FalseProp?) (loop ps result)]
+         [_
+          (let check-loop ([qs ps])
+            (match qs
+              [(cons q qs) (cond
+                             [(complementary? p q) -tt]
+                             [(implies-atomic? p q) (loop ps result)]
+                             [else (check-loop qs)])]
+              [_ #:when (for/or ([q (in-list result)])
+                          (implies-atomic? p q))
+                 (loop ps result)]
+              [_ (loop ps (cons p result))]))])]
+      [_ (distribute (compact-or-props result))])))
 
+;; -and
+;; (listof Prop?) -> Prop?
+;;
+;; Smart 'normalizing' constructor for conjunctions. The result
+;; will be a conjunction of only atomic propositions and disjunctions
+;; (i.e. a CNF proposition)
 (define (-and . args)
-  (define mk
-    (case-lambda [() -tt]
-                 [(f) f]
-                 [ps (make-AndProp (sort ps prop<?))]))
-  (define (flatten-ands ps)
-    (let loop ([ps ps] [results null])
-      (match ps
-        [(list) results]
-        [(cons (AndProp: ps*) ps) (loop ps (append ps* results))]
-        [(cons f ps) (loop ps (cons f results))])))
+  (define-values (pos neg others)
+    (let loop ([args args]
+               [pos '()]
+               [neg '()]
+               [others '()])
+      (match args
+        [(cons arg args)
+         (match arg
+           [(TypeProp: o t) (loop args (intersect-update pos o t) neg others)]
+           [(NotTypeProp: o t) (loop args pos (union-update neg o t) others)]
+           [(AndProp: ps)
+            (let-values ([(pos neg others) (loop ps pos neg others)])
+              (loop args pos neg others))]
+           [_ (loop args pos neg (cons arg others))])]
+        [_ (values pos neg others)])))
   ;; Move all the type props up front as they are the stronger props
-  (define-values (props other-args)
-    (partition (λ (p) (or (TypeProp? p) (NotTypeProp? p)))
-               (flatten-ands (remove-duplicates args eq? #:key Rep-seq))))
-  (define-values (type-props not-type-props)
-    (partition TypeProp? props))
-  (let loop ([ps (append type-props not-type-props other-args)] [result null])
-    (if (null? ps)
-        (apply mk (compact result #f))
-        (match (car ps)
-          [(and t (FalseProp:)) t]
-          [(TrueProp:) (loop (cdr ps) result)]
-          [t (cond [(for/or ([f (in-list (append (cdr ps) result))])
-                      (contradictory? f t))
-                    -ff]
-                   [(let ([t-seq (Rep-seq t)])
-                      (for/or ([f (in-list result)])
-                        (or (= (Rep-seq f) t-seq)
-                            (implies-atomic? f t))))
-                    (loop (cdr ps) result)]
-                   [else
-                    (loop (cdr ps) (cons t result))])]))))
+  (let loop ([ps (append (for*/list ([p (in-mlist pos)]
+                                     [p (in-value (-is-type (mcar p) (mcdr p)))]
+                                     #:when (not (prop-equal? -tt p)))
+                           p)
+                         (for*/list ([p (in-mlist neg)]
+                                     [p (in-value (-not-type (mcar p) (mcdr p)))]
+                                     #:when (not (prop-equal? -tt p)))
+                           p)
+                         others)]
+             [result null])
+    (match ps
+      [(cons p ps)
+       (cond
+         [(let check-loop ([qs ps])
+            (match qs
+              [(cons q qs) (cond
+                             [(contradictory? p q) -ff]
+                             [(implies-atomic? q p) (loop ps result)]
+                             [else (check-loop qs)])]
+              [_ #f]))]
+         [(for/or ([q (in-list result)])
+            (implies-atomic? q p))
+          (loop ps result)]
+         [else (loop ps (cons p result))])]
+      [_ (make-AndProp result)])))
 
 ;; add-unconditional-prop: tc-results? Prop? -> tc-results?
 ;; Ands the given proposition to the props in the tc-results.
@@ -209,14 +297,17 @@
     [(tc-any-results: f) (tc-any-results (-and prop f))]
     [(tc-results: ts (list (PropSet: ps+ ps-) ...) os)
      (ret ts
-          (for/list ([f+ ps+] [f- ps-])
+          (for/list ([f+ (in-list ps+)]
+                     [f- (in-list ps-)])
             (-PS (-and prop f+) (-and prop f-)))
           os)]
     [(tc-results: ts (list (PropSet: ps+ ps-) ...) os dty dbound)
      (ret ts
           (for/list ([f+ ps+] [f- ps-])
             (-PS (-and prop f+) (-and prop f-)))
-          os)]))
+          os
+          dty
+          dbound)]))
 
 
 ;; ands the given type prop to both sides of the given arr for each argument
@@ -254,4 +345,4 @@
      (ret ts
           empties
           empties
-          dty dbound)]))
+          dty dbound)]))
\ No newline at end of file
diff --git a/typed-racket-lib/typed-racket/types/resolve.rkt b/typed-racket-lib/typed-racket/types/resolve.rkt
index 1d79a291..e4dd1d25 100644
--- a/typed-racket-lib/typed-racket/types/resolve.rkt
+++ b/typed-racket-lib/typed-racket/types/resolve.rkt
@@ -9,11 +9,11 @@
          (contract-req)
          racket/format)
 
-(provide resolve-name resolve-app needs-resolving?
+(provide resolve-name resolve-app resolvable?
          resolve resolve-app-check-error
          resolver-cache-remove!
          current-check-polymorphic-recursion)
-(provide/cond-contract [resolve-once (Type/c . -> . (or/c Type/c #f))])
+(provide/cond-contract [resolve-once (Type? . -> . (or/c Type? #f))])
 
 (define-struct poly (name vars) #:prefab)
 
@@ -31,8 +31,7 @@
 
 (define (resolve-name t)
   (match t
-    [(Name/simple: n) (let ([t (lookup-type-name n)])
-                        (if (Type/c? t) t #f))]
+    [(Name/simple: (app lookup-type-name t)) (if (Type? t) t #f)]
     [_ (int-err "resolve-name: not a name ~a" t)]))
 
 (define already-resolving? (make-parameter #f))
@@ -48,77 +47,69 @@
                        "\n  expected: " n
                        "\n  given: " (length rands)
                        "\n  arguments...: " rands)))]
-      [(Name/struct: n)
-       (when (and (current-poly-struct)
-                  (free-identifier=? n (poly-name (current-poly-struct))))
-        (define num-rands (length rands))
-        (define num-poly (length (poly-vars (current-poly-struct))))
-        ;; check arity of constructor first
-        (if (= num-rands num-poly)
-            (when (not (or (ormap Error? rands)
-                           (andmap type-equal? rands
-                                   (poly-vars (current-poly-struct)))))
-                  (tc-error (~a "structure type constructor applied to non-regular arguments"
-                                "\n  type: " rator
-                                "\n  arguments...: " rands)))
-            (tc-error (~a "wrong number of arguments to structure type constructor"
-                          "\n  type: " rator
-                          "\n  expected: " num-poly
-                          "\n  given: " num-rands
-                          "\n  arguments...: " rands))))]
-      [(Name: name-id num-args #f)
-       (cond [(> num-args 0)
-              (define num-rands (length rands))
-              (unless (= num-rands num-args)
-                (tc-error (~a "wrong number of arguments to polymorphic type"
-                              "\n  type: " rator
-                              "\n  expected: " num-args
-                              "\n  given: " num-rands
-                              "\n  arguments...: " rands)))
-              ;; Does not allow polymorphic recursion since both type
-              ;; inference and equirecursive subtyping for polymorphic
-              ;; recursion are difficult.
-              ;;
-              ;; Type inference is known to be undecidable in general, but
-              ;; practical algorithms do exist[1] that do not diverge in
-              ;; practice.
-              ;;
-              ;; It is possible that equirecursive subtyping with polymorphic
-              ;; recursion is as difficult as equivalence of DPDAs[2], which is
-              ;; known to be decidable[3], but good algorithms may not exist.
-              ;;
-              ;; [1] Fritz Henglein. "Type inference with polymorphic recursion"
-              ;;     TOPLAS 1993
-              ;; [2] Marvin Solomon. "Type definitions with parameters"
-              ;;     POPL 1978
-              ;; [3] Geraud Senizergues.
-              ;;     "L(A)=L(B)? decidability results from complete formal systems"
-              ;;     TCS 2001.
-              ;;
-              ;; check-argument : Type Id -> Void
-              ;; Check argument to make sure there's no polymorphic recursion
-              (define (check-argument given-type arg-name)
-                (define ok?
-                  (or (F? given-type)
-                      (not (member (syntax-e arg-name) (fv given-type)))))
-                (unless ok?
-                  (tc-error (~a "recursive type cannot be applied at a"
-                                " different type in its recursive invocation"
-                                "\n  type: " rator
-                                "\n  new argument name: " arg-name
-                                "\n  new argument: " given-type
-                                "\n  new arguments...: " rands))))
-              (match (current-check-polymorphic-recursion)
-                [`#s(poly-rec-info ,same-component? ,current-vars)
-                 #:when (same-component? name-id)
-                 (for* ([rand (in-list rands)]
-                        [var (in-list current-vars)])
-                   (check-argument rand var))]
-                [_ (void)])]
-             [else
-              (tc-error (~a "type cannot be applied"
-                            "\n  type: " rator
-                            "\n  arguments...: " rands))])]
+      [(Name/struct: n) #:when (and (current-poly-struct)
+                                    (free-identifier=? n (poly-name (current-poly-struct))))
+       (define poly-num (length (poly-vars (current-poly-struct))))
+       (if (= poly-num (length rands))
+           (when (not (or (ormap Error? rands)
+                          (andmap type-equal? rands
+                                  (poly-vars (current-poly-struct)))))
+             (tc-error (~a "structure type constructor applied to non-regular arguments"
+                           "\n  type: " rator
+                           "\n  arguments...: " rands)))
+           (tc-error (~a "wrong number of arguments to structure type constructor"
+                         "\n  type: " rator
+                         "\n  expected: " poly-num
+                         "\n  given: " (length rands)
+                         "\n  arguments...: " rands)))]
+      [(Name: name-id num-args _) #:when (> num-args 0)
+       (define num-rands (length rands))
+       (unless (= num-rands num-args)
+         (tc-error (~a "wrong number of arguments to polymorphic type"
+                       "\n  type: " rator
+                       "\n  expected: " num-args
+                       "\n  given: " num-rands
+                       "\n  arguments...: " rands)))
+       ;; Does not allow polymorphic recursion since both type
+       ;; inference and equirecursive subtyping for polymorphic
+       ;; recursion are difficult.
+       ;;
+       ;; Type inference is known to be undecidable in general, but
+       ;; practical algorithms do exist[1] that do not diverge in
+       ;; practice.
+       ;;
+       ;; It is possible that equirecursive subtyping with polymorphic
+       ;; recursion is as difficult as equivalence of DPDAs[2], which is
+       ;; known to be decidable[3], but good algorithms may not exist.
+       ;;
+       ;; [1] Fritz Henglein. "Type inference with polymorphic recursion"
+       ;;     TOPLAS 1993
+       ;; [2] Marvin Solomon. "Type definitions with parameters"
+       ;;     POPL 1978
+       ;; [3] Geraud Senizergues.
+       ;;     "L(A)=L(B)? decidability results from complete formal systems"
+       ;;     TCS 2001.
+       ;;
+       ;; check-argument : Type Id -> Void
+       ;; Check argument to make sure there's no polymorphic recursion
+       (define (check-argument given-type arg-name)
+         (define ok?
+           (or (F? given-type)
+               (not (member (syntax-e arg-name) (fv given-type)))))
+         (unless ok?
+           (tc-error (~a "recursive type cannot be applied at a"
+                         " different type in its recursive invocation"
+                         "\n  type: " rator
+                         "\n  new argument name: " arg-name
+                         "\n  new argument: " given-type
+                         "\n  new arguments...: " rands))))
+       (match (current-check-polymorphic-recursion)
+         [`#s(poly-rec-info ,same-component? ,current-vars)
+          #:when (same-component? name-id)
+          (for* ([rand (in-list rands)]
+                 [var (in-list current-vars)])
+            (check-argument rand var))]
+         [_ (void)])]
       [(Mu: _ _) (void)]
       [(App: _ _ _) (void)]
       [(Error:) (void)]
@@ -143,23 +134,17 @@
                        "\n  arguments: " rands))])))
 
 
-(define (needs-resolving? t)
-  (or (Mu? t) (App? t) (Name? t)))
-
-(define resolver-cache (make-hasheq))
+(define resolver-cache (make-hash))
 
 (define (resolve-once t)
-  (define seq (Rep-seq t))
-  (define r (hash-ref resolver-cache seq #f))
+  (define r (hash-ref resolver-cache t #f))
   (or r
       (let ([r* (match t
                   [(Mu: _ _) (unfold t)]
-                  [(App: r r* s)
-                   (resolve-app r r* s)]
+                  [(App: r r* s) (resolve-app r r* s)]
                   [(? Name?) (resolve-name t)])])
-        (when (and r*
-                   (not (currently-subtyping?)))
-          (hash-set! resolver-cache seq r*))
+        (when (and r* (not (currently-subtyping?)))
+          (hash-set! resolver-cache t r*))
         r*)))
 
 ;; resolver-cache-remove! : (Listof Type) -> Void
@@ -168,15 +153,12 @@
 ;; undo certain resolutions.
 (define (resolver-cache-remove! keys)
   (for ([key (in-list keys)])
-    (hash-remove! resolver-cache (Rep-seq key))))
+    (hash-remove! resolver-cache key)))
 
 ;; Repeatedly unfolds Mu, App, and Name constructors until the top type
 ;; constructor is not one of them.
-;; Type/c? -> Type/c?
+;; Type? -> Type?
 (define (resolve t)
-  (let loop ((t t))
-    (if (needs-resolving? t)
-        (loop (resolve-once t))
-        t)))
-
-;(trace resolve-app)
+  (if (resolvable? t)
+      (resolve (resolve-once t))
+      t))
diff --git a/typed-racket-lib/typed-racket/types/structural.rkt b/typed-racket-lib/typed-racket/types/structural.rkt
deleted file mode 100644
index c00c1e6d..00000000
--- a/typed-racket-lib/typed-racket/types/structural.rkt
+++ /dev/null
@@ -1,137 +0,0 @@
-
-#lang racket/base
-
-;; Module for providing recursive operations over types when the operation doesn't care about the
-;; type constructor.
-
-;; This file is meant to implement more general versions of type-case.
-;; Currently supported
-;; * Trivial type constructors (only have Rep? or (listof Rep?) fields)
-;; * A variance aware traversal of a Rep? with the return value having the same type constructor as
-;;    the input.
-;; To be added
-;; * Support for type constructors with non Rep? fields
-;; * Support for objects and filters
-;; * Support for smart constructors for the return value
-;; * Support for return values that are not Rep?
-;; * Parallel traversal of two types
-
-(require
-  "../utils/utils.rkt"
-  racket/match
-  (rep type-rep)
-  (for-syntax
-    racket/base
-    syntax/parse
-    racket/syntax))
-(provide
-  structural?
-  structural-map)
-
-
-(define-for-syntax structural-reps
-  #'([BoxTop ()]
-     [ChannelTop ()]
-     [Async-ChannelTop ()]
-     [ClassTop ()]
-     [UnitTop ()]
-     [Continuation-Mark-KeyTop ()]
-     [Error ()]
-     [HashtableTop ()]
-     [MPairTop ()]
-     [Prompt-TagTop ()]
-     [StructTypeTop ()]
-     [ThreadCellTop ()]
-     [Univ ()]
-     [VectorTop ()]
-
-     [CustodianBox (#:co)]
-     [Ephemeron (#:co)]
-     [Evt (#:co)]
-     [Future (#:co)]
-     [Instance (#:co)]
-     [Promise (#:co)]
-     [Set (#:co)]
-     [StructTop (#:co)]
-     [StructType (#:co)]
-     [Syntax (#:co)]
-     [Pair (#:co #:co)]
-     [Sequence ((#:listof #:co))]
-     [Function ((#:listof #:co))]
-
-     [Param (#:contra #:co)]
-
-     [Continuation-Mark-Keyof (#:inv)]
-     [Box (#:inv)]
-     [Channel (#:inv)]
-     [Async-Channel (#:inv)]
-     [ThreadCell (#:inv)]
-     [Vector (#:inv)]
-     [Hashtable (#:inv #:inv)]
-     [MPair (#:inv #:inv)]
-     [Prompt-Tagof (#:inv #:inv)]
-     [HeterogeneousVector ((#:listof #:inv))]
-
-     ;; Non Types
-     [Result (#:co #:co #:co)]
-     [Values ((#:listof #:co))]
-     [AnyValues (#:co)]))
-
-(begin-for-syntax
-  (define-syntax-class type-name
-    #:attributes (pred? matcher: maker)
-    (pattern t:id
-      #:with pred? (format-id #'t "~a?" #'t)
-      #:with matcher: (format-id #'t "~a:" #'t)
-      #:with maker (format-id #'t "make-~a" #'t))))
-
-(begin-for-syntax
-  (define-syntax-class type-variance
-    #:attributes (sym)
-    (pattern #:co #:with sym 'co)
-    (pattern #:inv #:with sym 'inv)
-    (pattern #:contra #:with sym 'contra))
-
-  (define-syntax-class type-field
-    (pattern var:type-variance)
-    (pattern (#:listof var:type-variance))))
-
-
-
-(define-syntax (gen-structural? stx)
-  (syntax-parse structural-reps
-   [([type:type-name (field:type-field ...)] ...)
-    #'(lambda (t)
-        (or (type.pred? t) ...))]))
-
-;; Returns true if the type/prop/object supports structural operations.
-(define structural? (gen-structural?))
-
-
-(define-syntax (gen-structural-map stx)
-  (syntax-parse stx
-   [(_ input-type:id recur-f:id)
-    (define-syntax-class type-field*
-      #:attributes (recur)
-      (pattern var:type-variance
-        #:with recur #'(λ (t) (recur-f t 'var.sym)))
-      (pattern (#:listof var:type-variance)
-        #:with recur #'(λ (ts) (for/list ([t (in-list ts)]) (recur-f t 'var.sym)))))
-
-    (define-syntax-class type-clause
-      #:attributes (match-clause)
-      (pattern [type:type-name (field:type-field* ...)]
-        #:with (field-pat ...) (generate-temporaries #'(field ...))
-        #:with match-clause
-          #'[(type.matcher: field-pat ...)
-             (type.maker (field.recur field-pat) ...)]))
-
-    (syntax-parse structural-reps
-     [(:type-clause ...)
-       #'(match input-type match-clause ...)])]))
-
-;; Rep? (-> Rep? (or/c 'co 'contra 'inv) Rep?) -> Rep?
-;; Calls `f` on each sub-type with the corresponding variance of the sub-type and combines the results
-;; using the type constructor of the input type
-(define (structural-map t f)
-  (gen-structural-map t f))
diff --git a/typed-racket-lib/typed-racket/types/substitute.rkt b/typed-racket-lib/typed-racket/types/substitute.rkt
index d3b57524..3beab6f1 100644
--- a/typed-racket-lib/typed-racket/types/substitute.rkt
+++ b/typed-racket-lib/typed-racket/types/substitute.rkt
@@ -5,9 +5,9 @@
          racket/lazy-require
          (contract-req)
          (only-in (types base-abbrev) -Tuple* -lst -Null -result ManyUniv)
-         (rep type-rep rep-utils)
+         (rep type-rep values-rep rep-utils)
          (utils tc-utils)
-         (rep free-variance)
+         (rep rep-utils free-variance)
          (env tvar-env))
 (lazy-require ("union.rkt" (Un)))
 
@@ -18,18 +18,18 @@
 (provide-for-cond-contract substitution/c)
 
 (define-struct/cond-contract subst-rhs () #:transparent)
-(define-struct/cond-contract (t-subst subst-rhs) ([type Type/c]) #:transparent)
-(define-struct/cond-contract (i-subst subst-rhs) ([types (listof Type/c)]) #:transparent)
-(define-struct/cond-contract (i-subst/starred subst-rhs) ([types (listof Type/c)] [starred Type/c]) #:transparent)
-(define-struct/cond-contract (i-subst/dotted subst-rhs) ([types (listof Type/c)] [dty Type/c] [dbound symbol?]) #:transparent)
+(define-struct/cond-contract (t-subst subst-rhs) ([type Rep?]) #:transparent)
+(define-struct/cond-contract (i-subst subst-rhs) ([types (listof Rep?)]) #:transparent)
+(define-struct/cond-contract (i-subst/starred subst-rhs) ([types (listof Rep?)] [starred Rep?]) #:transparent)
+(define-struct/cond-contract (i-subst/dotted subst-rhs) ([types (listof Rep?)] [dty Rep?] [dbound symbol?]) #:transparent)
 
 (define-for-cond-contract substitution/c (hash/c symbol? subst-rhs? #:immutable #t))
-(define-for-cond-contract simple-substitution/c (hash/c symbol? Type/c #:immutable #t))
+(define-for-cond-contract simple-substitution/c (hash/c symbol? Rep? #:immutable #t))
 
 (define (subst v t e) (substitute t v e))
 
 (define/cond-contract (make-simple-substitution vs ts)
-  (([vs (listof symbol?)] [ts (listof Type/c)]) ()
+  (([vs (listof symbol?)] [ts (listof Rep?)]) ()
    #:pre (vs ts) (= (length vs) (length ts))
     . ->i . [_ substitution/c])
   (for/hash ([v (in-list vs)] [t (in-list ts)])
@@ -39,138 +39,150 @@
 
 ;; substitute-many : Hash[Name,Type] Type -> Type
 (define/cond-contract (substitute-many subst target)
-  (simple-substitution/c Type? . -> .  Type?)
-  (define (sb t) (substitute-many subst t))
+  (simple-substitution/c Rep? . -> .  Rep?)
   (define names (hash-keys subst))
-  (define fvs (free-vars* target))
-  (if (ormap (lambda (name) (free-vars-has-key? fvs name)) names)
-      (type-case (#:Type sb #:Prop (sub-f sb) #:Object (sub-o sb))
-                 target
-                 [#:Union tys (apply Un (map sb tys))]
-                 [#:F name (hash-ref subst name target)]
-                 [#:arr dom rng rest drest kws
-                        (cond
-                          [(and (pair? drest)
-                                (ormap (λ (name)
-                                          (and (equal? name (cdr drest))
-                                               (not (bound-tvar? name))
-                                               name))
-                                       names))
-                           =>
-                           (lambda (name)
-                             (int-err "substitute used on ... variable ~a in type ~a" name target))]
-                          [else
-                           (make-arr (map sb dom)
-                                     (sb rng)
-                                     (and rest (sb rest))
-                                     (and drest (cons (sb (car drest)) (cdr drest)))
-                                     (map sb kws))])]
-                 [#:ValuesDots types dty dbound
-                               (cond
-                                 [(ormap (lambda (x) (and (equal? dbound x) (not (bound-tvar? x)))) names) =>
-                                  (lambda (name)
-                                    (int-err "substitute used on ... variable ~a in type ~a" name target))]
-                                 [else (make-ValuesDots (map sb types) (sb dty) dbound)])]
-                 [#:ListDots dty dbound
-                             (cond
-                               [(ormap (lambda (x) (and (equal? dbound x) (not (bound-tvar? x)))) names) =>
-                                (lambda (name)
-                                  (int-err "substitute used on ... variable ~a in type ~a" name target))]
-                               [else (make-ListDots (sb dty) dbound)])])
-      target))
+  (let sub ([target target])
+    (match target
+      [(F: name) (hash-ref subst name target)]
+      [(arr: dom rng rest drest kws)
+       (cond
+         [(and (pair? drest)
+               (ormap (λ (name) (and (equal? name (cdr drest))
+                                     (not (bound-tvar? name))
+                                     name))
+                      names))
+          =>
+          (λ (name)
+            (int-err "substitute used on ... variable ~a in type ~a" name target))]
+         [else
+          (make-arr (map sub dom)
+                    (sub rng)
+                    (and rest (sub rest))
+                    (and drest (cons (sub (car drest)) (cdr drest)))
+                    (map sub kws))])]
+      [(ValuesDots: types dty dbound)
+       (cond
+         [(for/or ([name (in-list names)])
+            (and (equal? dbound name)
+                 (not (bound-tvar? name))))
+          =>
+          (λ (name)
+            (int-err "substitute used on ... variable ~a in type ~a" name target))]
+         [else (make-ValuesDots (map sub types) (sub dty) dbound)])]
+      [(ListDots: dty dbound)
+       (cond
+         [(for/or ([name (in-list names)])
+            (and (equal? dbound name)
+                 (not (bound-tvar? name))))
+          =>
+          (λ (name)
+            (int-err "substitute used on ... variable ~a in type ~a" name target))]
+         [else (make-ListDots (sub dty) dbound)])]
+      [_ (Rep-fold sub target)])))
+
 
 
 ;; substitute : Type Name Type -> Type
 (define/cond-contract (substitute image name target)
-  (Type/c symbol? Type? . -> . Type?)
+  (Rep? symbol? Rep? . -> . Rep?)
   (substitute-many (hash name image) target))
 
 ;; implements angle bracket substitution from the formalism
 ;; substitute-dots : Listof[Type] Option[type] Name Type -> Type
+;; implements angle bracket substitution from the formalism (TODO what formalism?)
+;; substitute-dots : Listof[Type] Option[type] Name Type -> Type
 (define/cond-contract (substitute-dots images rimage name target)
-  ((listof Type/c) (or/c #f Type/c) symbol? Type?  . -> . Type?)
-  (define (sb t) (substitute-dots images rimage name t))
-  (if (or (set-member? (free-vars-names (free-idxs* target)) name)
-          (set-member? (free-vars-names (free-vars* target)) name))
-      (type-case (#:Type sb #:Prop (sub-f sb)) target
-                 [#:ListDots dty dbound
-                             (if (eq? name dbound)
-                                 ;; We need to recur first, just to expand out any dotted usages of this.
-                                 (let ([expanded (sb dty)])
-                                   (for/fold ([t (if rimage (-lst rimage) -Null)])
-                                     ([img (in-list (reverse images))])
-                                     (make-Pair (substitute img name expanded) t)))
-                                 (make-ListDots (sb dty) dbound))]
-                 [#:ValuesDots types dty dbound
-                               (if (eq? name dbound)
-                                   (if rimage
-                                       ManyUniv
-                                       (make-Values
-                                        (append
-                                         (map sb types)
-                                         ;; We need to recur first, just to expand out any dotted usages of this.
-                                         (let ([expanded (sb dty)])
-                                           (for/list ([img (in-list images)])
-                                             (-result (substitute img name expanded)))))))
-                                   (make-ValuesDots (map sb types) (sb dty) dbound))]
-                 [#:arr dom rng rest drest kws
-                        (if (and (pair? drest)
-                                 (eq? name (cdr drest)))
-                            (make-arr (append
-                                       (map sb dom)
-                                       ;; We need to recur first, just to expand out any dotted usages of this.
-                                       (let ([expanded (sb (car drest))])
-                                         (map (lambda (img) (substitute img name expanded)) images)))
-                                      (sb rng)
-                                      rimage
-                                      #f
-                                      (map sb kws))
-                            (make-arr (map sb dom)
-                                      (sb rng)
-                                      (and rest (sb rest))
-                                      (and drest (cons (sb (car drest)) (cdr drest)))
-                                      (map sb kws)))])
-      target))
+  ((listof Rep?) (or/c #f Rep?) symbol? Rep?  . -> . Rep?)
+  (let sub ([target target])
+    (match target
+      [(ListDots: dty dbound)
+       (if (eq? name dbound)
+           ;; We need to recur first, just to expand out any dotted usages of this.
+           (let ([expanded (sub dty)])
+             (for/fold ([t (if rimage (-lst rimage) -Null)])
+                       ([img (in-list (reverse images))])
+               (make-Pair (substitute img name expanded) t)))
+           (make-ListDots (sub dty) dbound))]
+      [(ValuesDots: types dty dbound)
+       (cond
+         [(eq? name dbound)
+          (cond
+            [rimage ManyUniv]
+            [else
+             (make-Values
+              (append
+               (map sub types)
+               ;; We need to recur first, just to expand out any dotted usages of this.
+               (let ([expanded (sub dty)])
+                 (for/list ([img (in-list images)])
+                   (-result (substitute img name expanded))))))])]
+         [else (make-ValuesDots (map sub types) (sub dty) dbound)])]
+      [(arr: dom rng rest drest kws)
+       (cond
+         [(and (pair? drest)
+               (eq? name (cdr drest)))
+          (make-arr (append
+                     (map sub dom)
+                     ;; We need to recur first, just to expand out any dotted usages of this.
+                     (let ([expanded (sub (car drest))])
+                       (map (λ (img) (substitute img name expanded))
+                            images)))
+                    (sub rng)
+                    rimage
+                    #f
+                    (map sub kws))]
+         [else
+          (make-arr (map sub dom)
+                    (sub rng)
+                    (and rest (sub rest))
+                    (and drest (cons (sub (car drest)) (cdr drest)))
+                    (map sub kws))])]
+      [_ (Rep-fold sub target)])))
 
 ;; implements curly brace substitution from the formalism, with the addition
 ;; that a substitution can include fixed args in addition to a different dotted arg
 ;; substitute-dotted : Listof[Type] Type Name Name Type -> Type
 (define (substitute-dotted pre-image image image-bound name target)
-  (define (sb t) (substitute-dotted pre-image image image-bound name t))
-  ;; We do a quick check on the free variables to see if we can short circuit the substitution
-  (if (or (set-member? (free-vars-names (free-idxs* target)) name)
-          (set-member? (free-vars-names (free-vars* target)) name))
-      (type-case (#:Type sb #:Prop (sub-f sb))
-                 target
-                 [#:ValuesDots types dty dbound
-                               (let ([extra-types (if (eq? name dbound) pre-image null)])
-                                 (make-ValuesDots (append (map sb types) (map -result extra-types))
-                                                  (sb dty)
-                                                  (if (eq? name dbound) image-bound dbound)))]
-                 [#:ListDots dty dbound
-                             (-Tuple*
-                               (if (eq? name dbound) pre-image null)
-                               (make-ListDots (sb dty)
-                                              (if (eq? name dbound) image-bound dbound)))]
-                 [#:F name*
-                      (if (eq? name* name)
-                          image
-                          target)]
-                 [#:arr dom rng rest drest kws
-                        (let ([extra-types (if (and drest (eq? name (cdr drest))) pre-image null)])
-                          (make-arr (append (map sb dom) extra-types)
-                                    (sb rng)
-                                    (and rest (sb rest))
-                                    (and drest
-                                         (cons (substitute image (cdr drest) (sb (car drest)))
-                                               (if (eq? name (cdr drest)) image-bound (cdr drest))))
-                                    (map sb kws)))])
-       target))
+  (let sub ([target target])
+    (match target
+      [(ValuesDots: types dty dbound)
+       (let ([extra-types (cond
+                            [(eq? name dbound) pre-image]
+                            [else null])])
+         (make-ValuesDots (append (map sub types) (map -result extra-types))
+                          (sub dty)
+                          (cond
+                            [(eq? name dbound) image-bound]
+                            [else dbound])))]
+      [(ListDots: dty dbound)
+       (-Tuple*
+        (if (eq? name dbound) pre-image null)
+        (make-ListDots (sub dty)
+                       (if (eq? name dbound) image-bound dbound)))]
+      [(F: name*)
+       (cond [(eq? name* name) image]
+             [else target])]
+      [(arr: dom rng rest drest kws)
+       (let ([extra-types (cond
+                            [(and drest (eq? name (cdr drest)))
+                             pre-image]
+                            [else null])])
+         (make-arr (append (map sub dom) extra-types)
+                   (sub rng)
+                   (and rest (sub rest))
+                   (and drest
+                        (cons (substitute image (cdr drest) (sub (car drest)))
+                              (cond
+                                [(eq? name (cdr drest))
+                                 image-bound]
+                                [else (cdr drest)])))
+                   (map sub kws)))]
+      [_ (Rep-fold sub target)])))
 
 ;; substitute many variables
 ;; subst-all : substitution/c Type -> Type
 (define/cond-contract (subst-all s ty)
-  (substitution/c Type? . -> . Type?)
+  (substitution/c Rep? . -> . Rep?)
 
   (define t-substs
     (for/fold ([acc (hash)]) ([(v r) (in-hash s)])
diff --git a/typed-racket-lib/typed-racket/types/remove.rkt b/typed-racket-lib/typed-racket/types/subtract.rkt
similarity index 60%
rename from typed-racket-lib/typed-racket/types/remove.rkt
rename to typed-racket-lib/typed-racket/types/subtract.rkt
index ff7cd61f..ec4c1dd7 100644
--- a/typed-racket-lib/typed-racket/types/remove.rkt
+++ b/typed-racket-lib/typed-racket/types/subtract.rkt
@@ -1,31 +1,32 @@
 #lang racket/base
 
 (require "../utils/utils.rkt"
-         (rep type-rep rep-utils)
+         (rep type-rep rep-utils type-mask)
          (types abbrev union subtype resolve utils)
          racket/match racket/set)
 
-(provide remove)
+(provide subtract)
 
 
-;; remove
+;; subtract
 ;; Type Type -> Type
 ;; conservatively calculates set subtraction
 ;; between the types (i.e. t - s)
-(define (remove t s)
+(define (subtract t s)
   (define result
-    (let rem ([t t])
+    (let sub ([t t])
       (match t
+        [_ #:when (disjoint-masks? (Type-mask t) (Type-mask s)) t]
         [_ #:when (subtype t s) -Bottom]
         [(or (App: _ _ _) (? Name?))
          ;; must be different, since they're not subtypes
          ;; and n must refer to a distinct struct type
          t]
-        [(Union: elems) (apply Un (map rem elems))]
+        [(Union: elems) (apply Un (map sub elems))]
         [(Intersection: ts)
-         (apply -unsafe-intersect (set-map ts rem))]
-        [(? Mu?) (rem (unfold t))]
-        [(Poly: vs b) (make-Poly vs (rem b))]
+         (apply -unsafe-intersect (set-map ts sub))]
+        [(? Mu?) (sub (unfold t))]
+        [(Poly: vs b) (make-Poly vs (sub b))]
         [_ t])))
   (cond
     [(subtype t result) t]
diff --git a/typed-racket-lib/typed-racket/types/subtype.rkt b/typed-racket-lib/typed-racket/types/subtype.rkt
index fcf14df6..7a83058b 100644
--- a/typed-racket-lib/typed-racket/types/subtype.rkt
+++ b/typed-racket-lib/typed-racket/types/subtype.rkt
@@ -1,47 +1,97 @@
 #lang racket/base
 (require (except-in "../utils/utils.rkt" infer)
          racket/match racket/function racket/lazy-require
-         racket/list racket/set
-         (prefix-in c: (contract-req))
-         (rep type-rep prop-rep object-rep rep-utils)
+         racket/list
+         (contract-req)
+         (rep type-rep prop-rep object-rep
+              core-rep type-mask values-rep rep-utils
+              free-variance)
          (utils tc-utils early-return)
-         (types utils resolve base-abbrev match-expanders
-                numeric-tower substitute current-seen prefab signatures)
-         (for-syntax racket/base syntax/parse racket/sequence))
+         (types utils resolve match-expanders current-seen
+                numeric-tower substitute prefab signatures)
+         (for-syntax racket/base syntax/parse racket/sequence)
+         (rename-in "base-abbrev.rkt"
+                    [-> t->]
+                    [->* t->*]))
 
 (lazy-require
   ("union.rkt" (Un))
   ("../infer/infer.rkt" (infer))
   ("../typecheck/tc-subst.rkt" (restrict-values)))
 
-(define subtype-cache (make-hash))
 
-(define-syntax-rule (handle-failure e)
-  e)
+(provide/cond-contract
+ [subtype (-> Type? Type? boolean?)]
+ [subresult (-> Result? Result? boolean?)]
+ [subval (-> SomeValues? SomeValues? boolean?)]
+ [type-compare? (-> (or/c Type? SomeValues?) (or/c Type? SomeValues?) boolean?)]
+ [subtypes (-> (listof Type?) (listof Type?) boolean?)]
+ [subtypes/varargs (-> (listof Type?) (listof Type?) (or/c Type? #f) boolean?)])
 
-;; is s a subtype of t?
+
+;;************************************************************
+;; Public Interface to Subtyping
+;;************************************************************
+
+;; is t1 a subtype of t2?
 ;; type type -> boolean
-(define/cond-contract (subtype s t)
-  (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)
-  (and (subtype* (current-seen) s t) #t))
+(define (subtype t1 t2)
+  (define res (and (subtype* (seen) t1 t2) #t))
+  res)
+
+
+;; is v1 a subval of v2?
+;; SomeValue? SomeValue -> boolean
+;; (i.e. subtyping on SomeValues)
+(define (subval v1 v2)
+  (and (subval* (seen) v1 v2) #t))
+
+;; are t1 and t2 equivalent types (w.r.t. subtyping)
+(define (type-compare? t1 t2)
+  (or (equal? t1 t2) (and (subtype t1 t2)
+                          (subtype t2 t1))))
 
 ;; are all the s's subtypes of all the t's?
 ;; [type] [type] -> boolean
-(define (subtypes s t) (and (subtypes* (current-seen) s t) #t))
+(define (subtypes t1s t2s) (and (subtypes* (seen) t1s t2s) #t))
+
+(define (subresult r1 r2) (and (subresult* (seen) r1 r2) #t))
+
+;;************************************************************
+;; General Subtyping Helpers
+;;************************************************************
+
 
 ;; check subtyping for two lists of types
 ;; List[(cons Number Number)] listof[type] listof[type] -> Opt[List[(cons Number Number)]]
-(define (subtypes* A ss ts)
-  (cond [(and (null? ss) (null? ts) A)]
-        [(or (null? ss) (null? ts)) #f]
-        [(subtype* A (car ss) (car ts))
+(define (subtypes* A t1s t2s)
+  (cond [(and (null? t1s) (null? t2s) A)]
+        [(or (null? t1s) (null? t2s)) #f]
+        [(subtype* A (car t1s) (car t2s))
          =>
-         (lambda (A*) (subtypes* A* (cdr ss) (cdr ts)))]
+         (λ (A*) (subtypes* A* (cdr t1s) (cdr t2s)))]
+        [else #f]))
+
+(define (subresults* A rs1 rs2)
+  (cond [(and (null? rs1) (null? rs2) A)]
+        [(or (null? rs1) (null? rs2)) #f]
+        [(subresult* A (car rs1) (car rs2))
+         =>
+         (λ (A*) (subresults* A* (cdr rs1) (cdr rs2)))]
+        [else #f]))
+
+(define (subvals* A vs1 vs2)
+  (cond [(and (null? vs1) (null? vs2)) A]
+        [(or (null? vs1) (null? vs2)) #f]
+        [(subval* A (car vs1) (car vs2))
+         =>
+         (λ (A*) (subvals* A* (cdr vs1) (cdr vs2)))]
         [else #f]))
 
 ;; check if s is a supertype of any element of ts
 (define (supertype-of-one/arr A s ts)
-  (ormap (lambda (e) (arr-subtype*/no-fail A e s)) ts))
+  (for/or ([t (in-list ts)])
+    (arr-subtype*/no-fail A t s)))
 
 (define-syntax (let*/and stx)
   (syntax-parse stx
@@ -56,16 +106,30 @@
   (define-syntax-class sub*
     (pattern e:expr))
   (syntax-parse stx
-    [(_ init (s:sub* . args) ...+)
+    [(_ init (s:sub* args:expr ... (~optional (~seq #:unless unless:expr)
+                                              #:defaults ([unless #'#f])))
+        ...+)
      (with-syntax ([(A* ... A-last) (generate-temporaries #'(s ...))])
        (with-syntax ([(clauses ...)
                       (for/list ([s (in-syntax #'(s ...))]
-                                 [args (in-syntax #'(args ...))]
+                                 [args (in-syntax #'((args ...) ...))]
+                                 [skip-tst (in-syntax #'(unless ...))]
                                  [A (in-syntax #'(init A* ...))]
                                  [A-next (in-syntax #'(A* ... A-last))])
-                         #`[#,A-next (#,s #,A . #,args)])])
-        (syntax/loc stx (let*/and (clauses ...)
-			   A-last))))]))
+                        (cond
+                          [(equal? (syntax-e #'tst) #f)
+                           #`[#,A-next (#,s #,A . #,args)]]
+                          [else
+                           #`[#,A-next (or (and #,skip-tst #,A)
+                                           (#,s #,A . #,args))]]))])
+         (syntax/loc stx (let*/and (clauses ...)
+                                   A-last))))]))
+
+
+;;************************************************************
+;; Function Subtyping Helpers
+;;************************************************************
+
 
 ;; kw-subtypes : (Listof (Pairof Num Num)) (Listof Keyword) (Listof Keyword)
 ;;               -> (Option (Listof (Pairof Num Num)))
@@ -77,109 +141,134 @@
 ;; Note that in terms of width, s-kws may have more keywords (i.e., F_s accepts
 ;; all keywords that F_t does) but the types in s-kws must be supertypes of those
 ;; in t-kws (i.e., F_s domain types are at least as permissive as those of F_t).
-(define (kw-subtypes* A0 s-kws t-kws)
-  (let loop ([A A0] [s s-kws] [t t-kws])
+(define (kw-subtypes* A kws1 kws2)
+  (let loop ([A A] [kws1 kws1] [kws2 kws2])
     (and
      A
-     (match* (s t)
-       [((cons (Keyword: ks ts rs) rest-s) (cons (Keyword: kt tt rt) rest-t))
-	(cond [(eq? kt ks)
+     (match* (kws1 kws2)
+       [((cons (Keyword: k1 t1 r1) rest1) (cons (Keyword: k2 t2 r2) rest2))
+	(cond [(eq? k2 k1)
 	       (and ;; if t is optional, s must be as well
-		(or rt (not rs))
-		(loop (subtype* A tt ts) rest-s rest-t))]
+		(or r2 (not r1))
+		(loop (subtype* A t2 t1) rest1 rest2))]
 	      ;; optional extra keywords in s are ok
 	      ;; we just ignore them
-	      [(and (not rs) (keyword<? ks kt)) (loop A rest-s t)]
+	      [(and (not r1) (keyword<? k1 k2)) (loop A rest1 kws2)]
 	      ;; extra keywords in t are a problem
 	      [else #f])]
        ;; no more keywords to satisfy, the rest in t must be optional
-       [(_ '()) (and (andmap (match-lambda [(Keyword: _ _ rs) (not rs)]) s) A)]
+       [(_ '()) (and (andmap (match-lambda [(Keyword: _ _ r1) (not r1)])
+                             kws1) A)]
        ;; we failed to satisfy all the keyword
        [(_ _) #f]))))
 
-;; simple co/contra-variance for ->
-(define (arr-subtype*/no-fail A0 s t)
-    (match* (s t)
-      ;; the really simple case
-      [((arr: s1 s2 #f #f '())
-        (arr: t1 t2 #f #f '()))
-       (subtype-seq A0
-                    (subtypes* t1 s1)
-                    (subtype* (restrict-values s2 t1) t2))]
-      [((arr: s1 s2 #f #f s-kws)
-        (arr: t1 t2 #f #f t-kws))
-       (subtype-seq A0
-                    (subtypes* t1 s1)
-                    (kw-subtypes* s-kws t-kws)
-                    (subtype* (restrict-values s2 t1) t2))]
-      [((arr: s-dom s-rng s-rest #f s-kws)
-        (arr: t-dom t-rng #f #f t-kws))
-       (subtype-seq A0
-                    (subtypes*/varargs t-dom s-dom s-rest)
-                    (kw-subtypes* s-kws t-kws)
-                    (subtype* (restrict-values s-rng t-dom) t-rng))]
-      [((arr: s-dom s-rng #f #f s-kws)
-        (arr: t-dom t-rng t-rest #f t-kws))
-       #f]
-      [((arr: s-dom s-rng s-rest #f s-kws)
-        (arr: t-dom t-rng t-rest #f t-kws))
-       (subtype-seq A0
-                    (subtypes*/varargs t-dom s-dom s-rest)
-                    (subtype* t-rest s-rest)
-                    (kw-subtypes* s-kws t-kws)
-                    (subtype* (restrict-values s-rng t-dom) t-rng))]
-      ;; handle ... varargs when the bounds are the same
-      [((arr: s-dom s-rng #f (cons s-drest dbound) s-kws)
-        (arr: t-dom t-rng #f (cons t-drest dbound) t-kws))
-       (subtype-seq A0
-                    (subtype* t-drest s-drest)
-                    (subtypes* t-dom s-dom)
-                    (kw-subtypes* s-kws t-kws)
-                    (subtype* (restrict-values s-rng t-dom) t-rng))]
-      [(_ _) #f]))
-
-;; check subtyping of props, so that predicates subtype correctly
-(define (prop-subtype* A0 s t)
-  (match* (s t)
-   [(f f) A0]
-   [((FalseProp:) t) A0]
-   [(s (TrueProp:)) A0]
-   [((TypeProp: o t1) (TypeProp: o t2))
-    (subtype* A0 t1 t2)]
-   [((NotTypeProp: o t1) (NotTypeProp: o t2))
-    (subtype* A0 t2 t1)]
-   [(_ _) #f]))
-
-(define (subtypes/varargs args dom rst)
-  (handle-failure (and (subtypes*/varargs null args dom rst) #t)))
-
-(define (subtypes*/varargs A0 argtys dom rst)
-  (let loop-varargs ([dom dom] [argtys argtys] [A A0])
-    (cond
-      [(not A) #f]
-      [(and (null? dom) (null? argtys)) A]
-      [(null? argtys) #f]
-      [(and (null? dom) rst)
-       (cond [(subtype* A (car argtys) rst) => (lambda (A) (loop-varargs dom (cdr argtys) A))]
-             [else #f])]
-      [(null? dom) #f]
-      [(subtype* A (car argtys) (car dom)) => (lambda (A) (loop-varargs (cdr dom) (cdr argtys) A))]
-      [else #f])))
-
-;(trace subtypes*/varargs)
 
+;; combine-arrs
+;;
+;; Checks if this function is defined by an uneccessary case->
+;; matching the following pattern:
+;; τ0 -> σ ∧ τ1 -> σ ∧ τn -> σ ...
+;; and if so, returns the combined function type:
+;; (∪ τ0 τ1 ... τn)-> σ
+;; amk: would it be better to simplify function types ahead of time
+;; for cases like this where there is a preferable normal form?
 (define/cond-contract (combine-arrs arrs)
-  (c:-> (c:listof arr?) (c:or/c #f arr?))
+  (-> (listof arr?) (or/c #f arr?))
   (match arrs
     [(list (and a1 (arr: dom1 rng1 #f #f '())) (arr: dom rng #f #f '()) ...)
      (cond
        [(null? dom) (make-arr dom1 rng1 #f #f '())]
        [(not (apply = 1 (length dom1) (map length dom))) #f]
-       [(not (for/and ([rng2 (in-list rng)]) (type-equal? rng1 rng2)))
+       [(not (for/and ([rng2 (in-list rng)]) (equal? rng1 rng2)))
         #f]
        [else (make-arr (apply map Un (cons dom1 dom)) rng1 #f #f '())])]
     [_ #f]))
 
+;; simple co/contra-variance for ->
+(define/cond-contract (arr-subtype*/no-fail A arr1 arr2)
+  (-> list? arr? arr? any/c)
+  (match* (arr1 arr2)
+    ;; the really simple case
+    [((arr: dom1 rng1 #f #f '())
+      (arr: dom2 rng2 #f #f '()))
+     (subtype-seq A
+                  (subtypes* dom2 dom1)
+                  (subval* (restrict-values rng1 dom2) rng2))]
+    [((arr: dom1 rng1 #f #f kws1)
+      (arr: dom2 rng2 #f #f kws2))
+     (subtype-seq A
+                  (subtypes* dom2 dom1)
+                  (kw-subtypes* kws1 kws2)
+                  (subval* (restrict-values rng1 dom2) rng2))]
+    [((arr: dom1 rng1 rest1 #f kws1)
+      (arr: dom2 rng2 #f    #f kws2))
+     (subtype-seq A
+                  (subtypes*/varargs dom2 dom1 rest1)
+                  (kw-subtypes* kws1 kws2)
+                  (subval* (restrict-values rng1 dom2) rng2))]
+    [((arr: dom1 rng1 #f    #f kws1)
+      (arr: dom2 rng2 rest2 #f kws2))
+     #f]
+    [((arr: dom1 rng1 rest1 #f kws1)
+      (arr: dom2 rng2 rest2 #f kws2))
+     (subtype-seq A
+                  (subtypes*/varargs dom2 dom1 rest1)
+                  (subtype* rest2 rest1)
+                  (kw-subtypes* kws1 kws2)
+                  (subval* (restrict-values rng1 dom2) rng2))]
+    ;; handle ... varargs when the bounds are the same
+    [((arr: dom1 rng1 #f (cons drest1 dbound) kws1)
+      (arr: dom2 rng2 #f (cons drest2 dbound) kws2))
+     (subtype-seq A
+                  (subtype* drest2 drest1)
+                  (subtypes* dom2 dom1)
+                  (kw-subtypes* kws1 kws2)
+                  (subval* (restrict-values rng1 dom2) rng2))]
+    [(_ _) #f]))
+
+
+;;************************************************************
+;; Prop 'Subtyping'
+;;************************************************************
+
+;; check subtyping of props, so that predicates subtype correctly
+(define (prop-subtype* A p1 p2)
+  (match* (p1 p2)
+    [(p p) A]
+    [((? FalseProp?) t) A]
+    [(_ (? TrueProp?)) A]
+    [((TypeProp: o1 t1)
+      (TypeProp: o2 t2))
+     #:when (equal? o1 o2)
+     (subtype* A t1 t2)]
+    [((NotTypeProp: o1 t1)
+      (NotTypeProp: o2 t2))
+     #:when (equal? o1 o2)
+     (subtype* A t2 t1)]
+    [(_ _) #f]))
+
+(define (subtypes/varargs args dom rst)
+  (and (subtypes*/varargs null args dom rst) #t))
+
+(define (subtypes*/varargs A argtys dom rst)
+  (let loop-varargs ([dom dom] [argtys argtys] [A A])
+    (cond
+      [(not A) #f]
+      [(and (null? dom) (null? argtys)) A]
+      [(null? argtys) #f]
+      [(and (null? dom) rst)
+       (cond [(subtype* A (car argtys) rst) => (λ (A) (loop-varargs dom (cdr argtys) A))]
+             [else #f])]
+      [(null? dom) #f]
+      [(subtype* A (car argtys) (car dom)) => (λ (A) (loop-varargs (cdr dom) (cdr argtys) A))]
+      [else #f])))
+
+
+;;************************************************************
+;; Struct Helpers
+;;************************************************************
+
+
 (define-match-expander NameStruct:
   (lambda (stx)
     (syntax-case stx ()
@@ -191,17 +280,17 @@
                    _ _))])))
 
 (define (subtype/flds* A flds flds*)
-  (for/fold ([A A]) ([f (in-list flds)] [f* (in-list flds*)] #:break (not A))
-    (and
-     A
-     (match* (f f*)
-       [((fld: t _ #t) (fld: t* _ #t))
-	(subtype-seq A
-		     (subtype* t* t)
-		     (subtype* t t*))]
-       [((fld: t _ #f) (fld: t* _ #f))
-	(subtype* A t t*)]
-       [(_ _) #f]))))
+  (for/fold ([A A])
+            ([f (in-list flds)] [f* (in-list flds*)]
+             #:break (not A))
+    (match* (f f*)
+      [((fld: t _ #t) (fld: t* _ #t))
+       (subtype-seq A
+                    (subtype* t* t)
+                    (subtype* t t*))]
+      [((fld: t _ #f) (fld: t* _ #f))
+       (subtype* A t t*)]
+      [(_ _) #f])))
 
 (define (unrelated-structs s1 s2)
   (define (in-hierarchy? s par)
@@ -221,532 +310,471 @@
           [(Struct: _ (? Struct? p) _ _ _ _) (in-hierarchy? p par)]
           [(Struct: _ (Poly: _ p) _ _ _ _) (in-hierarchy? p par)]
           [(Struct: _ #f _ _ _ _) #f]
-          [_ (int-err "wtf is this? ~a" s)])))
+          [_ (int-err "what is this?!?! ~a" s)])))
   (not (or (in-hierarchy? s1 s2) (in-hierarchy? s2 s1))))
 
-(define/cond-contract (type-equiv? A0 s t)
-  (c:-> list? Type? Type? c:any/c)
-  (subtype-seq A0
-	       (subtype* s t)
-	       (subtype* t s)))
 
-(define bottom-key (Rep-seq -Bottom))
-(define top-key (Rep-seq Univ))
+;;************************************************************
+;; Values Subtyping
+;;************************************************************
+
+
+(define/cond-contract (subval* A v1 v2)
+  (-> (listof (cons/c Type? Type?)) SomeValues? SomeValues?
+      any/c)
+  (match* (v1 v2)
+    ;; subtyping on values is pointwise, except special case for Bottom
+    [((or (Values: (list (Result: (== -Bottom) _ _)))
+          (Values: (list (Result: _ (PropSet: (? FalseProp?) (? FalseProp?)) _))))
+      _)
+     A]
+    [((Values: results1) (Values: results2))
+     (subresults* A results1 results2)]
+    [((ValuesDots: rs1 dty1 dbound)
+      (ValuesDots: rs2 dty2 dbound))
+     (subtype-seq A
+                  (subresults* rs1 rs2)
+                  (subtype* dty1 dty2))]
+    [((AnyValues: prop1) (AnyValues: prop2))
+     (prop-subtype* A prop1 prop2)]
+    [((or (Values: (list (Result: _ ps1 _) ...))
+          (ValuesDots: (list (Result: _ ps1 _) ...) _ _))
+      (AnyValues: prop2))
+     (ormap (match-lambda
+              [(PropSet: p1+ p1-)
+               (subtype-seq A
+                            (prop-subtype* p1+ prop2)
+                            (prop-subtype* p1- prop2))])
+            ps1)]
+    [(_ _) #f]))
+
+;;************************************************************
+;; Result Subtyping
+;;************************************************************
+
+(define/cond-contract (subresult* A res1 res2)
+  (-> (listof (cons/c Type? Type?)) Result? Result?
+        any/c)
+  (match* (res1 res2)
+    [((Result: t1 (PropSet: p1+ p1-) o1)
+      (Result: t2 (PropSet: p2+ p2-) o2))
+     (and (or (equal? o1 o2) (Empty? o2) (not o2))
+          (subtype-seq A
+                       (subtype* t1 t2)
+                       (prop-subtype* p1+ p2+)
+                       (prop-subtype* p1- p2-)))]))
+
+;;************************************************************
+;; Type Subtyping
+;;************************************************************
+
+(define/cond-contract (type-equiv? A t1 t2)
+  (-> list? Type? Type? any/c)
+  (subtype-seq A
+	       (subtype* t1 t2)
+	       (subtype* t2 t1)))
 
 ;; the algorithm for recursive types transcribed directly from TAPL, pg 305
 ;; List[(cons Number Number)] type type -> List[(cons Number Number)] or #f
 ;; is s a subtype of t, taking into account previously seen pairs A
-(define/cond-contract (subtype* A s t)
-  (c:-> (c:listof (c:cons/c fixnum? fixnum?)) Type? Type? c:any/c)
-  (define ss (Rep-seq s))
-  (define st (Rep-seq t))
+;;
+;; <><NOTE><> the seen list (A) should be updated for the following
+;; types as they are encountered:
+;; needs-resolved? types (Mus, Names, Apps),
+;; Instances, and Structs (Prefabs?)
+(define/cond-contract (subtype* A t1 t2)
+  (-> (listof (cons/c Type? Type?)) Type? Type? (or/c #f list?))
   (early-return
-   #:return-when (or (eq? ss st) (seen? ss st A)) A
-   (define cr (let ([inner (hash-ref subtype-cache st #f)])
-                (if inner
-                    (hash-ref inner ss 'missing)
-                    'missing)))
+   #:return-when (seen? t1 t2 A) A
+   #:return-when (Univ? t2) A
+   ;; error is top and bot
+   #:return-when (or (type-equal? t1 Err)
+                     (type-equal? t2 Err)) A
+   #:return-when (type-equal? t1 -Bottom) A
+   (define mask1 (Type-mask t1))
+   (define mask2 (Type-mask t2))
+   #:return-when (disjoint-masks? mask1 mask2) #f
+   #:return-when (type-equal? t1 t2) A
+   (define t1-subtype-cache (Type-subtype-cache t1))
+   (define cr (hash-ref t1-subtype-cache (Rep-seq t2) 'missing))
    #:return-when (boolean? cr) (and cr A)
-   (define ks (Type-key s))
-   (define kt (Type-key t))
-   #:return-when (and (symbol? ks) (symbol? kt) (not (eq? ks kt))) #f
-   #:return-when (and (symbol? ks) (pair? kt) (not (memq ks kt))) #f
-   #:return-when 
-   (and (pair? ks) (pair? kt)
-        (for/and ([i (in-list ks)]) (not (memq i kt))))
-   #f
-   #:return-when (eq? ss bottom-key) A
-   #:return-when (eq? st top-key) A
-   (define A0 (remember s t A))
-   (define r
-     ;; FIXME -- make this go into only the places that need it -- slows down new-metrics.rkt significantly
-     (update-current-seen A0
-       (match* (s t)
-         ;; these cases are above as special cases
-         ;; [((Union: (list)) _) A0] ;; this is extremely common, so it goes first
-         ;; [(_ (Univ:)) A0]
-         ;; error is top and bot
-         [(_ (Error:)) A0]
-         [((Error:) _) A0]
-         ;; (Un) is bot
-         [(_ (Union: (list))) #f]
-         ;; value types
-         [((Value: v1) (Value: v2))
-          #:when (equal? v1 v2) A0]
-         [((Intersection: ss) t)
-          (and 
-           (for/or ([s (in-immutable-set ss)])
-             (subtype* A0 s t))
-           A0)]
-         [(s (Intersection: ts))
-          (and 
-           (for/fold ([A A0])
-                     ([t (in-immutable-set ts)]
-                      #:break (not A))
-             (subtype* A s t))
-           A0)]
-         ;; values are subtypes of their "type"
-         [((Value: v) (Base: _ _ pred _)) (if (pred v) A0 #f)]
-         ;; tvars are equal if they are the same variable
-         [((F: t) (F: t*)) (if (eq? t t*) A0 #f)]
-         ;; Avoid needing to resolve things that refer to different structs.
-         ;; Saves us from non-termination
-         ;; Must happen *before* the sequence cases, which sometimes call `resolve' in match expanders
-         [((or (? Struct? s1) (NameStruct: s1)) (or (? Struct? s2) (NameStruct: s2)))
-          #:when (unrelated-structs s1 s2)
-          #f]
-         ;; similar case for structs and base types, which are obviously unrelated
-         [((Base: _ _ _ _) (or (? Struct? s1) (NameStruct: s1)))
-          #f]
-         [((or (? Struct? s1) (NameStruct: s1)) (Base: _ _ _ _))
-          #f]
-         ;; same for all values.
-         [((Value: (? (negate struct?) _)) (or (? Struct? s1) (NameStruct: s1)))
-          #f]
-         [((or (? Struct? s1) (NameStruct: s1)) (Value: (? (negate struct?) _)))
-          #f]
-         ;; from define-new-subtype
-         [((Distinction: nm1 id1 t1) (app resolve (Distinction: nm2 id2 t2)))
-          #:when (and (equal? nm1 nm2) (equal? id1 id2))
-          (subtype* A0 t1 t2)]
-         [((Distinction: _ _ t1) t2)
-          (subtype* A0 t1 t2)]
-         ;; sequences are covariant
-         [((Sequence: ts) (Sequence: ts*))
-          (subtypes* A0 ts ts*)]
-         [((Listof: t) (Sequence: (list t*)))
-          (subtype* A0 t t*)]
-         [((Pair: t1 t2) (Sequence: (list t*)))
-          (subtype-seq A0 (subtype* t1 t*) (subtype* t2 (-lst t*)))]
-         [((MListof: t) (Sequence: (list t*)))
-          (subtype* A0 t t*)]
-         ;; To check that mutable pair is a sequence we check that the cdr
-         ;; is both an mutable list and a sequence
-         [((MPair: t1 t2) (Sequence: (list t*)))
-          (subtype-seq A0
-                       (subtype* t1 t*)
-                       (subtype* t2 (simple-Un -Null (make-MPairTop)))
-                       (subtype* t2 t))]
-         ;; Note: this next case previously used the List: match expander, but
-         ;;       using that would cause an infinite loop in certain cases
-         ;;       (i.e., Struct types, see PR 14364) because the expander
-         ;;       uses `resolve`. This is not normally a problem, but during
-         ;;       subtyping it's dangerous to call functions that can cause
-         ;;       substitution and thus more subtyping checks.
-         ;;
-         ;;       Instead, we can just check for Null here since combined with
-         ;;       the Pair: case above and resolution of types like Mu, all the
-         ;;       List: cases should be covered.
-         [((Value: '()) (Sequence: (list t*))) A0]
-         [((HeterogeneousVector: ts) (Sequence: (list t*)))
-          (subtypes* A0 ts (map (λ (_) t*) ts))]
-         [((Vector: t) (Sequence: (list t*)))
-          (subtype* A0 t t*)]
-         [((Base: 'FlVector _ _ _) (Sequence: (list t*)))
-          (subtype* A0 -Flonum t*)]
-         [((Base: 'ExtFlVector _ _ _) (Sequence: (list t*)))
-          (subtype* A0 -ExtFlonum t*)]
-         [((Base: 'FxVector _ _ _) (Sequence: (list t*)))
-          (subtype* A0 -Fixnum t*)]
-         [((Base: 'String _ _ _) (Sequence: (list t*)))
-          (subtype* A0 -Char t*)]
-         [((Base: 'Bytes _ _ _) (Sequence: (list t*)))
-          (subtype* A0 -Byte t*)]
-         [((Base: 'Input-Port _ _ _) (Sequence: (list t*)))
-          (subtype* A0 -Nat t*)]
-         [((Value: (? exact-nonnegative-integer? n)) (Sequence: (list t*)))
-          (define possibilities
-            (list
-             (list byte? -Byte)
-             (list portable-index? -Index)
-             (list portable-fixnum? -NonNegFixnum)
-             (list values -Nat)))
-          (define type
-            (for/or ((pred-type (in-list possibilities)))
-              (match pred-type
-                ((list pred? type)
-                 (and (pred? n) type)))))
-          (subtype* A0 type t*)]
-         [((Base: _ _ _ #t) (Sequence: (list t*)))
-          (define type
-            ;; FIXME: thread the store through here
-            (for/or ((t (in-list (list -Byte -Index -NonNegFixnum -Nat))))
-              (or (and (subtype* A0 s t) t))))
-          (if type
-              (subtype* A0 type t*)
-              #f)]
-         [((Hashtable: k v) (Sequence: (list k* v*)))
-          (subtypes* A0 (list k v) (list k* v*))]
-         [((Set: t) (Sequence: (list t*)))
-          (subtype* A0 t t*)]
-         ;; special-case for case-lambda/union with only one argument              
-         [((Function: arr1) (Function: (list arr2)))
-          (cond [(null? arr1) #f]
-                [else
-                 (define comb (combine-arrs arr1))
-                 (or (and comb (arr-subtype*/no-fail A0 comb arr2))
-                     (supertype-of-one/arr A0 arr2 arr1))])]
-         ;; case-lambda
-         [((Function: arr1) (Function: arr2))
-          (if (null? arr1) #f
-              (let loop-arities ([A* A0]
-                                 [arr2 arr2])
-                (cond
-                  [(null? arr2) A*]
-                  [(supertype-of-one/arr A* (car arr2) arr1) => (lambda (A) (loop-arities A (cdr arr2)))]
-                  [else #f])))]
-         ;; recur structurally on pairs
-         [((Pair: a d) (Pair: a* d*))
-          (subtypes* A0 (list a d) (list a* d*))]
-         ;; recur structurally on dotted lists, assuming same bounds
-         [((ListDots: s-dty dbound) (ListDots: t-dty dbound*))
-          (and (eq? dbound dbound*)
-               (subtype* A0 s-dty t-dty))]
-         ;; For dotted lists and regular lists, we check that (All (dbound) s-dty) is a subtype
-         ;; of t-elem, so that no matter what dbound is instatiated with s-dty is still a subtype
-         ;; of t-elem. We cannot just replace dbound with Univ because of variance issues.
-         [((ListDots: s-dty dbound) (Listof: t-elem))
-          (subtype* A0 (-poly (dbound) s-dty) t-elem)]
-         ;; quantification over two types preserves subtyping
-         [((Poly: ns b1) (Poly: ms b2))               
-          #:when (= (length ns) (length ms))
-          ;; substitute ns for ms in b2 to make it look like b1
-          (subtype* A0 b1 (subst-all (make-simple-substitution ms (map make-F ns)) b2))]
-         [((PolyDots: (list ns ... n-dotted) b1)
-           (PolyDots: (list ms ... m-dotted) b2))
+   (define result
+     (match* (t1 t2)
+       ;; if this works, we're done, otherwise wait until after unions
+       ;; are explored to break the intersection apart
+       [((Intersection: t1s) _) #:when (for/or ([t1 (in-list t1s)])
+                                         (subtype* A t1 t2))
+                                A]
+       [(_ (Intersection: t2s))
+        (for/fold ([A A])
+                  ([t2 (in-list t2s)]
+                   #:break (not A))
+          (subtype* A t1 t2))]
+       ;; from define-new-subtype
+       [((Distinction: nm1 id1 t1) (app resolve (Distinction: nm2 id2 t2)))
+        #:when (and (equal? nm1 nm2) (equal? id1 id2))
+        (subtype* A t1 t2)]
+       [((Distinction: _ _ t1) t2) (subtype* A t1 t2)]
+       ;; tvars are equal if they are the same variable
+       [((F: var1) (F: var2)) (and (eq? var1 var2) A)]
+       ;; structural types of the same kind can be checked by simply
+       ;; referencing the field variances and performing the
+       ;; appropriate recursive calls
+       [((? structural? t1) (? structural? t2))
+        #:when (eq? (Rep-name t1)
+                    (Rep-name t2))
+        (for/fold ([A A])
+                  ([v (in-list (Type-variances t1))]
+                   [t1 (in-list (Rep-values t1))]
+                   [t2 (in-list (Rep-values t2))]
+                   #:break (not A))
           (cond
-            [(< (length ns) (length ms))
-             (define-values (short-ms rest-ms) (split-at ms (length ns)))
-             ;; substitute ms for ns in b1 to make it look like b2
-             (define subst
-               (hash-set (make-simple-substitution ns (map make-F short-ms))
-                         n-dotted (i-subst/dotted (map make-F rest-ms) (make-F m-dotted) m-dotted)))
-             (subtype* A0 (subst-all subst b1) b2)]
-            [else
-             (define-values (short-ns rest-ns) (split-at ns (length ms)))
-             ;; substitute ns for ms in b2 to make it look like b1
-             (define subst
-               (hash-set (make-simple-substitution ms (map make-F short-ns))
-                         m-dotted (i-subst/dotted (map make-F rest-ns) (make-F n-dotted) n-dotted)))
-             (subtype* A0 b1 (subst-all subst b2))])]
-         [((PolyDots: (list ns ... n-dotted) b1)
-           (Poly: (list ms ...) b2))
-          #:when (<= (length ns) (length ms))
-          ;; substitute ms for ns in b1 to make it look like b2
-          (define subst
-            (hash-set (make-simple-substitution ns (map make-F (take ms (length ns))))
-                      n-dotted (i-subst (map make-F (drop ms (length ns))))))
-          (subtype* A0 (subst-all subst b1) b2)]
-         [((Refinement: par _) t)
-          (subtype* A0 par t)]
-         ;; use unification to see if we can use the polytype here
-         [((Poly: vs b) s)
-          #:when (infer vs null (list b) (list s) Univ)
-          A0]
-         [((PolyDots: (list vs ... vdotted) b) s)
-          #:when (infer vs (list vdotted) (list b) (list s) Univ)
-          A0]
-         [(s (or (Poly: vs b) (PolyDots: vs b)))
-          #:when (null? (fv b))
-          (subtype* A0 s b)]
-         ;; rec types, applications and names (that aren't the same)
-         [((? needs-resolving? s) other)
-          (let ([s* (resolve-once s)])
-            (if (Type/c? s*) ;; needed in case this was a name that hasn't been resolved yet
-                (subtype* A0 s* other)
-                #f))]
-         [(other (? needs-resolving? t))
-          (let ([t* (resolve-once t)])
-            (if (Type/c? t*) ;; needed in case this was a name that hasn't been resolved yet
-                (subtype* A0 other t*)
-                #f))]
-         ;; for unions, we check the cross-product
-         ;; some special cases for better performance
-         ;; first, if both types are numeric, they will be built from the same base types
-         ;; so we can check for simple set inclusion of the union components
-         [((Base: _ _ _ #t) (Union: l2))
-          #:when (eq? kt 'number)
-          (and (memq s l2) A0)]
-         [((Union: l1) (Union: l2))
-          #:when (and (eq? ks 'number) (eq? kt 'number))
-          ;; l1 should be a subset of l2
-          ;; since union elements are sorted, a linear scan works
-          (let loop ([l1 l1] [l2 l2])
-            (cond [(null? l1)
-                   A0]
-                  [(null? l2)
-                   #f]
-                  [(eq? (car l1) (car l2))
-                   (loop (cdr l1) (cdr l2))]
-                  [else
-                   (loop l1 (cdr l2))]))]
-         [((Union: elems) t)
-          (and 
-           (andmap (λ (elem) (subtype* A0 elem t)) elems)
-           A0)]
-         [(s (Union: elems))
-          (and (ormap (λ (elem) (subtype* A0 s elem)) elems)
-               A0)]
-         ;; subtyping on immutable structs is covariant
-         [((Struct: nm _ flds proc _ _) (Struct: nm* _ flds* proc* _ _)) 
-          #:when (free-identifier=? nm nm*) 
-          (let ([A (cond [(and proc proc*) (subtype* A0 proc proc*)]
-                         [proc* #f]
-                         [else A0])])
-            (and A (subtype/flds* A flds flds*)))]
-         [((Struct: nm _ _ _ _ _) (StructTop: (Struct: nm* _ _ _ _ _)))
-          #:when (free-identifier=? nm nm*)
-          A0]
-         ;; All struct-type types are subtypes of the struct type top type
-         [((StructType: _) (StructTypeTop:)) A0]
-         ;; Promises are covariant
-         [((Promise: s) (Promise: t))
-          (subtype* A0 s t)]
-         ;ephemerons are covariant
-         [((Ephemeron: s) (Ephemeron: t))
-          (subtype* A0 s t)]
-         [((CustodianBox: s) (CustodianBox: t))
-          (subtype* A0 s t)]
-         [((Set: t) (Set: t*)) (subtype* A0 t t*)]
-         ;; Evts are covariant
-         [((Evt: t) (Evt: t*)) (subtype* A0 t t*)]
-         [((Base: 'Semaphore _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'Output-Port _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'Input-Port _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'TCP-Listener _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'Thread _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'Subprocess _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'Will-Executor _ _ _) (Evt: t))
-          (subtype* A0 s t)]
-         [((Base: 'LogReceiver _ _ _) (Evt: t))
-          (subtype* A0
-                    (make-HeterogeneousVector
-                     (list -Symbol -String Univ
-                           (Un (-val #f) -Symbol)))
-                    t)]
-         ;; FIXME: change Univ to Place-Message-Allowed if/when that type is defined
-         [((Base: 'Place _ _ _) (Evt: (== Univ)))
-          #t]
-         [((Base: 'Base-Place-Channel _ _ _) (Evt: (== Univ)))
-          #t]
-         [((CustodianBox: t) (Evt: t*))
-          ;; Note that it's the whole box type that's being
-          ;; compared against t* here
-          (subtype* A0 s t*)]
-         [((Channel: t) (Evt: t*)) (subtype* A0 t t*)]
-         [((Async-Channel: t) (Evt: t*)) (subtype* A0 t t*)]
-         ;; Invariant types
-         [((Box: s) (Box: t)) (type-equiv? A0 s t)]
-         [((Box: _) (BoxTop:)) A0]
-         [((Weak-Box: s) (Weak-Box: t)) (type-equiv? A0 s t)]
-         [((Weak-Box: _) (Weak-BoxTop:)) A0]
-         [((ThreadCell: s) (ThreadCell: t)) (type-equiv? A0 s t)]
-         [((ThreadCell: _) (ThreadCellTop:)) A0]
-         [((Channel: s) (Channel: t)) (type-equiv? A0 s t)]
-         [((Channel: _) (ChannelTop:)) A0]
-         [((Async-Channel: s) (Async-Channel: t)) (type-equiv? A0 s t)]
-         [((Async-Channel: _) (Async-ChannelTop:)) A0]
-         [((Vector: s) (Vector: t)) (type-equiv? A0 s t)]
-         [((Vector: _) (VectorTop:)) A0]
-         [((HeterogeneousVector: _) (VectorTop:)) A0]
-         [((HeterogeneousVector: (list e ...)) (Vector: e*))
-          (for/fold ((A A0)) ((e (in-list e)) #:break (not A))
-            (and A (type-equiv? A e e*)))]
-         [((HeterogeneousVector: (list s* ...)) (HeterogeneousVector: (list t* ...)))
-          (if (= (length s*) (length t*))
-              (for/fold ((A A0)) ((s (in-list s*)) (t (in-list t*)) #:break (not A))
-                (type-equiv? A s t))
-              #f)]
-         [((MPair: s1 s2) (MPair: t1 t2))
-          (subtype-seq A0
-                       (type-equiv? s1 t1)
-                       (type-equiv? s2 t2))]
-         [((MPair: _ _) (MPairTop:)) A0]
-         [((Hashtable: s1 s2) (Hashtable: t1 t2))
-          (subtype-seq A0
-                       (type-equiv? s1 t1)
-                       (type-equiv? s2 t2))]
-         [((Hashtable: _ _) (HashtableTop:)) A0]
-         [((Prompt-Tagof: s1 s2) (Prompt-Tagof: t1 t2))
-          (subtype-seq A0
-                       (type-equiv? s1 t1)
-                       (type-equiv? s2 t2))]
-         [((Prompt-Tagof: _ _) (Prompt-TagTop:)) A0]
-         [((Continuation-Mark-Keyof: s) (Continuation-Mark-Keyof: t))
-          (type-equiv? A0 s t)]
-         [((Continuation-Mark-Keyof: _) (Continuation-Mark-KeyTop:)) A0]
-         ;; subtyping on structs follows the declared hierarchy
-         [((Struct: nm (? Type/c? parent) _ _ _ _) other)
-          (subtype* A0 parent other)]
-         [((Prefab: k1 ss) (Prefab: k2 ts))
-          (and (prefab-key-subtype? k1 k2)
-               (and (>= (length ss) (length ts))
-                    (for/fold ([A A0])
-                              ([s (in-list ss)]
-                               [t (in-list ts)]
-                               [mut? (in-list (prefab-key->field-mutability k2))]
-                               #:break (not A))
-                      (and A
-                           (if mut?
-                               (subtype-seq A
-                                            (subtype* t s)
-                                            (subtype* s t))
-                               (subtype* A s t))))))]
-         ;; subtyping on values is pointwise, except special case for Bottom
-         [((Values: (list (Result: (== -Bottom) _ _))) _)
-          A0]
-         [((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
-         [((ValuesDots: s-rs s-dty dbound) (ValuesDots: t-rs t-dty dbound))
-          (subtype-seq A0
-                       (subtypes* s-rs t-rs)
-                       (subtype* s-dty t-dty))]
-         [((AnyValues: s-f) (AnyValues: t-f))
-          (prop-subtype* A0 s-f t-f)]
-         [((or (Values: (list (Result: _ fs _) ...))
-               (ValuesDots: (list (Result: _ fs _) ...) _ _))
-           (AnyValues: t-f))
-          (for/or ([f (in-list fs)])
-            (match f
-              [(PropSet: f+ f-)
-               (subtype-seq A0
-                            (prop-subtype* f+ t-f)
-                            (prop-subtype* f- t-f))]))]
-         [((Result: t (PropSet: ft ff) o) (Result: t* (PropSet: ft* ff*) o))
-          (subtype-seq A0
-                       (subtype* t t*)
-                       (prop-subtype* ft ft*)
-                       (prop-subtype* ff ff*))]
-         [((Result: t (PropSet: ft ff) o) (Result: t* (PropSet: ft* ff*) (Empty:)))
-          (subtype-seq A0
-                       (subtype* t t*)
-                       (prop-subtype* ft ft*)
-                       (prop-subtype* ff ff*))]
-         ;; subtyping on other stuff
-         [((Syntax: t) (Syntax: t*))
-          (subtype* A0 t t*)]
-         [((Future: t) (Future: t*))
-          (subtype* A0 t t*)]
-         [((Param: s-in s-out) (Param: t-in t-out))
-          (subtype-seq A0
-                       (subtype* t-in s-in)
-                       (subtype* s-out t-out))]
-         [((Param: in out) t)
-          (subtype* A0 (cl->* (-> out) (-> in -Void)) t)]
-         [((Instance: (? needs-resolving? s)) other)
-          (let ([s* (resolve-once s)])
-            (if (Type/c? s*)
-                (subtype* A0 (make-Instance s*) other)
-                #f))]
-         [(other (Instance: (? needs-resolving? t)))
-          (let ([t* (resolve-once t)])
-            (if (Type/c? t*)
-                (subtype* A0 other (make-Instance t*))
-                #f))]
-         [((Instance: (Class: _ _ field-map method-map augment-map _))
-           (Instance: (Class: _ _ field-map* method-map* augment-map* _)))
-          (define (subtype-clause? map map*)
-            (and (for/and ([key+type (in-list map*)])
+            [(eq? v Covariant)
+             (subtype* A t1 t2)]
+            [(eq? v Invariant)
+             (type-equiv? A t1 t2)]
+            [else ;; Contravariant
+             (subtype* A t2 t1)]))]
+       ;; If the type has a registered top type predicate, let's check it!
+       [((? has-top-type?) _) #:when ((top-type-pred t1) t2) A]
+       ;; quantification over two types preserves subtyping
+       [((Poly: ns b1) (Poly: ms b2))               
+        #:when (= (length ns) (length ms))
+        ;; substitute ns for ms in b2 to make it look like b1
+        (subtype* A b1 (subst-all (make-simple-substitution ms (map make-F ns)) b2))]
+       [((PolyDots: (list ns ... n-dotted) b1)
+         (PolyDots: (list ms ... m-dotted) b2))
+        (cond
+          [(< (length ns) (length ms))
+           (define-values (short-ms rest-ms) (split-at ms (length ns)))
+           ;; substitute ms for ns in b1 to make it look like b2
+           (define subst
+             (hash-set (make-simple-substitution ns (map make-F short-ms))
+                       n-dotted (i-subst/dotted (map make-F rest-ms) (make-F m-dotted) m-dotted)))
+           (subtype* A (subst-all subst b1) b2)]
+          [else
+           (define-values (short-ns rest-ns) (split-at ns (length ms)))
+           ;; substitute ns for ms in b2 to make it look like b1
+           (define subst
+             (hash-set (make-simple-substitution ms (map make-F short-ns))
+                       m-dotted (i-subst/dotted (map make-F rest-ns) (make-F n-dotted) n-dotted)))
+           (subtype* A b1 (subst-all subst b2))])]
+       [((PolyDots: (list ns ... n-dotted) b1)
+         (Poly: (list ms ...) b2))
+        #:when (<= (length ns) (length ms))
+        ;; substitute ms for ns in b1 to make it look like b2
+        (define subst
+          (hash-set (make-simple-substitution ns (map make-F (take ms (length ns))))
+                    n-dotted (i-subst (map make-F (drop ms (length ns))))))
+        (subtype* A (subst-all subst b1) b2)]
+       ;; use unification to see if we can use the polytype here
+       [((Poly: vs1 b1) _)
+        #:when (infer vs1 null (list b1) (list t2) Univ)
+        A]
+       [((PolyDots: (list vs1 ... vdotted1) b1) _)
+        #:when (infer vs1 (list vdotted1) (list b1) (list t2) Univ)
+        A]
+       [(_ (or (Poly:     vs2 b2)
+               (PolyDots: vs2 b2)))
+        #:when (null? (fv b2))
+        (subtype* A t1 b2)]
+       ;; recur structurally on dotted lists, assuming same bounds
+       [((ListDots: dty1 dbound1) (ListDots: dty2 dbound2))
+        (and (eq? dbound1 dbound2)
+             (subtype* A dty1 dty2))]
+       ;; For dotted lists and regular lists, we check that (All
+       ;; (dbound) s-dty) is a subtype of t-elem, so that no matter
+       ;; what dbound is instatiated with s-dty is still a subtype of
+       ;; t-elem. We cannot just replace dbound with Univ because of
+       ;; variance issues.
+       [((ListDots: dty1 dbound1) (Listof: t2-elem))
+        (subtype* A (-poly (dbound1) dty1) t2-elem)]
+       [((Value: v) (Base: _ _ pred _)) (if (pred v) A #f)]
+       [((? resolvable?) _)
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (let ([t1 (resolve-once t1)])
+              ;; check needed for if a name that hasn't been resolved yet
+              (and (Type? t1) (subtype* A t1 t2)))))]
+       [(_ (? resolvable?))
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (let ([t2 (resolve-once t2)])
+              ;; check needed for if a name that hasn't been resolved yet
+              (and (Type? t2) (subtype* A t1 t2)))))]
+       [((Union: elems) t)
+        (for/fold ([A A])
+                  ([elem (in-list elems)]
+                   #:break (not A))
+          (subtype* A elem t))]
+       [(s (Union: elems))
+        (and (ormap (λ (elem) (subtype* A s elem)) elems) A)]
+       ;; intersections as subtypes need to be handled after some forms (e.g. Unions)
+       ;; otherwise we will get the wrong answer for
+       ;; queries such as: (∩ A B) <: (U String (∩ A B))
+       [((Intersection: t1s) _)
+        (for/or ([t1 (in-list t1s)])
+          (subtype* A t1 t2))]
+       ;; Avoid needing to resolve things that refer to different structs.
+       ;; Saves us from non-termination
+       ;; Must happen *before* the sequence cases, which sometimes call `resolve' in match expanders
+       [((or (? Struct? s1) (NameStruct: s1))
+         (or (? Struct? s2) (NameStruct: s2)))
+        #:when (unrelated-structs s1 s2)
+        #f]
+       ;; same for all values.
+       [((Value: (? (negate struct?) _)) (or (? Struct? s1) (NameStruct: s1)))
+        #f]
+       [((or (? Struct? s1) (NameStruct: s1)) (Value: (? (negate struct?) _)))
+        #f]
+       ;; sequences are covariant
+       [((Sequence: ts1) (Sequence: ts2)) (subtypes* A ts1 ts2)]
+       [((Hashtable: k1 v1) (Sequence: (list k2 v2)))
+        (subtype-seq A
+                     (subtype* k1 k2)
+                     (subtype* v1 v2))]
+       ;; special-case for case-lambda/union with only one argument              
+       [((Function: arr1) (Function: (list arr2)))
+        (cond [(null? arr1) #f]
+              [else
+               (define comb (combine-arrs arr1))
+               (or (and comb (arr-subtype*/no-fail A comb arr2))
+                   (supertype-of-one/arr A arr2 arr1))])]
+       ;; case-lambda
+       [((Function: arrs1) (Function: arrs2))
+        (if (null? arrs1) #f
+            (let loop-arities ([A A]
+                               [arrs2 arrs2])
+              (cond
+                [(null? arrs2) A]
+                [(supertype-of-one/arr A (car arrs2) arrs1)
+                 => (λ (A) (loop-arities A (cdr arrs2)))]
+                [else #f])))]
+       [((Refinement: t1-parent _) _)
+        (subtype* A t1-parent t2)]
+       ;; subtyping on immutable structs is covariant
+       [((Struct: nm1 _ flds1 proc1 _ _) (Struct: nm2 _ flds2 proc2 _ _)) 
+        #:when (free-identifier=? nm1 nm2) 
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (let ([A (cond [(and proc1 proc2) (subtype* A proc1 proc2)]
+                           [proc2 #f]
+                           [else A])])
+              (and A (subtype/flds* A flds1 flds2)))))]
+       [((Struct: nm1 _ _ _ _ _) (StructTop: (Struct: nm2 _ _ _ _ _)))
+        #:when (free-identifier=? nm1 nm2)
+        A]
+       ;; vector special cases
+       [((HeterogeneousVector: elems1) (Vector: t2))
+        (for/fold ([A A])
+                  ([elem1 (in-list elems1)] #:break (not A))
+          (type-equiv? A elem1 t2))]
+       [((HeterogeneousVector: elems1) (HeterogeneousVector: elems2))
+        (cond [(= (length elems1)
+                  (length elems2))
+               (for/fold ([A A])
+                         ([elem1 (in-list elems1)]
+                          [elem2 (in-list elems2)]
+                          #:break (not A))
+                 (type-equiv? A elem1 elem2))]
+              [else #f])]
+       ;; subtyping on structs follows the declared hierarchy
+       [((Struct: nm1 (? Type? parent1) _ _ _ _) _)
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (subtype* A parent1 t2)))]
+       [((Prefab: k1 ss) (Prefab: k2 ts))
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (and (prefab-key-subtype? k1 k2)
+                 (and (>= (length ss) (length ts))
+                      (for/fold ([A A])
+                                ([s (in-list ss)]
+                                 [t (in-list ts)]
+                                 [mut? (in-list (prefab-key->field-mutability k2))]
+                                 #:break (not A))
+                        (and A
+                             (if mut?
+                                 (subtype-seq A
+                                              (subtype* t s)
+                                              (subtype* s t))
+                                 (subtype* A s t))))))))]
+       ;; subtyping on other stuff
+       [((Param: in1 out1) _)
+        (subtype* A (cl->* (t-> out1) (t-> in1 -Void)) t2)]
+       ;; homogeneous Sequence call helper for remaining cases
+       ;; that are subtypes of a homogeneous Sequence
+       [(_ (Sequence: (list seq-t))) (homo-sequence-subtype A t1 seq-t)]
+       ;; events call off to helper for remaining cases
+       [(_ (Evt: evt-t)) (event-subtype A t1 evt-t)]
+       [((Instance: (? resolvable? t1*)) _)
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (let ([t1* (resolve-once t1*)])
+              (and (Type? t1*)
+                   (subtype* A (make-Instance t1*) t2)))))]
+       [(_ (Instance: (? resolvable? t2*)))
+        (let ([A (remember t1 t2 A)])
+          (with-updated-seen A
+            (let ([t2* (resolve-once t2*)])
+              (and (Type? t2*)
+                   (subtype* A t1 (make-Instance t2*))))))]
+       [((Instance: (Class: _ _ field-map method-map augment-map _))
+         (Instance: (Class: _ _ field-map* method-map* augment-map* _)))
+        (define (subtype-clause? map map*)
+          (and (for/and ([key+type (in-list map*)])
+                 (match-define (list key type) key+type)
+                 (assq key map))
+               (let/ec escape
+                 (for/fold ([A A])
+                           ([key+type (in-list map)])
                    (match-define (list key type) key+type)
-                   (assq key map))
-                 (let/ec escape
-                   (for/fold ([A A0])
-                             ([key+type (in-list map)])
-                     (match-define (list key type) key+type)
-                     (define result (assq (car key+type) map*))
-                     (or (and (not result) A)
-                         (let ([type* (cadr result)])
-                           (or (subtype* A type type*)
-                               (escape #f))))))))
-          (and ;; Note that init & augment clauses don't matter for objects
-               (subtype-clause? method-map method-map*)
-               (subtype-clause? field-map field-map*))]
-         [((? Class?) (ClassTop:)) A0]
-         [((Class: row inits fields methods augments init-rest)
-           (Class: row* inits* fields* methods* augments* init-rest*))
-          ;; TODO: should the result be folded instead?
-          (define sub (curry subtype* A))
-          ;; check that each of inits, fields, methods, etc. are
-          ;; equal by sorting and checking type equality
-          (define (equal-clause? clause clause* [inits? #f])
-            (cond
-             [(not inits?)
-              (match-define (list (list names types) ...) clause)
-              (match-define (list (list names* types*) ...) clause*)
-              (and (= (length names) (length names*))
-                   (andmap equal? names names*)
-                   (andmap sub types types*))]
-             [else
-              (match-define (list (list names types opt?) ...)
-                            clause)
-              (match-define (list (list names* types* opt?*) ...)
-                            clause*)
-              (and (= (length names) (length names*))
-                   (andmap equal? names names*)
-                   (andmap sub types types*)
-                   (andmap equal? opt? opt?*))]))
-          ;; There is no non-trivial width subtyping on class types, but it's
-          ;; possible for two "equal" class types to look different
-          ;; in the representation. We deal with that here.
-          (and (or (and (or (Row? row) (not row))
-                        (or (Row? row*) (not row*)))
-                   (equal? row row*))
-               (equal-clause? inits inits* #t)
-               (equal-clause? fields fields*)
-               (equal-clause? methods methods*)
-               (equal-clause? augments augments*)
-               (or (and init-rest init-rest*
-                        (sub init-rest init-rest*))
-                   (and (not init-rest) (not init-rest*))))]
-         [((? Unit?) (UnitTop:)) A0]
-         ;; For Unit types invoke-types are covariant
-         ;; imports and init-depends are covariant in that importing fewer
-         ;; signatures results in a subtype
-         ;; exports conversely are contravariant, subtypes export more signatures
-         [((Unit: imports exports init-depends t) (Unit: imports* exports* init-depends* t*))
-          (and (check-sub-signatures? imports* imports)
-               (check-sub-signatures? exports exports*)
-               (check-sub-signatures? init-depends* init-depends)
-               (subtype-seq A0
-                            (subtype* t t*)))]
-         ;; otherwise, not a subtype
-         [(_ _) #f])))
-     (when (null? A)
-       (hash-set!
-         (hash-ref! subtype-cache st (lambda () (make-hash)))
-         ss (and r #t)))
-     r))
+                   (define result (assq (car key+type) map*))
+                   (or (and (not result) A)
+                       (let ([type* (cadr result)])
+                         (or (subtype* A type type*)
+                             (escape #f))))))))
+        (and ;; Note that init & augment clauses don't matter for objects
+         (subtype-clause? method-map method-map*)
+         (subtype-clause? field-map field-map*))]
+       [((Class: row inits fields methods augments init-rest)
+         (Class: row* inits* fields* methods* augments* init-rest*))
+        ;; TODO: should the result be folded instead?
+        (define (sub t1 t2) (subtype* A t1 t2))
+        ;; check that each of inits, fields, methods, etc. are
+        ;; equal by sorting and checking type equality
+        (define (equal-clause? clause clause* [inits? #f])
+          (cond
+            [(not inits?)
+             (match-define (list (list names types) ...) clause)
+             (match-define (list (list names* types*) ...) clause*)
+             (and (= (length names) (length names*))
+                  (andmap equal? names names*)
+                  (andmap sub types types*))]
+            [else
+             (match-define (list (list names types opt?) ...)
+               clause)
+             (match-define (list (list names* types* opt?*) ...)
+               clause*)
+             (and (= (length names) (length names*))
+                  (andmap equal? names names*)
+                  (andmap sub types types*)
+                  (andmap equal? opt? opt?*))]))
+        ;; There is no non-trivial width subtyping on class types, but it's
+        ;; possible for two "equal" class types to look different
+        ;; in the representation. We deal with that here.
+        (and (or (and (or (Row? row) (not row))
+                      (or (Row? row*) (not row*)))
+                 (equal? row row*))
+             (equal-clause? inits inits* #t)
+             (equal-clause? fields fields*)
+             (equal-clause? methods methods*)
+             (equal-clause? augments augments*)
+             (or (and init-rest init-rest*
+                      (sub init-rest init-rest*))
+                 (and (not init-rest) (not init-rest*)
+                      A)))]
+       ;; For Unit types invoke-types are covariant
+       ;; imports and init-depends are covariant in that importing fewer
+       ;; signatures results in a subtype
+       ;; exports conversely are contravariant, subtypes export more signatures
+       [((Unit: imports1 exports1 init-depends1 t1)
+         (Unit: imports2 exports2 init-depends2 t2))
+        (and (check-sub-signatures? imports2 imports1)
+             (check-sub-signatures? exports1 exports2)
+             (check-sub-signatures? init-depends2 init-depends1)
+             (subval* A t1 t2))]
+       ;; otherwise, not a subtype
+       [(_ _) #f]))
+   (when (null? A) (hash-set! t1-subtype-cache (Rep-seq t2) (and result #t)))
+   result))
 
-(define (type-compare? a b)
-  (or (type-equal? a b)
-      (and (subtype a b) (subtype b a))))
+;;************************************************************
+;; Other Subtyping Special Cases
+;;************************************************************
 
-;; List[(cons Number Number)] type type -> maybe[List[(cons Number Number)]]
-(define subtype*/no-fail subtype*)
+(define seq-base-types `((FlVector . ,-Flonum)
+                         (ExtFlVector . ,-ExtFlonum)
+                         (FxVector . ,-Fixnum)
+                         (String . ,-Char)
+                         (Bytes . ,-Byte)
+                         (Input-Port . ,-Nat)))
 
-(provide/cond-contract
- [subtype (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)]
- [type-compare? (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)]
- [subtypes (c:-> (c:listof (c:or/c Type/c SomeValues/c))
-                 (c:listof (c:or/c Type/c SomeValues/c))
-                 boolean?)]
- [subtypes/varargs (c:-> (c:listof Type/c) (c:listof Type/c) (c:or/c Type/c #f) boolean?)])
+;; Homo-sequence-subtype
+;; is t a subtype of (Sequence: seq-t)?
+(define/cond-contract (homo-sequence-subtype A t seq-t)
+  (-> list? Type? Type? any/c)
+  (match t
+    [(Pair: t1 t2)
+     (subtype-seq A
+                  (subtype* t1 seq-t)
+                  (subtype* t2 (-lst seq-t)))]
+    ;; To check that mutable pair is a sequence we check that the cdr
+    ;; is both an mutable list and a sequence
+    [(MPair: t1 t2)
+     (subtype-seq A
+                  (subtype* t1 seq-t)
+                  (subtype* t2 (simple-Un -Null (make-MPairTop)))
+                  (subtype* t2 (make-Sequence (list seq-t))))]
+    [(Value: '()) A]
+    [(HeterogeneousVector: ts)
+     (subtypes* A ts (make-list (length ts) seq-t))]
+    [(or (Vector: t) (Set: t)) (subtype* A t seq-t)]
+    [(Base: kind _ _ _) #:when (assq kind seq-base-types)
+     (subtype* A (cdr (assq kind seq-base-types)) seq-t)]
+    [(Value: (? exact-nonnegative-integer? n))
+     (define possibilities
+       (list
+        (list byte? -Byte)
+        (list portable-index? -Index)
+        (list portable-fixnum? -NonNegFixnum)
+        (list values -Nat)))
+     (define type
+       (for/or ((pred-type (in-list possibilities)))
+         (match pred-type
+           ((list pred? type)
+            (and (pred? n) type)))))
+     (subtype* A type seq-t)]
+    [(Base: _ _ _ #t)
+     (define type
+       ;; FIXME: thread the store through here
+       (for/or ((num-t (in-list (list -Byte -Index -NonNegFixnum -Nat))))
+         (or (and (subtype* A t num-t) num-t))))
+     (if type
+         (subtype* A type seq-t)
+         #f)]
+    [_ #f]))
 
-;(require racket/trace)
-;(trace subtype*)
-;(trace supertype-of-one/arr)
-;(trace arr-subtype*/no-fail)
-;(trace subtype*/no-fail)
-;(trace subtypes*)
-;(trace subtype)
 
-;(subtype (-> Univ B) (-> Univ Univ))
-;(subtype (make-poly '(a) (make-tvar 'a)) (make-lst N))
+;; event-subtype
+;; returns if t is a subtype of (Evt: evt-t)
+(define/cond-contract (event-subtype A t evt-t)
+  (-> list? Type? Type? (or/c list? #f))
+  (match t
+    [(Base: kind _ _ _) #:when (memq kind '(Semaphore
+                                            Output-Port
+                                            Input-Port
+                                            TCP-Listener
+                                            Thread
+                                            Subprocess
+                                            Will-Executor))
+     (subtype* A t evt-t)]
+    ;; FIXME: change Univ to Place-Message-Allowed if/when that type is defined
+    [(Base: kind _ _ _) #:when (and (Univ? evt-t)
+                                    (memq kind '(Place Base-Place-Channel)))
+     A]
+    [(Base: 'LogReceiver _ _ _)
+     (subtype* A
+               (make-HeterogeneousVector
+                (list -Symbol -String Univ
+                      (Un (-val #f) -Symbol)))
+               evt-t)]
+    [(CustodianBox: _)
+     ;; Note that it's the whole box type that's being
+     ;; compared against t* here
+     (subtype* A t evt-t)]
+    [(or (Channel: t)
+         (Async-Channel: t))
+     (subtype* A t evt-t)]
+    [_ #f]))
 
-;;problem:
-;; (subtype (make-Mu 'x (make-Syntax (make-Union (list (make-Base 'Number #'number? number?) (make-F 'x))))) (make-Syntax (make-Univ)))
diff --git a/typed-racket-lib/typed-racket/types/tc-error.rkt b/typed-racket-lib/typed-racket/types/tc-error.rkt
index 28a193cc..12633039 100644
--- a/typed-racket-lib/typed-racket/types/tc-error.rkt
+++ b/typed-racket-lib/typed-racket/types/tc-error.rkt
@@ -14,11 +14,11 @@
  [tc-error/expr/fields ((string?) (#:more (c:or/c string? #f) #:return c:any/c #:stx syntax?)
                         #:rest (c:listof c:any/c) . c:->* . c:any/c)]
 
- [lookup-fail (identifier? . c:-> . Type/c)]
- [lookup-type-fail (identifier? . c:-> . Type/c)]
+ [lookup-fail (identifier? . c:-> . Type?)]
+ [lookup-type-fail (identifier? . c:-> . Type?)]
  [lookup-variance-fail (identifier? . c:-> . void?)])
 
-;; produce a type-checking error, and also return a result (e.g., a tc-result)
+;; produce a type-checking error, and also return a result (e.g., a tc-results)
 (define (tc-error/expr msg
                        #:return [return (ret -Bottom)]
                        #:stx [stx (current-orig-stx)]
diff --git a/typed-racket-lib/typed-racket/types/tc-result.rkt b/typed-racket-lib/typed-racket/types/tc-result.rkt
index 4280c10e..f2aff49b 100644
--- a/typed-racket-lib/typed-racket/types/tc-result.rkt
+++ b/typed-racket-lib/typed-racket/types/tc-result.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require "../utils/utils.rkt"
-         (rep type-rep prop-rep)
+         (rep core-rep type-rep prop-rep values-rep)
          (utils tc-utils)
          (types base-abbrev)
          racket/match
@@ -10,10 +10,10 @@
 ;; this structure represents the result of typechecking an expression
 ;; fields are #f only when the direct result of parsing or annotations
 (define-struct/cond-contract tc-result
-  ([t Type/c] [pset (c:or/c PropSet? #f)] [o (c:or/c Object? #f)])
+  ([t Type?] [pset (c:or/c PropSet? #f)] [o (c:or/c OptObject? #f)])
   #:transparent)
 (define-struct/cond-contract tc-results
-  ([ts (c:listof tc-result?)] [drest (c:or/c (c:cons/c Type/c symbol?) #f)])
+  ([ts (c:listof tc-result?)] [drest (c:or/c (c:cons/c Type? symbol?) #f)])
   #:transparent)
 (define-struct/cond-contract tc-any-results ([f (c:or/c Prop? #f)]) #:transparent)
 
@@ -32,10 +32,12 @@
     [(tc-any-results: p) (and p #t)]
     [(tc-results: _ ps os)
      (and (andmap (λ (x) x) ps)
-          (andmap (λ (x) x) os))]
+          (andmap (λ (x) x) os)
+          #t)]
     [(tc-results: _ ps os _ _)
      (and (andmap (λ (x) x) ps)
-          (andmap (λ (x) x) os))]
+          (andmap (λ (x) x) os)
+          #t)]
     [else #f]))
 
 
@@ -79,7 +81,7 @@
 
 ;; expand-Results: (Listof Rresult) -> (Values (Listof Type) (Listof PropSet) (Listof Object))
 (define (expand-Results results)
-  (values (map Result-t results) (map Result-f results) (map Result-o results)))
+  (values (map Result-t results) (map Result-ps results) (map Result-o results)))
 
 
 (define-match-expander Results:
@@ -88,7 +90,7 @@
    [(_ tp fp op) (Values: (app expand-Results tp fp op))]
    [(_ tp fp op dty dbound) (ValuesDots: (app expand-Results tp fp op) dty dbound)]))
 
-;; make-tc-result*: Type/c PropSet/c Object? -> tc-result?
+;; make-tc-result*: Type? PropSet/c Object? -> tc-result?
 ;; Smart constructor for a tc-result.
 (define (-tc-result type [prop -tt-propset] [object -empty-obj])
   (cond
@@ -102,7 +104,7 @@
 (define ret
   (case-lambda [(t)
                 (make-tc-results
-                 (cond [(Type/c? t)
+                 (cond [(Type? t)
                         (list (-tc-result t -tt-propset -empty-obj))]
                        [else
                         (for/list ([i (in-list t)])
@@ -110,7 +112,7 @@
                  #f)]
                [(t pset)
                 (make-tc-results
-                 (if (Type/c? t)
+                 (if (Type? t)
                      (list (-tc-result t pset -empty-obj))
                      (for/list ([i (in-list t)] [pset (in-list pset)])
                        (-tc-result i pset -empty-obj)))
@@ -130,18 +132,16 @@
                      (list (-tc-result t pset o)))
                  (cons dty dbound))]))
 
-;(trace ret)
-
 (provide/cond-contract
  [ret
-  (c:->i ([t (c:or/c Type/c (c:listof Type/c))])
+  (c:->i ([t (c:or/c Type? (c:listof Type?))])
          ([f (t) (if (list? t)
                      (c:listof (c:or/c #f PropSet?))
                      (c:or/c #f PropSet?))]
           [o (t) (if (list? t)
-                     (c:listof (c:or/c #f Object?))
-                     (c:or/c #f Object?))]
-          [dty Type/c]
+                     (c:listof (c:or/c #f OptObject?))
+                     (c:or/c #f OptObject?))]
+          [dty Type?]
           [dbound symbol?])
          [res tc-results/c])])
 
@@ -152,11 +152,11 @@
 (provide/cond-contract
  [rename -tc-result tc-result
    (c:case->
-     (Type/c . c:-> . tc-result?)
-     (Type/c PropSet? Object? . c:-> . tc-result?))]
+     (Type? . c:-> . tc-result?)
+     (Type? PropSet? OptObject? . c:-> . tc-result?))]
  [tc-any-results ((c:or/c Prop? #f) . c:-> . tc-any-results?)]
- [tc-result-t (tc-result? . c:-> . Type/c)]
- [rename tc-results-ts* tc-results-ts (tc-results? . c:-> . (c:listof Type/c))]
+ [tc-result-t (tc-result? . c:-> . Type?)]
+ [rename tc-results-ts* tc-results-ts (tc-results? . c:-> . (c:listof Type?))]
  [tc-result-equal? (tc-result? tc-result? . c:-> . boolean?)]
  [tc-result? (c:any/c . c:-> . boolean?)]
  [tc-results? (c:any/c . c:-> . boolean?)]
diff --git a/typed-racket-lib/typed-racket/types/type-table.rkt b/typed-racket-lib/typed-racket/types/type-table.rkt
index da997f39..0b0e18d8 100644
--- a/typed-racket-lib/typed-racket/types/type-table.rkt
+++ b/typed-racket-lib/typed-racket/types/type-table.rkt
@@ -104,7 +104,7 @@
               ;; down compilation excessively (e.g., serializing the 4k type
               ;; of the + function)
               (printer-thunk type-names
-                (pretty-format-type (cleanup-type type))))]
+                (pretty-format-rep (cleanup-type type))))]
         [(or (tc-results: types)
              (tc-results: types _ _ _ _)) ; FIXME, account for dty/dbound
          (printer-thunk type-names
@@ -112,8 +112,8 @@
                   (for/list ([(type index) (in-indexed (in-list types))])
                     (format "Value ~a:~n  ~a~n"
                             (add1 index)
-                            (pretty-format-type (cleanup-type type)
-                                                #:indent 2)))))]
+                            (pretty-format-rep (cleanup-type type)
+                                               #:indent 2)))))]
         [(tc-any-results: _) "AnyValues"]))
     (cond [(not printed-type-thunks) tooltips]
           [else
diff --git a/typed-racket-lib/typed-racket/types/union.rkt b/typed-racket-lib/typed-racket/types/union.rkt
index 00c1f322..59b5f8d5 100644
--- a/typed-racket-lib/typed-racket/types/union.rkt
+++ b/typed-racket-lib/typed-racket/types/union.rkt
@@ -9,14 +9,7 @@
 
 
 (provide/cond-contract
- [Un (() #:rest (c:listof Type/c) . c:->* . Type/c)])
-
-;; List[Type] -> Type
-;; Argument types should not overlap or be union types
-(define (make-union* types)
-  (match types
-    [(list t) t]
-    [_ (make-Union types)]))
+ [Un (() #:rest (c:listof Type?) . c:->* . Type?)])
 
 ;; a is a Type (not a union type)
 ;; b is a List[Type] (non overlapping, non Union-types)
@@ -24,7 +17,7 @@
 ;; The overlapping constraint is lifted if we are in the midst of subtyping. This is because during
 ;; subtyping calls to subtype are expensive.
 (define (merge a b)
-  (define b* (make-union* b))
+  (define b* (make-Union b))
   (match* (a b)
     ;; If a union element is a Name application, then it should not
     ;; be checked for subtyping since that can cause infinite
@@ -58,7 +51,7 @@
      (cond [(hash-ref Un-cache args #f)]
            [else
             (define ts (foldr merge '()
-                              (remove-dups (sort (append-map flat args) type<?))))
-            (define type (make-union* ts))
+                              (remove-duplicates (append-map flat args) type-equal?)))
+            (define type (make-Union ts))
             (hash-set! Un-cache args type)
             type])]))
diff --git a/typed-racket-lib/typed-racket/types/update.rkt b/typed-racket-lib/typed-racket/types/update.rkt
index 1d2dccf4..9ad4ad80 100644
--- a/typed-racket-lib/typed-racket/types/update.rkt
+++ b/typed-racket-lib/typed-racket/types/update.rkt
@@ -4,9 +4,9 @@
 (require racket/match racket/list
          (contract-req)
          (infer-in infer)
-         (rep type-rep prop-rep object-rep rep-utils)
+         (rep core-rep type-rep prop-rep object-rep values-rep rep-utils)
          (utils tc-utils)
-         (types resolve subtype remove union)
+         (types resolve subtype subtract union)
          (rename-in (types abbrev)
                     [-> -->]
                     [->* -->*]
@@ -22,7 +22,7 @@
 ;; path-elems : which fields we're traversing to update,
 ;;   in *syntactic order* (e.g. (car (cdr x)) -> '(car cdr))  
 (define/cond-contract (update t new-t pos? path-elems)
-  (Type/c Type/c boolean? (listof PathElem?) . -> . Type/c)
+  (Type? Type? boolean? (listof PathElem?) . -> . Type?)
   ;; build-type: build a type while propogating bottom
   (define (build constructor . args)
     (if (memf Bottom? args) -Bottom (apply constructor args)))
@@ -32,10 +32,6 @@
   (let update
     ([t t] [path (reverse path-elems)])
     (match path
-      ;; path is empty (base case)
-      [(list) (cond
-                [pos? (intersect (resolve t) new-t)]
-                [else (remove (resolve t) new-t)])]
       ;; path is non-empty
       ;; (i.e. there is some field access we'll try and traverse)
       [(cons path-elem rst)
@@ -87,9 +83,20 @@
          
          [((Union: ts) _)
           (apply Un (map (λ (t) (update t path)) ts))]
+
+         [((Intersection: ts) _)
+          (for/fold ([t Univ])
+                    ([elem (in-list ts)])
+            (intersect t (update elem path)))]
          
          [(_ _)
-          ;; This likely comes up with (-lst t) and we need to improve the system to make sure this case
-          ;; dosen't happen
-          ;;(int-err "update along ill-typed path: ~a ~a ~a" t t* lo)
-          t])])))
\ No newline at end of file
+          (match path-elem
+            [(CarPE:) (intersect t (-pair (update Univ rst) Univ))]
+            [(CdrPE:) (intersect t (-pair Univ (update Univ rst)))]
+            [(SyntaxPE:) (intersect t (-syntax-e (update Univ rst)))]
+            [(ForcePE:) (intersect t (-force (update Univ rst)))]
+            [_ t])])]
+      ;; path is empty (base case)
+      [_ (cond
+           [pos? (intersect (resolve t) new-t)]
+           [else (subtract (resolve t) new-t)])])))
diff --git a/typed-racket-lib/typed-racket/types/utils.rkt b/typed-racket-lib/typed-racket/types/utils.rkt
index 16ab53dd..dc789d11 100644
--- a/typed-racket-lib/typed-racket/types/utils.rkt
+++ b/typed-racket-lib/typed-racket/types/utils.rkt
@@ -14,17 +14,6 @@
 (provide (all-from-out "tc-result.rkt" "tc-error.rkt"))
 
 
-;; unfold : Type -> Type
-;; must be applied to a Mu
-(define (unfold t)
-  (match t
-    [(Mu: name b)
-     (define (sb target)
-       (type-case (#:Type sb #:Prop (sub-f sb) #:Object (sub-o sb))
-         target
-         [#:F name* (if (eq? name name*) t target)]))
-     (sb b)]))
-
 (define (instantiate-poly t types)
   (match t
     [(Poly: ns body)
@@ -114,14 +103,13 @@
         ok?)))
 
 (provide/cond-contract
- [unfold (Mu? . -> . Type/c)]
- [instantiate-poly ((or/c Poly? PolyDots? PolyRow?) (listof Type/c)
-                    . -> . Type/c)]
+ [instantiate-poly ((or/c Poly? PolyDots? PolyRow?) (listof Rep?)
+                    . -> . Rep?)]
  [instantiate-poly-dotted
-  (PolyDots? (listof Type/c) Type/c symbol? . -> . Type/c)] 
+  (PolyDots? (listof Rep?) Rep? symbol? . -> . Rep?)] 
  [fv (Rep? . -> . (listof symbol?))]
  [fi (Rep? . -> . (listof symbol?))]
- [fv/list ((listof Type/c) . -> . (set/c symbol?))]
+ [fv/list ((listof Rep?) . -> . (set/c symbol?))]
  [current-poly-struct (parameter/c (or/c #f poly?))]
  [has-optional-args? (-> (listof arr?) any)]
  )
diff --git a/typed-racket-lib/typed-racket/utils/primitive-comparison.rkt b/typed-racket-lib/typed-racket/utils/primitive-comparison.rkt
new file mode 100644
index 00000000..736f921e
--- /dev/null
+++ b/typed-racket-lib/typed-racket/utils/primitive-comparison.rkt
@@ -0,0 +1,55 @@
+#lang racket/base
+
+(require racket/unsafe/ops
+         racket/format)
+
+(provide primitive<=?)
+
+;; vector of predicates for primitives paired with
+;; functions which compair primitives of the same type
+(define prims
+  (vector  (cons (λ (v) (eq? v #t)) (λ _ #t))
+           (cons (λ (v) (eq? v #f)) (λ _ #t))
+           (cons (λ (v) (eq? v '())) (λ _ #t))
+           (cons real? <=)
+           (cons complex? (λ (x y) (and (<= (real-part x)
+                                            (real-part y))
+                                        (<= (imag-part x)
+                                            (imag-part y)))))
+           (cons char? char<=?)
+           (cons string? string<=?)
+           (cons bytes? (λ (b1 b2) (or (bytes<? b1 b2)
+                                       (bytes=? b1 b2))))
+           (cons symbol? (λ (s1 s2) (or (symbol<? s1 s2)
+                                        (eq? s1 s2))))
+           (cons keyword? (λ (k1 k2) (or (keyword<? k1 k2)
+                                         (eq? k1 k2))))
+           (cons pair? (λ (p1 p2) (and (primitive<=? (car p1) (car p2))
+                                       (primitive<=? (cdr p1) (cdr p2)))))
+           (cons vector? (λ (v1 v2) (and (< (vector-length v1) (vector-length v2))
+                                         (and (= (vector-length v1) (vector-length v2))
+                                              (for/and ([val1 (in-vector v1)]
+                                                        [val2 (in-vector v2)])
+                                                (primitive<=? val1 val2))))))
+           (cons box? (λ (b1 b2) (primitive<=? (unbox b1) (unbox b2))))))
+
+;; finds which index into prims 's' belongs
+(define (index-of s)
+  (let loop ([i 0])
+    (cond
+      [(unsafe-fx<= i (vector-length prims))
+       (if ((unsafe-car (unsafe-vector-ref prims i)) s)
+           i
+           (loop (unsafe-fx+ i 1)))]
+      [else (error 'index-of "impossible!")])))
+
+;; compares two primitives (i.e. sexps) based on the ordering
+;; implied by the 'prims' predicates and, if they are equal types of
+;; primitives, on the functions contained in prims
+(define (primitive<=? s1 s2)
+  (define idx1 (index-of s1))
+  (define idx2 (index-of s2))
+  (cond
+    [(unsafe-fx< idx1 idx2) #t]
+    [(unsafe-fx> idx1 idx2) #f]
+    [else ((unsafe-cdr (vector-ref prims idx1)) s1 s2)]))
diff --git a/typed-racket-lib/typed-racket/utils/utils.rkt b/typed-racket-lib/typed-racket/utils/utils.rkt
index f73c9abb..12cd22d1 100644
--- a/typed-racket-lib/typed-racket/utils/utils.rkt
+++ b/typed-racket-lib/typed-racket/utils/utils.rkt
@@ -5,9 +5,10 @@ This file is for utilities that are of general interest,
 at least theoretically.
 |#
 
-(require (for-syntax racket/base syntax/parse/pre racket/string)
+(require (for-syntax racket/base racket/string)
          racket/require-syntax racket/provide-syntax
          racket/match
+         syntax/parse/define
          racket/struct-info "timing.rkt")
 
 (provide
@@ -22,7 +23,8 @@ at least theoretically.
  filter-multiple
  syntax-length
  in-sequence-forever
- match*/no-order)
+ match*/no-order
+ bind)
 
 (define optimize? (make-parameter #t))
 (define-for-syntax enable-contracts? (and (getenv "PLT_TR_CONTRACTS") #t))
@@ -99,12 +101,15 @@ at least theoretically.
          define-struct/cond-contract
          define/cond-contract
          contract-req
+         define/provide
          define/cond-contract/provide
          define-for-cond-contract
          provide-for-cond-contract
          require-for-cond-contract
          begin-for-cond-contract)
 
+
+
 (define-require-syntax contract-req
   (if enable-contracts?
       (lambda (stx) (datum->syntax stx 'racket/contract))
@@ -136,11 +141,19 @@ at least theoretically.
         [(_ e:expr ...) #'(begin)])))
 
 
-(define-syntax-rule (define/cond-contract/provide (name . args) c . body)
-  (begin (define/cond-contract name c
-           (begin
-            (define (name . args) body)
-            name))
+(define-syntax (define/provide stx)
+  (syntax-parse stx
+    [(_ name:id . body)
+     (syntax/loc stx
+       (begin (define name . body)
+              (provide name)))]
+    [(_ (name:id . args) . body)
+     (syntax/loc stx
+       (begin (define (name . args) . body)
+              (provide name)))]))
+
+(define-simple-macro (define/cond-contract/provide (name:id . args) c . body)
+  (begin (define (name . args) . body)
          (provide/cond-contract [name c])))
 
 ;; these are versions of the contract forms conditionalized by `enable-contracts?'
@@ -253,3 +266,9 @@ at least theoretically.
         . clauses)
      #`(match* (val1 val2)
          . #,(parse-clauses #'clauses))]))
+
+
+(define-match-expander bind
+  (syntax-parser
+    [(_ x:id val:expr)
+     #'(app (λ (_) val) x)]))
diff --git a/typed-racket-more/typed/racket/sandbox.rkt b/typed-racket-more/typed/racket/sandbox.rkt
index 6b96c83e..c7c5e318 100644
--- a/typed-racket-more/typed/racket/sandbox.rkt
+++ b/typed-racket-more/typed/racket/sandbox.rkt
@@ -4,7 +4,7 @@
 ;; racket/sandbox
 
 (require racket/sandbox
-         (for-syntax (only-in typed-racket/rep/type-rep make-ValuesDots)))
+         (for-syntax (only-in typed-racket/rep/values-rep make-ValuesDots)))
 
 (provide exn:fail:resource?
          exn:fail:resource-resource)
diff --git a/typed-racket-test/fail/pr13209.rkt b/typed-racket-test/fail/pr13209.rkt
index 9bba8b82..e379e2aa 100644
--- a/typed-racket-test/fail/pr13209.rkt
+++ b/typed-racket-test/fail/pr13209.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"wrong number of arguments to structure type constructor")
+(exn-pred #rx"wrong number of arguments")
 #lang typed/racket
 
 ;; Test for PR 13209
diff --git a/typed-racket-test/succeed/type-printer-single-level.rkt b/typed-racket-test/succeed/type-printer-single-level.rkt
index 7794788c..9ef52a57 100644
--- a/typed-racket-test/succeed/type-printer-single-level.rkt
+++ b/typed-racket-test/succeed/type-printer-single-level.rkt
@@ -28,22 +28,21 @@
               (string-append "(U Integer String)\n[can expand further: Integer]"
                              "(-> Foo Foo)\n[can expand further: Foo]"
                              "(-> Number Integer)\n[can expand further: Integer Number]"
-                             "(-> (U String\n"
-                             "       0\n"
+                             "(-> (U 0\n"
                              "       1\n"
                              "       Byte-Larger-Than-One\n"
-                             "       Positive-Index-Not-Byte\n"
-                             "       Positive-Fixnum-Not-Index\n"
                              "       Negative-Fixnum\n"
+                             "       Negative-Integer-Not-Fixnum\n"
+                             "       Positive-Fixnum-Not-Index\n"
+                             "       Positive-Index-Not-Byte\n"
                              "       Positive-Integer-Not-Fixnum\n"
-                             "       Negative-Integer-Not-Fixnum)\n"
-                             "    (U String\n"
-                             "       0\n"
+                             "       String)\n"
+                             "    (U 0\n"
                              "       1\n"
                              "       Byte-Larger-Than-One\n"
-                             "       Positive-Index-Not-Byte\n"
-                             "       Positive-Fixnum-Not-Index\n"
                              "       Negative-Fixnum\n"
+                             "       Negative-Integer-Not-Fixnum\n"
+                             "       Positive-Fixnum-Not-Index\n"
+                             "       Positive-Index-Not-Byte\n"
                              "       Positive-Integer-Not-Fixnum\n"
-                             "       Negative-Integer-Not-Fixnum))\n"))
-
+                             "       String))\n"))
diff --git a/typed-racket-test/unit-tests/check-below-tests.rkt b/typed-racket-test/unit-tests/check-below-tests.rkt
index a8591fa7..b2245ae7 100644
--- a/typed-racket-test/unit-tests/check-below-tests.rkt
+++ b/typed-racket-test/unit-tests/check-below-tests.rkt
@@ -33,7 +33,7 @@
      (for-each check-object os)]
     [(tc-any-results: f)
      (check-prop f)]
-    [(? Type/c?)
+    [(? Type?)
      (void)]))
 
 
diff --git a/typed-racket-test/unit-tests/class-tests.rkt b/typed-racket-test/unit-tests/class-tests.rkt
index c8c443e1..2b0a9254 100644
--- a/typed-racket-test/unit-tests/class-tests.rkt
+++ b/typed-racket-test/unit-tests/class-tests.rkt
@@ -5,6 +5,7 @@
 (require (submod "typecheck-tests.rkt" test-helpers)
          (except-in "test-utils.rkt" private)
          (for-syntax racket/base
+                     (submod "typecheck-tests.rkt" test-helpers)
                      typed-racket/tc-setup
                      typed-racket/utils/tc-utils))
 
@@ -52,7 +53,7 @@
                           (init x)
                           (define/public (m x) 0)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"superclass expression should produce a class"]
    ;; Method using argument type
    [tc-e (let ()
@@ -83,7 +84,7 @@
                           (init [x 0])
                           (define/public (m x) (send this z))))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"method not understood.*method name: z"]
    ;; Send to other methods
    [tc-e (let ()
@@ -107,8 +108,8 @@
          -Void]
    ;; Send to non object
    [tc-err (send 4 m 3)
-      #:ret (ret (-val 5) -ff-propset)
-      #:expected (ret (-val 5) #f #f)]
+      #:ret (tc-ret -Bottom -ff-propset)
+      #:expected (tc-ret -Bottom -ff-propset)]
    ;; Fails, sending to multiple/unknown values
    [tc-err (send (values 'a 'b) m 'c)
            #:msg #rx"expected single value"]
@@ -131,7 +132,7 @@
            (define (f o) (send o m))
            (f (new (class object% (super-new)
                      (define/public (m) (values "foo" 'bar))))))
-         #:ret (ret (list (t:Un -String -Symbol) (t:Un -String -Symbol)))]
+         #:ret (tc-ret (list (t:Un -String -Symbol) (t:Un -String -Symbol)))]
    [tc-err
     (let ()
       (define obj
@@ -165,13 +166,13 @@
                     (super-new)
                     (field [x : String "foo"])))
              'not-string)
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"set-field! only allowed with"]
    ;; fails, field's default value has wrong type
    [tc-err (class object% (super-new)
              (: x Symbol)
              (field [x "foo"]))
-           #:ret (ret (-class #:field ([x -Symbol])))
+           #:ret (tc-ret (-class #:field ([x -Symbol])))
            #:msg #rx"expected: Symbol.*given: String"]
    ;; Fail, field access to missing field
    [tc-err (let ()
@@ -180,7 +181,7 @@
                           (super-new)
                           (define/public (m) (get-field n this))))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"missing an expected field.*field: n"]
    ;; Fail, conflict with parent field
    [tc-err (let ()
@@ -196,7 +197,7 @@
                           (field [n 17])
                           (super-new)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"has a conflicting public field.*field: n"]
    ;; Fail, conflict with parent method
    [tc-err (let ()
@@ -209,7 +210,7 @@
                           (super-new)
                           (define/public (m) 17)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"has a conflicting public method.*method: m"]
    ;; Inheritance
    [tc-e (let ()
@@ -226,7 +227,7 @@
          -Void]
    ;; fail, superclass expression is not a class with no expected type
    [tc-err (class "foo" (super-new))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg "expected: a class"]
    ;; should fail, too many methods
    [tc-err (let ()
@@ -235,7 +236,7 @@
                           (super-new)
                           (define/public (m) 0)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"method `m' that is not in expected type"]
    ;; same as previous
    [tc-err (let ()
@@ -244,7 +245,7 @@
                           (define/public (m x) (add1 x))
                           (define/public (n) 0)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"method `n' that is not in expected type"]
    ;; fails, too many inits
    [tc-err (let ()
@@ -252,7 +253,7 @@
              (define c% (class object% (super-new)
                           (init x)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"init `x' that is not in expected type"]
    ;; fails, init should be optional but is mandatory
    [tc-err (let ()
@@ -260,7 +261,7 @@
              (define c% (class object% (super-new)
                           (init str)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: optional init `str'.*given: mandatory init `str'"]
    ;; fails, too many fields
    [tc-err (let ()
@@ -268,7 +269,7 @@
              (define c% (class object% (super-new)
                           (field [str "foo"] [x 0])))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"field `x' that is not in expected type"]
    ;; test that an init with no annotation still type-checks
    ;; (though it will have the Any type)
@@ -313,7 +314,7 @@
                  (define/public (m) 0)))
 
              (mixin arg-class%))
-           #:ret (ret (-class #:method ([m (t:-> -Integer)] [n (t:-> -String)])))
+           #:ret (tc-ret (-class #:method ([m (t:-> -Integer)] [n (t:-> -String)])))
            #:msg #rx"lacks expected method `n'"]
    ;; Fail, bad mixin argument
    [tc-err (let ()
@@ -334,7 +335,7 @@
 
              (mixin arg-class%)
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"lacks expected method `m'"]
    ;; classes that don't use define/public directly
    [tc-e (let ()
@@ -369,7 +370,7 @@
              (: c% (Class (init [x Integer])))
              (define c% (class object% (init x)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"must call `super-new'"]
    ;; fails, non-top-level super-new
    ;; FIXME: this case also spits out additional untyped identifier
@@ -378,7 +379,7 @@
              (: c% (Class (init [x Integer])))
              (define c% (class object% (let () (super-new)) (init x)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"must call `super-new'"]
    ;; fails, bad super-new argument
    [tc-err (let ()
@@ -387,7 +388,7 @@
              (: d% (Class))
              (define d% (class c% (super-new [x "bad"])))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: Symbol.*given: String"]
    ;; test override
    [tc-e (let ()
@@ -418,7 +419,7 @@
                           (define/override (m y)
                             (string-append (assert y string?) "foo"))))
              (void))
-           #:ret (ret -Void)]
+           #:ret (tc-ret -Void)]
    ;; local field access and set!
    [tc-e (let ()
            (: c% (Class (field [x Integer])
@@ -460,7 +461,7 @@
                           (define/public (m y) 'a)
                           (string-append (string->symbol "a") "a")))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: String.*given: Symbol"]
    ;; fails, ill-typed method call
    [tc-err (let ()
@@ -469,7 +470,7 @@
                           (define/public (m y) 'a)
                           (m "foo")))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: Symbol.*given: String"]
    ;; fails, ill-typed field access
    [tc-err (let ()
@@ -478,7 +479,7 @@
                           (field [f "foo"])
                           (set! f 'a)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: String.*given: 'a"]
    ;; test private field
    [tc-e (let ()
@@ -504,14 +505,14 @@
              (: x Symbol)
              (define x 'a)
              (set! x "foo"))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg #rx"expected: Symbol.*given: String"]
    ;; fails, bad private field default
    [tc-err (class object%
              (super-new)
              (: x Symbol)
              (define x "foo"))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg #rx"expected: Symbol.*given: String"]
    ;; ok, synthesis works on private fields
    [tc-e (class object% (super-new)
@@ -550,20 +551,20 @@
              (define/private (x) 'a)
              (: m (-> String))
              (define/public (m) (x)))
-           #:ret (ret (-class #:method ([m (t:-> -String)])))
+           #:ret (tc-ret (-class #:method ([m (t:-> -String)])))
            #:msg #rx"expected: String.*given: Symbol"]
    ;; fails, not enough annotation on private
    [tc-err (class object% (super-new)
              (define/private (x) 3)
              (: m (-> Integer))
              (define/public (m) (x)))
-           #:ret (ret (-class #:method ([m (t:-> -Integer)])))
+           #:ret (tc-ret (-class #:method ([m (t:-> -Integer)])))
            #:msg #rx"Cannot apply expression of type Any"]
    ;; fails, ill-typed private method implementation
    [tc-err (class object% (super-new)
              (: x (-> Symbol))
              (define/private (x) "bad result"))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg #rx"expected: Symbol.*given: String"]
    ;; test optional init arg
    [tc-e (let ()
@@ -591,7 +592,7 @@
                           (: x Integer)
                           (init [x 0])))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: mandatory init `x'.*given: optional init `x'"]
    ;; fails, mandatory init not provided
    [tc-err (let ()
@@ -599,7 +600,7 @@
                           (: x Integer)
                           (init x)))
              (new d%))
-           #:ret (ret (-object #:init ([x -Integer #f])))
+           #:ret (tc-ret (-object #:init ([x -Integer #f])))
            #:msg #rx"value not provided for named init arg x"]
    ;; test that provided super-class inits don't count
    ;; towards the type of current class
@@ -618,10 +619,10 @@
                                  (init x))
                           (super-new [x 3])))
              (new c% [x 5]))
-           #:ret (ret (-object))]
+           #:ret (tc-ret (-object))]
    ;; fails, super-new can only be called once per class
    [tc-err (class object% (super-new) (super-new))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg #rx"`super-new' a single time"]
    ;; test passing an init arg to super-new
    [tc-e (let ()
@@ -641,10 +642,10 @@
              (: x String)
              (init x)
              (super-new [x x]))
-           #:ret (ret (-class #:init ([x -String #f])))]
+           #:ret (tc-ret (-class #:init ([x -String #f])))]
    ;; fails, superclass does not accept this init arg
    [tc-err (class object% (super-new [x 3]))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg "not accepted by superclass"]
    ;; test inherit method
    [tc-e (let ()
@@ -716,11 +717,11 @@
    [tc-err (class (class object% (super-new))
              (super-new)
              (inherit-field [y x]))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg #rx"superclass is missing a required field"]
    ;; fails, missing super method for inherit
    [tc-err (class (class object% (super-new)) (super-new) (inherit z))
-           #:ret (ret (-class))]
+           #:ret (tc-ret (-class))]
    ;; fails, bad argument type to inherited method
    [tc-err (class (class object% (super-new)
                     (: m (Integer -> Integer))
@@ -728,7 +729,7 @@
              (super-new)
              (inherit m)
              (m "foo"))
-           #:ret (ret (-class #:method ([m (t:-> -Integer -Integer)])))]
+           #:ret (tc-ret (-class #:method ([m (t:-> -Integer -Integer)])))]
    ;; test that keyword methods type-check
    [tc-e (let ()
            (: c% (Class [n (Integer #:foo Integer -> Integer)]))
@@ -857,7 +858,7 @@
                         (public [m m])
                         (define m (lambda () "a"))))
            (send (new c%) m))
-         #:ret (ret -String -true-propset)]
+         #:ret (tc-ret -String -true-propset)]
    ;; fails, internal name not accessible
    [tc-err (let ()
              (define c% (class object% (super-new)
@@ -899,7 +900,7 @@
                           (: i Integer)
                           (init ([i j]))))
              (new c% [i 5]))
-           #:ret (ret (-object #:init ([j -Integer #f])))]
+           #:ret (tc-ret (-object #:init ([j -Integer #f])))]
    ;; test that different internal names can map to the same external name
    ;; and that the internal-external name mapping is set correctly.
    [tc-e (class object%
@@ -919,7 +920,7 @@
    [tc-err (class object% (super-new)
              (: z Integer)
              (init [z "foo"]))
-           #:ret (ret (-class #:init ([z -Integer #t])))
+           #:ret (tc-ret (-class #:init ([z -Integer #t])))
            #:msg #rx"expected: Integer.*given: String"]
    ;; test init field default value
    [tc-e (let ()
@@ -932,7 +933,7 @@
    [tc-err (class object% (super-new)
              (: x Integer)
              (init-field ([x y] "foo")))
-           #:ret (ret (-class #:init ([y -Integer #t]) #:field ([y -Integer])))]
+           #:ret (tc-ret (-class #:init ([y -Integer #t]) #:field ([y -Integer])))]
    ;; test type-checking method with internal/external
    [tc-err (let ()
              (: c% (Class [n (Integer -> Integer)]))
@@ -951,7 +952,7 @@
    [tc-err (class object% (super-new)
              (define/public (m) (n))
              (define/public (n x) 0))
-           #:ret (ret (-class #:method ([m (t:-> -Bottom)] [n (t:-> Univ -Zero : -true-propset)])))
+           #:ret (tc-ret (-class #:method ([m (t:-> -Bottom)] [n (t:-> Univ -Zero : -true-propset)])))
            #:msg #rx"since it is not a function type"]
    ;; test type-checking for classes without any
    ;; internal type annotations on methods
@@ -959,7 +960,7 @@
            (define c% (class object% (super-new)
                         (define/public (m) "a")))
            (send (new c%) m))
-         #:ret (ret -String -true-propset)]
+         #:ret (tc-ret -String -true-propset)]
    ;; test inheritance without expected
    [tc-e (let ()
            (define c% (class (class object% (super-new)
@@ -1001,7 +1002,7 @@
                (class cls (super-new)
                  (field [x 5])))
              (row-inst f (Row (field [x Integer]))))
-           #:ret (ret (t:-> (-class 
+           #:ret (tc-ret (t:-> (-class 
                               #:row (make-Row null `([x ,-Integer]) null null #f))
                             (-class
                               #:row (make-Row null `([x ,-Integer]) null null #f)
@@ -1020,7 +1021,7 @@
                (row-inst f (Row (field [y Integer]))))
              (instantiated
               (class object% (super-new))))
-           #:ret (ret (-class
+           #:ret (tc-ret (-class
                         #:row (make-Row null (list (list 'y -Integer)) null null #f)
                         #:field ([x -Integer])))]
    ;; fails, the argument object lacks required fields (with inference)
@@ -1030,7 +1031,7 @@
                              (Class (field [x Any]) #:row-var r))))
              (define (mixin cls) cls)
              (mixin object%))
-           #:ret (ret (-class #:row (make-Row null null null null #f)
+           #:ret (tc-ret (-class #:row (make-Row null null null null #f)
                               #:field ([x Univ])))
            #:msg #rx"lacks expected field `x'"]
    ;; mixin application succeeds
@@ -1095,7 +1096,7 @@
                (class cls (super-new)
                  (field [x 5])))
              (row-inst f (Row (field [x Integer]))))
-           #:ret (ret (t:-> (-class 
+           #:ret (tc-ret (t:-> (-class 
                               #:row (make-Row null `([x ,-Integer]) null null #f))
                             (-class
                               #:row (make-Row null `([x ,-Integer]) null null #f)
@@ -1204,7 +1205,7 @@
                  (define/augment (m x)
                    (string-append x "bar"))))
              (send (new c%) m 'b))
-           #:ret (ret -Symbol)
+           #:ret (tc-ret -Symbol)
            #:msg #rx"expected: String.*given: Symbol"]
    ;; Fail, bad inner default
    [tc-err (class object%
@@ -1212,7 +1213,7 @@
              (: m (Symbol -> Symbol))
              (define/pubment (m x)
                (inner "foo" m x)))
-           #:ret (ret (-class #:method ([m (t:-> -Symbol -Symbol)])
+           #:ret (tc-ret (-class #:method ([m (t:-> -Symbol -Symbol)])
                               #:augment ([m (t:-> -Symbol -Symbol)])))
            #:msg #rx"expected: Symbol.*given: String"]
    ;; Fail, wrong number of arguments to inner
@@ -1221,7 +1222,7 @@
              (: m (Integer -> Integer))
              (define/pubment (m x)
                (inner 3 m)))
-           #:ret (ret (-class #:method ([m (t:-> -Integer -Integer)])
+           #:ret (tc-ret (-class #:method ([m (t:-> -Integer -Integer)])
                               #:augment ([m (t:-> -Integer -Integer)])))
            #:msg #rx"wrong number of arguments provided.*expected: 2"]
    ;; Fail, bad augment type
@@ -1237,7 +1238,7 @@
                  (super-new)
                  (define/augment (m x) "bad type")))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: Symbol.*given: String"]
    ;; Fail, cannot augment non-augmentable method
    [tc-err (let ()
@@ -1251,7 +1252,7 @@
                  (super-new)
                  (define/augment (m x) 1)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"superclass is missing a required augmentable method"]
    ;; Pubment with separate internal/external names
    [tc-e (let ()
@@ -1282,7 +1283,7 @@
                  (: x Symbol)
                  (init-field x)))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: String"]
    ;; test polymorphic class
    [tc-e (let ()
@@ -1303,7 +1304,7 @@
                  (init-field x)
                  (set! x "a")))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: A.*given: String"]
    ;; test polymorphism with keyword
    [tc-e (let ()
@@ -1343,21 +1344,21 @@
              (super-new)
              (: m (X -> X))
              (define/public (m x) "a"))
-           #:ret (ret (-poly (X) (-class #:method ([m (t:-> X X)]))))
+           #:ret (tc-ret (-poly (X) (-class #:method ([m (t:-> X X)]))))
            #:msg #rx"expected: X.*given: String"]
    ;; fails because default init value cannot be polymorphic
    [tc-err (class object%
              #:forall (Z)
              (super-new)
              (init-field [x : Z] [y : Z 0]))
-           #:ret (ret (-poly (Z) (-class #:init-field ([x Z #f] [y Z #t]))))
+           #:ret (tc-ret (-poly (Z) (-class #:init-field ([x Z #f] [y Z #t]))))
            #:msg #rx"expected: Z.*given: Zero"]
    ;; fails because default field value cannot be polymorphic
    [tc-err (class object%
              #:forall (Z)
              (super-new)
              (field [x : Z "a"]))
-           #:ret (ret (-poly (Z) (-class #:field ([x Z]))))
+           #:ret (tc-ret (-poly (Z) (-class #:field ([x Z]))))
            #:msg #rx"expected: Z.*given: String"]
    ;; test in-clause type annotations (next several tests)
    [tc-e (let ()
@@ -1402,7 +1403,7 @@
              (super-new)
              (: x String)
              (field [x : Symbol 0]))
-           #:ret (ret (-class #:field ([x -String])))
+           #:ret (tc-ret (-class #:field ([x -String])))
            #:msg #rx"duplicate type annotation.*new type: Symbol"]
    ;; fails, expected type and annotation don't match
    [tc-err (let ()
@@ -1410,13 +1411,13 @@
              (define c% (class object% (super-new)
                           (field [x : Symbol 'a])))
              (void))
-           #:ret (ret -Void)
+           #:ret (tc-ret -Void)
            #:msg #rx"expected: String.*given: Symbol"]
    ;; fails, but make sure it's not an internal error
    [tc-err (class object% (super-new)
              (define/pubment (foo x) 0)
              (define/public (g x) (foo 3)))
-           #:ret (ret (-class #:method ([g (t:-> Univ -Bottom)]
+           #:ret (tc-ret (-class #:method ([g (t:-> Univ -Bottom)]
                                         [foo (t:-> Univ -Zero : -true-propset)])
                               #:augment ([foo top-func])))
            #:msg #rx"Cannot apply expression of type Any"]
@@ -1483,7 +1484,7 @@
                           (super-new)
                           (init-rest [rst : (List Symbol)])))
              (make-object c% "wrong"))
-           #:ret (ret (make-Instance (make-Class #f null null null null (-Tuple (list -Symbol)))))
+           #:ret (tc-ret (make-Instance (make-Class #f null null null null (-Tuple (list -Symbol)))))
            #:msg #rx"expected: \\(List Symbol.*given: \\(List String"]
    ;; PR 14408, test init-field order
    [tc-e (let ()
@@ -1506,7 +1507,7 @@
          -Void]
    ;; fail, too many positional arguments to superclass
    [tc-err (class object% (super-make-object "foo"))
-           #:ret (ret (-class))
+           #:ret (tc-ret (-class))
            #:msg #rx"too many positional init arguments"]
    ;; check that case-lambda methods work
    [tc-e (let ()
@@ -1530,7 +1531,7 @@
              (: m (case-> (Any -> Integer)))
              (public m)
              (define m (case-lambda [(x) "bad"])))
-           #:ret (ret (-class #:method [(m (t:-> Univ -Integer))]))
+           #:ret (tc-ret (-class #:method [(m (t:-> Univ -Integer))]))
            #:msg #rx"expected: Integer.*given: String"]
    ;; test that rest args work
    [tc-e (let ()
@@ -1557,8 +1558,8 @@
            (class object%
              (super-new)
              (init x)))
-         #:ret (ret (-poly (A) (-class #:init ([x A #f]))))
-         #:expected (ret (-poly (A) (-class #:init ([x A #f]))) #f #f)]
+         #:ret (tc-ret (-poly (A) (-class #:init ([x A #f]))))
+         #:expected (tc-ret (-poly (A) (-class #:init ([x A #f]))) #f #f)]
    ;; test uses of a macro in the body of the class
    [tc-e
     (let ()
@@ -1741,7 +1742,7 @@
    [tc-e (class object%
            (super-new)
            (define/public foo (case-lambda [(str) (void)] [(sym size) (void)])))
-         (-class #:method [(foo (cl->* (t:-> Univ Univ -Void) (t:-> Univ -Void)))])]
+         (-class #:method [(foo (cl->* (t:-> Univ Univ -Void : -true-propset) (t:-> Univ -Void : -true-propset)))])]
    ;; PR 14911
    [tc-e (class object%
            (super-new)
@@ -2020,7 +2021,7 @@
                  (define/public (m)
                    (if (string? x) (string-append x "bar") "baz"))))
              (error "foo"))
-           #:msg #rx"expected: String.*given: \\(U String 'obfuscate\\)"]
+           #:msg #rx"expected: String.*given: \\(U 'obfuscate String\\)"]
    [tc-err (let ()
              (define c%
                (class object%
@@ -2032,7 +2033,7 @@
                  (define/public (m)
                    (if (string? x) (string-append x "bar") "baz"))))
              (error "foo"))
-           #:msg #rx"expected: String.*given: \\(U String 'obfuscate\\)"]
+           #:msg #rx"expected: String.*given: \\(U 'obfuscate String\\)"]
    [tc-err (let ()
              (define c%
                (class object%
@@ -2044,7 +2045,7 @@
                  (define/public (m)
                    (if (string? x) (string-append x "bar") "baz"))))
              (error "foo"))
-           #:msg #rx"expected: String.*given: \\(U String 'obfuscate\\)"]
+           #:msg #rx"expected: String.*given: \\(U 'obfuscate String\\)"]
    ;; tests that we are not creating objects for mutable private fields
    [tc-e (let ()
            (class object%
diff --git a/typed-racket-test/unit-tests/contract-tests.rkt b/typed-racket-test/unit-tests/contract-tests.rkt
index ba0267c3..6a13a605 100644
--- a/typed-racket-test/unit-tests/contract-tests.rkt
+++ b/typed-racket-test/unit-tests/contract-tests.rkt
@@ -5,7 +5,7 @@
                      syntax/parse)
          (for-template racket/base)
          (private type-contract)
-         (rep type-rep)
+         (rep type-rep values-rep)
          (types abbrev numeric-tower union)
          (static-contracts combinators optimize)
          (submod typed-racket/private/type-contract numeric-contracts)
@@ -137,7 +137,7 @@
               (t (make-Function
                    (list (make-arr* (list Univ) -Boolean #:kws (list (make-Keyword '#:key Univ #t))
                                     #:props (-PS (-is-type 0 -Symbol) (-not-type 0 -Symbol))))))
-              (t (-struct #'struct-name #f (list (make-fld -Symbol #'acc #f))))
+              (t (-struct #'struct-name1 #f (list (make-fld -Symbol #'acc #f))))
               ;; Adapted from PR 13815
               (t (-poly (a) (-> a a)))
               (t (-poly (a) (-mu X (-> a X))))
@@ -203,7 +203,7 @@
                         (-> -Boolean -Boolean)
                         (-> -Symbol -Symbol))
                       "two cases of arity 1")
-              (t/fail (-struct #'struct-name #f (list (make-fld -Symbol #'acc #f)) (-> -Symbol))
+              (t/fail (-struct #'struct-name2 #f (list (make-fld -Symbol #'acc #f)) (-> -Symbol))
                       "procedural structs are not supported")
               (t/fail (-Syntax (-> -Boolean -Boolean))
                       "required a flat contract but generated a chaperone contract")
@@ -218,7 +218,7 @@
                     (make-arr* (list) -Boolean #:kws (list (make-Keyword '#:key Univ #t)))
                     (make-arr* (list Univ Univ) -Boolean #:kws (list (make-Keyword '#:key2 Univ #t)))))
                 "case function type with optional keyword arguments")
-              (t/fail (-vec (-struct #'struct-name #f (list (make-fld (-seq -Symbol) #'acc #f)) #f #t))
+              (t/fail (-vec (-struct #'struct-name3 #f (list (make-fld (-seq -Symbol) #'acc #f)) #f #t))
                       "required a chaperone contract but generated an impersonator contract")
 
               (t-sc -Number number/sc)
diff --git a/typed-racket-test/unit-tests/generalize-tests.rkt b/typed-racket-test/unit-tests/generalize-tests.rkt
index 9eb2a3cd..cdbba86f 100644
--- a/typed-racket-test/unit-tests/generalize-tests.rkt
+++ b/typed-racket-test/unit-tests/generalize-tests.rkt
@@ -3,7 +3,7 @@
 (require "test-utils.rkt"
          racket/format
          rackunit
-         (rep rep-utils)
+         (rep rep-utils core-rep type-rep)
          (types generalize abbrev union)
          (for-syntax racket/base syntax/parse))
 
diff --git a/typed-racket-test/unit-tests/metafunction-tests.rkt b/typed-racket-test/unit-tests/metafunction-tests.rkt
index 497f0321..c88ef811 100644
--- a/typed-racket-test/unit-tests/metafunction-tests.rkt
+++ b/typed-racket-test/unit-tests/metafunction-tests.rkt
@@ -3,7 +3,7 @@
 (require "test-utils.rkt"
          rackunit racket/format
          (typecheck tc-metafunctions tc-subst)
-         (rep prop-rep type-rep object-rep)
+         (rep prop-rep type-rep object-rep values-rep)
          (types abbrev union prop-ops tc-result numeric-tower)
          (for-syntax racket/base syntax/parse))
 
@@ -16,9 +16,10 @@
      (quasisyntax/loc stx
        (test-case (~a '(new + existing = expected))
          (define success
-           (let/ec exit
-             (define-values (res-formulas res-props) (combine-props new existing exit))
-             #,(syntax/loc stx (check-equal? (append res-formulas res-props) expected))
+           (let-values ([(res-formulas res-props) (combine-props new existing)])
+             #,(syntax/loc stx (check-equal? (and res-formulas
+                                                  (append res-formulas res-props))
+                                             expected))
              #t))
          #,(syntax/loc stx (check-equal? success box-v))))]))
 
@@ -89,59 +90,59 @@
         (ret -Symbol (-PS -tt -ff)))
 
       (check-equal?
-        (values->tc-results (make-Values (list (-result -Symbol (-PS -tt -ff) (make-Path null '(0 0)))))
+        (values->tc-results (make-Values (list (-result -Symbol (-PS -tt -ff) (make-Path null '(0 . 0)))))
                             (list -empty-obj) (list Univ))
         (ret -Symbol (-PS -tt -ff)))
 
       (check-equal?
-        (values->tc-results (make-Values (list (-result (-opt -Symbol) (-PS (-is-type '(0 0) -String) -tt))))
+        (values->tc-results (make-Values (list (-result (-opt -Symbol) (-PS (-is-type '(0 . 0) -String) -tt))))
                             (list -empty-obj) (list Univ))
         (ret (-opt -Symbol) -tt-propset))
 
       (check-equal?
-        (values->tc-results (make-Values (list (-result (-opt -Symbol) (-PS (-not-type '(0 0) -String) -tt))))
+        (values->tc-results (make-Values (list (-result (-opt -Symbol) (-PS (-not-type '(0 . 0) -String) -tt))))
                             (list -empty-obj) (list Univ))
         (ret (-opt -Symbol) -tt-propset))
 
       (check-equal?
-        (values->tc-results (make-Values (list (-result (-opt -Symbol) (-PS (-not-type '(0 0) -String) -tt)
-                                                 (make-Path null '(0 0)))))
+        (values->tc-results (make-Values (list (-result (-opt -Symbol) (-PS (-not-type '(0 . 0) -String) -tt)
+                                                 (make-Path null '(0 . 0)))))
                             (list (make-Path null #'x)) (list Univ))
         (ret (-opt -Symbol) (-PS (-not-type #'x -String) -tt) (make-Path null #'x)))
 
       ;; Check additional props
       (check-equal?
-        (values->tc-results (make-Values (list (-result (-opt -String) (-PS -tt (-not-type '(0 0) -String))
-                                                 (make-Path null '(0 0)))))
+        (values->tc-results (make-Values (list (-result (-opt -String) (-PS -tt (-not-type '(0 . 0) -String))
+                                                 (make-Path null '(0 . 0)))))
                             (list (make-Path null #'x)) (list -String))
         (ret -String -true-propset (make-Path null #'x)))
 
       ;; Substitute into ranges correctly
       (check-equal?
-        (values->tc-results (make-Values (list (-result (-opt (-> Univ -Boolean : (-PS (-is-type '(0 0) -Symbol) -tt))))))
+        (values->tc-results (make-Values (list (-result (-opt (-> Univ -Boolean : (-PS (-is-type '(0 . 0) -Symbol) -tt))))))
                             (list (make-Path null #'x)) (list Univ))
-        (ret (-opt (-> Univ -Boolean : (-PS (-is-type '(0 0) -Symbol) -tt)))))
+        (ret (-opt (-> Univ -Boolean : (-PS (-is-type '(0 . 0) -Symbol) -tt)))))
 
       (check-equal?
-        (values->tc-results (make-Values (list (-result (-opt (-> Univ -Boolean : (-PS (-is-type '(1 0) -Symbol) -tt))))))
+        (values->tc-results (make-Values (list (-result (-opt (-> Univ -Boolean : (-PS (-is-type '(1 . 0) -Symbol) -tt))))))
                             (list (make-Path null #'x)) (list Univ))
         (ret (-opt (-> Univ -Boolean : (-PS (-is-type #'x -Symbol) -tt)))))
 
       ;; Substitute into prop of any values
       (check-equal?
-        (values->tc-results (make-AnyValues (-is-type '(0 0) -String))
+        (values->tc-results (make-AnyValues (-is-type '(0 . 0) -String))
                             (list (make-Path null #'x)) (list Univ))
         (tc-any-results (-is-type #'x -String)))
 
 
       (check-equal?
-        (values->tc-results (-values-dots null (-> Univ -Boolean : (-PS (-is-type '(1 0) -String) -tt)) 'b)
+        (values->tc-results (-values-dots null (-> Univ -Boolean : (-PS (-is-type '(1 . 0) -String) -tt)) 'b)
                             (list (make-Path null #'x)) (list Univ))
         (ret null null null (-> Univ -Boolean : (-PS (-is-type #'x -String) -tt)) 'b))
 
       ;; Prop is restricted by type of object
       (check-equal?
-        (values->tc-results (make-Values (list (-result -Boolean (-PS (-is-type '(0 0) -PosReal) (-is-type '(0 0) -NonPosReal)))))
+        (values->tc-results (make-Values (list (-result -Boolean (-PS (-is-type '(0 . 0) -PosReal) (-is-type '(0 . 0) -NonPosReal)))))
                             (list (make-Path null #'x)) (list -Integer))
         (ret -Boolean (-PS (-is-type #'x -PosInt) (-is-type #'x -NonPosInt))))
 
@@ -150,9 +151,9 @@
         (values->tc-results
          (make-Values
           (list (-result -Boolean
-                         (-PS (make-TypeProp (make-Path (list -car) '(0 0))
+                         (-PS (make-TypeProp (make-Path (list -car) '(0 . 0))
                                              -PosReal)
-                              (make-TypeProp (make-Path (list -car) '(0 0))
+                              (make-TypeProp (make-Path (list -car) '(0 . 0))
                                              -NonPosReal)))))
          (list (make-Path null #'x))
          (list (-lst -Integer)))
@@ -163,12 +164,12 @@
 
     (test-suite "replace-names"
       (check-equal?
-        (replace-names (list (list #'x (make-Path null (list 0 0))))
+        (replace-names (list #'x) (list (make-Path null '(0 . 0)))
                        (ret Univ -tt-propset (make-Path null #'x)))
-        (ret Univ -tt-propset (make-Path null (list 0 0))))
+        (ret Univ -tt-propset (make-Path null '(0 . 0))))
       (check-equal?
-        (replace-names (list (list #'x (make-Path null (list 0 0))))
+        (replace-names (list #'x) (list (make-Path null '(0 . 0)))
                        (ret (-> Univ Univ : -tt-propset : (make-Path null #'x))))
-        (ret (-> Univ Univ : -tt-propset : (make-Path null (list 1 0)))))
+        (ret (-> Univ Univ : -tt-propset : (make-Path null '(1 . 0)))))
     )
   ))
diff --git a/typed-racket-test/unit-tests/parse-type-tests.rkt b/typed-racket-test/unit-tests/parse-type-tests.rkt
index 66d0d3ad..ec6f9777 100644
--- a/typed-racket-test/unit-tests/parse-type-tests.rkt
+++ b/typed-racket-test/unit-tests/parse-type-tests.rkt
@@ -10,7 +10,7 @@
            (env tvar-env type-alias-env mvar-env)
            (utils tc-utils)
            (private parse-type)
-           (rep type-rep)
+           (rep type-rep values-rep)
 
            (submod typed-racket/base-env/base-types initialize)
            (rename-in (types union abbrev numeric-tower resolve)
@@ -168,13 +168,13 @@
     (t:->* (list Univ) -Boolean : (-PS (-not-type 0 -Number) (-is-type 0 -Number)))]
    [(-> Any (-> Any Boolean : #:+ (Number @ 1 0) #:- (! Number @ 1 0)))
     (t:-> Univ
-          (t:->* (list Univ) -Boolean : (-PS (-is-type '(1 0) -Number) (-not-type '(1 0) -Number))))]
+          (t:->* (list Univ) -Boolean : (-PS (-is-type (cons 1 0) -Number) (-not-type (cons 1 0) -Number))))]
    [(-> Any Any (-> Any Boolean : #:+ (Number @ 1 1) #:- (! Number @ 1 1)))
     (t:-> Univ Univ
-          (t:->* (list Univ) -Boolean : (-PS (-is-type '(1 1) -Number) (-not-type '(1 1) -Number))))]
+          (t:->* (list Univ) -Boolean : (-PS (-is-type (cons 1 1) -Number) (-not-type (cons 1 1) -Number))))]
    [(-> Any #:foo Any (-> Any Boolean : #:+ (Number @ 1 0) #:- (! Number @ 1 0)))
     (->key Univ #:foo Univ #t
-           (t:->* (list Univ) -Boolean : (-PS (-is-type '(1 0) -Number) (-not-type '(1 0) -Number))))]
+           (t:->* (list Univ) -Boolean : (-PS (-is-type (cons 1 0) -Number) (-not-type (cons 1 0) -Number))))]
    [(All (a b) (-> (-> a Any : #:+ b) (Listof a) (Listof b)))
     (-poly (a b) (t:-> (asym-pred a Univ (-PS (-is-type 0 b) -tt)) (-lst a) (-lst b)))]
    [(All (a b) (-> (-> a Any : #:+ (! b)) (Listof a) (Listof b)))
@@ -239,7 +239,7 @@
    [(->* (#:bar Integer Integer) (#:foo Integer String) Void)
     (->optkey -Integer [-String] #:bar -Integer #t #:foo -Integer #f -Void)]
    [(->* (Any (-> Any Boolean : #:+ (String @ 1 0))) Void)
-    (t:-> Univ (t:->* (list Univ) -Boolean : (-PS (-is-type '(1 0) -String) -tt))
+    (t:-> Univ (t:->* (list Univ) -Boolean : (-PS (-is-type (cons 1 0) -String) -tt))
           -Void)]
    [FAIL (->* (Any (-> Any Boolean : #:+ (String @ 2 0))) Void)
          #:msg "Index 2 used in"]
diff --git a/typed-racket-test/unit-tests/prop-tests.rkt b/typed-racket-test/unit-tests/prop-tests.rkt
index 725283ea..2f9620c0 100644
--- a/typed-racket-test/unit-tests/prop-tests.rkt
+++ b/typed-racket-test/unit-tests/prop-tests.rkt
@@ -59,7 +59,7 @@
         -ff
         -ff)
 
-      (test-opposite #:not-complementary #:contradictory
+      (test-opposite #:complementary #:contradictory
         -ff
         -tt)
 
diff --git a/typed-racket-test/unit-tests/remove-intersect-tests.rkt b/typed-racket-test/unit-tests/remove-intersect-tests.rkt
index 0b92257c..5b31f7ef 100644
--- a/typed-racket-test/unit-tests/remove-intersect-tests.rkt
+++ b/typed-racket-test/unit-tests/remove-intersect-tests.rkt
@@ -3,7 +3,7 @@
          (for-syntax racket/base)
          (r:infer infer)
          (rep type-rep)
-         (types abbrev numeric-tower subtype union remove overlap)
+         (types abbrev numeric-tower subtype union subtract overlap)
          rackunit)
 (provide tests)
 (gen-test-main)
@@ -64,10 +64,10 @@
   (syntax-case stx ()
     [(_ [t1 t2 res] ...)
      (syntax/loc stx
-       (test-suite "Tests for remove"
-                   (test-check (format "~a ~a" 't1 't2) type-compare? (remove t1 t2) res) ...))]))
+       (test-suite "Tests for subtract"
+                   (test-check (format "~a ~a" 't1 't2) type-compare? (subtract t1 t2) res) ...))]))
 
-(define remove-tests
+(define subtract-tests
   (remo-tests
    [(Un -Number -Symbol) -Number -Symbol]
    [-Number -Number (Un)]
@@ -90,7 +90,7 @@
    ))
 
 (define tests
-  (test-suite "Remove Intersect"
-     remove-tests
+  (test-suite "Subtract Intersect"
+     subtract-tests
      intersect-tests
      overlap-tests))
diff --git a/typed-racket-test/unit-tests/special-env-typecheck-tests.rkt b/typed-racket-test/unit-tests/special-env-typecheck-tests.rkt
index 3cc36db3..aaa7ae5f 100644
--- a/typed-racket-test/unit-tests/special-env-typecheck-tests.rkt
+++ b/typed-racket-test/unit-tests/special-env-typecheck-tests.rkt
@@ -27,11 +27,11 @@
 
 (begin-for-syntax (do-standard-inits))
 
-(define-syntax-rule (tc-e/t e t) (tc-e e #:ret (ret t -true-propset)))
+(define-syntax-rule (tc-e/t e t) (tc-e e #:ret (reduce-tc-results/subsumption (ret t -true-propset))))
 
 (define-syntax (tc-e stx)
   (syntax-parse stx
-    [(tc-e expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))]
+    [(tc-e expr ty) (syntax/loc stx (tc-e expr #:ret (reduce-tc-results/subsumption (ret ty))))]
     [(id a #:ret b)
      (syntax/loc stx
        (test-case (format "~a ~a" (quote-line-number id) 'a)
@@ -44,7 +44,9 @@
             [(res2) (phase1-phase0-eval #`'#,b)])
            (with-check-info (['expanded expanded])
              (unless (tc-result-equal/test? res1 res2)
-               (fail-check "Expression didn't have expected type."))))))]))
+               (fail-check (format "Expression didn't have expected type.\n Expected: ~a\n Actual: ~a\n"
+                                   (struct->vector res1)
+                                   (struct->vector res2))))))))]))
 
 (define tests
   (test-suite
diff --git a/typed-racket-test/unit-tests/subtype-tests.rkt b/typed-racket-test/unit-tests/subtype-tests.rkt
index 0671040e..831af426 100644
--- a/typed-racket-test/unit-tests/subtype-tests.rkt
+++ b/typed-racket-test/unit-tests/subtype-tests.rkt
@@ -2,7 +2,7 @@
 
 (require "test-utils.rkt"
          (types subtype numeric-tower union utils abbrev)
-         (rep type-rep)
+         (rep type-rep values-rep)
          (env init-envs type-env-structs)
          rackunit
          (for-syntax racket/base))
@@ -60,6 +60,8 @@
     [(-unsafe-intersect -Sexp
                         (Un -Null (-pair -Sexp (-unsafe-intersect (make-Listof Univ) -Sexp))))
      (make-Listof Univ)]
+    [(-unsafe-intersect (-v A) (-v B))
+     (Un -String (-unsafe-intersect (-v A) (-v B)))]
    ;; sexps vs list*s of nums
    [(-mu x (Un -Number -Symbol (make-Listof x))) (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))]
    [(-mu x (Un -Number (make-Listof x))) (-mu x (Un -Number -Symbol (make-Listof x)))]
@@ -131,7 +133,7 @@
     (cl-> [() (-pair -Number (-v b))]
           [(-Number) (-pair -Number (-v b))])]
 
-   [(-values (list -Number)) (-values (list Univ))]
+   ;[(-values (list -Number)) (-values (list Univ))]
 
    [(-poly (b) ((Un (make-Base 'foo #'dummy values #f)
                     (-struct #'bar #f
@@ -171,6 +173,8 @@
    [(-pair -String (-lst -String)) (-seq -String)]
    [FAIL (-pair -String (-lst -Symbol)) (-seq -String)]
    [FAIL (-pair -String (-vec -String)) (-seq -String)]
+   [(-mpair -String -Null) (-seq -String)]
+   [(-mlst -String) (-seq -String)]
    [(-mpair -String (-mlst -String)) (-seq -String)]
    [FAIL (-mpair -String (-mlst -Symbol)) (-seq -String)]
    [FAIL (-mpair -String (-vec -String)) (-seq -String)]
@@ -280,8 +284,8 @@
    [FAIL (make-ListDots (-box (make-F 'a)) 'a) (-lst (-box Univ))]
    [(make-ListDots (-> -Symbol (make-F 'a)) 'a) (-lst (-> -Symbol Univ))]
 
-   [FAIL (make-ValuesDots (list) -Symbol 'a) (make-ValuesDots (list (-result -String)) -String 'a)]
-   [(-values (list -Bottom)) (-values (list -String -Symbol))]
+   ;[FAIL (make-ValuesDots (list) -Symbol 'a) (make-ValuesDots (list (-result -String)) -String 'a)]
+   ;[(-values (list -Bottom)) (-values (list -String -Symbol))]
 
    [(-> Univ -Bottom) (-> Univ (-values (list -String -Symbol)))]
    [(-> Univ -Bottom) (-> Univ (-values-dots null -String 'x))]
diff --git a/typed-racket-test/unit-tests/type-printer-tests.rkt b/typed-racket-test/unit-tests/type-printer-tests.rkt
index 047698e7..ae7f4c23 100644
--- a/typed-racket-test/unit-tests/type-printer-tests.rkt
+++ b/typed-racket-test/unit-tests/type-printer-tests.rkt
@@ -7,6 +7,7 @@
          typed-racket/standard-inits
          typed-racket/tc-setup
          typed-racket/rep/type-rep
+         typed-racket/rep/values-rep
          typed-racket/types/abbrev
          typed-racket/types/numeric-tower
          typed-racket/types/printer
@@ -21,7 +22,7 @@
   (string=? (format "~a" thing) str))
 
 (define (pretty-prints-as? thing str)
-  (string=? (pretty-format-type thing) str))
+  (string=? (pretty-format-rep thing) str))
 
 (define-binary-check (check-prints-as? prints-as? actual expected))
 (define-binary-check (check-pretty-prints-as? pretty-prints-as? actual expected))
@@ -49,9 +50,12 @@
     (check-prints-as? (-lst* -String -Symbol) "(List String Symbol)")
 
     ;; next three cases for PR 14552
-    (check-prints-as? (-mu x (Un (-pair x x) -Null)) "(Rec x (U Null (Pairof x x)))")
-    (check-prints-as? (-mu x (Un (-pair (-box x) x) -Null)) "(Rec x (U Null (Pairof (Boxof x) x)))")
-    (check-prints-as? (-mu x (Un (-mpair x x) -Null)) "(Rec x (U Null (MPairof x x)))")
+    (check-prints-as? (-mu x (Un (-pair x x) -Null))
+                      "(Rec x (U Null (Pairof x x)))")
+    (check-prints-as? (-mu x (Un (-pair (-box x) x) -Null))
+                      "(Rec x (U Null (Pairof (Boxof x) x)))")
+    (check-prints-as? (-mu x (Un (-mpair x x) -Null))
+                      "(Rec x (U Null (MPairof x x)))")
 
     (check-prints-as? -Custodian "Custodian")
     (check-prints-as? (make-Opaque #'integer?) "(Opaque integer?)")
@@ -86,14 +90,14 @@
     (check-prints-as? (-> Univ Univ -Boolean : (-PS (-is-type 1 -String) -tt))
                       "(-> Any Any Boolean)")
     ;; PR 14510 (next three tests)
-    (check-prints-as? (-> Univ (-> Univ -Boolean : (-PS (-is-type '(1 0) -String)
-                                                        (-not-type '(1 0) -String))))
+    (check-prints-as? (-> Univ (-> Univ -Boolean : (-PS (-is-type '(1 . 0) -String)
+                                                        (-not-type '(1 . 0) -String))))
                       "(-> Any (-> Any Boolean))")
-    (check-prints-as? (-> Univ Univ -Boolean : (-PS (-is-type '(0 1) -String)
-                                                    (-not-type '(0 1) -String)))
+    (check-prints-as? (-> Univ Univ -Boolean : (-PS (-is-type '(0 . 1) -String)
+                                                    (-not-type '(0 . 1) -String)))
                       "(-> Any Any Boolean)")
-    (check-prints-as? (-> Univ Univ -Boolean : (-PS (-is-type '(0 0) -String)
-                                                    (-not-type '(0 0) -String)))
+    (check-prints-as? (-> Univ Univ -Boolean : (-PS (-is-type '(0 . 0) -String)
+                                                    (-not-type '(0 . 0) -String)))
                       "(-> Any Any Boolean)")
     (check-prints-as? (-> Univ (make-Values (list (-result -String -tt-propset -empty-obj)
                                                   (-result -String -tt-propset -empty-obj))))
@@ -110,15 +114,15 @@
                              (one-of/c 'binary 'text)
                              #f
                              -Void)
-                      (string-append "(-> Any Path-String [#:exists (U 'error"
-                                     " 'append 'update 'replace 'truncate"
-                                     " 'truncate/replace)] [#:mode (U"
+                      (string-append "(-> Any Path-String [#:exists (U 'append"
+                                     " 'error 'replace 'truncate 'truncate/replace"
+                                     " 'update)] [#:mode (U"
                                      " 'binary 'text)] Void)"))
     (check-prints-as? (-> Univ (-AnyValues -tt)) "(-> Any AnyValues)")
-    (check-prints-as? (-> Univ (-AnyValues (-is-type '(0 0) -String)))
+    (check-prints-as? (-> Univ (-AnyValues (-is-type '(0 . 0) -String)))
                       "(-> Any AnyValues : (String @ (0 0)))")
     (check-prints-as? (-AnyValues -tt) "AnyValues")
-    (check-prints-as? (-AnyValues (-is-type '(0 0) -String))
+    (check-prints-as? (-AnyValues (-is-type '(0 . 0) -String))
                       "(AnyValues : (String @ (0 0)))")
 
     (check-prints-as? (->opt Univ [] -Void) "(-> Any Void)")
diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt
index bdb2ef3a..69385f5e 100644
--- a/typed-racket-test/unit-tests/typecheck-tests.rkt
+++ b/typed-racket-test/unit-tests/typecheck-tests.rkt
@@ -28,13 +28,20 @@
   (define (cross-phase-failure-check-infos* cpf)
     (map (λ (args) (apply check-info args)) (cross-phase-failure-check-infos cpf))))
 
+(module custom-ret racket/base
+  (require typed-racket/utils/utils
+           (rename-in (types prop-ops tc-result) [ret raw-ret]))
+  (provide tc-ret)
+  (define (tc-ret . args)
+    (reduce-tc-results/subsumption (apply raw-ret args))))
+
 ;; Functions for testing correct behavior of typechecking
 (module tester racket/base
   (require
     (submod ".." cross-phase-failure)
     typed-racket/utils/utils
     racket/base racket/match
-    (types tc-result printer)
+    (rename-in (types prop-ops tc-result printer) [ret raw-ret])
     syntax/parse
     (for-template (only-in typed-racket/typed-racket do-standard-inits))
     (typecheck typechecker check-below)
@@ -44,10 +51,9 @@
     test-literal test-literal/fail
     test test/proc test/fail)
 
-
   (do-standard-inits)
   (print-complex-props? #t)
-
+  
   ;; tr-expand: syntax? -> syntax?
   ;; Expands out a form and annotates it with necesarry TR machinery.
   (define (tr-expand stx)
@@ -89,9 +95,9 @@
           [(_ _) ""]))
 
       (raise (cross-phase-failure
-               #:actual result
-               #:expected golden
-               (string-append base-message extra-message1 extra-message2)))))
+              #:actual result
+              #:expected golden
+              (string-append base-message extra-message1 extra-message2)))))
 
   ;; test: syntax? tc-results? [(option/c tc-results?)]
   ;;       [(listof (list id type))] -> void?
@@ -173,11 +179,13 @@
   'cross-phase-failure
   "evaluator.rkt"
   (except-in "test-utils.rkt" private)
+  'custom-ret
   syntax/location syntax/srcloc
   (for-syntax
     racket/base
     syntax/parse
-    'tester))
+    'tester
+    'custom-ret))
 
 (provide tests)
 (gen-test-main)
@@ -193,16 +201,17 @@
            tc-e/t
            tc-err
            tc-l
-           tc-l/err))
+           tc-l/err
+           tc-ret))
 
 (begin-for-syntax
   (define-splicing-syntax-class return
-    (pattern ty:expr #:attr v #'(ret ty))
+    (pattern ty:expr #:attr v #'(tc-ret ty))
     (pattern (~seq #:ret r:expr) #:attr v #'r))
 
   (define-splicing-syntax-class err-return
     (pattern (~seq #:ret r:expr) #:attr v #'r)
-    (pattern (~seq) #:attr v #'(ret -Bottom)))
+    (pattern (~seq) #:attr v #'(tc-ret -Bottom)))
 
   (define-splicing-syntax-class expected
     (pattern (~seq #:expected v:expr))
@@ -236,10 +245,6 @@
 ;;Constructs the syntax that calls eval and returns the answer to the user
 (define-syntax (tc-e stx)
   (syntax-parse stx
-    [(_ code:expr #:proc p)
-     (quasisyntax/loc stx
-       (test-phase1 code
-         (test/proc (quote-syntax code) p)))]
     [(_ code:expr return:return ex:expected env:extend-env)
      (quasisyntax/loc stx
        (test-phase1 code
@@ -247,7 +252,7 @@
 
 (define-syntax (tc-e/t stx)
   (syntax-parse stx
-    [(_ e t) (syntax/loc stx (tc-e e #:ret (ret t -true-propset)))]))
+    [(_ e t) (syntax/loc stx (tc-e e #:ret (tc-ret t)))]))
 
 ;; check that a literal typechecks correctly
 (define-syntax (tc-l stx)
@@ -315,7 +320,7 @@
   (prefix-in r: (only-in racket/base let-values))
   ;; Needed for constructing TR types in expected values
   (for-syntax
-    (rep type-rep prop-rep object-rep)
+    (rep core-rep type-rep prop-rep object-rep values-rep)
     (base-env base-structs)
     (rename-in (types abbrev union numeric-tower prop-ops utils resolve)
                [Un t:Un]
@@ -335,7 +340,7 @@
         e]))
 
   (define (-path t var)
-    (ret t
+    (tc-ret t
          (-PS (-not-type var (-val #f))
               (-is-type var (-val #f)))
          (make-Path null var))))
@@ -528,7 +533,7 @@
         [tc-e/t (lambda: ([x : Number] [y : Boolean]) 3)
                 (t:-> -Number -Boolean -PosByte : -true-propset)]
         [tc-e/t (lambda () 3) (t:-> -PosByte : -true-propset)]
-        [tc-e (values 3 4) #:ret (ret (list -PosByte -PosByte) (list -true-propset -true-propset))]
+        [tc-e (values 3 4) #:ret (tc-ret (list -PosByte -PosByte) (list -true-propset -true-propset))]
         [tc-e (cons 3 4) (-pair -PosByte -PosByte)]
         [tc-e (cons 3 (ann '() : (Listof Integer))) (make-Listof -Integer)]
         [tc-e (void) -Void]
@@ -536,11 +541,11 @@
         [tc-e (void #t #f '(1 2 3)) -Void]
         [tc-e/t #() (make-HeterogeneousVector (list))]
         [tc-err #(3)
-           #:ret (ret (make-HeterogeneousVector (list -Integer -Integer)))
-           #:expected (ret (make-HeterogeneousVector (list -Integer -Integer)))]
+                #:ret (tc-ret (make-HeterogeneousVector (list -Integer -Integer)))
+                #:expected (tc-ret (make-HeterogeneousVector (list -Integer -Integer)))]
         [tc-err #(3 4 5)
-           #:ret (ret (make-HeterogeneousVector (list -Integer -Integer)))
-           #:expected (ret (make-HeterogeneousVector (list -Integer -Integer)))]
+                #:ret (tc-ret (make-HeterogeneousVector (list -Integer -Integer)))
+                #:expected (tc-ret (make-HeterogeneousVector (list -Integer -Integer)))]
         [tc-e/t #(3 4 5) (make-HeterogeneousVector (list -Integer -Integer -Integer))]
         [tc-e/t '(2 3 4) (-lst* -PosByte -PosByte -PosByte)]
         [tc-e/t '(2 3 #t) (-lst* -PosByte -PosByte (-val #t))]
@@ -549,8 +554,8 @@
         [tc-e (vector) (make-HeterogeneousVector (list))]
         [tc-e (vector) #:ret (tc-any-results -tt) #:expected (tc-any-results #f)]
         [tc-err (vector)
-           #:ret (ret -Integer)
-           #:expected (ret -Integer)]
+                #:ret (tc-ret -Integer)
+           #:expected (tc-ret -Integer)]
         [tc-e (vector-immutable 2 "3" #t) (make-HeterogeneousVector (list -Integer -String -Boolean))]
         [tc-e (make-vector 4 1) (-vec -Integer)]
         [tc-e (build-vector 4 (lambda (x) 1)) (-vec -Integer)]
@@ -573,16 +578,16 @@
                 (make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))]
         [tc-e/t (plambda: (a) ([l : (Listof a)]) (car l))
                 (make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))]
-        [tc-e/t (case-lambda: [([a : Number] [b : Number]) (+ a b)]) (t:-> -Number -Number -Number)]
+        [tc-e/t (case-lambda: [([a : Number] [b : Number]) (+ a b)]) (t:-> -Number -Number -Number : -true-propset)]
         [tc-e/t (tr:case-lambda [([a : Number] [b : Number]) (+ a b)])
-                (t:-> -Number -Number -Number)]
+                (t:-> -Number -Number -Number : -true-propset)]
         [tc-e/t (let: ([x : Number 5]) x) -Number]
         [tc-e (let-values ([(x) 4]) (+ x 1)) -PosIndex]
         [tc-e (let-values ([(x y) (values 3 #t)]) (and (= x 1) (not y)))
-              #:ret (ret -Boolean -false-propset)]
+              #:ret (tc-ret -Boolean -false-propset)]
         [tc-e/t (values 3) -PosByte]
-        [tc-e (values) #:ret (ret null)]
-        [tc-e (values 3 #f) #:ret (ret (list -PosByte (-val #f)) (list -true-propset -false-propset))]
+        [tc-e (values) #:ret (tc-ret null)]
+        [tc-e (values 3 #f) #:ret (tc-ret (list -PosByte (-val #f)) (list -true-propset -false-propset))]
         [tc-e (map #{values @ Symbol} '(a b c)) (-pair -Symbol (make-Listof -Symbol))]
         [tc-e (andmap add1 (ann '() (Listof Number))) (t:Un (-val #t) -Number)]
         [tc-e (ormap add1 (ann '() (Listof Number))) (t:Un (-val #f) -Number)]
@@ -621,9 +626,9 @@
         [tc-e/t (begin0 #t) (-val #t)]
         [tc-e/t (begin0 #t 3) (-val #t)]
         [tc-e/t #t (-val #t)]
-        [tc-e #f #:ret (ret (-val #f) -false-propset)]
+        [tc-e #f #:ret (tc-ret (-val #f) -false-propset)]
         [tc-e/t '#t (-val #t)]
-        [tc-e '#f #:ret (ret (-val #f) -false-propset)]
+        [tc-e '#f #:ret (tc-ret (-val #f) -false-propset)]
         [tc-e/t (if #f 'a 3) -PosByte]
         [tc-e/t (if #f #f #t) (t:Un (-val #t))]
         [tc-e (when #f 3) -Void]
@@ -633,7 +638,7 @@
                             [(null? x) 1]))
               -One]
         [tc-e/t (lambda: ([x : Number] . [y : Number *]) (car y))
-                (->* (list -Number) -Number -Number)]
+                (->* (list -Number) -Number -Number : -true-propset)]
         [tc-e ((lambda: ([x : Number] . [y : Number *]) (car y)) 3) -Number]
         [tc-e ((lambda: ([x : Number] . [y : Number *]) (car y)) 3 4 5) -Number]
         [tc-e ((lambda: ([x : Number] . [y : Number *]) (car y)) 3 4) -Number]
@@ -645,12 +650,12 @@
                 (->* (list -Number) -Boolean -Boolean)]
         [tc-e ((lambda: ([x : Number] . [y : Boolean *]) (car y)) 3) -Boolean]
         [tc-e (apply (lambda: ([x : Number] . [y : Boolean *]) (car y)) 3 '(#f)) -Boolean]
-        [tc-e (lambda args (void)) #:ret (ret (t:-> -String -Void) -true-propset)
-                                   #:expected (ret (t:-> -String -Void) -true-propset)]
+        [tc-e (lambda args (void)) #:ret (tc-ret (t:-> -String -Void) -true-propset)
+                                   #:expected (tc-ret (t:-> -String -Void) -true-propset)]
         [tc-e (lambda (x y . z)
                 (+ x y (+ (length z))))
-              #:ret (ret (t:-> -Byte -Index -Number) -true-propset)
-              #:expected (ret (t:-> -Byte -Index -Number) -true-propset)]
+              #:ret (tc-ret (t:-> -Byte -Index -Number) -true-propset)
+              #:expected (tc-ret (t:-> -Byte -Index -Number) -true-propset)]
 
         [tc-e/t (let: ([x : Number 3])
                       (when (number? x) #t))
@@ -676,8 +681,10 @@
               -Number]
 
         [tc-e/t (let ([x 1]) x) -One]
-        [tc-e (let ([x 1]) (boolean? x)) #:ret (ret -Boolean -false-propset)]
-        [tc-e (boolean? number?) #:ret (ret -Boolean -false-propset)]
+        [tc-e (let ([x 1]) (boolean? x)) #:ret (tc-ret -Boolean -false-propset)]
+        [tc-e (let ([f : (-> Any Boolean : Number) number?])
+                (boolean? f))
+              #:ret (tc-ret -Boolean -false-propset)]
 
         [tc-e (let: ([x : (Option Number) #f]) x) (t:Un -Number (-val #f))]
         [tc-e (let: ([x : Any 12]) (not (not x))) -Boolean]
@@ -763,7 +770,7 @@
               -Number]
 
 
-        [tc-e null #:ret (ret (-val null) -true-propset (-id-path #'null))]
+        [tc-e null #:ret (tc-ret (-val null) -true-propset (-id-path #'null))]
 
         [tc-e/t (let* ([sym 'squarf]
                        [x (if (= 1 2) 3 sym)])
@@ -785,7 +792,7 @@
                       (if (string=? x 'foo)
                           "foo"
                           x))
-          #:ret (ret (t:Un -String (-val 'foo)) -true-propset)]
+                #:ret (tc-ret (t:Un -String (-val 'foo)) -true-propset)]
 
         [tc-e/t (let: ([x : (U String 5) 5])
                         (if (eq? x 5)
@@ -796,11 +803,11 @@
         [tc-e (let* ([sym 'squarf]
                      [x (if (= 1 2) 3 sym)])
                 (if (eq? x sym) 3 x))
-              #:ret (ret -PosByte -true-propset)]
+              #:ret (tc-ret -PosByte -true-propset)]
         [tc-e (let* ([sym 'squarf]
                      [x (if (= 1 2) 3 sym)])
                 (if (eq? sym x) 3 x))
-              #:ret (ret -PosByte -true-propset)]
+              #:ret (tc-ret -PosByte -true-propset)]
         ;; equal? as predicate for symbols
         [tc-e/t (let: ([x : (Un 'foo Number) 'foo])
                       (if (equal? x 'foo) 3 x))
@@ -812,11 +819,11 @@
         [tc-e (let* ([sym 'squarf]
                      [x (if (= 1 2) 3 sym)])
                 (if (equal? x sym) 3 x))
-              #:ret (ret -PosByte -true-propset)]
+              #:ret (tc-ret -PosByte -true-propset)]
         [tc-e (let* ([sym 'squarf]
                      [x (if (= 1 2) 3 sym)])
                 (if (equal? sym x) 3 x))
-              #:ret (ret -PosByte -true-propset)]
+              #:ret (tc-ret -PosByte -true-propset)]
 
         [tc-e/t (let: ([x : (Listof Symbol)'(a b c)])
                       (cond [(memq 'a x) => car]
@@ -851,7 +858,7 @@
 
         ;;; tests for and
         [tc-e (let: ([x : Any 1]) (and (number? x) (boolean? x)))
-              #:ret (ret -Boolean -false-propset)]
+              #:ret (tc-ret -Boolean -false-propset)]
         [tc-e (let: ([x : Any 1]) (and (number? x) x))
               (t:Un -Number (-val #f))]
         [tc-e (let: ([x : Any 1]) (and x (boolean? x)))
@@ -894,21 +901,21 @@
                             (boolean? y))
                         (if (boolean? x) 1 x)
                         4))
-              #:ret (ret Univ -true-propset)]
+              #:ret (tc-ret Univ -true-propset)]
         [tc-e (let: ([x : Any 1])
                     (if (if ((lambda: ([x : Any]) x) 12)
                             #t
                             (boolean? x))
                         (if (boolean? x) 1 x)
                         4))
-              #:ret (ret Univ -true-propset)]
+              #:ret (tc-ret Univ -true-propset)]
         ;; T-AbsPred
         [tc-e/t (let ([p? (lambda: ([x : Any]) (number? x))])
                   (lambda: ([x : Any]) (if (p? x) (add1 x) (add1 12))))
-                (t:-> Univ -Number)]
+                (t:-> Univ -Number : -true-propset)]
         [tc-e/t (let ([p? (lambda: ([x : Any]) (not (number? x)))])
                   (lambda: ([x : Any]) (if (p? x) 12 (add1 x))))
-                (t:-> Univ -Number : (-PS -tt (-is-type 0 -Number)))]
+                (t:-> Univ -Number : -true-propset)]
         [tc-e/t (let* ([z 1]
                        [p? (lambda: ([x : Any]) (number? z))])
                   (lambda: ([x : Any]) (if (p? x) 11 12)))
@@ -917,11 +924,11 @@
                        [p? (lambda: ([x : Any]) (number? z))])
                   (lambda: ([x : Any]) (if (p? x) x 12)))
                 (t:-> Univ Univ : (-PS  (-not-type 0 (-val #f)) (-is-type 0 (-val #f)))
-                                : (make-Path null '(0 0)))]
+                                : (make-Path null '(0 . 0)))]
         [tc-e/t (let* ([z (ann 1 : Any)]
                        [p? (lambda: ([x : Any]) (not (number? z)))])
                   (lambda: ([x : Any]) (if (p? x) (ann (add1 7) Any) 12)))
-                (t:-> Univ Univ)]
+                (t:-> Univ Univ : -true-propset)]
         [tc-e/t (let* ([z 1]
                        [p? (lambda: ([x : Any]) (not (number? z)))])
                   (lambda: ([x : Any]) (if (p? x) x 12)))
@@ -930,21 +937,21 @@
                        [p? (lambda: ([x : Any]) z)])
                   (lambda: ([x : Any]) (if (p? x) x 12)))
                 (t:-> Univ Univ : (-PS (-not-type 0 (-val #f)) (-is-type 0 (-val #f)))
-                                : (make-Path null '(0 0)))]
+                                : (make-Path null '(0 . 0)))]
 
         [tc-e (not 1)
-          #:ret (ret -Boolean -false-propset)]
+          #:ret (tc-ret -Boolean -false-propset)]
 
         [tc-err ((lambda () 1) 2)
-          #:ret (ret (-val 1) -true-propset)]
+          #:ret (tc-ret (-val 1) -true-propset)]
         [tc-err (apply (lambda () 1) '(2))]
         [tc-err ((lambda: ([x : Any] [y : Any]) 1) 2)
-          #:ret (ret (-val 1) -true-propset)]
+          #:ret (tc-ret (-val 1) -true-propset)]
         [tc-err (map map '(2))]
         [tc-err ((plambda: (a) ([x : (a -> a)] [y : a]) (x y)) 5)]
         [tc-err ((plambda: (a) ([x : a] [y : a]) x) 5)]
         [tc-err (ann 5 : String)
-          #:ret (ret -String -true-propset)]
+          #:ret (tc-ret -String -true-propset)]
 
         ;; these don't work because the type annotation gets lost in marshalling
         #|
@@ -978,18 +985,18 @@
                  (: y Symbol)
                  (define y x)
                  y)
-                #:ret (ret -Symbol -true-propset)
+                #:ret (tc-ret -Symbol -true-propset)
                 #:msg #rx"expected: String|expected: Symbol"]
 
         ;; Test ill-typed code in letrec RHS
         [tc-err (let () (: x String) (define x 'foo) x)
-                #:ret (ret -String -true-propset)
+                #:ret (tc-ret -String -true-propset)
                 #:msg #rx"expected: String.*given: 'foo"]
 
         [tc-err (let ([x (add1 5)])
                   (set! x "foo")
                   x)
-          #:ret (ret -Integer -true-propset)]
+          #:ret (tc-ret -Integer -true-propset)]
         ;; w-c-m
         [tc-e/t (with-continuation-mark
                   ((inst make-continuation-mark-key Symbol)) 'mark
@@ -1002,8 +1009,8 @@
         [tc-err (with-continuation-mark 1 2 (5 4))]
 
         [tc-err (with-continuation-mark 'x 'y 'z)
-          #:ret (ret (-val 'z) -ff-propset)
-          #:expected (ret (-val 'z) #f #f)]
+          #:ret (tc-ret (-val 'z) -ff-propset)
+          #:expected (tc-ret (-val 'z) -ff-propset)]
 
 
         ;; call-with-values
@@ -1016,14 +1023,13 @@
               -Number]
         [tc-err (call-with-values (lambda () 1)
                                   (lambda: () 2))
-          #:ret (ret -PosByte -true-propset)]
+          #:ret (tc-ret -PosByte -true-propset)]
 
         [tc-err (call-with-values (lambda () (values 2))
                                   (lambda: ([x : Number] [y : Number]) (+ x y)))
-          #:ret (ret -Number)]
+          #:ret (tc-ret -Number)]
         [tc-err (call-with-values 5
-                                  (lambda: ([x : Number] [y : Number]) (+ x y)))
-          #:ret (ret -Number)]
+                                  (lambda: ([x : Number] [y : Number]) (+ x y)))]
         [tc-err (call-with-values (lambda () (values 2))
                                   5)]
         [tc-err (call-with-values (lambda () (values 2 1))
@@ -1122,7 +1128,7 @@
            (do: : Number ((x : (Listof Number) x (cdr x))
                           (sum : Number 0 (+ sum (car x))))
                 ((null? x) sum)))
-         #:ret (ret -Number -tt-propset -empty-obj)]
+         #:ret (tc-ret -Number)]
 
         [tc-e/t (if #f 1 'foo) (-val 'foo)]
 
@@ -1135,14 +1141,14 @@
         [tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list "foo")))
               (-pair (t:Un -String -PosByte) (-lst (t:Un -String -PosByte)))]
         [tc-e (plambda: (b ...) [y : b ... b] (apply append (map list y)))
-         #:ret (ret (-polydots (b) (->... (list) (b b) (-lst Univ))) -true-propset)]
+              #:ret (tc-ret (-polydots (b) (->... (list) (b b) (-lst Univ) : -true-propset)) -true-propset)]
         [tc-e/t (plambda: (b ...) [y : (Listof Integer) ... b] (apply append y))
-                (-polydots (b) (->... (list) ((-lst -Integer) b) (-lst -Integer)))]
+                (-polydots (b) (->... (list) ((-lst -Integer) b) (-lst -Integer) : -true-propset))]
 
         [tc-err (plambda: (a ...) ([z : String] . [w : Number ... a])
                           (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x)
                                  1 1 1 1 w))
-         #:ret (ret (-polydots (a) (->... (list -String) (-Number a) -Bottom)) -true-propset)]
+         #:ret (tc-ret (-polydots (a) (->... (list -String) (-Number a) -Bottom)) -true-propset)]
 
         [tc-err (plambda: (a ...) ([z : String] . [w : Number])
                           (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x)
@@ -1151,7 +1157,7 @@
         [tc-e/t (plambda: (a ...) ([z : String] . [w : Number ... a])
                         (apply (plambda: (b ...) ([x : Number] . [y : Number ... b]) x)
                                1 w))
-              (-polydots (a) ((list -String) (-Number a) . ->... . -Number))]
+              (-polydots (a) ((list -String) (-Number a) . ->... . -Number : -true-propset))]
         [tc-e (let ([f (plambda: (a ...) [w : a ... a] w)])
                 (f 1 "hello" #\c))
               (-lst* -One -String -Char)]
@@ -1159,11 +1165,11 @@
         [tc-e/t (inst (plambda: (a) ([x : a]) x) Integer)
                 (make-Function
                  (list (make-arr* (list -Integer) -Integer
-                                  #:props (-PS (-not-type (list 0 0) (-val #f))
-                                               (-is-type (list 0 0) (-val #f)))
-                                  #:object (make-Path null (list 0 0)))))]
+                                  #:props (-PS (-not-type (cons 0 0) (-val #f))
+                                               (-is-type (cons 0 0) (-val #f)))
+                                  #:object (make-Path null (cons 0 0)))))]
         [tc-e/t (inst (plambda: (a) [x : a *] (apply list x)) Integer)
-                ((list) -Integer . ->* . (-lst -Integer))]
+                ((list) -Integer . ->* . (-lst -Integer) : -true-propset)]
 
         ;; instantiating dotted terms
         [tc-e/t (inst (plambda: (a ...) [xs : a ... a] 3) Integer Boolean Integer)
@@ -1187,9 +1193,9 @@
         ;; error tests
         [tc-err (+ 3 #f)]
         [tc-err (let: ([x : Number #f]) x)
-          #:ret (ret -Number -true-propset)]
+          #:ret (tc-ret -Number -true-propset)]
         [tc-err (let: ([x : Number #f]) (+ 1 x))
-          #:ret (ret -Number)]
+          #:ret (tc-ret -Number)]
 
         [tc-err
          (let: ([x : Any '(foo)])
@@ -1197,14 +1203,14 @@
                    (if (list? x)
                        (add1 x)
                        12)))
-         #:ret (ret -PosByte -true-propset)]
+         #:ret (tc-ret -PosByte -true-propset)]
 
         [tc-err (let*: ([x : Any 1]
                         [f : (-> Void) (lambda () (set! x 'foo))])
                        (if (number? x)
                            (begin (f) (add1 x))
                            12))
-          #:ret (ret -PosByte -true-propset)]
+          #:ret (tc-ret -PosByte -true-propset)]
 
         [tc-err (ann 3 (Rec a a))]
         [tc-err (ann 3 (Rec a (U a 3)))]
@@ -1279,14 +1285,14 @@
                      (apply y zs))
                    ys)))
               (-polydots (a) ((list) ((list) (a a) . ->... . -Number) . ->* .
-                                     ((list) (a a) . ->... . (-lst -Number)) : -true-propset))]
+                                     ((list) (a a) . ->... . (-lst -Number) : -true-propset) : -true-propset))]
         [tc-e/t (plambda: (a ...) [ys : (a ... a -> Number) *]
                 (lambda: [zs : a ... a]
                   (map (lambda: ([y : (a ... a -> Number)])
                          (apply y zs))
                        ys)))
               (-polydots (a) ((list) ((list) (a a) . ->... . -Number) . ->* .
-                                     ((list) (a a) . ->... . (-lst -Number)) : -true-propset))]
+                                     ((list) (a a) . ->... . (-lst -Number) : -true-propset) : -true-propset))]
 
         [tc-e/t (lambda: ((x : (All (t) t)))
                        ((inst (inst x (All (t) (t -> t)))
@@ -1299,21 +1305,21 @@
         [tc-e/t (inst (plambda: (a ...) [ys : Number ... a]
                                 (apply + ys))
                       Boolean String Number)
-                (-Number -Number -Number . t:-> . -Number)]
+                (-Number -Number -Number . t:-> . -Number : -true-propset)]
 
         [tc-e (assq 'foo #{'((a b) (foo bar)) :: (Listof (List Symbol Symbol))})
               (t:Un (-val #f) (-lst* -Symbol -Symbol))]
 
         [tc-e/t (ann (lambda (x) x) (All (a) (a -> a)))
                 (-poly (a) (a . t:-> . a))]
-        [tc-e (apply values (list 1 2 3)) #:ret (ret (list -One -PosByte -PosByte))]
+        [tc-e (apply values (list 1 2 3)) #:ret (tc-ret (list -One -PosByte -PosByte))]
 
         [tc-e/t (ann (if #t 3 "foo") Integer) -Integer]
 
         [tc-e/t (plambda: (a ...) ([x : Number] . [y : a ... a])
                           (andmap null? (map list y)))
                 (-polydots (a) ((list -Number) (a a) . ->... . -Boolean))]
-        [tc-e (ann (error 'foo) (values Number Number)) #:ret (ret (list -Bottom -Bottom))]
+        [tc-e (ann (error 'foo) (values Number Number)) #:ret (tc-ret (list -Bottom -Bottom))]
 
         [tc-e (string->number "123")
               (t:Un (-val #f) -Number)]
@@ -1327,10 +1333,10 @@
         [tc-err (let: ([fact : (Number -> Number)
                              (lambda: ([n : Number]) (if (zero? n) 1 (* n (fact (- n 1)))))])
                         (fact 20))
-          #:ret (ret -Number)]
+          #:ret (tc-ret -Number)]
 
         [tc-err (ann (lambda: ([x : Any]) #f) (Any -> Boolean : String))
-          #:ret (ret (make-pred-ty -String) -true-propset)]
+          #:ret (tc-ret (make-pred-ty -String) -true-propset)]
 
 
         [tc-e (time (+ 3 4)) -PosIndex]
@@ -1344,7 +1350,7 @@
                                      [user : Number]
                                      [gc : Number])
                              'whatever))
-         #:ret (ret (-val 'whatever) -true-propset)]
+         #:ret (tc-ret (-val 'whatever) -true-propset)]
         [tc-e
          (call-with-values (lambda ()
                              ((inst time-apply Number Number Number Number Number Number Number)
@@ -1354,16 +1360,16 @@
                                      [user : Number]
                                      [gc : Number])
                              'whatever))
-         #:ret (ret (-val 'whatever) -true-propset)]
+         #:ret (tc-ret (-val 'whatever) -true-propset)]
         [tc-e (let: ([l : (Listof Any) (list 1 2 3)])
                 (if (andmap number? l)
                     (+ 1 (car l))
                     7))
               -Number]
         (tc-e (or (string->number "7") 7)
-              #:ret (ret -Number -true-propset))
+              #:ret (tc-ret -Number -true-propset))
         [tc-e (let ([x 1]) (if x x (add1 x)))
-              #:ret (ret -One -true-propset)]
+              #:ret (tc-ret -One -true-propset)]
         [tc-e (let: ([x : (U (Vectorof Integer) String) (vector 1 2 3)])
                 (if (vector? x) (vector-ref x 0) (string-length x)))
          -Integer]
@@ -1393,12 +1399,12 @@
                 (vector-ref #("a" "b") (- x 1)))
               -String]
         [tc-err (string-append "bar" (if (zero? (ann 0.0 Float)) #f "foo"))
-          #:ret (ret -String)]
+          #:ret (tc-ret -String)]
         [tc-err (do: : Void
                      ([j : Natural (+ i 'a) (+ j i)])
                      ((>= j 10))
                      #f)
-          #:ret (ret -Void -tt-propset -empty-obj)]
+          #:ret (tc-ret -Void)]
         [tc-err (apply +)]
         [tc-e/t
          (let ([x eof])
@@ -1411,7 +1417,7 @@
                (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number))))
               (-lst -Number)]
         [tc-err (list (values 1 2))
-          #:ret (ret (-Tuple (list -Bottom)))]
+          #:ret (tc-ret (-Tuple (list -Bottom)))]
 
         ;; Lists
         [tc-e (list-update '("a" "b" "c") 1 (λ (x) "a")) (-lst -String)]
@@ -1428,7 +1434,7 @@
 
         ;;Path tests
         (tc-e (path-string? "foo") -Boolean)
-        (tc-e (path-string? (string->path "foo")) #:ret (ret -Boolean -true-propset))
+        (tc-e (path-string? (string->path "foo")) #:ret (tc-ret -Boolean -true-propset))
         (tc-e (bytes->path #"foo" 'unix) -SomeSystemPath)
         (tc-e (bytes->path #"foo") -Path)
         (tc-e (bytes->path-element #"foo") -Path)
@@ -1446,8 +1452,8 @@
         (tc-e (expand-user-path "foo") -Path)
 
         ;;String Tests
-        (tc-e (string? "a") #:ret (ret -Boolean -true-propset))
-        (tc-e (string? 2) #:ret (ret -Boolean -false-propset))
+        (tc-e (string? "a") #:ret (tc-ret -Boolean -true-propset))
+        (tc-e (string? 2) #:ret (tc-ret -Boolean -false-propset))
 
         (tc-e (string->immutable-string (string #\a #\b)) -String)
         (tc-e (string-length (make-string 5 #\z)) -Index)
@@ -1505,8 +1511,8 @@
 
         ;Symbols
 
-        (tc-e (symbol? 'foo) #:ret (ret -Boolean -true-propset))
-        (tc-e (symbol? 2) #:ret (ret -Boolean -false-propset))
+        (tc-e (symbol? 'foo) #:ret (tc-ret -Boolean -true-propset))
+        (tc-e (symbol? 2) #:ret (tc-ret -Boolean -false-propset))
 
         (tc-e (symbol-interned? 'foo) -Boolean)
         (tc-e (symbol-interned? (string->unreadable-symbol "bar")) -Boolean)
@@ -1523,16 +1529,16 @@
         (tc-e (string->symbol (symbol->string 'foo)) -Symbol)
 
         ;Booleans
-        (tc-e (not #f) #:ret (ret -Boolean -true-propset))
-        (tc-e (false? #f) #:ret (ret -Boolean -true-propset))
-        (tc-e (not #t) #:ret (ret -Boolean -false-propset))
+        (tc-e (not #f) #:ret (tc-ret -Boolean -true-propset))
+        (tc-e (false? #f) #:ret (tc-ret -Boolean -true-propset))
+        (tc-e (not #t) #:ret (tc-ret -Boolean -false-propset))
         ;; It's not clear why the following test doesn't work,
         ;; but it works fine in the real typechecker
-        ;(tc-e (false? #t) #:ret (ret -Boolean -false-propset))
+        ;(tc-e (false? #t) #:ret (tc-ret -Boolean -false-propset))
 
 
-        (tc-e (boolean? true) #:ret (ret -Boolean -true-propset))
-        (tc-e (boolean? 6) #:ret (ret -Boolean -false-propset))
+        (tc-e (boolean? #t) #:ret (tc-ret -Boolean -true-propset))
+        (tc-e (boolean? 6) #:ret (tc-ret -Boolean -false-propset))
         (tc-e (immutable? (cons 3 4)) -Boolean)
 
         (tc-e (boolean=? #t false) -Boolean)
@@ -1571,24 +1577,24 @@
               (-opt (-pair -Bytes (-lst (-opt -Bytes)))))
 
         (tc-err (regexp-try-match "foo" "foobar")
-          #:ret (ret (t:Un (-val #f) (-pair -Bytes (-lst (t:Un (-val #f) -Bytes))))))
+          #:ret (tc-ret (t:Un (-val #f) (-pair -Bytes (-lst (t:Un (-val #f) -Bytes))))))
         (tc-e (regexp-try-match "foo" (open-input-string "foobar"))
               (-opt (-pair -Bytes (-lst (-opt -Bytes)))))
 
         (tc-err (regexp-match-peek "foo" "foobar")
-          #:ret (ret (t:Un (-val #f) (-pair -Bytes (-lst (t:Un (-val #f) -Bytes))))))
+          #:ret (tc-ret (t:Un (-val #f) (-pair -Bytes (-lst (t:Un (-val #f) -Bytes))))))
         (tc-e (regexp-match-peek "foo" (open-input-string "foobar"))
               (-opt (-pair -Bytes (-lst (-opt -Bytes)))))
 
         (tc-err (regexp-match-peek-immediate "foo" "foobar")
-          #:ret (ret (t:Un (-val #f) (-pair -Bytes (-lst (t:Un (-val #f) -Bytes))))))
+          #:ret (tc-ret (t:Un (-val #f) (-pair -Bytes (-lst (t:Un (-val #f) -Bytes))))))
         (tc-e (regexp-match-peek-immediate "foo" (open-input-string "foobar"))
               (-opt (-pair -Bytes (-lst (-opt -Bytes)))))
 
 
 
         [tc-e (regexp-match/end "foo" "foobar")
-              #:ret (ret (list (-opt (-pair -String (-lst (-opt -String)))) (-opt -Bytes)))]
+              #:ret (tc-ret (list (-opt (-pair -String (-lst (-opt -String)))) (-opt -Bytes)))]
 
         (tc-e (regexp-split "foo" "foobar") (-pair -String (-lst -String)))
         (tc-e (regexp-split "foo" #"foobar") (-pair -Bytes (-lst -Bytes)))
@@ -1596,7 +1602,7 @@
         (tc-e (regexp-split #"foo" #"foobar") (-pair -Bytes (-lst -Bytes)))
 
         (tc-err (regexp-split "foo" (path->string "foobar"))
-          #:ret (ret (-pair -String (-lst -String))))
+          #:ret (tc-ret (-pair -String (-lst -String))))
 
         (tc-e (regexp-replace "foo" "foobar" "rep") -String)
         (tc-e (regexp-replace #"foo" "foobar" "rep") -Bytes)
@@ -1697,8 +1703,8 @@
 
         ;Syntax
 
-        (tc-e (syntax? #'id) #:ret (ret -Boolean -true-propset))
-        (tc-e (syntax? 2) #:ret (ret -Boolean -false-propset))
+        (tc-e (syntax? #'id) #:ret (tc-ret -Boolean -true-propset))
+        (tc-e (syntax? 2) #:ret (tc-ret -Boolean -false-propset))
 
         (tc-e (syntax-source #'here) Univ)
         (tc-e (syntax-line #'here) (-opt -PosInt))
@@ -1715,17 +1721,17 @@
         (tc-e (parameter-procedure=? current-input-port current-output-port) -Boolean)
 
         ;Namespaces
-        (tc-e (namespace? 2) #:ret (ret -Boolean -false-propset))
-        (tc-e (namespace? (make-empty-namespace)) #:ret (ret -Boolean -true-propset))
+        (tc-e (namespace? 2) #:ret (tc-ret -Boolean -false-propset))
+        (tc-e (namespace? (make-empty-namespace)) #:ret (tc-ret -Boolean -true-propset))
 
-        (tc-e (namespace-anchor? 3) #:ret (ret -Boolean -false-propset))
+        (tc-e (namespace-anchor? 3) #:ret (tc-ret -Boolean -false-propset))
         (tc-e/t (lambda: ((x : Namespace-Anchor)) (namespace-anchor? x))
-                (t:-> -Namespace-Anchor -Boolean : -true-propset))
+                (t:-> -Namespace-Anchor -True : -true-propset))
 
 
-        (tc-e (variable-reference? 3) #:ret (ret -Boolean -false-propset))
+        (tc-e (variable-reference? 3) #:ret (tc-ret -Boolean -false-propset))
         (tc-e/t (lambda: ((x : Variable-Reference)) (variable-reference? x))
-                (t:-> -Variable-Reference  -Boolean : -true-propset))
+                (t:-> -Variable-Reference  -True : -true-propset))
 
         (tc-e (system-type 'os) (one-of/c 'unix 'windows 'macosx))
         (tc-e (system-type 'gc) (one-of/c 'cgc '3m))
@@ -1790,7 +1796,7 @@
                 (define-values (p std-out std-in std-err)
                  (subprocess #f #f #f (string->path "/bin/bash")))
                 (subprocess? p))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
 
         (tc-e (car (process "hello"))
               -Input-Port)
@@ -1831,7 +1837,7 @@
         (tc-e (compile-syntax #'(+ 1 2)) -Compiled-Expression)
         (tc-e (let: ((e : Compiled-Expression (compile #'(+ 1 2))))
                 (compiled-expression? e))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
         (tc-e (let: ((e : Compiled-Expression (compile #'(module + racket 2))))
                 (compiled-module-expression? e)) -Boolean)
 
@@ -1848,7 +1854,7 @@
                               (acc : (Any -> Any)))
                              (make-impersonator-property 'prop)))
                (impersonator-property? prop))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
 
         ;Security Guards
         (tc-e (make-security-guard (current-security-guard)
@@ -1857,14 +1863,14 @@
               -Security-Guard)
         (tc-e (let: ((s : Security-Guard (current-security-guard)))
                 (security-guard? s))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
 
 
         ;Custodians
         (tc-e (make-custodian) -Custodian)
         (tc-e (let: ((c : Custodian (current-custodian)))
                 (custodian? c))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
         (tc-e (let: ((c : (Custodian-Boxof Integer) (make-custodian-box (current-custodian) 1)))
                 (custodian-box-value c)) -Int)
 
@@ -1872,14 +1878,14 @@
         (tc-e (make-thread-group) -Thread-Group)
         (tc-e (let: ((tg : Thread-Group (current-thread-group)))
                 (thread-group? tg))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
 
 
         ;Inspector
         (tc-e (make-inspector) -Inspector)
         (tc-e (let: ((i : Inspector (current-inspector)))
                 (inspector? i))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
 
         ;Continuation Prompt Tags ang Continuation Mark Sets
         ;; TODO: supporting default-continuation-prompt-tag means we need to
@@ -1888,7 +1894,7 @@
         (tc-e (let: ((pt : (Prompt-Tagof Integer Integer) (make-continuation-prompt-tag)))
                    (continuation-marks #f pt)) -Cont-Mark-Set)
         (tc-e (let: ((set : Continuation-Mark-Set (current-continuation-marks)))
-                   (continuation-mark-set? set)) #:ret (ret -Boolean -true-propset))
+                   (continuation-mark-set? set)) #:ret (tc-ret -Boolean -true-propset))
 
         ;Logging
         (tc-e (make-logger 'name) -Logger)
@@ -1936,13 +1942,13 @@
               (-mu x (make-Evt x)))
         (tc-err (let: ([a : (U (Evtof Any) String) always-evt])
                   (if (handle-evt? a) a (string->symbol a)))
-          #:ret (ret (t:Un -Symbol (make-Evt Univ))))
+          #:ret (tc-ret (t:Un -Symbol (make-Evt Univ))))
         (tc-err (let: ([a : (U (Evtof Any) String) always-evt])
                   (if (channel-put-evt? a) a (string->symbol a)))
-          #:ret (ret (t:Un -Symbol (-mu x (make-Evt x)))))
+          #:ret (tc-ret (t:Un -Symbol (-mu x (make-Evt x)))))
         (tc-err (let: ([a : (U (Evtof Any) String) always-evt])
                   (if (semaphore-peek-evt? a) a (string->symbol a)))
-          #:ret (ret (t:Un -Symbol (-mu x (make-Evt x)))))
+          #:ret (tc-ret (t:Un -Symbol (-mu x (make-Evt x)))))
 
         ;Semaphores
         (tc-e (make-semaphore) -Semaphore)
@@ -1985,7 +1991,7 @@
                               (pred : (Any -> Any)) (acc : (Any -> Any)))
                              (make-struct-type-property 'prop)))
                (struct-type-property? prop))
-              #:ret (ret -Boolean -true-propset))
+              #:ret (tc-ret -Boolean -true-propset))
 
         ;; Boxes
         [tc-e (box-cas! (box "foo") "bar" "baz") -Boolean]
@@ -2003,7 +2009,7 @@
                   (: b2 (Weak-Boxof (U Symbol String)))
                   (define b2 b1)
                   (error "foo"))
-                #:msg #rx"expected: \\(Weak-Boxof \\(U Symbol String\\)\\)"]
+                #:msg #rx"expected: \\(Weak-Boxof \\(U String Symbol\\)\\)"]
 
         ;Wills
         (tc-e (make-will-executor) -Will-Executor)
@@ -2057,7 +2063,7 @@
               -Void)
         [tc-e (raise (exn:fail:contract "1" (current-continuation-marks))) (t:Un)]
         [tc-err (exn:fail:contract)
-          #:ret (ret (resolve (-struct-name #'exn:fail:contract)))]
+          #:ret (tc-ret (resolve (-struct-name #'exn:fail:contract)))]
         [tc-e (#%variable-reference) -Variable-Reference]
         [tc-e (#%variable-reference x) -Variable-Reference]
         [tc-e (#%variable-reference +) -Variable-Reference]
@@ -2069,13 +2075,13 @@
                             [(x y) (add1 x)])
                (case-> (Integer -> Integer)
                        (Integer Integer -> Integer)))
-              #:ret (ret (cl->* (t:-> -Integer -Integer)
+              #:ret (tc-ret (cl->* (t:-> -Integer -Integer)
                                 (t:-> -Integer -Integer -Integer))
                          -true-propset)]
         [tc-e (let ([my-pred (λ () #f)])
                 (for/and: : Any ([i (in-range 4)])
                           (my-pred)))
-              #:ret (ret Univ -tt-propset -empty-obj)]
+              #:ret (tc-ret Univ)]
         [tc-e/t
          (let ()
            (define: long : (List 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 Integer)
@@ -2170,7 +2176,7 @@
         [tc-e ((inst vector Index) 0)
               (-vec -Index)]
         [tc-err ((inst list Void) 1 2 3)
-          #:ret (ret (-lst -Void))]
+          #:ret (tc-ret (-lst -Void))]
         [tc-e ((inst list Any) 1 2 3)
               (-lst Univ)]
 
@@ -2189,7 +2195,7 @@
         [tc-err
           (let ((s (ann (set 2) Any)))
             (if (set? s) (ann s (Setof String)) ((inst set String))))
-          #:ret (ret (-set -String))]
+          #:ret (tc-ret (-set -String))]
 
         [tc-e (split-at (list 0 2 3 4 5 6) 3)
               (list (-lst -Byte) (-lst -Byte))]
@@ -2211,15 +2217,16 @@
           (ann
             ((letrec ((x (lambda (acc v) (if v (list v) acc)))) x) null (list 'bad 'prog))
             (Listof Symbol))
-          #:ret (ret (-lst -Symbol) -tt-propset -empty-obj)]
+          #:ret (tc-ret (-lst -Symbol))]
         [tc-e (filter values empty)
               (-lst -Bottom)]
         [tc-e (lambda lst (map (plambda: (b) ([x : b]) x) lst))
-              (-polydots (a) (->... (list) (a a) (make-ListDots a 'a)))
-              #:expected (ret (-polydots (a) (->... (list) (a a) (make-ListDots a 'a))))]
+              #:ret (tc-ret (-polydots (a) (->... (list) (a a) (make-ListDots a 'a))))
+              #:expected (tc-ret (-polydots (a) (->... (list) (a a) (make-ListDots a 'a))))]
 
-        [tc-e/t (ann (lambda (x) #t) (All (a) Any))
-                (-poly (a) Univ)]
+        [tc-e (ann (lambda (x) #t) (All (a) Any))
+              #:ret (tc-ret (-poly (a) Univ))
+              #:expected (tc-ret (-poly (a) Univ))]
         [tc-e
            ((inst filter Any Symbol) symbol? null)
            (-lst -Symbol)]
@@ -2230,11 +2237,11 @@
         [tc-e/t (ann (ann 'x Symbol) Symbol) -Symbol]
 
         [tc-err (lambda (x) x)
-          #:ret (ret (-poly (a) (cl->* (t:-> a a) (t:-> a a a))))
-          #:expected (ret (-poly (a) (cl->* (t:-> a a) (t:-> a a a))))]
+          #:ret (tc-ret (-poly (a) (cl->* (t:-> a a) (t:-> a a a))))
+          #:expected (tc-ret (-poly (a) (cl->* (t:-> a a) (t:-> a a a))))]
         [tc-err (plambda: (A) ((x : A)) x)
-          #:ret (ret (list -Symbol -Symbol))
-          #:expected (ret (list -Symbol -Symbol))]
+          #:ret (tc-ret (list -Symbol -Symbol))
+          #:expected (tc-ret (list -Symbol -Symbol))]
 
         [tc-e/t
           (case-lambda
@@ -2244,8 +2251,8 @@
 
         [tc-e
            (opt-lambda: ((x : Symbol 'a)) x)
-           #:ret (ret (t:-> -Symbol -Symbol) -true-propset)
-           #:expected (ret (t:-> -Symbol -Symbol) -true-propset)]
+           #:ret (tc-ret (t:-> -Symbol -Symbol) -true-propset)
+           #:expected (tc-ret (t:-> -Symbol -Symbol) -true-propset)]
 
         [tc-e/t (inst (ann (lambda (a) a) (All (a) (a -> a))) Symbol)
                 (t:-> -Symbol -Symbol)]
@@ -2260,7 +2267,7 @@
                   ;; note the propositions
                   (Any -> Boolean : #:+ (Integer @ x) #:- (! Integer @ x))))
            (if (f 'dummy) (add1 x) 2))
-         (t:-> Univ -Integer : (-PS -tt (-is-type 0 -Integer)))]
+         (t:-> Univ -Integer : -true-propset)]
 
         ;; This test ensures that curried predicates have
         ;; the correct props so that they can be used for
@@ -2281,9 +2288,9 @@
         ;; (should not trigger an error with free-identifier=?)
         [tc-e (lambda (x) (lambda (y) y))
               #:ret
-              (ret (t:-> Univ (t:-> Univ Univ : (-PS (-not-type (list 0 0) (-val #f))
-                                                     (-is-type (list 0 0) (-val #f)))
-                                              : (make-Path null (list 0 0)))
+              (tc-ret (t:-> Univ (t:-> Univ Univ : (-PS (-not-type (cons 0 0) (-val #f))
+                                                     (-is-type (cons 0 0) (-val #f)))
+                                              : (make-Path null (cons 0 0)))
                               : -true-propset)
                    -true-propset)]
 
@@ -2291,8 +2298,7 @@
        ;; written by the user
        [tc-e
         (let ()
-          (: f (Any -> (Any -> Boolean : #:+ (Symbol @ 1 0)
-                            #:- (! Symbol @ 1 0))
+          (: f (Any -> (Any -> Boolean : #:+ (Symbol @ 1 0) #:- (! Symbol @ 1 0))
                     : #:+ Top #:- Bot))
           (define f (λ (x) (λ (y) (symbol? x))))
           (: b (U Symbol String))
@@ -2344,7 +2350,7 @@
           (: x Real)
           (define x 3)
           (if ((negate pos?) x) x -5))
-        #:ret (ret -NonPosReal -true-propset)]
+        #:ret (tc-ret -NonPosReal -true-propset)]
 
        [tc-err
          (hash-ref! (ann (make-hash) (HashTable #f (-> #t))) #f (lambda () #t))]
@@ -2403,10 +2409,10 @@
        [tc-e (dropf-right '("a" b "x" "y") string?)
              (-lst (t:Un -String (-val 'b)))]
        [tc-e (splitf-at '("a" b "x" "y") string?)
-             #:ret (ret (list (-lst -String)
+             #:ret (tc-ret (list (-lst -String)
                               (-lst (t:Un -String (-val 'b)))))]
        [tc-e (splitf-at-right '("a" b "x" "y") string?)
-             #:ret (ret (list (-lst (t:Un -String (-val 'b)))
+             #:ret (tc-ret (list (-lst (t:Un -String (-val 'b)))
                               (-lst -String)))]
        [tc-e (combinations '(1 2 1)) (-lst (-lst -PosByte))]
        [tc-e (combinations '(1 2 1) 2) (-lst (-lst -PosByte))]
@@ -2477,9 +2483,9 @@
        [tc-err (let-values ([(name _1 _2 getter setter _3 _4 _5)
                              (struct-type-info struct:arity-at-least)])
                  (getter 'bad 0))
-         #:ret (ret Univ)]
+         #:ret (tc-ret Univ)]
        [tc-err (struct-type-make-constructor 'bad)
-         #:ret (ret top-func)]
+         #:ret (tc-ret top-func)]
        [tc-err (struct-type-make-predicate 'bad)]
 
        [tc-e
@@ -2493,7 +2499,7 @@
        [tc-e (current-future) (-opt (-future Univ))]
        [tc-e (add1 (processor-count)) -PosInt]
        [tc-e (assert (current-future) future?)
-             #:ret (ret (-future Univ) -true-propset)]
+             #:ret (tc-ret (-future Univ) -true-propset)]
        [tc-e (futures-enabled?) -Boolean]
        [tc-e (place-enabled?) -Boolean]
        [tc-e (dynamic-place "a.rkt" 'a #:at #f) -Place]
@@ -2557,17 +2563,13 @@
                 [y (in-list '("a" "b" "c"))]
                 #:when (eq? x 'x))
                (values x y))
-             #:ret (ret (-HT -Symbol -String)
-                        (-PS -tt -tt)
-                        -empty-obj)]
+             #:ret (tc-ret (-HT -Symbol -String))]
        [tc-e (for*/hash: : (HashTable Symbol String)
                ([k (in-list '(x y z))]
                 [v (in-list '("a" "b"))]
                 #:when (eq? k 'x))
                (values k v))
-             #:ret (ret (-HT -Symbol -String)
-                        (-PS -tt -tt)
-                        -empty-obj)]
+             #:ret (tc-ret (-HT -Symbol -String))]
 
        ;; PR 13937
        [tc-e (let ()
@@ -2602,16 +2604,16 @@
 
        ;; call-with-input-string and friends - PR 14050
        [tc-e (call-with-input-string "abcd" (lambda: ([input : Input-Port]) (values 'a 'b)))
-             #:ret (ret (list (-val 'a) (-val 'b)))]
+             #:ret (tc-ret (list (-val 'a) (-val 'b)))]
        [tc-e (call-with-input-bytes #"abcd" (lambda: ([input : Input-Port]) (values 'a 'b)))
-             #:ret (ret (list (-val 'a) (-val 'b)))]
+             #:ret (tc-ret (list (-val 'a) (-val 'b)))]
 
        [tc-e (lambda: ([x : (U (Parameter Symbol) Symbol)])
                (if (parameter? x)
                    (x)
                    x))
-             #:ret (ret (t:-> (t:Un (-Param -Symbol -Symbol) -Symbol) -Symbol))
-             #:expected (ret (t:-> (t:Un (-Param -Symbol -Symbol) -Symbol) -Symbol))]
+             #:ret (tc-ret (t:-> (t:Un (-Param -Symbol -Symbol) -Symbol) -Symbol))
+             #:expected (tc-ret (t:-> (t:Un (-Param -Symbol -Symbol) -Symbol) -Symbol))]
 
        ;; time-apply and similar functions (test improved inference)
        [tc-e (let ()
@@ -2620,7 +2622,7 @@
                (f '(a b) "foo"))
              -String]
        [tc-e (time-apply (lambda: ([x : Symbol] [y : Symbol]) "foo") '(a b))
-             #:ret (ret (list (-lst* -String) -Nat -Nat -Nat))]
+             #:ret (tc-ret (list (-lst* -String) -Nat -Nat -Nat))]
 
        ;; test kw function without type annotation
        [tc-e (let () (tr:define (f x #:y y) y) (f 'a #:y 'b)) Univ]
@@ -2650,48 +2652,48 @@
        [tc-e ((tr:lambda (x #:y y . args) y) 'a #:y 'b) Univ]
        [tc-e ((tr:lambda (x #:y [y 'y] . args) y) 'a #:y 'b) Univ]
        [tc-err (let () (tr:define (f x #:y y) (string-append x "foo")) (void))
-         #:ret (ret -Void)
+         #:ret (tc-ret -Void)
          #:msg #rx"expected: String.*given: Any"]
        [tc-err (let () (tr:define (f x #:y y) y) (f "a"))
-         #:ret (ret Univ)
+         #:ret (tc-ret Univ)
          #:msg #rx"required keyword was not supplied"]
 
        ;; test lambdas with mixed type expressions, typed keywords, typed
        ;; optional arguments
        [tc-e (tr:lambda (x [y : String]) (string-append y "b"))
-             #:ret (ret (t:-> Univ -String -String) -true-propset)]
+             #:ret (tc-ret (t:-> Univ -String -String : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x [y : String] . z) (string-append y "b"))
-             #:ret (ret (->* (list Univ -String) Univ -String) -true-propset)]
+             #:ret (tc-ret (->* (list Univ -String) Univ -String  : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x [y : String] . [z : String *]) (string-append y "b"))
-             #:ret (ret (->* (list Univ -String) -String -String) -true-propset)]
+             #:ret (tc-ret (->* (list Univ -String) -String -String  : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x [y : String]) : String (string-append y "b"))
-             #:ret (ret (t:-> Univ -String -String) -true-propset)]
+             #:ret (tc-ret (t:-> Univ -String -String : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x z [y : String]) (string-append y "b"))
-             #:ret (ret (t:-> Univ Univ -String -String) -true-propset)]
+             #:ret (tc-ret (t:-> Univ Univ -String -String  : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x z [y : String] . w) (string-append y "b"))
-             #:ret (ret (->* (list Univ Univ -String) Univ -String) -true-propset)]
+             #:ret (tc-ret (->* (list Univ Univ -String) Univ -String  : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x z [y : String] . [w : String *]) (string-append y "b"))
-             #:ret (ret (->* (list Univ Univ -String) -String -String) -true-propset)]
+             #:ret (tc-ret (->* (list Univ Univ -String) -String -String  : -true-propset) -true-propset)]
        [tc-e (tr:lambda (x z [y : String]) : String (string-append y "b"))
-             #:ret (ret (t:-> Univ Univ -String -String) -true-propset)]
+             #:ret (tc-ret (t:-> Univ Univ -String -String  : -true-propset) -true-propset)]
        [tc-err (tr:lambda (x [y : String]) : Symbol (string-append y "b"))
-         #:ret (ret (t:-> Univ -String -Symbol) -true-propset)
+         #:ret (tc-ret (t:-> Univ -String -Symbol  : -true-propset) -true-propset)
          #:msg "expected: Symbol.*given: String"]
        [tc-err (tr:lambda (x [y : String "a"] z) (string-append y "b"))
                #:msg "expected optional lambda argument"]
        [tc-e (tr:lambda (x [y : String "a"]) (string-append y "b"))
-             (->opt Univ [-String] -String)]
+             (->opt Univ [-String] (make-Values (list (make-Result -String -true-propset -empty-obj))))]
        [tc-e (tr:lambda (x [y : String "a"] . z) (string-append y "b"))
-             (->optkey Univ [-String] #:rest Univ -String)]
+             (->optkey Univ [-String] #:rest Univ (make-Values (list (make-Result -String -true-propset -empty-obj))))]
        [tc-e (tr:lambda (x [y : String "a"] . [z : String *]) (string-append y "b"))
-             (->optkey Univ [-String] #:rest -String -String)]
+             (->optkey Univ [-String] #:rest -String (make-Values (list (make-Result -String -true-propset -empty-obj))))]
        [tc-e (tr:lambda (x y [z : String "a"]) (string-append z "b"))
-             (->opt Univ Univ [-String] -String)]
+             (->opt Univ Univ [-String] (make-Values (list (make-Result -String -true-propset -empty-obj))))]
        [tc-e (tr:lambda (w x [y : String "y"] [z : String "z"]) (string-append y z))
-             (->opt Univ Univ [-String -String] -String)]
+             (->opt Univ Univ [-String -String] (make-Values (list (make-Result -String -true-propset -empty-obj))))]
        [tc-e (tr:lambda (w [x : String] [y : String "y"] [z : String "z"])
                (string-append x z))
-             (->opt Univ -String [-String -String] -String)]
+             (->opt Univ -String [-String -String] (make-Values (list (make-Result -String -true-propset -empty-obj))))]
        [tc-e (tr:lambda (x #:y [y : String]) (string-append y "b"))
              (->key Univ #:y -String #t -String)]
        [tc-e (tr:lambda (x #:y [y : String] . z) (string-append y "b"))
@@ -2737,14 +2739,14 @@
        ;; get right in the expected result type and polymorphic types are
        ;; harder to test for equality.
        [tc-e ((inst (tr:lambda #:forall (A) (x [y : A]) y) String) 'a "foo")
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e ((inst (tr:lambda #:∀ (A) (x [y : A]) y) String) 'a "foo")
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e ((inst (tr:lambda #:forall (A ...) (x . [rst : A ... A]) rst) String) 'a "foo")
              (-lst* -String)]
        #| FIXME: does not work yet, TR thinks the type variable is unbound
        [tc-e (inst (tr:lambda #:forall (A) (x [y : A] [z : String "z"]) y) String)
-             #:ret (ret (->opt Univ -String [-String] -String) -true-propset)]
+             #:ret (tc-ret (->opt Univ -String [-String] -String) -true-propset)]
        |#
 
        ;; test `define` with mixed type annotations
@@ -2773,9 +2775,9 @@
        [tc-e (let ([y 'y] [x : String "foo"]) (string-append x "bar"))
              -String]
        [tc-e (let #:forall (A) ([x : A "foo"]) x)
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e (let #:forall (A) ([y 'y] [x : A "foo"]) x)
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e/t (let* ([x "foo"]) x) -String]
        [tc-e (let* ([x : String "foo"]) (string-append x "bar"))
              -String]
@@ -2812,48 +2814,48 @@
                (string-append x y))
              -String]
        [tc-e (let loop ([x "x"]) x)
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e (let loop ([x : String "x"]) x)
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e (let/cc k "foo") -String]
        [tc-e (let/ec k "foo") -String]
        [tc-e (let/cc k : String (k "foo")) -String]
        [tc-e (let/ec k : String (k "foo")) -String]
        [tc-e (ann (do ([x : Integer 0 (add1 x)]) ((> x 10) x) (displayln x))
                   Integer)
-             #:ret (ret -Integer -tt-propset -empty-obj)]
+             #:ret (tc-ret -Integer)]
        [tc-e (do : Integer ([x : Integer 0 (add1 x)]) ((> x 10) x) (displayln x))
-             #:ret (ret -Integer -tt-propset -empty-obj)]
+             #:ret (tc-ret -Integer)]
        [tc-e (tr:case-lambda [(x [y : String]) x])
-             #:ret (ret (t:-> Univ -String Univ
-                              : (-PS (-not-type (list 0 0) (-val #f))
-                                     (-is-type (list 0 0) (-val #f)))
-                              : (make-Path null (list 0 0)))
+             #:ret (tc-ret (t:-> Univ -String Univ
+                              : (-PS (-not-type (cons 0 0) (-val #f))
+                                     (-is-type (cons 0 0) (-val #f)))
+                              : (make-Path null (cons 0 0)))
                         -true-propset)]
        [tc-e (tr:case-lambda [(x [y : String] . rst) x])
-             #:ret (ret (->* (list Univ -String) Univ Univ
-                             : (-PS (-not-type (list 0 0) (-val #f))
-                                    (-is-type (list 0 0) (-val #f)))
-                             : (make-Path null (list 0 0)))
+             #:ret (tc-ret (->* (list Univ -String) Univ Univ
+                             : (-PS (-not-type (cons 0 0) (-val #f))
+                                    (-is-type (cons 0 0) (-val #f)))
+                             : (make-Path null (cons 0 0)))
                         -true-propset)]
        [tc-e (tr:case-lambda [(x [y : String] . [rst : String *]) x])
-             #:ret (ret (->* (list Univ -String) -String Univ
-                             : (-PS (-not-type (list 0 0) (-val #f))
-                                    (-is-type (list 0 0) (-val #f)))
-                             : (make-Path null (list 0 0)))
+             #:ret (tc-ret (->* (list Univ -String) -String Univ
+                             : (-PS (-not-type (cons 0 0) (-val #f))
+                                    (-is-type (cons 0 0) (-val #f)))
+                             : (make-Path null (cons 0 0)))
                         -true-propset)]
        [tc-e (tr:case-lambda #:forall (A) [([x : A]) x])
-             #:ret (ret (-poly (A)
+             #:ret (tc-ret (-poly (A)
                           (t:-> A A
-                                : (-PS (-not-type (list 0 0) (-val #f))
-                                       (-is-type (list 0 0) (-val #f)))
-                                : (make-Path null (list 0 0))))
+                                : (-PS (-not-type (cons 0 0) (-val #f))
+                                       (-is-type (cons 0 0) (-val #f)))
+                                : (make-Path null (cons 0 0))))
                         -true-propset)]
 
        ;; PR 13651 and related
        [tc-e (tr:lambda #:forall (a ...) ([f : (-> String (values a ... a))])
                (f "foo"))
-             #:ret (ret (-polydots (a)
+             #:ret (tc-ret (-polydots (a)
                           (t:-> (t:-> -String (make-ValuesDots '() a 'a))
                                 (make-ValuesDots '() a 'a)))
                         -true-propset)]
@@ -2861,7 +2863,7 @@
                      ((ann (lambda () (apply (inst values A B ... B) a b))
                            (-> (values A B ... B)))))
                    String String Symbol)
-             #:ret (ret (t:-> -String -String -Symbol
+             #:ret (tc-ret (t:-> -String -String -Symbol
                               (-values (list -String -String -Symbol)))
                         -true-propset)]
 
@@ -2959,7 +2961,7 @@
              (let () (define-type-alias A (Listof B))
                      (define-type-alias B (Listof A))
                      "dummy")
-             #:ret (ret -String -true-propset)]
+             #:ret (tc-ret -String -true-propset)]
        [tc-e (let () (define-type-alias A (Listof B))
                      (define-type-alias B (U #f (Listof A)))
                      (: a A)
@@ -3009,47 +3011,47 @@
                #:msg "type information"]
        ;; make sure no-binding cases like the middle expression are checked
        [tc-err (let () (define r "r") (string-append r 'foo) (define x "x") "y")
-         #:ret (ret -String -true-propset)
+         #:ret (tc-ret -String -true-propset)
          #:msg "expected: String.*given: 'foo"]
 
        ;; Polydotted types are not checking equality correctly
        [tc-err (ann (lambda () (let ([my-values values]) (my-values)))
                  (All (A ...) (-> (Values Symbol ... A))))
-         #:ret (ret (-polydots (A) (t:-> (-values-dots null -Symbol 'A))) -true-propset)]
+         #:ret (tc-ret (-polydots (A) (t:-> (-values-dots null -Symbol 'A))) -true-propset)]
 
        [tc-e (list 'x)
-             #:ret (ret (-Tuple (list -Symbol)))
-             #:expected (ret (-Tuple (list -Symbol)) #f #f)]
+             #:ret (tc-ret (-Tuple (list -Symbol)))
+             #:expected (tc-ret (-Tuple (list -Symbol)) #f #f)]
        [tc-e (list 'y)
-             #:ret (ret (-lst -Symbol))
-             #:expected (ret (-lst -Symbol) #f #f)]
+             #:ret (tc-ret (-lst -Symbol))
+             #:expected (tc-ret (-lst -Symbol) #f #f)]
        [tc-e (reverse (list 'x 'y))
-             #:ret (ret (-Tuple (list (-val 'y) (-val 'x))))
-             #:expected (ret (-Tuple (list (-val 'y) (-val 'x))) #f #f)]
+             #:ret (tc-ret (-Tuple (list (-val 'y) (-val 'x))))
+             #:expected (tc-ret (-Tuple (list (-val 'y) (-val 'x))) #f #f)]
 
        [tc-err (vector 1 2)
-         #:ret (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-propset -empty-obj)
-         #:expected (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-propset #f)]
+         #:ret (tc-ret (make-HeterogeneousVector (list -Byte -Byte)) -false-propset -empty-obj)
+         #:expected (tc-ret (make-HeterogeneousVector (list -Byte -Byte)) -false-propset #f)]
 
        [tc-err (values 'x)
-         #:ret (ret (list -Symbol -Symbol))
-         #:expected (ret (list -Symbol -Symbol) (list #f #f ) (list #f #f))]
+         #:ret (tc-ret (list -Symbol -Symbol))
+         #:expected (tc-ret (list -Symbol -Symbol) (list #f #f ) (list #f #f))]
 
        [tc-err (values 'x 'y 'z)
-         #:ret (ret (list -Symbol -Symbol))
-         #:expected (ret (list -Symbol -Symbol) (list #f #f ) (list #f #f))]
+         #:ret (tc-ret (list -Symbol -Symbol))
+         #:expected (tc-ret (list -Symbol -Symbol) (list #f #f ) (list #f #f))]
 
        [tc-err (values 'y)
-         #:ret (ret (list -Symbol) (list -tt-propset) (list -empty-obj) Univ 'B)
-         #:expected (ret (list -Symbol) (list #f ) (list #f) Univ 'B)]
+         #:ret (tc-ret (list -Symbol) (list -true-propset) (list -empty-obj) Univ 'B)
+         #:expected (tc-ret (list -Symbol) (list #f ) (list #f) Univ 'B)]
 
        [tc-err (values (values 'x 'y))
-         #:ret (ret (-val 'x))
-         #:expected (ret (-val 'x) #f #f)]
+         #:ret (tc-ret (-val 'x))
+         #:expected (tc-ret (-val 'x) #f #f)]
 
        [tc-err (if (random) (values 1 2) 3)
-         #:ret (ret (-val 3) -tt-propset)
-         #:expected (ret (-val 3) #f #f)]
+         #:ret (tc-ret (-val 3) -true-propset)
+         #:expected (tc-ret (-val 3) #f #f)]
 
        [tc-err
          (let* ([x 42]
@@ -3058,7 +3060,7 @@
            (if #t
                (add1 "")
                0))
-         #:ret (ret -Bottom)]
+         #:ret (tc-ret -Bottom)]
 
        [tc-e
          (let: ([x : Any 4])
@@ -3122,8 +3124,8 @@
                         (Number -> Number)))
            (define z (lambda (a) a))
            (z "y"))
-         #:ret (ret -String -ff-propset)
-         #:expected (ret -String #f #f)]
+         #:ret (tc-ret -String -ff-propset)
+         #:expected (tc-ret -String -ff-propset)]
 
        [tc-err
          (let ()
@@ -3132,14 +3134,14 @@
                   (-> Symbol #:b Symbol Symbol)))
            (define z (lambda (a #:b b) a))
            (z "y" #:b "y"))
-         #:ret (ret -String -ff-propset)
-         #:expected (ret -String #f #f)]
+         #:ret (tc-ret -String -ff-propset)
+         #:expected (tc-ret -String -ff-propset)]
 
        [tc-e/t
          (lambda (x)
            (unless (number? x)
              (error 'foo)))
-         (t:-> Univ -Void : (-PS (-is-type 0 -Number) (-is-type 0 -Number)))]
+         (t:-> Univ -Void : (-PS (-is-type 0 -Number) -ff))]
 
        [tc-e
          (let ([x : (U) (error 'fail)])
@@ -3149,12 +3151,12 @@
        [tc-err
          (let ([f (lambda (x y) y)])
            (f 1))
-         #:ret (ret Univ -tt-propset)]
+         #:ret (tc-ret Univ)]
 
        [tc-err
          (let ([f (lambda (x y) y)])
            (f 1 2 3))
-         #:ret (ret -PosByte -true-propset)]
+         #:ret (tc-ret -PosByte)]
 
        [tc-err
          (case-lambda
@@ -3162,107 +3164,107 @@
            ((x . y) 'x)
            (w (first w)))
          #:ret
-           (ret (cl->* (->* (list -Symbol -Symbol) -Symbol -Symbol)
+           (tc-ret (cl->* (->* (list -Symbol -Symbol) -Symbol -Symbol)
                        (->* (list) -String -String)))
          #:expected
-           (ret (cl->* (->* (list -Symbol -Symbol) -Symbol -Symbol)
+           (tc-ret (cl->* (->* (list -Symbol -Symbol) -Symbol -Symbol)
                        (->* (list) -String -String)))]
 
        [tc-e
          (case-lambda
            [() 1]
            [args 2])
-         #:ret (ret (t:-> (-val 1)) -true-propset)
-         #:expected (ret (t:-> (-val 1)) #f)]
+         #:ret (tc-ret (t:-> (-val 1)) -true-propset)
+         #:expected (tc-ret (t:-> (-val 1)) #f)]
 
        [tc-e
          (case-lambda
            [(x . y) 2]
            [args 1])
-         #:ret (ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) -true-propset)
-         #:expected (ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) #f)]
+         #:ret (tc-ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) -true-propset)
+         #:expected (tc-ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) #f)]
 
        [tc-e
          (case-lambda
            [(x) 2]
            [args 1])
-         #:ret (ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) -true-propset)
-         #:expected (ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) #f)]
+         #:ret (tc-ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) -true-propset)
+         #:expected (tc-ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 2))) #f)]
 
        [tc-err
          (case-lambda
            [(x . y) 1]
            [args 2])
-         #:ret (ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 1))) -true-propset)
-         #:expected (ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 1))) #f)]
+         #:ret (tc-ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 1))) -true-propset)
+         #:expected (tc-ret (cl->* (t:-> (-val 1)) (t:-> Univ (-val 1))) #f)]
 
        ;; typecheck-fail should fail
        [tc-err (typecheck-fail #'stx "typecheck-fail")
                #:msg #rx"typecheck-fail"]
        [tc-err (string-append (typecheck-fail #'stx "typecheck-fail") "bar")
-               #:ret (ret -String)
+               #:ret (tc-ret -String)
                #:msg #rx"typecheck-fail"]
 
        [tc-e
          (let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
            (lambda xs (apply f xs)))
-         #:ret (ret (->* (list) Univ Univ))
-         #:expected (ret (->* (list) Univ Univ))]
+         #:ret (tc-ret (->* (list) Univ Univ))
+         #:expected (tc-ret (->* (list) Univ Univ))]
 
        [tc-e
          (let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
            (lambda xs (apply f (ann (cons 'y xs) (cons Symbol (Listof Any))))))
-         #:ret (ret (->* (list) Univ Univ))
-         #:expected (ret (->* (list) Univ Univ))]
+         #:ret (tc-ret (->* (list) Univ Univ))
+         #:expected (tc-ret (->* (list) Univ Univ))]
 
        [tc-e
          (let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
            (lambda xs (apply f 'y xs)))
-         #:ret (ret (->* (list) Univ Univ))
-         #:expected (ret (->* (list) Univ Univ))]
+         #:ret (tc-ret (->* (list) Univ Univ))
+         #:expected (tc-ret (->* (list) Univ Univ))]
 
        [tc-err
          (let: ([f : (case->) (case-lambda)])
             (apply f empty))
-         #:ret (ret -Bottom)
+         #:ret (tc-ret -Bottom)
          #:msg #rx"has no cases"]
        [tc-err
          (let: ([f : (All (A) (case->)) (case-lambda)])
             (apply f empty))
-         #:ret (ret -Bottom)
+         #:ret (tc-ret -Bottom)
          #:msg #rx"has no cases"]
        [tc-err
          (let: ([f : (All (A ...) (case->)) (case-lambda)])
             (apply f empty))
-         #:ret (ret -Bottom)
+         #:ret (tc-ret -Bottom)
          #:msg #rx"has no cases"]
 
        [tc-err
          (let: ([f : (case->) (case-lambda)])
             (apply f empty))
-         #:ret (ret -Bottom)
+         #:ret (tc-ret -Bottom)
          #:msg #rx"has no cases"]
        [tc-err
          (let: ([f : (All (A) (case->)) (case-lambda)])
             (apply f empty))
-         #:ret (ret -Bottom)
+         #:ret (tc-ret -Bottom)
          #:msg #rx"has no cases"]
        [tc-err
          (let: ([f : (All (A ...) (case->)) (case-lambda)])
             (apply f empty))
-         #:ret (ret -Bottom)
+         #:ret (tc-ret -Bottom)
          #:msg #rx"has no cases"]
 
        [tc-e/t
          (let: ([f : (All (a) (a a * -> Void)) (λ _ (void))])
            (plambda: (A B ...) ([xs : (List Any A ... B)])
              (apply f xs)))
-         (-polydots (a b) (t:-> (-pair Univ  (make-ListDots a 'b)) -Void))]
+         (-polydots (a b) (t:-> (-pair Univ  (make-ListDots a 'b)) -Void : -true-propset))]
        [tc-e/t
          (let: ([f : (All (a) (a a * -> Void)) (λ _ (void))])
            (plambda: (A B ...) ([xs : (List A ... B)])
              (apply f (first xs) xs)))
-         (-polydots (a b) (t:-> (make-ListDots a 'b) -Void))]
+         (-polydots (a b) (t:-> (make-ListDots a 'b) -Void : -true-propset))]
 
        [tc-e/t
          (let ()
@@ -3287,7 +3289,7 @@
              (* x x))
            'x)
          -Symbol
-         #:expected (ret -Symbol)]
+         #:expected (tc-ret -Symbol)]
 
        [tc-e
          (ann (for/list ([z #"foobar"]) (add1 z)) (Listof Integer))
@@ -3296,33 +3298,33 @@
        [tc-e
          (lambda (a . b) (apply values a b))
 
-         #:ret (ret (-polydots (A B ...) (->... (list A) (B B) (-values-dots (list A) B 'B))))
-         #:expected (ret (-polydots (A B ...) (->... (list A) (B B) (-values-dots (list A) B 'B))))
+         #:ret (tc-ret (-polydots (A B ...) (->... (list A) (B B) (-values-dots (list A) B 'B))))
+         #:expected (tc-ret (-polydots (A B ...) (->... (list A) (B B) (-values-dots (list A) B 'B))))
          ]
        [tc-e
          (tr:lambda (x #:y [y 3]) x)
-         #:ret (ret (->key Univ #:y Univ #f Univ) -true-propset)
-         #:expected (ret (->key Univ #:y Univ #f Univ) #f)]
+         #:ret (tc-ret (->key Univ #:y Univ #f Univ) -true-propset)
+         #:expected (tc-ret (->key Univ #:y Univ #f Univ) #f)]
        [tc-err
          (lambda xs (plambda: (b) ([x : Any]) 3))
-         #:ret (ret (-polydots (a) (->... (list) (a a) (-values-dots (list) a 'a))))
-         #:expected (ret (-polydots (a) (->... (list) (a a) (-values-dots (list) a 'a))))]
+         #:ret (tc-ret (-polydots (a) (->... (list) (a a) (-values-dots (list) a 'a))))
+         #:expected (tc-ret (-polydots (a) (->... (list) (a a) (-values-dots (list) a 'a))))]
 
 
        [tc-e
          (tr:lambda xs (tr:lambda (x)
                          (apply values (map (tr:lambda (z) (tr:lambda (y) (symbol? x))) xs))))
          #:ret
-           (ret (-polydots (a ...)
+           (tc-ret (-polydots (a ...)
                   (->... (list) (a a)
                          (-values (list
                                    (t:-> Univ
                                          (-values-dots
                                           (list)
                                           (t:-> Univ -Boolean
-                                                : (-PS (-is-type (list 1 0) -Symbol) -tt)) 'a)))))))
+                                                : (-PS (-is-type (cons 1 0) -Symbol) -tt)) 'a)))))))
            #:expected
-           (ret (-polydots (a ...)
+           (tc-ret (-polydots (a ...)
                   (->...
                    (list) (a a)
                    (-values
@@ -3330,38 +3332,38 @@
                      (t:-> Univ
                            (-values-dots
                             (list)
-                            (t:-> Univ -Boolean : (-PS (-is-type (list 1 0) -Symbol) -tt)) 'a)))))))]
+                            (t:-> Univ -Boolean : (-PS (-is-type (cons 1 0) -Symbol) -tt)) 'a)))))))]
 
        [tc-err
          (inst (eval '3) Any)
-         #:ret (ret -Bottom)]
+         #:ret (tc-ret -Bottom)]
        [tc-err
          (lambda xs (inst (apply values (plambda: (b) ([x : b]) x) xs) Symbol))
-         #:ret (ret (-polydots (a ...) (->... (list) (a a)
+         #:ret (tc-ret (-polydots (a ...) (->... (list) (a a)
                                               (-values-dots (list (t:-> -Symbol -Symbol)) a 'a))))
-         #:expected (ret (-polydots (a ...)
+         #:expected (tc-ret (-polydots (a ...)
                                     (->... (list) (a a)
                                            (-values-dots (list (t:-> -Symbol -Symbol)) a 'a))))]
 
        [tc-err
          (lambda xs (andmap (lambda: ([x : (Vectorof Any)]) x) xs))
-         #:ret (ret (-polydots (a ...) (->... (list) ((-vec a) a) (t:Un (-val #f) (-vec Univ)))))
-         #:expected (ret (-polydots (a ...) (->... (list) ((-vec a) a)
+         #:ret (tc-ret (-polydots (a ...) (->... (list) ((-vec a) a) (t:Un (-val #f) (-vec Univ)))))
+         #:expected (tc-ret (-polydots (a ...) (->... (list) ((-vec a) a)
                                                    (t:Un (-val #f) (-vec Univ)))))]
        [tc-err
          (lambda xs (andmap (lambda: ([x : #f]) x) xs))
-         #:ret (ret (-polydots (a ...) (->... (list) ((-val #f) a) (-val #f))))
-         #:expected (ret (-polydots (a ...) (->... (list) ((-val #f) a) (-val #f))))]
+         #:ret (tc-ret (-polydots (a ...) (->... (list) ((-val #f) a) (-val #f))))
+         #:expected (tc-ret (-polydots (a ...) (->... (list) ((-val #f) a) (-val #f))))]
 
        [tc-e
         ((letrec ([lp (lambda (x) lp)]) lp) 'y)
-        #:ret (ret (t:-> -Symbol Univ) -true-propset)
-        #:expected (ret (t:-> -Symbol Univ) #f #f)]
+        #:ret (tc-ret (t:-> -Symbol Univ) -true-propset)
+        #:expected (tc-ret (t:-> -Symbol Univ) #f #f)]
 
        [tc-e
          (list (vector 1 2 3))
-        #:ret (ret (-seq (-vec Univ)))
-        #:expected (ret (-seq (-vec Univ)))]
+        #:ret (tc-ret (-seq (-vec Univ)))
+        #:expected (tc-ret (-seq (-vec Univ)))]
 
        ;; PR 14557 - apply union of functions with different return values
        [tc-err
@@ -3375,11 +3377,11 @@
           (: f (U (-> (values String Symbol)) (-> (values Void Void))))
           (define (f) (values "foo" 'bar))
           (f))
-        #:ret (ret (list (t:Un -String -Void) (t:Un -Symbol -Void)))]
+        #:ret (tc-ret (list (t:Un -String -Void) (t:Un -Symbol -Void)))]
        [tc-e (syntax->datum #`(#,(lambda (x) x)))
-             #:ret (ret Univ)]
+             #:ret (tc-ret Univ)]
        [tc-e (stx->list #'(a . b))
-             #:ret (ret (t:Un (-lst (-Syntax Univ)) (-val #f)))]
+             #:ret (tc-ret (t:Un (-lst (-Syntax Univ)) (-val #f)))]
 
        [tc-e/t
          (lambda (x)
@@ -3390,8 +3392,8 @@
            (g x)
            x)
          (t:-> Univ -String
-               : (-PS (-and (-is-type '(0 0) -String) (-not-type '(0 0) (-val #f))) -ff)
-               : (make-Path null '(0 0)))]
+               : (-PS (-and (-is-type '(0 . 0) -String) (-not-type '(0 . 0) (-val #f))) -ff)
+               : (make-Path null '(0 . 0)))]
 
        ;; PR 14576
        [tc-e
@@ -3411,15 +3413,15 @@
         (let: ([foo : (All (b ...) ((List (List b ... b) ... b) -> (List (List b ... b) ... b)))
                  (lambda (x) x)])
           (foo (list (list))))
-        #:ret (ret -Bottom)]
+        #:ret (tc-ret -Bottom)]
 
        ;; PR 14580
        [tc-err
         (let: ([foo : (All (b ...) ((List (List b ... b) ... b) -> (List (List b ... b) ... b)))
                  (lambda (x) x)])
           (foo (list (list "string" 'symbol))))
-        #:ret (ret (-lst* (-lst* -String)))
-        #:expected (ret (-lst* (-lst* -String)))]
+        #:ret (tc-ret (-lst* (-lst* -String)))
+        #:expected (tc-ret (-lst* (-lst* -String)))]
 
        ;; PR 13898
        [tc-err
@@ -3475,7 +3477,7 @@
           (: y String)
           (define y (for/fold: ((x : String null)) ((v : String null)) x))
           y)
-        #:ret (ret -String -true-propset)
+        #:ret (tc-ret -String -true-propset)
         #:msg #rx"expected: String.*given: (Null|'\\(\\))"]
 
        ;; PR 14493
@@ -3502,13 +3504,13 @@
        [tc-e
          (with-handlers ([exn:fail? (λ (exn) 4)])
             5)
-         #:ret (ret -Nat -true-propset)
-         #:expected (ret -Nat #f)]
+         #:ret (tc-ret -Nat -true-propset)
+         #:expected (tc-ret -Nat #f)]
        [tc-e
          (with-handlers ([exn:fail? (λ (exn) #f)])
             5)
-         #:ret (ret Univ -tt-propset)
-         #:expected (ret Univ #f)]
+         #:ret (tc-ret Univ)
+         #:expected (tc-ret Univ #f)]
        [tc-e
         (with-handlers ([void (λ: ([x : Any]) #t)]) #f)
         -Boolean]
@@ -3523,13 +3525,13 @@
        [tc-err
         (with-handlers ([string? (lambda (e) (string-append e "bar"))])
           (raise "foo"))
-        #:ret (ret -String)
+        #:ret (tc-ret -String)
         #:msg #rx"expected: String.*given: Any"]
        [tc-e
         (with-handlers ([string? (lambda: ([e : String]) (string-append e "bar"))]
                         [symbol? (lambda (x) (symbol->string x))])
           (raise 'foo))
-        #:ret (ret -String)]
+        #:ret (tc-ret -String)]
 
        [tc-err
         (raise (λ ([x : Number]) (add1 x)))]
@@ -3702,7 +3704,7 @@
          (t:-> -RealZero (t:Un (-val #t) -InexactRealNan) : -true-propset)]
        [tc-e/t
          (lambda: ([x : Positive-Integer]) (zero? x))
-         (t:-> -PosInt -Boolean : -false-propset)]
+         (t:-> -PosInt -False : -false-propset)]
        [tc-e/t
          (lambda: ([x : Natural]) (zero? x))
          (t:-> -Nat -Boolean : (-PS (-is-type 0 (-val 0)) (-not-type 0 (-val 0))))]
@@ -3716,9 +3718,9 @@
           (t:-> -Fixnum -Boolean : (-PS (-is-type 0 -NegFixnum) (-is-type 0 -NonNegFixnum)))]
 
        [tc-e (< (ann 0 Integer) +inf.0)
-        #:ret (ret -Boolean -true-propset)]
+        #:ret (tc-ret -Boolean -true-propset)]
        [tc-e (> -inf.0 (ann 0 Exact-Rational))
-        #:ret (ret -Boolean -false-propset)]
+        #:ret (tc-ret -Boolean -false-propset)]
        [tc-e/t (lambda: ([x : Flonum]) (and (<= +inf.f x) x))
         (t:-> -Flonum (t:Un (-val #f) (-val +inf.0))
               : (-PS (-is-type 0 (-val +inf.0)) (-not-type 0 (-val +inf.0))))]
@@ -3744,11 +3746,11 @@
        [tc-e/t (lambda: ([x : One])
                  (let ([f (plambda: (a ...) [w : a ... a] w)])
                    (f x "hello" #\c)))
-        (t:-> -One (-lst* -One -String -Char))]
+        (t:-> -One (-lst* -One -String -Char) : -true-propset)]
 
        [tc-e/t
          (lambda: ([x : Positive-Integer]) (< x 1))
-         (t:-> -PosInt -Boolean : -false-propset)]
+         (t:-> -PosInt -False : -false-propset)]
        [tc-e/t
          (lambda: ([x : Integer]) (>= x 1))
          (t:-> -Integer -Boolean : (-PS (-is-type 0 -PosInt) (-is-type 0 -NonPosInt)))]
@@ -3757,7 +3759,7 @@
          (t:-> -NonNegFlonum -Boolean : (-PS (-is-type 0 -FlonumZero) (-is-type 0 -PosFlonum)))]
        [tc-e/t
          (lambda: ([x : Byte]) (if (< 0 x) x 1))
-         (t:-> -Byte -PosByte : (-PS (-is-type (list 0 0) -Byte) -ff))]
+         (t:-> -Byte -PosByte : (-PS (-is-type (cons 0 0) -Byte) -ff))]
 
        [tc-e/t ((inst values Any) "a") -String]
        [tc-e ((inst second Any Any Any) (list "a" "b")) -String]
@@ -3878,8 +3880,8 @@
        ;; Need an `ann` here because TR doesn't typecheck the literal ".."
        ;; with a precise enough type to satisfy Module-Path
        [tc-e (ann `(submod ".." bar ,(ann ".." "..")) Module-Path)
-             #:ret (ret -Module-Path)
-             #:expected (ret -Module-Path)]
+             #:ret (tc-ret -Module-Path)
+             #:expected (tc-ret -Module-Path)]
        [tc-e/t (ann '(lib "foo") Module-Path) -Module-Path]
        [tc-err (begin (ann '(submod ".." bar ".") Module-Path)
                       (error "foo"))]
@@ -3891,7 +3893,7 @@
 
        ;; PR 15138
        [tc-e (for*/lists: ((xs : (Listof Symbol))) ((x '(a b c))) x)
-             #:ret (ret (-lst -Symbol) (-PS -tt -ff) -empty-obj)]
+             #:ret (tc-ret (-lst -Symbol) (-PS -tt -ff) -empty-obj)]
        [tc-e (for*/fold: ((xs : (Listof Symbol) '())) ((x '(a b c)))
                (cons x xs))
              (-lst -Symbol)]