(defpackage :my-structures
  (:use :cl)
  (:export #:mydefstruct))

(in-package :my-structures)

(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 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 ',name ,@slots)))
(defun accessors (name slots)
  (loop for slot in slots
	for i upfrom 1 collect
	`(defun ,(accessor-name name slot) (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 1 collect
	`(defun ,(setter-name name slot) (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)
	     ,(setter-name name slot))))


(defmacro mydefstruct (name &rest slots)
  `(progn
     ,(constructor name slots)
     ,@ (accessors name slots)
     ,@ (setters name slots)
     ,@ (setfers name slots)))