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

Undo premature optimization from change b821d53b

Browse source
This commit is contained in:
Douglas Katzman 2014-07-21 14:49:52 -04:00
parent 4f2f8417a5
commit 80e9a6e539
2 changed files with 26 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/code/pred.lisp
View file

@ -46,14 +46,33 @@
(t (return-from extended-sequence-p nil)))))
(when (layout-invalid layout)
(setq layout (update-object-layout-or-invalid x slayout)))
;; It's impossible to create an instance which is exactly
;; It's _nearly_ impossible to create an instance which is exactly
;; of type SEQUENCE. To wit: (make-instance 'sequence) =>
;; "Cannot allocate an instance of #<BUILT-IN-CLASS SEQUENCE>."
;; So we do not need to check for that. Just use the 'inherits' vector.
;; We should not need to check for that, just the 'inherits' vector.
;; However, bootstrap code does a sleazy thing, making an instance of
;; the abstract base type which is impossible for user code to do.
;; Preferably the prototype instance for SEQUENCE would be one that could
;; exist, so it would be a STANDARD-OBJECT and SEQUENCE. But it's not.
;; Hence we have to check for a layout that no code using the documented
;; sequence API would ever see, just to get the boundary case right.
;; Note also:
;; - Some builtins use a prototype object that is strictly deeper than
;; layout of the named class because it is indeed the case that no
;; object's layout can ever be EQ to that of the ancestor.
;; e.g. a fixnum as representative of class REAL
;; - Some builtins actually fail (TYPEP (CLASS-PROTOTYPE X) X)
;; but that's not an excuse for getting SEQUENCE wrong:
;; (CLASS-PROTOTYPE (FIND-CLASS 'FLOAT)) => 42
;; (CLASS-PROTOTYPE (FIND-CLASS 'VECTOR)) => 42
;; (CLASS-PROTOTYPE (FIND-CLASS 'LIST)) => 42
;; (CLASS-PROTOTYPE (FIND-CLASS 'STRING)) => 42
(let ((inherits (layout-inherits (truly-the layout layout))))
(declare (optimize (safety 0)))
(and (> (length inherits) depthoid)
(eq (svref inherits depthoid) slayout)))))
(if (and (> (length inherits) depthoid)
(eq (svref inherits depthoid) slayout))
t
(eq layout slayout)))))
;;; Is X a SEQUENCE? Harder than just (OR VECTOR LIST)
(defun sequencep (x)

3
tests/seq.impure.lisp
View file

@ -1293,4 +1293,7 @@
(with-test (:name :generic-sequence-reverse)
(assert-error (reverse (make-instance 'bogus-reversal-seq))))
(with-test (:name :abstract-base-sequence-satisfies-sequencep)
(assert (typep (sb-pcl::class-prototype (find-class 'sequence)) 'sequence)))
;;; success