(library (strigoform type)
  (export define-type)
  (import (scheme base)
          (hoot match)
          (only (hoot syntax) define-syntax-rule))

  ;; Record types are only just beginning to be added to Hoot and
  ;; there isn't support for mutable structs, yet. So, tagged
  ;; vectors will have to do.
  (define-syntax-rule (define-type name
                        constructor
                        predicate
                        (field getter setter) ...)
    (begin
      (define (constructor field ...)
        (vector 'name field ...))
      (define (predicate obj)
        (match obj
          (#('name field ...) #t)
          (_ #f)))
      (define (getter obj)
        (match obj
          (#('name field ...)
           field)))
      ...
      (define setter
        (let ((i (+ (- (length '(field ...))
                       (length (memq 'field '(field ...))))
                    1)))
          (lambda (obj val)
            (match obj
              (#('name field ...)
               (vector-set! obj i val))))))
      ...)))