Commit ba573abf authored by Marius Gerbershagen's avatar Marius Gerbershagen

defstruct: don't use eval in define-structure

parent e3cda739
Pipeline #34802817 passed with stage
......@@ -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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment