diff --git a/srfi/9.sld b/srfi/9.sld
new file mode 100644
index 00000000..59560be1
--- /dev/null
+++ b/srfi/9.sld
@@ -0,0 +1,83 @@
+;; TODO: this does not work yet, need (begin) to be able to inject
+;; define's in its outer scope
+;;
+;;; This is based on the implementation of SRFI 9 from chibi scheme
+(define-library (srfi 9)
+  (export define-record-type)
+  ;(import (scheme base))
+  (begin
+    (define-syntax define-record-type
+      (er-macro-transformer
+       (lambda (expr rename compare)
+         (let* ((name+parent (cadr expr))
+                (name (if (pair? name+parent) (car name+parent) name+parent))
+                (parent (and (pair? name+parent) (cadr name+parent)))
+                (name-str (symbol->string name)) ;(identifier->symbol name)))
+                (procs (cddr expr))
+                (make (caar procs))
+                (make-fields (cdar procs))
+                (pred (cadr procs))
+                (fields (cddr procs))
+                (_define (rename 'define))
+                (_lambda (rename 'lambda))
+                (_let (rename 'let))
+                (_register (rename 'register-simple-type))
+                (_slot-set! (rename 'slot-set!))
+                (_type_slot_offset (rename 'type-slot-offset)))
+           ;; catch a common mistake
+           (if (eq? name make)
+               (error "same binding for record rtd and constructor" name))
+           `(,(rename 'begin)
+             ;; type
+             (,_define ,name (,_register ,name-str ,parent ',(map car fields)))
+             ;; predicate
+             (,_define ,pred (,(rename 'make-type-predicate)
+                              ,(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)
+             ;; constructor
+             (,_define ,make
+               ,(let lp ((ls make-fields) (sets '()))
+                  (cond
+                   ((null? ls)
+                    `(,_let ((%make (,(rename 'make-constructor)
+                                     ,(symbol->string make) ;(identifier->symbol make))
+                                     ,name)))
+                       (,_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 `(,(car (cddr field)) res ,(car ls)) sets)))
+                       (else
+                        (lp (cdr ls)
+                            (cons `(,_slot-set! ,name res (,_type_slot_offset ,name ',(car ls)) ,(car ls))
+                                  sets))))))))))))))))