(module ssql-record

(define-ssql-record ssql-record->insert)

(import chicken scheme)
(use coops coops-primitive-objects defstruct lolevel)

(define-generic (ssql-record->insert record))

(define-syntax define-ssql-record
  (ir-macro-transformer
   (lambda (x i c)
     (let* ((record  (symbol->string (strip-syntax (cadr x))))
            (record? (string->symbol (string-append record "?")))
            (class   (string->symbol (string-append "<" record ">")))
            (->alist (string->symbol (string-append record "->alist"))))
       `(begin
          (defstruct . ,(cdr x))
          (define-primitive-class ,class (<record>) ,record?)
          (define-method (ssql-record->insert (record ,class))
            (let ((alist (,->alist record)))
              `(insert (into ,',(string->symbol record))
                       (columns ,(map car alist))
                       (values ,(list->vector (map cdr alist)))))))))))

)

(import ssql-record)

(define-ssql-record person
  first-name last-name age)

(define angelina
  (make-person first-name: "Angela"
               last-name: "Merkel"
               age: 99))

(pp (ssql-record->insert angelina))

;; output:
 
(insert
  (into person)
  (columns (first-name last-name age))
  (values #("Angela" "Merkel" 99)))