diff --git a/collects/typed-scheme/rep/effect-rep.ss b/collects/typed-scheme/rep/effect-rep.ss
index dd755d1f..0812e04f 100644
--- a/collects/typed-scheme/rep/effect-rep.ss
+++ b/collects/typed-scheme/rep/effect-rep.ss
@@ -4,6 +4,10 @@
 (require mzlib/etc)
 (require "rep-utils.ss" "free-variance.ss")
 
+
+
+#|
+
 (de True-Effect () [#:frees #f] [#:fold-rhs #:base])
 
 (de False-Effect () [#:frees #f] [#:fold-rhs #:base])
@@ -39,3 +43,4 @@
 (de Latent-Var-False-Effect () [#:frees #f] [#:fold-rhs #:base])
 
 ;; could also have latent true/false effects, but seems pointless
+|#
\ No newline at end of file
diff --git a/collects/typed-scheme/rep/object-rep.ss b/collects/typed-scheme/rep/object-rep.ss
new file mode 100644
index 00000000..e56bddd5
--- /dev/null
+++ b/collects/typed-scheme/rep/object-rep.ss
@@ -0,0 +1,22 @@
+#lang scheme/base
+
+(require scheme/match scheme/contract "rep-utils.ss" "free-variance.ss")
+
+(dpe CarPE () [#:frees #f] [#:fold-rhs #:base])
+(dpe CdrPE () [#:frees #f] [#:fold-rhs #:base])
+(dpe StructPE ([t Type?] [idx natural-number/c])     
+    [#:frees (free-vars* t) (free-idxs* t)]
+    [#:fold-rhs (*StructPE (type-rec-id t) idx)])
+
+(do Bot () [#:frees #f] [#:fold-rhs #:base])
+
+(do Path ([p (listof PathElem?)] [v identifier?])
+  [#:intern (list p (hash-id v))]
+  [#:frees (combine-frees (map free-vars* p)) (combine-frees (map free-idxs* p))]
+  [#:fold-rhs (*Path (map pathelem-rec-id t) v)])
+
+(dlo LBot () [#:frees #f] [#:fold-rhs #:base])
+
+(dlo LPath ([p (listof PathElem?)] [idx natural-number/c])
+  [#:frees (combine-frees (map free-vars* p)) (combine-frees (map free-idxs* p))]
+  [#:fold-rhs (*LPath (map pathelem-rec-id t) idx)])
\ No newline at end of file
diff --git a/collects/typed-scheme/rep/rep-utils.ss b/collects/typed-scheme/rep/rep-utils.ss
index caaa0daa..ad394dfd 100644
--- a/collects/typed-scheme/rep/rep-utils.ss
+++ b/collects/typed-scheme/rep/rep-utils.ss
@@ -15,132 +15,146 @@
           syntax/stx
 	  (rename-in (utils utils) [id mk-id])))
 
-(provide == dt de print-type* print-effect* Type Type? Effect Effect? defintern hash-id Type-seq Effect-seq Type-key)
+(provide == defintern hash-id (for-syntax fold-target))
 
-
-
-;; hash table for defining folds over types
-(define-values-for-syntax (type-name-ht effect-name-ht)
-  (values (make-hasheq) (make-hasheq)))
-
-(provide (for-syntax type-name-ht effect-name-ht))
-
-
-;; all types are Type?
-(define-struct/printer Type (seq key) (lambda (a b c) ((unbox print-type*) a b c)))
-
-(define-struct/printer Effect (seq key) (lambda (a b c) ((unbox print-effect*) a b c)))
-
-
-
-
-
-;; type/effect definition macro
-
-(define-for-syntax type-rec-id #'type-rec-id)
-(define-for-syntax effect-rec-id #'effect-rec-id)
 (define-for-syntax fold-target #'fold-target)
 
-(provide (for-syntax type-rec-id effect-rec-id fold-target))
+(define-for-syntax (mk par ht-stx)      
+  (define-syntax-class opt-cnt-id
+    #:attributes (i cnt)
+    (pattern i:id
+             #:with cnt #'any/c)
+    (pattern [i:id cnt]))
+  (define-syntax-class no-provide-kw
+    (pattern #:no-provide))
+  (define-syntax-class idlist
+    #:attributes ((i 1) (cnt 1) fs)
+    (pattern (oci:opt-cnt-id ...)               
+             #:with (i ...) #'(oci.i ...)
+             #:with (cnt ...) #'(oci.cnt ...)
+             #:with fs #'(i ...)))
+  (define (combiner f flds)
+    (syntax-parse flds
+      [() #'empty-hash-table]
+      [(e) #`(#,f e)]
+      [(e ...) #`(combine-frees (list (#,f e) ...))]))
+  (define-syntax-class frees-pat
+    #:transparent
+    #:attributes (f1 f2)
+    (pattern (f1:expr f2:expr))
+    (pattern (#f)
+             #:with f1 #'empty-hash-table
+             #:with f2 #'empty-hash-table))
+  (define-syntax-class fold-pat
+    #:transparent
+    #:attributes (e)
+    (pattern #:base
+             #:with e fold-target)
+    (pattern ex:expr
+             #:with e #'#'ex))
+  (lambda (stx)          
+    (syntax-parse stx 
+      [(dform nm:id flds:idlist ([[#:key key-expr:expr]] #:opt 
+                                 [[#:intern intern?:expr]] #:opt
+                                 [[#:frees . frees:frees-pat]] #:opt
+                                 [[#:fold-rhs fold-rhs:fold-pat]] #:opt
+                                 [[#:contract cnt:expr]] #:opt
+                                 [no-provide?:no-provide-kw] #:opt) ...*)
+       (with-syntax* 
+        ([ex (mk-id #'nm #'nm ":")]
+         [kw-stx (string->keyword (symbol->string #'nm.datum))]
+         [parent par]
+         [(s:ty maker pred acc ...) (build-struct-names #'nm (syntax->list #'flds.fs) #f #t #'nm)]
+         [*maker (mk-id #'nm "*" #'nm)]
+         [**maker (mk-id #'nm "**" #'nm)]
+         [*maker-cnt (if enable-contracts?
+                         (or #'cnt #'(flds.cnt ... . -> . pred))
+                         #'any/c)]
+         [ht-stx ht-stx]
+         [bfs-fold-rhs (cond [#'fold-rhs #`(lambda (tr er) #,#'fold-rhs.e)]
+                             [else #'(lambda (type-rec-id effect-rec-id) 
+                                       #`(*maker (#,type-rec-id flds.i) ...))])]
+         [provides (if #'no-provide?
+                       #'(begin)                                 
+                       #`(begin 
+                           (provide ex pred acc ...)
+                           (p/c (rename *maker maker *maker-cnt))))]
+         [intern 
+          (let ([mk (lambda (int) #`(defintern (**maker . flds.fs) maker #,int #:extra-arg key-expr))])
+            (syntax-parse #'flds.fs
+              [_ #:when #'intern?
+                 (mk #'intern?)]
+              [() (mk #'#f)]
+              [(f) (mk #'f)]
+              [_ (mk #'(list . flds.fs))]))]
+         [frees 
+          (with-syntax ([(f1 f2) (if #'frees
+                                     #'(frees.f1 frees.f2)
+                                     (list (combiner #'free-vars* #'flds.fs)
+                                           (combiner #'free-idxs* #'flds.fs)))])
+            (quasisyntax/loc stx
+              (w/c nm ([*maker *maker-cnt])
+                   (define (*maker . flds.fs)
+                     (define v (**maker . flds.fs))
+                     (unless-in-table 
+                      var-table v
+                      (define fvs f1)
+                      (define fis f2)
+                      (hash-set! var-table v fvs)
+                      (hash-set! index-table v fis))
+                     v))))])
+        #`(begin
+            (define-struct (nm parent) flds.fs #:inspector #f)
+            (define-match-expander ex
+              (lambda (s)
+                (syntax-parse s 
+                  [(_ . fs) 
+                   #:with pat (syntax/loc s (_ _ . fs))
+                   (syntax/loc s (struct nm pat))])))
+            (begin-for-syntax
+              (hash-set! ht-stx 'kw-stx (list #'ex #'flds.fs bfs-fold-rhs #'#,stx)))
+            intern
+            provides
+            frees))])))
 
-(define-syntaxes (dt de)
-  (let ()
-    (define-syntax-class opt-cnt-id
-      #:attributes (i cnt)
-      (pattern i:id
-               #:with cnt #'any/c)
-      (pattern [i:id cnt]))
-    (define-syntax-class no-provide-kw
-      (pattern #:no-provide))
-    (define-syntax-class idlist
-      #:attributes ((i 1) (cnt 1) fs)
-      (pattern (oci:opt-cnt-id ...)               
-               #:with (i ...) #'(oci.i ...)
-               #:with (cnt ...) #'(oci.cnt ...)
-               #:with fs #'(i ...)))
-    (define (combiner f flds)
-      (syntax-parse flds
-        [() #'empty-hash-table]
-        [(e) #`(#,f e)]
-        [(e ...) #`(combine-frees (list (#,f e) ...))]))
-    (define-syntax-class frees-pat
-      #:transparent
-      #:attributes (f1 f2)
-      (pattern (f1:expr f2:expr))
-      (pattern (#f)
-               #:with f1 #'empty-hash-table
-               #:with f2 #'empty-hash-table))
-    (define-syntax-class fold-pat
-      #:transparent
-      #:attributes (e)
-      (pattern #:base
-               #:with e fold-target)
-      (pattern ex:expr
-	       #:with e #'#'ex))
-    (define (mk par ht-stx)        
-      (lambda (stx)          
-        (syntax-parse stx 
-          [(dform nm:id flds:idlist ([[#:key key-expr:expr]] #:opt 
-				     [[#:intern intern?:expr]] #:opt
-				     [[#:frees . frees:frees-pat]] #:opt
-				     [[#:fold-rhs fold-rhs:fold-pat]] #:opt
-                                     [[#:contract cnt:expr]] #:opt
-				     [no-provide?:no-provide-kw] #:opt) ...*)
-	   (with-syntax* 
-	     ([ex (mk-id #'nm #'nm ":")]
-	      [kw-stx (string->keyword (symbol->string #'nm.datum))]
-	      [parent par]
-	      [(s:ty maker pred acc ...) (build-struct-names #'nm (syntax->list #'flds.fs) #f #t #'nm)]
-	      [*maker (mk-id #'nm "*" #'nm)]
-	      [**maker (mk-id #'nm "**" #'nm)]
-              [*maker-cnt (if enable-contracts?
-                              (or #'cnt #'(flds.cnt ... . -> . pred))
-                              #'any/c)]
-	      [ht-stx ht-stx]
-	      [bfs-fold-rhs (cond [#'fold-rhs #`(lambda (tr er) #,#'fold-rhs.e)]
-				  [else #'(lambda (type-rec-id effect-rec-id) 
-					    #`(*maker (#,type-rec-id flds.i) ...))])]
-	      [provides (if #'no-provide?
-			    #'(begin)                                 
-			    #`(begin 
-				(provide ex pred acc ...)
-				(p/c (rename *maker maker *maker-cnt))))]
-	      [intern 
-	       (let ([mk (lambda (int) #`(defintern (**maker . flds.fs) maker #,int #:extra-arg key-expr))])
-		 (syntax-parse #'flds.fs
-		   [_ #:when #'intern?
-		    (mk #'intern?)]
-		   [() (mk #'#f)]
-		   [(f) (mk #'f)]
-		   [_ (mk #'(list . flds.fs))]))]
-              [frees 
-               (with-syntax ([(f1 f2) (if #'frees
-                                          #'(frees.f1 frees.f2)
-                                          (list (combiner #'free-vars* #'flds.fs)
-                                                (combiner #'free-idxs* #'flds.fs)))])
-                 (quasisyntax/loc stx
-                   (w/c nm ([*maker *maker-cnt])
-                     (define (*maker . flds.fs)
-                       (define v (**maker . flds.fs))
-                       (unless-in-table 
-                        var-table v
-                        (define fvs f1)
-                        (define fis f2)
-                        (hash-set! var-table v fvs)
-                        (hash-set! index-table v fis))
-                       v))))])
-	     #`(begin
-		 (define-struct (nm parent) flds.fs #:inspector #f)
-		 (define-match-expander ex
-		   (lambda (s)
-		     (syntax-parse s 
-		       [(_ . fs) 
-			#:with pat (syntax/loc s (_ _ . fs))
-			(syntax/loc s (struct nm pat))])))
-		 (begin-for-syntax
-		  (hash-set! ht-stx 'kw-stx (list #'ex #'flds.fs bfs-fold-rhs #'#,stx)))
-		 intern
-		 provides
-		 frees))])))
-  (values (mk #'Type #'type-name-ht) (mk #'Effect #'effect-name-ht))))
 
+(define-syntax (make-prim-type stx)
+  (define default-flds #'(seq))
+  (define-syntax-class type-name-base
+    #:attributes (i lower-s first-letter (fld-names 1))
+    #:transparent
+    (pattern i:id
+             #:with lower-s (string-downcase (symbol->string #'i.datum))
+             #:with (fld-names ...) default-flds
+             #:with first-letter (string-ref #'lower-s 0))
+    (pattern [i:id #:d d-name:id]
+             #:with (fld-names ...) default-flds
+             #:with lower-s (string-downcase (symbol->string #'i.datum))
+             #:with first-letter (symbol->string #'d-name.datum))
+    (pattern [i:id #:fields extra-fld-names:id ...]
+             #:with (fld-names ...) (datum->syntax #f (append (syntax->list default-flds) 
+                                                              (syntax->list #'(extra-fld-names ...))))
+             #:with lower-s (string-downcase (symbol->string #'i.datum))
+             #:with first-letter (string-ref #'lower-s 0)))
+  (define-syntax-class type-name
+    #:transparent
+    (pattern :type-name-base
+             #:with name #'i
+             #:with printer (mk-id #'i "print-" #'lower-s "*")
+             #:with ht (mk-id #'i #'lower-s "-name-ht")
+             #:with rec-id (mk-id #'i #'lower-s "-rec-id")
+             #:with d-id (mk-id #'i "d" #'first-letter)
+             #:with (_ _ pred? accs ...) 
+                    (datum->syntax #f (build-struct-names #'name (syntax->list #'(fld-names ...)) #f #t #'name))))
+  (syntax-parse stx
+    [(_ i:type-name ...)
+     #'(begin
+         (provide i.d-id ... i.printer ... i.name ... i.pred? ... i.accs ... ...
+                  (for-syntax i.ht ... i.rec-id ...))
+         (define-syntax i.d-id (mk #'i.name #'i.ht)) ...
+         (define-for-syntax i.ht (make-hasheq)) ...
+         (define-struct/printer i.name (i.fld-names ...) (lambda (a b c) ((unbox i.printer) a b c))) ...
+         (define-for-syntax i.rec-id #'i.rec-id) ...)]))
+
+(make-prim-type [Type #:fields key] Filter [LatentFilter #:d lf] Object [LatentObject #:d lo]
+                [PathElem #:d pe])
diff --git a/collects/typed-scheme/rep/type-rep.ss b/collects/typed-scheme/rep/type-rep.ss
index 58528227..e34ba3f1 100644
--- a/collects/typed-scheme/rep/type-rep.ss
+++ b/collects/typed-scheme/rep/type-rep.ss
@@ -5,6 +5,7 @@
 	 "rep-utils.ss" "effect-rep.ss" "free-variance.ss"
          mzlib/trace scheme/match
          scheme/contract
+         stxclass/util
          (for-syntax scheme/base))
 
 (define name-table (make-weak-hasheq))
@@ -161,7 +162,7 @@
                       (and rest (type-rec-id rest))
                       (and drest (cons (type-rec-id (car drest)) (cdr drest)))
                       (for/list ([kw kws])
-                        (cons (Keyword-kw kw) (type-rec-id (Keyword-ty kw)) (Keyword-require? kw)))
+                        (make Keyword (Keyword-kw kw) (type-rec-id (Keyword-ty kw)) (Keyword-require? kw)))
                       (map effect-rec-id thn-eff)
                       (map effect-rec-id els-eff))])