mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Get rid of a use of PCL-COMPILE for defstruct
Never JIT-compile a writer for a readonly slot. Instead when macroexpanding DEFSTRUCT, always create anonymized incarnations of each slot accessor and hand those to the CLOS class installer. Thusly all rigmarole about whether there is a pair of globally BOUNDP function names per slot is irrelevant.
This commit is contained in:
Douglas Katzman
parent
42e5e09341
commit
d2ca90b6f3
|
|
@ -136,6 +136,8 @@
|
|||
|
||||
(/show0 "entering !COLD-INIT")
|
||||
#+sb-show (setq */show* t)
|
||||
(setq sb-kernel::*defstruct-hooks* '(sb-kernel::!bootstrap-defstruct-hook)
|
||||
sb-kernel::*struct-accesss-fragments-delayed* nil)
|
||||
(let ((stream (!make-cold-stderr-stream)))
|
||||
(setq *error-output* stream
|
||||
*standard-output* stream
|
||||
|
|
|
|||
|
|
@ -241,6 +241,51 @@
|
|||
;;; the source form to them directly.
|
||||
(defvar *dsd-source-form*)
|
||||
|
||||
(defun accessor-definitions (dd defuns)
|
||||
(if defuns
|
||||
;; Return the ordinary toplevel (usually, anyway) defuns
|
||||
(loop for dsd in (dd-slots dd)
|
||||
for accessor-name = (dsd-accessor-name dsd)
|
||||
unless (accessor-inherited-data accessor-name dd)
|
||||
nconc (dx-let ((key (cons dd dsd)))
|
||||
(let ((source-form (and (boundp '*dsd-source-form*)
|
||||
(cdr (assq dsd *dsd-source-form*)))))
|
||||
`(,@(unless (dsd-read-only dsd)
|
||||
`((sb-c:xdefun (setf ,accessor-name) :accessor ,source-form (value instance)
|
||||
,(slot-access-transform :setf '(instance value) key))))
|
||||
(sb-c:xdefun ,accessor-name :accessor ,source-form (instance)
|
||||
,(slot-access-transform :read '(instance) key))))))
|
||||
;; Return fragements of code that CLOS can use.
|
||||
;; We don't return the toplevel DEFUNs because those generally
|
||||
;; perform an unneeded type-check unless in safety 0.
|
||||
;; These lambdas don't need to check the instance
|
||||
;; because it was already subject to type-based dispatch.
|
||||
;; FIXME: it seems like all these fragments should be packed into a single codebob
|
||||
;; which will have less overhead than separate blobs.
|
||||
;; Afaict, the only way to do that is to return one lambda that returns all the lambdas.
|
||||
(collect ((result))
|
||||
(dolist (dsd (dd-slots dd) (result))
|
||||
(binding* ((key (cons dd dsd))
|
||||
(name (string (dsd-name dsd))) ; anonymize by stringification
|
||||
((reader writer) (dsd-reader dsd (neq (dd-type dd) 'structure))))
|
||||
(declare (dynamic-extent key))
|
||||
(result `(named-lambda (setf ,name) (#1=#:v #2=#:x)
|
||||
,@(if (eql (dsd-type dsd) 't)
|
||||
;; no typecheck
|
||||
`((,writer (truly-the ,(dd-name dd) #2#) ,(dsd-index dsd) #1#) #1#)
|
||||
`(,(slot-access-transform :setf `(#1# (truly-the ,(dd-name dd) #2#))
|
||||
key :function))))
|
||||
`(named-lambda ,name (#2#)
|
||||
,(if (and (dsd-always-boundp dsd) (dsd-safe-p dsd))
|
||||
;; Most slots are always-boundp (don't have a BOA constructor
|
||||
;; that omits slots) and safe-p (type-safe for reading),
|
||||
;; so we can be concise rather than use SLOT-ACCESS-TRANSFORM
|
||||
;; plus a rebinding of X with TRULY-THE.
|
||||
`(,reader (truly-the ,(dd-name dd) #2#) ,(dsd-index dsd))
|
||||
;; Don't check X, but do check the the fetched value.
|
||||
(slot-access-transform :read `((truly-the ,(dd-name dd) #2#))
|
||||
key)))))))))
|
||||
|
||||
;;; shared logic for host macroexpansion for SB-XC:DEFSTRUCT and
|
||||
;;; cross-compiler macroexpansion for CL:DEFSTRUCT
|
||||
;;; This monster has exactly one inline use in the final image,
|
||||
|
|
@ -340,7 +385,7 @@
|
|||
,@(awhen (dd-predicate-name dd)
|
||||
`((sb-c:xdefun ,(dd-predicate-name dd) :predicate nil (object)
|
||||
(typep object ',(dd-name dd)))))
|
||||
,@(accessor-definitions dd))))
|
||||
,@(accessor-definitions dd t))))
|
||||
(if (and delayp (not (compiler-layout-ready-p name)))
|
||||
`((sb-impl::%simple-eval ',(cons 'progn defuns)
|
||||
(make-null-lexenv)))
|
||||
|
|
@ -352,7 +397,8 @@
|
|||
;; %TARGET-DEFSTRUCT returns NAME
|
||||
(%target-defstruct ',dd
|
||||
,(if optimize-speed
|
||||
(gen-custom-equalp dd comparators))))))
|
||||
(gen-custom-equalp dd comparators))
|
||||
,@(accessor-definitions dd nil)))))
|
||||
;; Not DD-CLASS-P
|
||||
;; FIXME: missing package lock checks
|
||||
`((eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
|
|
@ -2053,19 +2099,6 @@ or they must be declared locally notinline at each call site.~@:>"
|
|||
;; because the container itself will check.
|
||||
(if (eq type t) initform `(the ,type ,initform)))))
|
||||
(dd-slots dd))))))))))
|
||||
|
||||
(defun accessor-definitions (dd)
|
||||
(loop for dsd in (dd-slots dd)
|
||||
for accessor-name = (dsd-accessor-name dsd)
|
||||
unless (accessor-inherited-data accessor-name dd)
|
||||
nconc (dx-let ((key (cons dd dsd)))
|
||||
(let ((source-form (and (boundp '*dsd-source-form*)
|
||||
(cdr (assq dsd *dsd-source-form*)))))
|
||||
`(,@(unless (dsd-read-only dsd)
|
||||
`((sb-c:xdefun (setf ,accessor-name) :accessor ,source-form (value instance)
|
||||
,(slot-access-transform :setf '(instance value) key))))
|
||||
(sb-c:xdefun ,accessor-name :accessor ,source-form (instance)
|
||||
,(slot-access-transform :read '(instance) key)))))))
|
||||
|
||||
;;;; instances with ALTERNATE-METACLASS
|
||||
;;;;
|
||||
|
|
@ -2169,11 +2202,14 @@ or they must be declared locally notinline at each call site.~@:>"
|
|||
(setf (info :type :kind ',class-name) :instance))
|
||||
,@(when (eq metaclass-name 'static-classoid)
|
||||
`((declaim (freeze-type ,class-name)))))
|
||||
,@(accessor-definitions dd)
|
||||
,@(accessor-definitions dd t)
|
||||
,@(when constructor
|
||||
(multiple-value-bind (allocate set-layout)
|
||||
(ecase dd-type
|
||||
(structure
|
||||
;; I think the only nonfuncallable alternate-metaclass structure
|
||||
;; is CONDITION, which has its own fancy constructor.
|
||||
;; Maybe this should be (bug "Can't happen") ?
|
||||
(values `(%make-structure-instance-macro ,dd nil) nil))
|
||||
(funcallable-structure
|
||||
(values `(truly-the ,class-name
|
||||
|
|
@ -2186,7 +2222,11 @@ or they must be declared locally notinline at each call site.~@:>"
|
|||
,@(mapcar (lambda (dsd)
|
||||
`(setf (,(dsd-accessor-name dsd) object) ,(dsd-name dsd)))
|
||||
(dd-slots dd))
|
||||
object)))))))
|
||||
object))))
|
||||
(!target-defstruct-altmetaclass ',dd ,@(accessor-definitions dd nil)))))
|
||||
#+sb-xc-host
|
||||
(defun !target-defstruct-altmetaclass (&rest args)
|
||||
(declare (ignore args)))
|
||||
|
||||
;;;; finalizing bootstrapping
|
||||
|
||||
|
|
|
|||
|
|
@ -251,12 +251,27 @@
|
|||
(defun assign-equalp-impl (type-name function)
|
||||
(set-wrapper-equalp-impl (find-layout type-name) function))
|
||||
|
||||
(defun %target-defstruct (dd equalp)
|
||||
;;; This variable is just a somewhat hokey way to pass additional
|
||||
;;; arguments to the defstruct hook (which renders the structure definition
|
||||
;;; into a CLOS class) without having to figure out some means of stashing
|
||||
;;; functions in the DD or DD for the structure.
|
||||
(defvar *struct-accesss-fragments* nil)
|
||||
(define-load-time-global *struct-accesss-fragments-delayed* nil)
|
||||
|
||||
(defun !bootstrap-defstruct-hook (classoid)
|
||||
;; I hate this, but do whatever it takes...
|
||||
;; A better approach might be to write the correct data
|
||||
;; into the LAYOUT-SLOT-TABLE now.
|
||||
;; (I think that's where the code fragments end up)
|
||||
(unless (member (classoid-name classoid) '(pathname condition)) ; KLUDGE
|
||||
(push (cons (classoid-name classoid) *struct-accesss-fragments*)
|
||||
*struct-accesss-fragments-delayed*)))
|
||||
|
||||
(defun %target-defstruct (dd equalp &rest accessors)
|
||||
(declare (type defstruct-description dd))
|
||||
|
||||
(when (dd-doc dd)
|
||||
(setf (documentation (dd-name dd) 'structure)
|
||||
(dd-doc dd)))
|
||||
(setf (documentation (dd-name dd) 'structure) (dd-doc dd)))
|
||||
|
||||
(let ((classoid (find-classoid (dd-name dd))))
|
||||
(let ((layout (classoid-wrapper classoid)))
|
||||
|
|
@ -289,11 +304,18 @@
|
|||
(lambda (a b)
|
||||
(sb-impl::instance-equalp* comparators a b)))))))
|
||||
|
||||
(when *type-system-initialized*
|
||||
(let ((*struct-accesss-fragments* accessors))
|
||||
(dolist (fun *defstruct-hooks*)
|
||||
(funcall fun classoid))))
|
||||
|
||||
(dd-name dd))
|
||||
(defun !target-defstruct-altmetaclass (dd &rest accessors)
|
||||
(declare (type defstruct-description dd))
|
||||
(let ((classoid (find-classoid (dd-name dd)))
|
||||
(*struct-accesss-fragments* accessors))
|
||||
(dolist (fun *defstruct-hooks*)
|
||||
(funcall fun classoid)))
|
||||
t)
|
||||
|
||||
;;; Similar to DO-INSTANCE-TAGGED-SLOT but iterating over all words.
|
||||
(defmacro do-layout-bitmap ((index-var taggedp-var layout count) &body guts)
|
||||
|
|
|
|||
|
|
@ -123,23 +123,62 @@
|
|||
(defun eval-form (form)
|
||||
(lambda () (eval form)))
|
||||
|
||||
(defun ensure-non-standard-class (name classoid &optional existing-class)
|
||||
(flet
|
||||
(defun ensure-non-standard-class (name classoid &optional existing-class extra-data)
|
||||
(labels
|
||||
((ensure (metaclass slots)
|
||||
(let ((supers (mapcar #'classoid-name (classoid-direct-superclasses classoid))))
|
||||
(ensure-class-using-class existing-class name
|
||||
:metaclass metaclass :name name
|
||||
:direct-superclasses supers
|
||||
:direct-slots slots)))
|
||||
(slot-initargs-from-structure-slotd (slotd)
|
||||
(let ((accessor (dsd-accessor-name slotd)))
|
||||
(slot-initargs-from-structure-slotd (slotd writer-fn reader-fn)
|
||||
`(:name ,(dsd-name slotd)
|
||||
:defstruct-accessor-symbol ,accessor
|
||||
:internal-reader-function ,(structure-slotd-reader-function slotd)
|
||||
:internal-writer-function ,(structure-slotd-writer-function name slotd)
|
||||
:defstruct-accessor-symbol ,(dsd-accessor-name slotd)
|
||||
:internal-reader-function ,reader-fn
|
||||
:internal-writer-function ,writer-fn
|
||||
:type ,(dsd-type slotd)
|
||||
:initform ,(dsd-default slotd)
|
||||
:initfunction ,(eval-form (dsd-default slotd)))))
|
||||
;; This is nuts! any DEFAULT might need its lexical environment,
|
||||
;; yet we EVAL in the null environment.
|
||||
:initfunction ,(eval-form (dsd-default slotd))))
|
||||
(accessor-closures (dsd)
|
||||
(multiple-value-bind (reader-fn writer-fn) (sb-kernel::dsd-reader dsd nil)
|
||||
;; This is for a structure class that exists only in its compile-time representation.
|
||||
;; I don't see how these would get called, since you can't make an instance
|
||||
;; of the structure.
|
||||
(list (lambda (newval object) (funcall writer-fn newval object) newval)
|
||||
(lambda (object) (funcall reader-fn object)))))
|
||||
(structure-type-slot-description-list (type)
|
||||
(let* ((dd (find-defstruct-description type))
|
||||
(include (dd-include dd))
|
||||
(all-slots (dd-slots dd)))
|
||||
(unless extra-data
|
||||
(acond ((assoc (dd-name dd) sb-kernel::*struct-accesss-fragments-delayed*)
|
||||
(let ((fragments (cdr it)))
|
||||
(dolist (dsd (dd-slots dd))
|
||||
(push (list dsd (pop fragments) (pop fragments)) extra-data)))
|
||||
(setq sb-kernel::*struct-accesss-fragments-delayed*
|
||||
(delete it sb-kernel::*struct-accesss-fragments-delayed*)))
|
||||
(t
|
||||
(dolist (dsd (dd-slots dd))
|
||||
(push (cons dsd (accessor-closures dsd)) extra-data)))))
|
||||
(multiple-value-bind (super slot-overrides)
|
||||
(if (consp include)
|
||||
(values (car include) (mapcar #'car (cdr include)))
|
||||
(values include nil))
|
||||
(let ((included-slots
|
||||
(when super
|
||||
(dd-slots (find-defstruct-description super)))))
|
||||
;; This seems like a very unclear way to do what it's doing, which is
|
||||
;; collect slots of TYPE that are not in its direct ancestor, *or*
|
||||
;; which have an altered definition relative to the inherited one.
|
||||
(loop for slot = (pop all-slots)
|
||||
for included-slot = (pop included-slots)
|
||||
while slot
|
||||
when (or (not included-slot)
|
||||
(member (dsd-name included-slot) slot-overrides :test #'eq))
|
||||
collect (apply #'slot-initargs-from-structure-slotd
|
||||
(assoc slot extra-data)))))))
|
||||
(slot-initargs-from-condition-slot (slot)
|
||||
`(:name ,(condition-slot-name slot)
|
||||
:initargs ,(condition-slot-initargs slot)
|
||||
|
|
@ -152,29 +191,7 @@
|
|||
:allocation ,(condition-slot-allocation slot)
|
||||
:documentation ,(condition-slot-documentation slot))))
|
||||
(cond ((structure-type-p name)
|
||||
;; This seems like a somewhat unclear way to do what it's doing, which is
|
||||
;; collect slots of TYPE that are not in its direct ancestor, *or*
|
||||
;; which have an altered definition relative to the inherited one.
|
||||
(flet ((structure-type-slot-description-list (type)
|
||||
(let* ((dd (find-defstruct-description type))
|
||||
(include (dd-include dd))
|
||||
(all-slots (dd-slots dd)))
|
||||
(multiple-value-bind (super slot-overrides)
|
||||
(if (consp include)
|
||||
(values (car include) (mapcar #'car (cdr include)))
|
||||
(values include nil))
|
||||
(let ((included-slots
|
||||
(when super
|
||||
(dd-slots (find-defstruct-description super)))))
|
||||
(loop for slot = (pop all-slots)
|
||||
for included-slot = (pop included-slots)
|
||||
while slot
|
||||
when (or (not included-slot)
|
||||
(member (dsd-name included-slot) slot-overrides :test #'eq))
|
||||
collect slot))))))
|
||||
(ensure 'structure-class
|
||||
(mapcar #'slot-initargs-from-structure-slotd
|
||||
(structure-type-slot-description-list name)))))
|
||||
(ensure 'structure-class (structure-type-slot-description-list name)))
|
||||
((condition-type-p name)
|
||||
(ensure 'condition-class
|
||||
(mapcar #'slot-initargs-from-condition-slot
|
||||
|
|
@ -182,14 +199,30 @@
|
|||
(t
|
||||
(error "~@<~S is not the name of a class.~@:>" name)))))
|
||||
|
||||
(defun ensure-deffoo-class (classoid)
|
||||
(defun ensure-deffoo-class (classoid &optional accessors)
|
||||
(let ((class (classoid-pcl-class classoid)))
|
||||
(cond (class
|
||||
(ensure-non-standard-class (class-name class) classoid class))
|
||||
(ensure-non-standard-class (class-name class) classoid class accessors))
|
||||
((eq 'complete **boot-state**)
|
||||
(ensure-non-standard-class (classoid-name classoid) classoid)))))
|
||||
(ensure-non-standard-class (classoid-name classoid) classoid nil accessors)))))
|
||||
|
||||
(pushnew 'ensure-deffoo-class sb-kernel::*defstruct-hooks*)
|
||||
(defun ensure-defstruct-class (classoid)
|
||||
;; Create an association from the DSD to the reader and writer functions.
|
||||
(let* ((name (classoid-name classoid))
|
||||
(dd (find-defstruct-description name))
|
||||
(fragments sb-kernel::*struct-accesss-fragments*))
|
||||
(collect ((accessors))
|
||||
(dolist (dsd (dd-slots dd))
|
||||
(accessors (list dsd (pop fragments) (pop fragments))))
|
||||
(ensure-deffoo-class classoid (accessors)))))
|
||||
|
||||
;;; Prior to the normal (steady-state) defstruct hook getting installed,
|
||||
;;; we just accumulate an alist of slot accessor functions keyed by
|
||||
;;; the type name. After switching it over, we start calling
|
||||
;;; ENSURE-CLASS-USING-CLASS. But that means if PCL isn't ready to
|
||||
;;; actually create classes, we can't switch over. So we refrain
|
||||
;;; from installing the DEFSTRUCT-HOOK until there are no more
|
||||
;;; defstruct forms to execute within PCL itself.
|
||||
(pushnew 'ensure-deffoo-class sb-kernel::*define-condition-hooks*)
|
||||
|
||||
(defun !make-class-predicate (class name source-location)
|
||||
|
|
|
|||
|
|
@ -461,6 +461,11 @@
|
|||
(info
|
||||
:accessor slot-definition-info)))
|
||||
|
||||
(defun uninitialized-accessor-function (type slotd)
|
||||
(lambda (&rest args)
|
||||
(declare (ignore args))
|
||||
(error "~:(~A~) function~@[ for ~S ~] not yet initialized."
|
||||
type slotd)))
|
||||
;;; We use a structure here, because fast slot-accesses to this information
|
||||
;;; are critical to making SLOT-VALUE-USING-CLASS &co fast: places that need
|
||||
;;; these functions can access the SLOT-INFO directly, avoiding the overhead
|
||||
|
|
|
|||
|
|
@ -71,6 +71,7 @@
|
|||
(fmakunbound gf-name)
|
||||
(ensure-accessor gf-name))
|
||||
|
||||
(setq sb-kernel::*defstruct-hooks* '(ensure-defstruct-class))
|
||||
(compute-standard-slot-locations)
|
||||
(dolist (s '(condition function structure-object))
|
||||
(sb-kernel::do-subclassoids ((k v) (find-classoid s))
|
||||
|
|
|
|||
|
|
@ -221,67 +221,6 @@
|
|||
(cond ((std-instance-p instance) (std-instance-slots instance))
|
||||
((fsc-instance-p instance) (fsc-instance-slots instance))))
|
||||
|
||||
;;;; structure-instance stuff
|
||||
;;;;
|
||||
;;;; FIXME: Now that the code is SBCL-only, this extra layer of
|
||||
;;;; abstraction around our native structure representation doesn't
|
||||
;;;; seem to add anything useful, and could probably go away.
|
||||
|
||||
|
||||
|
||||
(defun uninitialized-accessor-function (type slotd)
|
||||
(lambda (&rest args)
|
||||
(declare (ignore args))
|
||||
(error "~:(~A~) function~@[ for ~S ~] not yet initialized."
|
||||
type slotd)))
|
||||
|
||||
(defun structure-slotd-reader-function (slotd)
|
||||
(let ((name (dsd-accessor-name slotd)))
|
||||
(if (fboundp name)
|
||||
(fdefinition name)
|
||||
(uninitialized-accessor-function :reader slotd))))
|
||||
|
||||
;;; Return a function to write the slot identified by SLOTD.
|
||||
;;; This is easy for read/write slots - we just return the accessor
|
||||
;;; that was already set up - but it requires work for read-only slots.
|
||||
;;; Basically we get the slotter-setter-lambda-form and compile it.
|
||||
;;; Using (COERCE lambda-form 'FUNCTION) as used to be done might produce
|
||||
;;; an interpreted function. I'm not sure whether that's right or wrong,
|
||||
;;; because if the DEFSTRUCT itself were evaluated, then the ordinary
|
||||
;;; accessors would indeed be interpreted. However if the DEFSTRUCT were
|
||||
;;; compiled, and the fasl loaded in a Lisp with *EVALUATOR-MODE* = :INTERPRET,
|
||||
;;; arguably this is against the expectation that all things got compiled.
|
||||
;;; But can people really expect that manipulating read-only slots
|
||||
;;; via (SETF SLOT-VALUE) should be fast?
|
||||
;;;
|
||||
;;; Damned-if-you-do / damned-if-you don't - the best thing would be to
|
||||
;;; compile all accessors at "really" compile-time but not store the writer
|
||||
;;; for a reaadonly slot under the #<fdefn> for #'(SETF slot-name).
|
||||
;;; FIXME: this is highly obfuscated and we should just do exactly what the
|
||||
;;; preceding comment suggests: compile all slot-writer frobs and attach
|
||||
;;; them to the defstruct-definition in %TARGET-DEFSTRUCT.
|
||||
(defun structure-slotd-writer-function (type slotd)
|
||||
;; TYPE is not used, because the DD is taken from runtime data.
|
||||
(declare (ignore type))
|
||||
(if (dsd-read-only slotd)
|
||||
;; We'd like to compile the writer just-in-time and store it
|
||||
;; back into the STRUCTURE-DIRECT-SLOT-DEFINITION and also
|
||||
;; the LAYOUT for the class, but we don't have a handle on
|
||||
;; any of the containing objects. So this has to be a closure.
|
||||
(let ((setter 0))
|
||||
(lambda (newval instance)
|
||||
(if (eql setter 0)
|
||||
(let* ((dd (wrapper-info (%instance-wrapper instance)))
|
||||
(f (pcl-compile (slot-setter-lambda-form dd slotd))))
|
||||
(if (functionp f)
|
||||
(funcall (setq setter f) newval instance)
|
||||
(uninitialized-accessor-function :writer slotd)))
|
||||
(funcall (truly-the function setter) newval instance))))
|
||||
(let ((name `(setf ,(dsd-accessor-name slotd))))
|
||||
(if (fboundp name)
|
||||
(fdefinition name)
|
||||
(uninitialized-accessor-function :writer slotd)))))
|
||||
|
||||
(defun pcl-compile (expr &optional unsafe-policy)
|
||||
(let* ((base-policy sb-c::*policy*)
|
||||
(lexenv
|
||||
|
|
|
|||
|
|
@ -207,6 +207,6 @@
|
|||
;; hide the slot name from the compiler so it doesn't optimize
|
||||
(slot-name (eval ''allegedly-immutable-slot)))
|
||||
(setf (slot-value myobj slot-name) :newval1)
|
||||
(assert (= *compile-count* (1+ old-count)))
|
||||
(assert (= *compile-count* old-count)) ; no compilation
|
||||
(setf (slot-value myobj slot-name) :newval2)
|
||||
(assert (= *compile-count* (1+ old-count))))) ; same as before
|
||||
(assert (= *compile-count* old-count)))) ; no compilation
|
||||
|
|
|
|||
|
|
@ -137,17 +137,17 @@
|
|||
(locally (declare (optimize (safety 0)))
|
||||
(defstruct f
|
||||
(x (print t) :type fixnum)))
|
||||
(1 2 2))
|
||||
(1 2 2) (2))
|
||||
(assert-condition-source-paths
|
||||
(locally (declare (optimize (safety 0)))
|
||||
(defstruct f
|
||||
(x 33 :type cons)))
|
||||
(2 2))
|
||||
(2 2) (2))
|
||||
(assert-condition-source-paths
|
||||
(locally (declare (optimize (safety 0)))
|
||||
(defstruct f
|
||||
(x mm)))
|
||||
(2 2)))
|
||||
(2) (2 2)))
|
||||
|
||||
(with-test (:name (:source-path defgeneric :lambda-list))
|
||||
(assert-condition-source-paths
|
||||
|
|
|
|||
Loading…
Reference in a new issue