X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpred.lisp;h=44e6f19ada564a6652913275a273f3871ed51204;hb=8ea7b1a452fc87f91273c96bead8aa862bbc8b98;hp=ee5c9e8b23919d1ff316ae10745b69017400611b;hpb=c55397520c6238fb878bb80ed6687da1700b66ca;p=sbcl.git diff --git a/src/code/pred.lisp b/src/code/pred.lisp index ee5c9e8..44e6f19 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) @@ -115,43 +119,33 @@ (def-type-predicate-wrapper ratiop) (def-type-predicate-wrapper realp) (def-type-predicate-wrapper short-float-p) - (def-type-predicate-wrapper simple-array-p) - (def-type-predicate-wrapper simple-bit-vector-p) - (def-type-predicate-wrapper simple-base-string-p) - #!+sb-unicode (def-type-predicate-wrapper simple-character-string-p) - (def-type-predicate-wrapper simple-string-p) - (def-type-predicate-wrapper simple-vector-p) (def-type-predicate-wrapper single-float-p) - (def-type-predicate-wrapper stringp) (def-type-predicate-wrapper %instancep) (def-type-predicate-wrapper symbolp) (def-type-predicate-wrapper system-area-pointer-p) (def-type-predicate-wrapper weak-pointer-p) - (def-type-predicate-wrapper vectorp) - #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) - (def-type-predicate-wrapper unsigned-byte-32-p) #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) - (def-type-predicate-wrapper signed-byte-32-p) + (progn + (def-type-predicate-wrapper unsigned-byte-32-p) + (def-type-predicate-wrapper signed-byte-32-p)) #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) - (def-type-predicate-wrapper unsigned-byte-64-p) - #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) - (def-type-predicate-wrapper signed-byte-64-p) - (def-type-predicate-wrapper simple-array-nil-p) - (def-type-predicate-wrapper simple-array-unsigned-byte-2-p) - (def-type-predicate-wrapper simple-array-unsigned-byte-4-p) - (def-type-predicate-wrapper simple-array-unsigned-byte-8-p) - (def-type-predicate-wrapper simple-array-unsigned-byte-16-p) - (def-type-predicate-wrapper simple-array-unsigned-byte-32-p) - (def-type-predicate-wrapper simple-array-signed-byte-8-p) - (def-type-predicate-wrapper simple-array-signed-byte-16-p) - (def-type-predicate-wrapper simple-array-signed-byte-30-p) - (def-type-predicate-wrapper simple-array-signed-byte-32-p) - (def-type-predicate-wrapper simple-array-single-float-p) - (def-type-predicate-wrapper simple-array-double-float-p) - #!+long-float (def-type-predicate-wrapper simple-array-long-float-p) - (def-type-predicate-wrapper simple-array-complex-single-float-p) - (def-type-predicate-wrapper simple-array-complex-double-float-p) - #!+long-float (def-type-predicate-wrapper simple-array-complex-long-float-p) + (progn + (def-type-predicate-wrapper unsigned-byte-64-p) + (def-type-predicate-wrapper signed-byte-64-p)) + ;; Specialized array types + (macrolet ((saetp-defs () + `(progn + ,@(map 'list + (lambda (saetp) + `(def-type-predicate-wrapper + ,(symbolicate (sb!vm:saetp-primitive-type-name saetp) "-P"))) + sb!vm:*specialized-array-element-type-properties*)))) + (saetp-defs)) + ;; Other array types + (def-type-predicate-wrapper simple-array-p) + (def-type-predicate-wrapper simple-string-p) + (def-type-predicate-wrapper stringp) + (def-type-predicate-wrapper vectorp) (def-type-predicate-wrapper vector-nil-p)) ;;; Return the specifier for the type of object. This is not simply @@ -176,7 +170,8 @@ (extended-char 'extended-char) ((member t) 'boolean) (keyword 'keyword) - ((or array complex) (type-specifier (ctype-of object))) + ((or array complex) + (type-specifier (ctype-of object))) (t (let* ((classoid (layout-classoid (layout-of object))) (name (classoid-name classoid))) @@ -361,8 +356,9 @@ length and have identical components. Other arrays must be EQ to be EQUAL." #!+sb-test (let ((test-cases `((0.0 ,(load-time-value (make-unportable-float :single-float-negative-zero)) t) (0.0 1.0 nil) - (#c(1 0) #c(1.0 0) t) - (#c(1.1 0) #c(11/10 0) nil) ; due to roundoff error + (#c(1 0) #c(1.0 0.0) t) + (#c(0 1) #c(0.0 1.0) t) + (#c(1.1 0.0) #c(11/10 0) nil) ; due to roundoff error ("Hello" "hello" t) ("Hello" #(#\h #\E #\l #\l #\o) t) ("Hello" "goodbye" nil))))