36 lines
988 B
Common Lisp
36 lines
988 B
Common Lisp
|
|
(defun constructor-name (sym)
|
|
(intern (concatenate 'string "MAKE-" (string sym))))
|
|
|
|
(defun accessor-name (name sym)
|
|
(intern (concatenate 'string (string name) "-" (string sym))))
|
|
|
|
(defun setter-name (name sym)
|
|
(intern (concatenate 'string "SET-" (string name) "-" (string sym))))
|
|
|
|
(defun constructor (name slots)
|
|
`(defun ,(constructor-name name) ,slots
|
|
(list ,@slots)))
|
|
(defun accessors (name slots)
|
|
(loop for slot in slots
|
|
for i upfrom 0 collect
|
|
`(defun ,(accessor-name name slot) (obj)
|
|
(nth ,i obj))))
|
|
(defun setters (name slots)
|
|
(loop for slot in slots
|
|
for i upfrom 0 collect
|
|
`(defun ,(setter-name name slot) (obj val)
|
|
(setf (nth ,i obj) val))))
|
|
(defun setfers (name slots)
|
|
(loop for slot in slots collect
|
|
`(defsetf ,(accessor-name name slot)
|
|
,(setter-name name slot))))
|
|
|
|
|
|
(defmacro mydefstruct (name &rest slots)
|
|
`(progn
|
|
,(constructor name slots)
|
|
,@ (accessors name slots)
|
|
,@ (setters name slots)
|
|
,@ (setfers name slots)))
|