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

Add more (store-source-form 0) decls

Browse source
This commit is contained in:
Douglas Katzman 2022-07-14 17:13:53 -04:00
parent dc44f0366f
commit bf3034200a
2 changed files with 3 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/code/defstruct.lisp
View file

@ -66,6 +66,7 @@
(let ((vars (make-gensym-list (length slot-specs)))) (let ((vars (make-gensym-list (length slot-specs))))
(values (compile nil (values (compile nil
`(lambda (,@vars) `(lambda (,@vars)
(declare (optimize (sb-c:store-source-form 0)))
(%make-structure-instance-macro ,dd ',slot-specs ,@vars)))))) (%make-structure-instance-macro ,dd ',slot-specs ,@vars))))))
(defun %make-funcallable-structure-instance-allocator (dd slot-specs) (defun %make-funcallable-structure-instance-allocator (dd slot-specs)
@ -73,6 +74,7 @@
(bug "funcallable-structure-instance allocation with slots unimplemented")) (bug "funcallable-structure-instance allocation with slots unimplemented"))
(values (values
(compile nil `(lambda () (compile nil `(lambda ()
(declare (optimize (sb-c:store-source-form 0)))
(let ((object (%make-funcallable-instance ,(dd-length dd)))) (let ((object (%make-funcallable-instance ,(dd-length dd))))
(setf (%fun-wrapper object) ,(find-layout (dd-name dd))) (setf (%fun-wrapper object) ,(find-layout (dd-name dd)))
object))))) object)))))

2
tests/bad-mlf-test.lisp
View file

@ -1,5 +1,5 @@
(defun zook () (defun zook ()
(declare (optimize sb-c::store-source-form)) (declare (optimize sb-c:store-source-form))
(macrolet ((foo (x) (macrolet ((foo (x)
(declare (ignore x)) (declare (ignore x))
''hi)) ''hi))