diff --git a/mydefstruct.lisp b/mydefstruct.lisp index f703319..dbc6f69 100644 --- a/mydefstruct.lisp +++ b/mydefstruct.lisp @@ -1,3 +1,8 @@ +(defpackage :my-structures + (:use :cl) + (:export #:mydefstruct)) + +(in-package :my-structures) (defun constructor-name (sym) (intern (concatenate 'string "MAKE-" (string sym)))) @@ -8,19 +13,31 @@ (defun setter-name (name sym) (intern (concatenate 'string "SET-" (string name) "-" (string sym)))) +(defun obj-type (obj) + (car obj)) + +(defun make-error-message (real expected) + (format nil "Accessor called on wrong type! Expected ~a but found ~a" + expected real)) + + (defun constructor (name slots) `(defun ,(constructor-name name) ,slots - (list ,@slots))) + (list ',name ,@slots))) (defun accessors (name slots) (loop for slot in slots - for i upfrom 0 collect + for i upfrom 1 collect `(defun ,(accessor-name name slot) (obj) - (nth ,i obj)))) + (if (eql (obj-type obj) ',name) + (nth ,i obj) + (error (make-error-message (obj-type obj) ',name)))))) (defun setters (name slots) (loop for slot in slots - for i upfrom 0 collect + for i upfrom 1 collect `(defun ,(setter-name name slot) (obj val) - (setf (nth ,i obj) val)))) + (if (eql (obj-type obj) ',name) + (setf (nth ,i obj) val) + (error (make-error-message (obj-type obj) ',name)))))) (defun setfers (name slots) (loop for slot in slots collect `(defsetf ,(accessor-name name slot)