common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Highlight the slot clause for bad initforms in defclass.

Browse source
This commit is contained in:
Stas Boukarev 2022-04-29 19:10:45 +03:00
parent ecb6518979
commit 1e7d2505db
1 changed files with 11 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
src/pcl/defclass.lisp
View file

@ -345,23 +345,22 @@
(eq type t))
'(function constantly-0))
(t
(let* ((initform (if (eq type t)
initform
`(sb-c::with-source-form ,source-form
(the* (,type :source-form ,initform
;; Don't want to insert a cast,
;; as a subclass may change the type,
;; just report this at compile-time.
:use-annotations t)
,initform))))
(let* ((initform `(sb-c::with-source-form ,source-form
(the* (,type :source-form ,initform
;; Don't want to insert a cast,
;; as a subclass may change the type,
;; just report this at compile-time.
:use-annotations t)
,initform)))
(entry (assoc initform *initfunctions-for-this-defclass*
:test #'equal)))
(unless entry
(setq entry (list initform
(gensym)
`(function (lambda ()
(declare (optimize
(sb-c:store-coverage-data 0)))
`(function
(lambda ()
(declare (optimize (sb-c:store-coverage-data 0)
(sb-c:verify-arg-count 0)))
,initform))))
(push entry *initfunctions-for-this-defclass*))
(cadr entry)))))