From ba573abf9eb97820e3b958792e200f40a1c3fa8d Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Tue, 30 Oct 2018 11:58:19 +0100
Subject: [PATCH] defstruct: don't use eval in define-structure

---
 src/lsp/defstruct.lsp | 45 +++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 21 deletions(-)

diff --git a/src/lsp/defstruct.lsp b/src/lsp/defstruct.lsp
index c8980e25a..48970a1e4 100644
--- a/src/lsp/defstruct.lsp
+++ b/src/lsp/defstruct.lsp
@@ -308,33 +308,36 @@
   (create-type-name name)
   ;; We are going to modify this list!!!
   (setf slot-descriptions (copy-tree slot-descriptions))
-  ;; FIXME! We could do the same with ENSURE-CLASS!
   #+clos
   (unless type
-    (eval `(defclass ,name ,(and include (list include))
-             ,(mapcar
-               #'(lambda (sd)
-                   (if sd
-                       (list* (first sd)
-                              :initform (second sd)
-                              :initarg 
-                              (intern (symbol-name (first sd))
-                                      (find-package 'KEYWORD))
-                              (when (third sd) (list :type (third sd))))
-                       nil))            ; for initial offset slots
-               slot-descriptions)
-             (:metaclass structure-class))))
-  ;; FIXME! We can do the same with INSTALL-METHOD!
+    (clos:ensure-class
+     name
+     :direct-superclasses (and include (list include))
+     :direct-slots (mapcar
+                    #'(lambda (sd)
+                        (if sd
+                            (list* :name (first sd)
+                                   :initform (second sd)
+                                   :initargs
+                                   (list
+                                    (intern (symbol-name (first sd))
+                                            (find-package 'KEYWORD)))
+                                   (when (third sd) (list :type (third sd))))
+                            nil))            ; for initial offset slots
+                    slot-descriptions)
+     :metaclass 'structure-class))
   #+clos
   (when print-function
-    (eval `(defmethod print-object ((obj ,name) stream)
-             (,print-function obj stream 0)
-             obj)))
+    (clos::install-method 'print-object nil (list name t) '(obj stream)
+                          #'(lambda (obj stream)
+                              (funcall print-function obj stream 0)
+                              obj)))
   #+clos
   (when print-object
-    (eval `(defmethod print-object ((obj ,name) stream)
-            (,print-object obj stream)
-            obj)))
+    (clos::install-method 'print-object nil (list name t) '(obj stream)
+                          #'(lambda (obj stream)
+                              (funcall print-object obj stream)
+                              obj)))
   (when predicate
     (fset predicate (make-predicate name type named name-offset)))
   (put-sysprop name 'DEFSTRUCT-FORM `(defstruct ,name ,@slots))