haxala1r/program-saver
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added a newer version of the code. Cleaned up the defstruct definition.

Browse Source
This commit is contained in:
Emin Arslan 2025-01-25 16:07:03 +03:00
parent 2506c37def
commit 24a7d9b46b
3 changed files with 36 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored Normal file
View File

@ -0,0 +1 @@
*~

31
asd.lisp
View File

@ -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)))))))

35
mydefstruct.lisp Normal file
View File

@ -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)))