From 272e59575ed76512eb43e3f2361af4a36ecd4eed Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Wed, 24 Apr 2013 16:48:31 +0100 Subject: [PATCH] defstruct setf writers --- ecmalisp.lisp | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/ecmalisp.lisp b/ecmalisp.lisp index 1f960b6..8d5bac5 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -386,7 +386,7 @@ ;; A very simple defstruct built on lists. It supports just slot with ;; an optional default initform, and it will create a constructor, ;; predicate and accessors for you. - (defmacro defstruct (name &rest slots) + (defmacro !defstruct (name &rest slots) (unless (symbolp name) (error "It is not a full defstruct implementation.")) (let* ((name-string (symbol-name name)) @@ -412,11 +412,26 @@ ,@(with-collect (let ((index 1)) (dolist (slot slot-descriptions) - (let ((name (car slot))) - (collect `(defun ,(intern (concat name-string "-" (string name))) (x) - (unless (,predicate x) - (error ,(concat "The object is not a type " name-string))) - (nth ,index x))) + (let* ((name (car slot)) + (accessor-name (intern (concat name-string "-" (string name))))) + (collect + `(defun ,accessor-name (x) + (unless (,predicate x) + (error ,(concat "The object is not a type " name-string))) + (nth ,index x))) + ;; TODO: Implement this with a higher level + ;; abstraction like defsetf or (defun (setf ..)) + (collect + `(define-setf-expander ,accessor-name (x) + (let ((object (gensym)) + (new-value (gensym))) + (values (list object) + (list x) + (list new-value) + `(progn + (rplaca (nthcdr ,',index ,object) ,new-value) + ,new-value) + `(,',accessor-name ,object))))) (incf index))))) ',name))) -- 1.7.10.4