;;;; srfi-9-ext.scm
;;;; Kon Lovett, Apr '09

(module srfi-9-ext (define-record-type/primitive)

  (import scheme chicken)

;; SRFI-9 workalike w/o record type checking & immediate reference.
;; needs (include "chicken-primitive-object-inlines")

(define-syntax define-record-type/primitive
  (er-macro-transformer
    (lambda (form rename compare)
      (let ((_begin (rename 'begin))
            (_define (rename 'define)) )
        (let ((tag (cadr form))
              (ctor (caddr form))
              (pred (cadddr form))
              (slots (cddddr form)) )
          (let* ((vars (cdr ctor))
                 (inits (map (lambda (sname)
                               (if (memq (car sname) vars) (car sname) '(%undefined-value)) )
                           slots)))
            `(,_begin
               (,_define ,ctor (%make-structure ',tag ,@inits))
               (,_define (,pred x) (%structure-instance? x ',tag))
               ,@(let loop ((slots slots) (i 1))
                   (if (null? slots) '()
                       (let ((slot (car slots)))
                         `(,@(if (null? (cddr slot)) '()
                                 `((define (,(caddr slot) x y) (%structure-set! x ,i y))))
                           (,_define (,(cadr slot) x) (%structure-ref x ,i) )
                           ,@(loop (cdr slots) (add1 i)) ) ) ) ) ) ) ) ) ) ) )

) ;module srfi-9-ext