X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpred.lisp;h=6de30db3c106e0e4474d2c43bcc9088b93891f44;hb=2cb068e245e00505076e9c325424df2a1260bfb1;hp=93299ddc7e93d5df7ea3d29a2973b696cd73283e;hpb=a4cffc065c83d046fce193919bf6d4e53f181455;p=sbcl.git diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 93299dd..6de30db 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -21,7 +21,24 @@ (defun vector-t-p (x) (or (simple-vector-p x) (and (complex-vector-p x) - (simple-vector-p (%array-data-vector x))))) + (do ((data (%array-data-vector x) (%array-data-vector data))) + ((not (array-header-p data)) (simple-vector-p data)))))) + +;;; Is X a SEQUENCE? Harder than just (OR VECTOR LIST) +(defun sequencep (x) + (or (listp x) + (vectorp x) + (let* ((slayout #.(info :type :compiler-layout 'sequence)) + (depthoid #.(layout-depthoid (info :type :compiler-layout 'sequence))) + (layout (layout-of x))) + (when (layout-invalid layout) + (setq layout (update-object-layout-or-invalid x slayout))) + (if (eq layout slayout) + t + (let ((inherits (layout-inherits layout))) + (declare (optimize (safety 0))) + (and (> (length inherits) depthoid) + (eq (svref inherits depthoid) slayout))))))) ;;;; primitive predicates. These must be supported directly by the ;;;; compiler. @@ -73,6 +90,8 @@ (def-type-predicate-wrapper integerp) (def-type-predicate-wrapper listp) (def-type-predicate-wrapper long-float-p) + #!+(and sb-thread sb-lutex) + (def-type-predicate-wrapper lutexp) (def-type-predicate-wrapper lra-p) (def-type-predicate-wrapper null) (def-type-predicate-wrapper numberp) @@ -218,10 +237,9 @@ (defun equal (x y) #!+sb-doc - "Return T if X and Y are EQL or if they are structured components - whose elements are EQUAL. Strings and bit-vectors are EQUAL if they - are the same length and have identical components. Other arrays must be - EQ to be EQUAL." + "Return T if X and Y are EQL or if they are structured components whose +elements are EQUAL. Strings and bit-vectors are EQUAL if they are the same +length and have identical components. Other arrays must be EQ to be EQUAL." ;; Non-tail self-recursion implemented with a local auxiliary function ;; is a lot faster than doing it the straightforward way (at least ;; on x86oids) due to calling convention differences. -- JES, 2005-12-30