diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index da0597b0..50a484e1 100644
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -206,7 +206,9 @@ struct sexp_type_struct {
   short size_base, size_off;
   unsigned short size_scale;
   short weak_base, weak_len_base, weak_len_off, weak_len_scale, weak_len_extra;
+  short depth;
   char *name;
+  sexp cpl, slots;
   sexp_proc2 finalize;
 };
 
@@ -841,7 +843,10 @@ SEXP_API struct sexp_struct *sexp_type_specs;
 #define sexp_type_weak_len_off(x)      ((x)->value.type.weak_len_off)
 #define sexp_type_weak_len_scale(x)    ((x)->value.type.weak_len_scale)
 #define sexp_type_weak_len_extra(x)    ((x)->value.type.weak_len_extra)
+#define sexp_type_depth(x)             ((x)->value.type.depth)
 #define sexp_type_name(x)              ((x)->value.type.name)
+#define sexp_type_cpl(x)               ((x)->value.type.cpl)
+#define sexp_type_slots(x)             ((x)->value.type.slots)
 #define sexp_type_finalize(x)          ((x)->value.type.finalize)
 
 #define sexp_bignum_sign(x)            ((x)->value.bignum.sign)
@@ -1027,13 +1032,14 @@ SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags);
 #endif
 
 #if SEXP_USE_TYPE_DEFS
-SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
-SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp slots);
+SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
+SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp parent, sexp slots);
 SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj);
 #define sexp_register_c_type(ctx, name, finalizer)                      \
-  sexp_register_type(ctx, name, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \
-                     SEXP_ZERO, sexp_make_fixnum(sexp_sizeof(cpointer)), \
-                     SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \
+  sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE, SEXP_ZERO, SEXP_ZERO, \
+                     SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,                   \
+                     sexp_make_fixnum(sexp_sizeof(cpointer)),           \
+                     SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,        \
                      SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer)
 #endif
 
@@ -1070,8 +1076,8 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj)
 #define sexp_make_input_string_port(ctx, s) sexp_make_input_string_port_op(ctx sexp_api_pass(NULL, 1), s)
 #define sexp_get_output_string(ctx, out) sexp_get_output_string_op(ctx sexp_api_pass(NULL, 1), out)
 #define sexp_expt(ctx, a, b) sexp_expt_op(ctx sexp_api_pass(NULL, 2), a, b)
-#define sexp_register_simple_type(ctx, a, b) sexp_register_simple_type_op(ctx sexp_api_pass(NULL, 2), a, b)
-#define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p) sexp_register_type_op(ctx sexp_api_pass(NULL, 15), a, b, c, d, e, f, g, h, i, j, k, l, m, o, p)
+#define sexp_register_simple_type(ctx, a, b, c) sexp_register_simple_type_op(ctx sexp_api_pass(NULL, 3), a, b, c)
+#define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r) sexp_register_type_op(ctx sexp_api_pass(NULL, 17), a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r)
 #define sexp_make_type_predicate(ctx, a, b) sexp_make_type_predicate_op(ctx sexp_api_pass(NULL, 2), a, b)
 #define sexp_make_constructor(ctx, a, b) sexp_make_constructor_op(ctx sexp_api_pass(NULL, 2), a, b)
 #define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
diff --git a/lib/chibi/weak.c b/lib/chibi/weak.c
index f2d75687..16e74e8a 100644
--- a/lib/chibi/weak.c
+++ b/lib/chibi/weak.c
@@ -27,7 +27,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_gc_preserve3(ctx, name, t, op);
 
   name = sexp_c_string(ctx, "Ephemeron", -1);
-  t = sexp_register_simple_type(ctx, name, SEXP_TWO);
+  t = sexp_register_simple_type(ctx, name, SEXP_FALSE, SEXP_TWO);
   sexp_ephemeron_id = sexp_type_tag(t);
   sexp_type_field_len_base(t) = 0;
   sexp_type_weak_base(t) = sexp_type_field_base(t);
