diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/asd.lisp b/asd.lisp deleted file mode 100644 index a11cc38..0000000 --- a/asd.lisp +++ /dev/null @@ -1,31 +0,0 @@ -(progn - (defun add (a b) (+ a b)) - (defvar whatever 16)) - -;; struct -(progn - (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)))) - - (defmacro mydefstruct (name &rest slots) - `(progn - (defun ,(constructor-name name) - ,slots - (list ,@slots)) - ,@(loop for i from 0 to (1- (length slots)) collect - `(defun ,(accessor-name name (nth i slots)) - (instance) - (nth ,i instance))) - ,@ (loop for i from 0 to (1- (length slots)) collect - `(defun ,(setter-name name (nth i slots)) - (instance val) - (setf (nth ,i instance) val))) - ,@(loop for i from 0 to (1- (length slots)) collect - `(defsetf ,(accessor-name name (nth i slots)) - ,(setter-name name (nth i slots))))))) diff --git a/mydefstruct.lisp b/mydefstruct.lisp new file mode 100644 index 0000000..f703319 --- /dev/null +++ b/mydefstruct.lisp @@ -0,0 +1,35 @@ + +(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)))