diff --git a/kons.scm b/kons.scm
index 63cb8c24..075ef4ff 100644
--- a/kons.scm
+++ b/kons.scm
@@ -3,19 +3,44 @@
         (scheme write)
         (srfi 9))
 
-(define-record-type <pare>
-  (kons x y)
-  pare?
-  (x kar set-kar!)
-  (y kdr))
-
+;((lambda ()
+;
+;(define-record-type <pare>
+;  (kons x y)
+;  pare?
+;  (x kar) ;TODO: set-kar!)
+;  (y kdr))
+;
 ;(write
 ;  (list
 ;    (pare? (kons 1 2)) ; =. #t
 ;    (pare? (cons 1 2)) ; =. #f
-;    (kar (kons 1 2))   ; =. 1
-;    (kdr (kons 1 2))   ; =. 2
-;    (let ((k (kons 1 2)))
-;      (set-kar! k 3)
-;      (kar k)))) ;=. 3
+;;    (kar (kons 1 2))   ; =. 1
+;;    (kdr (kons 1 2))   ; =. 2
+;;    (let ((k (kons 1 2)))
+;;      (set-kar! k 3)
+;;      (kar k)) ;=. 3
+;))
+;))
 
+;(define <pare> (register-simple-type <pare> #f (quote (x y)))) 
+;(define pare? vector?) ;(make-type-predicate pare? <pare>)) 
+;(define kons 
+;  ((lambda (%make) 
+;     (lambda (x y) 
+;       ((lambda (res) 
+;          (slot-set! <pare> res (type-slot-offset <pare> (quote y)) y) 
+;          (slot-set! <pare> res (type-slot-offset <pare> (quote x)) x) 
+;          res) 
+;        (%make)))) 
+;   (make-constructor "kons" <pare>))) 
+(write 
+;  (list 
+;    (pare? (kons 1 2)) 
+    (pair? (cons 1 2))
+);)
+
+;(define (make-lambda)
+;  (lambda (a b c) (write (+ a b c))))
+;(define test (make-lambda))
+;(test 1 2 3)
diff --git a/srfi/9.sld b/srfi/9.sld
index 20982539..a356b4d9 100644
--- a/srfi/9.sld
+++ b/srfi/9.sld
@@ -3,9 +3,41 @@
 ;;
 ;;; This is based on the implementation of SRFI 9 from chibi scheme
 (define-library (srfi 9)
-  (export define-record-type)
-  (import (scheme base))
+  (export 
+    define-record-type
+    register-simple-type
+    make-type-predicate
+    make-constructor
+    slot-set!
+    type-slot-offset
+  )
+  (import (scheme base)
+          (scheme cyclone util))
   (begin
+    (define record-marker (list 'record-marker))
+    (define (register-simple-type name parent field-tags)
+      (let ((new (make-vector 3 #f)))
+        (vector-set! new 0 record-marker)
+        (vector-set! new 1 name)
+        (vector-set! new 2 field-tags)
+        new))
+    (define (make-type-predicate pred name)
+      (lambda (obj)
+        (and (vector? obj)
+             (equal? (vector-ref obj 0) record-marker)
+             (equal? (vector-ref obj 1) name))))
+    (define (make-constructor make name)
+      (lambda ()
+        (let* ((field-tags (vector-ref name 2))
+               (new (make-vector (length field-tags) #f)))
+          new)))
+    (define (type-slot-offset name sym)
+      (let ((field-tags (vector-ref name 2)))
+        (list-index2 sym field-tags)))
+    (define (slot-set! name obj idx val)
+      (let ((vec obj)) ;; TODO: get actual slots from obj
+        (vector-set! vec idx val)))
+
     (define-syntax define-record-type
       (er-macro-transformer
        (lambda (expr rename compare)
@@ -29,34 +61,37 @@
                (error "same binding for record rtd and constructor" name))
            `(,(rename 'begin)
              ;; type
-             (,_define ,name (,_register ,name-str ,parent ',(map car fields)))
+             (,_define ,name (,_register 
+                              ,name ;,name-str 
+                              ,parent 
+                              ',(map car fields)))
              ;; predicate
              (,_define ,pred (,(rename 'make-type-predicate)
-                              ,(symbol->string pred) ;(identifier->symbol pred))
+                              ,pred ;(symbol->string pred) ;(identifier->symbol pred))
                               ,name))
-             ;; fields
-             ,@(map (lambda (f)
-                      (and (pair? f) (pair? (cdr f))
-                           `(,_define ,(cadr f)
-                              (,(rename 'make-getter)
-                               ,(symbol->string
-                                 (cadr f)
-                                 ;(identifier->symbol (cadr f))
-                                )
-                               ,name
-                               (,_type_slot_offset ,name ',(car f))))))
-                    fields)
-             ,@(map (lambda (f)
-                      (and (pair? f) (pair? (cdr f)) (pair? (cddr f))
-                           `(,_define ,(car (cddr f))
-                              (,(rename 'make-setter)
-                               ,(symbol->string
-                                 (car (cddr f))
-                                 ;(identifier->symbol (car (cddr f)))
-                                )
-                               ,name
-                               (,_type_slot_offset ,name ',(car f))))))
-                    fields)
+;             ;; fields
+;             ,@(map (lambda (f)
+;                      (and (pair? f) (pair? (cdr f))
+;                           `(,_define ,(cadr f)
+;                              (,(rename 'make-getter)
+;                               ,(symbol->string
+;                                 (cadr f)
+;                                 ;(identifier->symbol (cadr f))
+;                                )
+;                               ,name
+;                               (,_type_slot_offset ,name ',(car f))))))
+;                    fields)
+;             ,@(map (lambda (f)
+;                      (and (pair? f) (pair? (cdr f)) (pair? (cddr f))
+;                           `(,_define ,(car (cddr f))
+;                              (,(rename 'make-setter)
+;                               ,(symbol->string
+;                                 (car (cddr f))
+;                                 ;(identifier->symbol (car (cddr f)))
+;                                )
+;                               ,name
+;                               (,_type_slot_offset ,name ',(car f))))))
+;                    fields)
              ;; constructor
              (,_define ,make
                ,(let lp ((ls make-fields) (sets '()))
@@ -80,4 +115,6 @@
                        (else
                         (lp (cdr ls)
                             (cons `(,_slot-set! ,name res (,_type_slot_offset ,name ',(car ls)) ,(car ls))
-                                  sets))))))))))))))))
+                                  sets)))))))))
+      )
+    ))))))