diff --git a/lib/srfi/18/threads.c b/lib/srfi/18/threads.c
index 3a3e2b15..d8f0f865 100644
--- a/lib/srfi/18/threads.c
+++ b/lib/srfi/18/threads.c
@@ -550,7 +550,8 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_mutex_id   = sexp_lookup_type(ctx, env, "mutex");
   sexp_condvar_id = sexp_lookup_type(ctx, env, "condition-variable");
   name = sexp_c_string(ctx, "pollfds", -1);
-  t = sexp_register_type(ctx, name, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,
+  t = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE,
+                         SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,
                          SEXP_ZERO, sexp_make_fixnum(sexp_sizeof_pollfds),
                          SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,
                          SEXP_ZERO, SEXP_ZERO, (sexp_proc2)sexp_free_pollfds);
diff --git a/lib/srfi/27/rand.c b/lib/srfi/27/rand.c
index 6190b811..7efd03f9 100644
--- a/lib/srfi/27/rand.c
+++ b/lib/srfi/27/rand.c
@@ -172,7 +172,8 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_gc_preserve2(ctx, name, op);
 
   name = sexp_c_string(ctx, "random-source", -1);
-  op = sexp_register_type(ctx, name, sexp_make_fixnum(sexp_offsetof_slot0),
+  op = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE,
+                          sexp_make_fixnum(sexp_offsetof_slot0),
                           ONE, ONE, ZERO, ZERO,
                           sexp_make_fixnum(sexp_sizeof_random),
                           ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, NULL);
