;;;; registration.scm
;;;; Kon Lovett, Oct '09

(module registration

  (;export
    make-registration
    registration? check-registration error-registration
    @registration-key @registration-ref @registration-deref! @registration-register!)

  (import
    scheme
    chicken
    (only data-structures alist-ref alist-update!)
    (only srfi-1 alist-delete!)
    (only type-checks define-check+error-type check-procedure check-symbol check-list))
  (require-library data-structures srfi-1 type-checks)

;;

(define (alist-keys alist)
  (map car alist) )

(define (alist-values alist)
  (map cdr alist) )

;;

(define-record-type registration
  (*make-registration nam srcs keys ref deref! reg!)
  registration?
  (nam    *registration-name)
  (srcs   *registration-sources *registration-sources-set!)
  (keys   @registration-key)
  (ref    @registration-ref)
  (deref! @registration-deref!)
  (reg!   @registration-register!) )

(define-check+error-type registration)

;;

(define (make-registration name sources)
  (letrec ((reg
            (*make-registration
              (check-symbol 'make-registration name "name")
              (check-list 'make-registration sources "sources")
              (lambda ()
                (alist-keys (*registration-sources reg)) )
              (lambda (name)
                (alist-ref
                  (check-symbol 'registration-ref name)
                  (*registration-sources reg)
                  eq? #f) )
              (lambda (name)
                (*registration-sources-set!
                  reg
                  (alist-delete!
                    (check-symbol 'registration-deref! name)
                    (*registration-sources reg)
                    eq?)) )
              (lambda (name ctor)
                (*registration-sources-set!
                  reg
                  (alist-update!
                    (check-symbol 'registration-register!! name)
                    (check-procedure 'registration-register! ctor)
                    (*registration-sources reg)
                    eq?)))) ) )
    reg ) )

) ;registration