;;; Note!  See the function `defstruct-insert-macros-in-buffer'
;;;        if you expect this to compile!

(defun defstruct-accessors (name field-list)
  (if field-list
      (cons 
       (list 'defmacro (intern (concat name "-" (car field-list))) 
	     (list 'thing)
	     (list 'list ''aref 'thing (length field-list)))
       (defstruct-accessors name (cdr field-list)))))

(defun defstruct-mutators (name field-list)
  (if field-list
      (cons 
       (list 'defmacro (intern (concat "set-" name "-" (car field-list)))
	     (list 'thing 'new-value)
	     (list 'list ''aset 'thing (length field-list) 'new-value))
       (defstruct-mutators name (cdr field-list)))))

(defmacro defstruct (name-symbol &rest fields)
  (let ((name (symbol-name name-symbol))
	(field-list (nreverse (mapcar 'symbol-name fields))))
    (append
     (list 'progn
	   (list 'defmacro (intern (concat "make-" name)) nil
		 (list 'list ''make-vector (1+ (length field-list)) 
		       (list 'quote (list 'quote name-symbol)))))
     (defstruct-accessors name field-list)
     (defstruct-mutators name field-list))))

(defun defstruct-insert-macros-in-buffer (expression)
  (insert (format "\n\n;;; code generated for %s\n" expression))
  (let ((code (cdr (macroexpand expression))))
    (while code
      (insert (format "%s\n" (car code)))
      (setq code (cdr code))))
  (insert (format ";;; end code generated for %s\n\n" expression)))