diff --git a/lib/srfi/9.module b/lib/srfi/9.module
index 58368111..7513b7f3 100644
--- a/lib/srfi/9.module
+++ b/lib/srfi/9.module
@@ -2,89 +2,5 @@
 (define-module (srfi 9)
   (export define-record-type)
   (import-immutable (scheme))
-  (body
-   (define-syntax define-record-type
-     (er-macro-transformer
-      (lambda (expr rename compare)
-        (let* ((name (cadr expr))
-               (name-str (symbol->string (identifier->symbol name)))
-               (make (caaddr expr))
-               (make-fields (cdaddr expr))
-               (pred (cadddr expr))
-               (fields (cddddr expr))
-               (num-fields (length fields))
-               (_define (rename 'define))
-               (_lambda (rename 'lambda))
-               (_let (rename 'let))
-               (_register (rename 'register-simple-type)))
-          (define (index-of field ls)
-            (let lp ((ls ls) (i 0))
-              (if (eq? field (caar ls)) i (lp (cdr ls) (+ i 1)))))
-          `(,(rename 'begin)
-            ;; type
-            (,_define ,name (,_register ,name-str ,num-fields))
-            ;; predicate
-            (,_define ,pred (,(rename 'make-type-predicate)
-                             ,(symbol->string (identifier->symbol pred))
-                             ,name))
-            ;; fields
-            ,@(let lp ((ls fields) (i 0) (res '()))
-                (if (null? ls)
-                    res
-                    (let ((res
-                           (cons `(,_define ,(cadar ls)
-                                    (,(rename 'make-getter)
-                                     ,(symbol->string
-                                       (identifier->symbol (cadar ls)))
-                                     ,name
-                                     ,i))
-                                 res)))
-                      (lp (cdr ls)
-                          (+ i 1)
-                          (if (pair? (cddar ls))
-                              (cons
-                               `(,_define ,(caddar ls)
-                                  (,(rename 'make-setter)
-                                   ,(symbol->string
-                                     (identifier->symbol (caddar ls)))
-                                   ,name
-                                   ,i))
-                               res)
-                              res)))))
-            ;; constructor
-            (,_define ,make
-              ,(let lp ((ls make-fields) (sets '()) (set-defs '()))
-                 (cond
-                  ((null? ls)
-                   `(,_let ((%make (,(rename 'make-constructor)
-                                    ,(symbol->string (identifier->symbol make))
-                                    ,name))
-                            ,@set-defs)
-                      (,_lambda ,make-fields
-                        (,_let ((res (%make)))
-                          ,@sets
-                          res))))
-                  (else
-                   (let ((field (assq (car ls) fields)))
-                     (cond
-                      ((not field)
-                       (error "unknown record field in constructor" (car ls)))
-                      ((pair? (cddr field))
-                       (lp (cdr ls)
-                           (cons (list (caddr field) 'res (car ls)) sets)
-                           set-defs))
-                      (else
-                       (let* ((setter-name
-                               (string-append "%" name-str "-"
-                                              (symbol->string (car ls)) "-set!"))
-                              (setter (rename (string->symbol setter-name)))
-                              (i (index-of (car ls) fields)))
-                         (lp (cdr ls)
-                             (cons (list setter 'res (car ls)) sets)
-                             (cons (list setter
-                                         (list (rename 'make-setter)
-                                               setter-name
-                                               name
-                                               (index-of (car ls) fields)))
-                                   set-defs)))))))))))))))))
+  (include "9.scm"))
 
diff --git a/lib/srfi/9.scm b/lib/srfi/9.scm
new file mode 100644
index 00000000..5100b341
--- /dev/null
+++ b/lib/srfi/9.scm
@@ -0,0 +1,87 @@
+
+(define-syntax define-record-type
+  (er-macro-transformer
+   (lambda (expr rename compare)
+     (let* ((name (if (pair? (cadr expr)) (caadr expr) (cadr expr)))
+            (parent (and (pair? (cadr expr)) (cadadr expr)))
+            (name-str (symbol->string (identifier->symbol name)))
+            (make (caaddr expr))
+            (make-fields (cdaddr expr))
+            (pred (cadddr expr))
+            (fields (cddddr expr))
+            (_define (rename 'define))
+            (_lambda (rename 'lambda))
+            (_let (rename 'let))
+            (_register (rename 'register-simple-type)))
+       (define (index-of field ls)
+         (let lp ((ls ls) (i 0))
+           (if (eq? field (caar ls)) i (lp (cdr ls) (+ i 1)))))
+       (write `(name: ,name parent: ,parent)) (newline)
+       `(,(rename 'begin)
+         ;; type
+         (,_define ,name (,_register ,name-str ,parent ',fields))
+         ;; predicate
+         (,_define ,pred (,(rename 'make-type-predicate)
+                          ,(symbol->string (identifier->symbol pred))
+                          ,name))
+         ;; fields
+         ,@(let lp ((ls fields) (i 0) (res '()))
+             (if (null? ls)
+                 res
+                 (let ((res
+                        (cons `(,_define ,(cadar ls)
+                                 (,(rename 'make-getter)
+                                  ,(symbol->string
+                                    (identifier->symbol (cadar ls)))
+                                  ,name
+                                  ,i))
+                              res)))
+                   (lp (cdr ls)
+                       (+ i 1)
+                       (if (pair? (cddar ls))
+                           (cons
+                            `(,_define ,(caddar ls)
+                               (,(rename 'make-setter)
+                                ,(symbol->string
+                                  (identifier->symbol (caddar ls)))
+                                ,name
+                                ,i))
+                            res)
+                           res)))))
+         ;; constructor
+         (,_define ,make
+           ,(let lp ((ls make-fields) (sets '()) (set-defs '()))
+              (cond
+               ((null? ls)
+                `(,_let ((%make (,(rename 'make-constructor)
+                                 ,(symbol->string (identifier->symbol make))
+                                 ,name))
+                         ,@set-defs)
+                   (,_lambda ,make-fields
+                     (,_let ((res (%make)))
+                       ,@sets
+                       res))))
+               (else
+                (let ((field (assq (car ls) fields)))
+                  (cond
+                   ((not field)
+                    (error "unknown record field in constructor" (car ls)))
+                   ((pair? (cddr field))
+                    (lp (cdr ls)
+                        (cons (list (caddr field) 'res (car ls)) sets)
+                        set-defs))
+                   (else
+                    (let* ((setter-name
+                            (string-append "%" name-str "-"
+                                           (symbol->string (car ls)) "-set!"))
+                           (setter (rename (string->symbol setter-name)))
+                           (i (index-of (car ls) fields)))
+                      (lp (cdr ls)
+                          (cons (list setter 'res (car ls)) sets)
+                          (cons (list setter
+                                      (list (rename 'make-setter)
+                                            setter-name
+                                            name
+                                            (index-of (car ls) fields)))
+                                set-defs))))))))))
+         (display "done\n"))))))
diff --git a/opcodes.c b/opcodes.c
index 34505644..3d3aff5d 100644
--- a/opcodes.c
+++ b/opcodes.c
@@ -154,7 +154,7 @@ _FN2(_I(SEXP_CHAR), _I(SEXP_STRING), _I(SEXP_FIXNUM), "string-ref", 0, sexp_stri
 _FN3(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_CHAR), "string-set!", 0, sexp_string_utf8_index_set),
 #endif
 #if SEXP_USE_TYPE_DEFS
-_FN2(_I(SEXP_TYPE), _I(SEXP_STRING), _I(SEXP_FIXNUM), "register-simple-type", 0, sexp_register_simple_type_op),
+_FN3(_I(SEXP_TYPE), _I(SEXP_STRING), _I(SEXP_TYPE), SEXP_NULL, "register-simple-type", 0, sexp_register_simple_type_op),
 _FN2(_I(SEXP_OPCODE), _I(SEXP_STRING), _I(SEXP_FIXNUM), "make-type-predicate", 0, sexp_make_type_predicate_op),
 _FN2(_I(SEXP_OPCODE), _I(SEXP_STRING), _I(SEXP_FIXNUM), "make-constructor", 0, sexp_make_constructor_op),
 _FN3(_I(SEXP_OPCODE), _I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "make-getter", 0, sexp_make_getter_op),
diff --git a/sexp.c b/sexp.c
index c16a2778..d043b9ae 100644
--- a/sexp.c
+++ b/sexp.c
@@ -77,42 +77,42 @@ sexp sexp_finalize_port (sexp ctx sexp_api_params(self, n), sexp port) {
 #endif
 
 static struct sexp_type_struct _sexp_type_specs[] = {
-  {SEXP_OBJECT, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "object", NULL},
-  {SEXP_TYPE, 0, 0, 0, 0, 0, sexp_sizeof(type), 0, 0, 0, 0, 0, 0, 0, "type", NULL},
-  {SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "integer", NULL},
-  {SEXP_NUMBER, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "number", NULL},
-  {SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "char", NULL},
-  {SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "boolean", NULL},
-  {SEXP_PAIR, sexp_offsetof(pair, car), 2, 3, 0, 0, sexp_sizeof(pair), 0, 0, 0, 0, 0, 0, 0, "pair", NULL},
-  {SEXP_SYMBOL, 0, 0, 0, 0, 0, sexp_sizeof(symbol)+1, sexp_offsetof(symbol, length), 1, 0, 0, 0, 0, 0, "symbol", NULL},
-  {SEXP_BYTES, 0, 0, 0, 0, 0, sexp_sizeof(bytes)+1, sexp_offsetof(bytes, length), 1, 0, 0, 0, 0, 0, "byte-vector", NULL},
+  {SEXP_OBJECT, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "object", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_TYPE, sexp_offsetof(type, cpl), 2, 2, 0, 0, sexp_sizeof(type), 0, 0, 0, 0, 0, 0, 0, 0, "type", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "integer", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_NUMBER, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "number", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "char", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "boolean", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_PAIR, sexp_offsetof(pair, car), 2, 3, 0, 0, sexp_sizeof(pair), 0, 0, 0, 0, 0, 0, 0, 0, "pair", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_SYMBOL, 0, 0, 0, 0, 0, sexp_sizeof(symbol)+1, sexp_offsetof(symbol, length), 1, 0, 0, 0, 0, 0, 0, "symbol", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_BYTES, 0, 0, 0, 0, 0, sexp_sizeof(bytes)+1, sexp_offsetof(bytes, length), 1, 0, 0, 0, 0, 0, 0, "byte-vector", SEXP_FALSE, SEXP_FALSE, NULL},
 #if SEXP_USE_PACKED_STRINGS
-  {SEXP_STRING, 0, 0, 0, 0, 0, sexp_sizeof(string)+1, sexp_offsetof(string, length), 1, 0, 0, 0, 0, 0, "string", NULL},
+  {SEXP_STRING, 0, 0, 0, 0, 0, sexp_sizeof(string)+1, sexp_offsetof(string, length), 1, 0, 0, 0, 0, 0, 0, "string", SEXP_FALSE, SEXP_FALSE, NULL},
 #else
-  {SEXP_STRING, sexp_offsetof(string, bytes), 1, 1, 0, 0, sexp_sizeof(string), 0, 0, 0, 0, 0, 0, 0, "string", NULL},
+  {SEXP_STRING, sexp_offsetof(string, bytes), 1, 1, 0, 0, sexp_sizeof(string), 0, 0, 0, 0, 0, 0, 0, 0, "string", SEXP_FALSE, SEXP_FALSE, NULL},
 #endif
-  {SEXP_VECTOR, sexp_offsetof(vector, data), 0, 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), sizeof(sexp), 0, 0, 0, 0, 0, "vector", NULL},
-  {SEXP_FLONUM, 0, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, 0, 0, 0, 0, 0, "real", NULL},
-  {SEXP_BIGNUM, 0, 0, 0, 0, 0, sexp_sizeof(bignum), sexp_offsetof(bignum, length), sizeof(sexp_uint_t), 0, 0, 0, 0, 0, "bignum", NULL},
-  {SEXP_CPOINTER, sexp_offsetof(cpointer, parent), 1, 0, 0, 0, sexp_sizeof(cpointer), sexp_offsetof(cpointer, length), 1, 0, 0, 0, 0, 0, "cpointer", NULL},
-  {SEXP_IPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, "input-port", SEXP_FINALIZE_PORT},
-  {SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, "output-port", SEXP_FINALIZE_PORT},
-  {SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, 0, 0, 0, 0, 0, "exception", NULL},
-  {SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, 0, 0, 0, 0, 0, "procedure", NULL},
-  {SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, "macro", NULL},
-  {SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, 0, 0, 0, 0, 0, "syntactic-closure", NULL},
-  {SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, 0, 0, 0, 0, 0, "environment", NULL},
-  {SEXP_BYTECODE, sexp_offsetof(bytecode, name), 3, 3, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, 0, 0, 0, 0, 0, "bytecode", NULL},
-  {SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, 0, 0, 0, 0, 0, "core-form", NULL},
-  {SEXP_OPCODE, sexp_offsetof(opcode, data), 7, 7, 0, 0, sexp_sizeof(opcode), 0, 0, 0, 0, 0, 0, 0, "opcode", NULL},
-  {SEXP_LAMBDA, sexp_offsetof(lambda, name), 11, 11, 0, 0, sexp_sizeof(lambda), 0, 0, 0, 0, 0, 0, 0, "lambda", NULL},
-  {SEXP_CND, sexp_offsetof(cnd, test), 4, 4, 0, 0, sexp_sizeof(cnd), 0, 0, 0, 0, 0, 0, 0, "conditional", NULL},
-  {SEXP_REF, sexp_offsetof(ref, name), 3, 3, 0, 0, sexp_sizeof(ref), 0, 0, 0, 0, 0, 0, 0, "reference", NULL},
-  {SEXP_SET, sexp_offsetof(set, var), 3, 3, 0, 0, sexp_sizeof(set), 0, 0, 0, 0, 0, 0, 0, "set!", NULL},
-  {SEXP_SEQ, sexp_offsetof(seq, ls), 2, 2, 0, 0, sexp_sizeof(seq), 0, 0, 0, 0, 0, 0, 0, "sequence", NULL},
-  {SEXP_LIT, sexp_offsetof(lit, value), 2, 2, 0, 0, sexp_sizeof(lit), 0, 0, 0, 0, 0, 0, 0, "literal", NULL},
-  {SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), 0, 0, 0, 0, 0, "stack", NULL},
-  {SEXP_CONTEXT, sexp_offsetof(context, bc), 12, 12, 0, 0, sexp_sizeof(context), 0, 0, 0, 0, 0, 0, 0, "context", NULL},
+  {SEXP_VECTOR, sexp_offsetof(vector, data), 0, 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), sizeof(sexp), 0, 0, 0, 0, 0, 0, "vector", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_FLONUM, 0, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, 0, 0, 0, 0, 0, 0, "real", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_BIGNUM, 0, 0, 0, 0, 0, sexp_sizeof(bignum), sexp_offsetof(bignum, length), sizeof(sexp_uint_t), 0, 0, 0, 0, 0, 0, "bignum", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_CPOINTER, sexp_offsetof(cpointer, parent), 1, 0, 0, 0, sexp_sizeof(cpointer), sexp_offsetof(cpointer, length), 1, 0, 0, 0, 0, 0, 0, "cpointer", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_IPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, "input-port", SEXP_FALSE, SEXP_FALSE, SEXP_FINALIZE_PORT},
+  {SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, "output-port", SEXP_FALSE, SEXP_FALSE, SEXP_FINALIZE_PORT},
+  {SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, 0, 0, 0, 0, 0, 0, "exception", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, 0, 0, 0, 0, 0, 0, "procedure", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, 0, "macro", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, 0, 0, 0, 0, 0, 0, "syntactic-closure", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, 0, 0, 0, 0, 0, 0, "environment", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_BYTECODE, sexp_offsetof(bytecode, name), 3, 3, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, 0, 0, 0, 0, 0, 0, "bytecode", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, 0, 0, 0, 0, 0, 0, "core-form", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_OPCODE, sexp_offsetof(opcode, data), 7, 7, 0, 0, sexp_sizeof(opcode), 0, 0, 0, 0, 0, 0, 0, 0, "opcode", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_LAMBDA, sexp_offsetof(lambda, name), 11, 11, 0, 0, sexp_sizeof(lambda), 0, 0, 0, 0, 0, 0, 0, 0, "lambda", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_CND, sexp_offsetof(cnd, test), 4, 4, 0, 0, sexp_sizeof(cnd), 0, 0, 0, 0, 0, 0, 0, 0, "conditional", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_REF, sexp_offsetof(ref, name), 3, 3, 0, 0, sexp_sizeof(ref), 0, 0, 0, 0, 0, 0, 0, 0, "reference", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_SET, sexp_offsetof(set, var), 3, 3, 0, 0, sexp_sizeof(set), 0, 0, 0, 0, 0, 0, 0, 0, "set!", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_SEQ, sexp_offsetof(seq, ls), 2, 2, 0, 0, sexp_sizeof(seq), 0, 0, 0, 0, 0, 0, 0, 0, "sequence", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_LIT, sexp_offsetof(lit, value), 2, 2, 0, 0, sexp_sizeof(lit), 0, 0, 0, 0, 0, 0, 0, 0, "literal", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), 0, 0, 0, 0, 0, 0, "stack", SEXP_FALSE, SEXP_FALSE, NULL},
+  {SEXP_CONTEXT, sexp_offsetof(context, bc), 12, 12, 0, 0, sexp_sizeof(context), 0, 0, 0, 0, 0, 0, 0, 0, "context", SEXP_FALSE, SEXP_FALSE, NULL},
 };
 
 #if SEXP_USE_GLOBAL_TYPES
@@ -129,6 +129,7 @@ static sexp_uint_t sexp_type_array_size = SEXP_NUM_CORE_TYPES;
 #endif
 
 sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
+                            sexp parent, sexp slots,
                             sexp fb, sexp felb, sexp flb, sexp flo, sexp fls,
                             sexp sb, sexp so, sexp sc, sexp w, sexp wb, sexp wo,
                             sexp ws, sexp we, sexp_proc2 f) {
@@ -137,9 +138,10 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
 #else
   sexp *v1, *v2;
 #endif
-  sexp res, type;
+  sexp_gc_var2(res, type);
   sexp_uint_t i, len, num_types=sexp_context_num_types(ctx),
     type_array_size=sexp_context_type_array_size(ctx);
+  sexp_gc_preserve2(ctx, res, type);
   if (num_types >= SEXP_MAXIMUM_TYPES) {
     res = sexp_user_exception(ctx, self, "register-type: exceeded maximum type limit", name);
   } else if (! sexp_stringp(name)) {
@@ -186,6 +188,21 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
     sexp_type_weak_len_extra(type) = sexp_unbox_fixnum(we);
     sexp_type_name(type) = strdup(sexp_string_data(name));
     sexp_type_finalize(type) = f;
+    if (sexp_typep(parent)) {
+      len = sexp_vectorp(sexp_type_cpl(parent)) ? sexp_vector_length(sexp_type_cpl(parent)) : 1;
+      sexp_type_cpl(type) = sexp_make_vector(ctx, sexp_make_fixnum(len+1), SEXP_VOID);
+      if (sexp_vectorp(sexp_type_cpl(parent)))
+        memcpy(sexp_vector_data(sexp_type_cpl(type)),
+               sexp_vector_data(sexp_type_cpl(parent)),
+               len * sizeof(sexp));
+      else
+        sexp_vector_data(sexp_type_cpl(type))[len-1] = parent;
+    } else {
+      len = 0;
+      sexp_type_cpl(type) = sexp_make_vector(ctx, SEXP_ONE, SEXP_VOID);
+    }
+    sexp_vector_data(sexp_type_cpl(type))[len] = type;
+    sexp_type_depth(type) = len;
     res = type;
 #if SEXP_USE_GLOBAL_TYPES
     sexp_num_types = num_types + 1;
@@ -193,14 +210,17 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
     sexp_global(ctx, SEXP_G_NUM_TYPES) = sexp_make_fixnum(num_types + 1);
 #endif
   }
+  sexp_gc_release2(ctx);
   return res;
 }
 
-sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp slots) {
-  short type_size = sexp_sizeof_header + sizeof(sexp)*sexp_unbox_fixnum(slots);
+sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp parent, sexp slots) {
+  sexp num_slots = sexp_length(ctx, slots);
+  short type_size = sexp_sizeof_header + sizeof(sexp)*sexp_unbox_fixnum(num_slots);
   return
-    sexp_register_type(ctx, name, sexp_make_fixnum(sexp_offsetof_slot0),
-                       slots, slots, SEXP_ZERO, SEXP_ZERO,
+    sexp_register_type(ctx, name, parent, slots,
+                       sexp_make_fixnum(sexp_offsetof_slot0),
+                       num_slots, num_slots, SEXP_ZERO, SEXP_ZERO,
                        sexp_make_fixnum(type_size), SEXP_ZERO, SEXP_ZERO,
                        SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,
                        NULL);
diff --git a/vm.c b/vm.c
index 814926fe..eef3e5b3 100644
--- a/vm.c
+++ b/vm.c
@@ -492,6 +492,21 @@ static sexp_uint_t sexp_restore_stack (sexp saved, sexp *current) {
       goto call_error_handler;}}                               \
     while (0)
 
+static int sexp_check_type(sexp ctx, sexp a, sexp b) {
+  int d;
+  sexp t, v;
+  if (! sexp_pointerp(a))
+    return 0;
+  if (sexp_isa(a, b))
+    return 1;
+  t = sexp_object_type(ctx, a);
+  v = sexp_type_cpl(t);
+  d = sexp_type_depth(b);
+  return sexp_vectorp(v)
+    && (d < sexp_vector_length(v))
+    && sexp_vector_ref(v, sexp_make_fixnum(d)) == b;
+}
+
 #if SEXP_USE_DEBUG_VM
 #include "opt/opcode_names.h"
 #endif
@@ -907,10 +922,17 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     _ARG1 = sexp_make_boolean(sexp_symbolp(_ARG1)); break;
   case SEXP_OP_CHARP:
     _ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break;
+  case SEXP_OP_ISA:
+    tmp1 = _ARG1, tmp2 = _ARG2;
+    if (! sexp_typep(tmp2)) sexp_raise("is-a?: not a type", tmp2);
+    top--;
+    goto do_check_type;
   case SEXP_OP_TYPEP:
     _ALIGN_IP();
-    _ARG1 = sexp_make_boolean(sexp_check_tag(_ARG1, _UWORD0));
+    tmp1 = _ARG1, tmp2 = sexp_type_by_index(ctx, _UWORD0);
     ip += sizeof(sexp);
+  do_check_type:
+    _ARG1 = sexp_make_boolean(sexp_check_type(ctx, tmp1, tmp2));
     break;
   case SEXP_OP_MAKE:
     _ALIGN_IP();
@@ -919,14 +941,14 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     break;
   case SEXP_OP_SLOT_REF:
     _ALIGN_IP();
-    if (! sexp_check_tag(_ARG1, _UWORD0))
+    if (! sexp_check_type(ctx, _ARG1, sexp_type_by_index(ctx, _UWORD0)))
       sexp_raise("slot-ref: bad type", sexp_list2(ctx, sexp_c_string(ctx, sexp_type_name_by_index(ctx, _UWORD0), -1), _ARG1));
     _ARG1 = sexp_slot_ref(_ARG1, _UWORD1);
     ip += sizeof(sexp)*2;
     break;
   case SEXP_OP_SLOT_SET:
     _ALIGN_IP();
-    if (! sexp_check_tag(_ARG1, _UWORD0))
+    if (! sexp_check_type(ctx, _ARG1, sexp_type_by_index(ctx, _UWORD0)))
       sexp_raise("slot-set!: bad type", sexp_list2(ctx, sexp_c_string(ctx, sexp_type_name_by_index(ctx, _UWORD0), -1), _ARG1));
     else if (sexp_immutablep(_ARG1))
       sexp_raise("slot-set!: immutable object", sexp_list1(ctx, _ARG1));
@@ -935,14 +957,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     ip += sizeof(sexp)*2;
     top--;
     break;
-  case SEXP_OP_ISA:
-    _ARG2 = sexp_make_boolean(sexp_isa(_ARG1, _ARG2));
-    top--;
-    break;
   case SEXP_OP_SLOTN_REF:
     if (! sexp_typep(_ARG1))
       sexp_raise("slot-ref: not a record type", sexp_list1(ctx, _ARG1));
-    else if (! sexp_isa(_ARG2, _ARG1))
+    else if (! sexp_check_type(ctx, _ARG2, _ARG1))
       sexp_raise("slot-ref: bad type", sexp_list1(ctx, _ARG2));
     else if (! sexp_fixnump(_ARG3))
       sexp_raise("slot-ref: not an integer", sexp_list1(ctx, _ARG3));
@@ -952,7 +970,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
   case SEXP_OP_SLOTN_SET:
     if (! sexp_typep(_ARG1))
       sexp_raise("slot-ref: not a record type", sexp_list1(ctx, _ARG1));
-    else if (! sexp_isa(_ARG2, _ARG1))
+    else if (! sexp_check_type(ctx, _ARG2, _ARG1))
       sexp_raise("slot-set!: bad type", sexp_list1(ctx, _ARG2));
     else if (sexp_immutablep(_ARG2))
       sexp_raise("slot-set!: immutable object", sexp_list1(ctx, _ARG2));