(defmacro defstruct ((name . opts) . slots)
(let ((dp (cadr (assq 'default-pointer opts)))
(conc-name (cadr (assq 'conc-name opts)))
(cons-name (implode (append '(m a k e -) (explodec name)))))
#Q (fset-carefully cons-name '(macro . initial_defstruct-cons))
#M (putprop cons-name 'initial_defstruct-cons 'macro)
#F (putd cons-name '(macro (x) (initial_defstruct-cons x)))
(foo nil (cons (list slot init) foo))
(chars (explodec conc-name))
(putprop cons-name foo 'initial_defstruct-inits)
(setq acsor (implode (append chars (explodec slot))))
(putprop acsor dp 'initial_defstruct-dp)
#Q (fset-carefully acsor '(macro . initial_defstruct-ref))
#M (putprop acsor 'initial_defstruct-ref 'macro)
#F (putd acsor '(macro (x) (initial_defstruct-ref x)))
(putprop acsor i 'initial_defstruct-i))))
(defun initial_defstruct-ref (form)
(let ((i (get (car form) 'initial_defstruct-i))
(get (car form) 'initial_defstruct-dp)
#+Multics `(car ,(do ((i i (1- i))
(defun initial_defstruct-cons (form)
(do ((inits (get (car form) 'initial_defstruct-inits)
(x nil (cons (or (get form (caar inits))