From e5bbbd6201b194cba9c6d5ce392ab4fcfa4e21e4 Mon Sep 17 00:00:00 2001 From: Emin Arslan Date: Sat, 25 Jan 2025 19:01:15 +0300 Subject: [PATCH] Final version of mydefstruct --- mydefstruct.lisp | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) 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)