defstruct   macro

(define-macro (defstruct s . ff)
   (let ((ss (symbol->string s)) (n (length ff)))
      (let* ((n1 (+ n 1))
       (vv (make-vector n1)))
   (let loop ((i 1) (ff ff))
      (if (<= i n)
    (let ((f (car ff)))
       (vector-set! vv i (if (pair? f) (cadr f) '(if #f #f)))
       (loop (+ i 1) (cdr ff)))))
   (let ((ff (map (lambda (f) (if (pair? f) (car f) f)) ff)))
      `(begin (define ,(string->symbol (string-append "make" "-" ss))
           (lambda fvfv
        (let ((st (make-vector ,n1)) (ff ',ff))
           (vector-set! st 0 ',s)
           ,@(let loop ((i 1) (r '()))
          (if (>= i n1) r
              (loop (+ i 1)
              (cons `(vector-set! st ,i
                ,
                (vector-ref vv i))
              r))))
           (let loop ((fvfv fvfv))
        (if (not (null? fvfv))
            (begin  (vector-set! st
               (+ (list-position (car fvfv) ff)
                  1)
               (cadr fvfv))
              (loop (cddr fvfv)))))
           st)))
        ,@(let loop ((i 1) (procs '()))
       (if (>= i n1) procs
           (loop (+ i 1)
           (let ((f (symbol->string (list-ref ff (- i 1)))))
              (cons `(define ,(string->symbol (string-append ss "." f))
            (lambda (x) (vector-ref x ,i)))
              (cons `(define ,(string->symbol (string-append "set!" ss "." f))
                  (lambda (x v)
               (vector-set! x ,i v)))
              procs))))))
        (define ,(string->symbol (string-append ss "?"))
           (lambda (x)
        (and (vector? x)
             (eqv? (vector-ref x 0) ',s)))))))))