X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpred.lisp;h=9f8ac786d42bde91421191a8bd78b2c975c3a87a;hb=829ced3e78a23ba153ba4db64e6ea6984c2313b6;hp=346e388e4a3bda4ae25c71b9890e7f7a69b7bce0;hpb=877c7683fc42a2350a6a422433a1a9be02fe3c4f;p=sbcl.git diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 346e388..9f8ac78 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -17,12 +17,18 @@ (defun streamp (stream) (typep stream 'stream)) -;;; Is X a (VECTOR T)? -(defun vector-t-p (x) - (or (simple-vector-p x) - (and (complex-vector-p x) - (do ((data (%array-data-vector x) (%array-data-vector data))) - ((not (array-header-p data)) (simple-vector-p data)))))) +;;; various (VECTOR FOO) type predicates, not implemented as simple +;;; widetag tests +(macrolet + ((def () + `(progn + ,@(loop for (name spec) in *vector-without-complex-typecode-infos* + collect `(defun ,name (x) + (or (typep x '(simple-array ,spec (*))) + (and (complex-vector-p x) + (do ((data (%array-data-vector x) (%array-data-vector data))) + ((not (array-header-p data)) (typep data '(simple-array ,spec (*)))))))))))) + (def)) ;;; Is X an extended sequence? (defun extended-sequence-p (x) @@ -106,8 +112,6 @@ (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) @@ -116,8 +120,10 @@ (def-type-predicate-wrapper realp) (def-type-predicate-wrapper short-float-p) (def-type-predicate-wrapper single-float-p) + #!+sb-simd-pack (def-type-predicate-wrapper simd-pack-p) (def-type-predicate-wrapper %instancep) (def-type-predicate-wrapper symbolp) + (def-type-predicate-wrapper %other-pointer-p) (def-type-predicate-wrapper system-area-pointer-p) (def-type-predicate-wrapper weak-pointer-p) #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) @@ -166,7 +172,7 @@ (extended-char 'extended-char) ((member t) 'boolean) (keyword 'keyword) - ((or array complex) + ((or array complex #!+sb-simd-pack sb!kernel:simd-pack) (type-specifier (ctype-of object))) (t (let* ((classoid (layout-classoid (layout-of object)))