0.6.11.16:

	Bug 86 isn't a bug. INTERSECTION is an unknown type. And
		(specifier-type '(and (or number vector) real)) is ok.
	moved FIXNUMP, BIGNUMP, and RATIOP to SB!INT
	deleted TARGET-FIXNUMP in favor of SB-INT:FIXNUMP
	added a xc definition of SB-INT:FIXNUMP in cross-type.lisp
	fixed doc string for SB-INT:FIXNUMP
	tweaked type predicate wrappers to facilitate lexical search

diff --git a/BUGS b/BUGS
index 82e95d2..8d402dc 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -825,12 +825,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   (I haven't tried to investigate this bug enough to guess whether
   there might be any user-level symptoms.)
 
-86:
-  The system doesn't know how to reduce
-    (specifier-type '(intersection (or number vector) real)),
-  it just ends up as a HAIRY-TYPE. Smarter INTERSECTION2 methods for
-  UNION-TYPE might help.
-
 87:
   Despite what the manual says, (DECLAIM (SPEED 0)) doesn't cause
   things to be byte compiled. This seems to be true in cmucl-2.4.19,

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 59b9764..ee19b69 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -632,14 +632,6 @@ Lisp extension proposal by David N. Gray"
 the stuff in here originated in CMU CL's EXTENSIONS package and is
 retained, possibly temporariliy, because it might be used internally."
     :use ("CL" "SB!ALIEN" "SB!C-CALL" "SB!SYS" "SB!GRAY")
-    ;; FIXME: RATIOP should probably not go through this package but be
-    ;; called directly from SB!KERNEL, unless it's implemented as
-    ;; TYPEP X 'RATIO in which case it doesn't need to be in SB!KERNEL.
-    ;; And BIGNUMP and FIXNUMP should probably just be in this package,
-    ;; even if they have low-level-optimized implementations. (Their
-    ;; *meanings* aren't low-level, even if their implementations are.)
-    :import-from (("SB!KERNEL" "BIGNUMP" "FIXNUMP" "RATIOP"))
-    :reexport ("BIGNUMP" "FIXNUMP" "RATIOP")
     :export ("*AFTER-SAVE-INITIALIZATIONS*" "*BEFORE-SAVE-INITIALIZATIONS*"
 
              "*ALL-MODIFIER-NAMES*"
@@ -708,6 +700,9 @@ retained, possibly temporariliy, because it might be used internally."
              "LONG-FLOATP"
              "SHORT-FLOATP"
              "SINGLE-FLOATP"
+             "FIXNUMP"
+             "BIGNUMP"
+             "RATIOP" 
 
              ;; encapsulation
              "ARGUMENT-LIST"
@@ -1161,12 +1156,12 @@ is a good idea, but see SB-SYS for blurring of boundaries."
              "FSET" "RAW-DEFINITION"
              "INVOKE-MACROEXPAND-HOOK"
              "DEFAULT-STRUCTURE-PRINT"
-             "LAYOUT" "LAYOUT-LENGTH" "RATIOP" "FIXNUMP" "TARGET-FIXNUMP"
+             "LAYOUT" "LAYOUT-LENGTH"
              "LAMBDA-WITH-ENVIRONMENT" "LAYOUT-PURE" "DSD-RAW-TYPE"
              "%COMPILER-DEFSTRUCT"
              "%COMPILER-ONLY-DEFSTRUCT" "FUNCTION-%COMPILER-ONLY-DEFSTRUCT"
              "DEFSTRUCT-DESCRIPTION" "UNDEFINE-STRUCTURE"
-             "BIGNUMP" "DD-COPIER" "UNDEFINE-FUNCTION-NAME" "DD-TYPE"
+             "DD-COPIER" "UNDEFINE-FUNCTION-NAME" "DD-TYPE"
              "CLASS-STATE" "INSTANCE"
              "*TYPE-SYSTEM-INITIALIZED*" "WEAK-POINTER-P" "FIND-LAYOUT"
              "DSD-NAME" "%TYPEP" "DD-RAW-INDEX"

diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index d699d4d..a43b3c4 100644 (file)
--- a/src/code/cross-type.lisp
+++ b/src/code/cross-type.lisp
@@ -11,6 +11,13 @@
 
 (in-package "SB!IMPL")
 
+;;; Is X a fixnum in the target Lisp?
+(defun fixnump (x)
+  (and (integerp x)
+       (<= sb!vm:*target-most-negative-fixnum*
+          x
+          sb!vm:*target-most-positive-fixnum*)))
+
 ;;; (This was a useful warning when trying to get bootstrapping
 ;;; to work, but it's mostly irrelevant noise now that the system
 ;;; works.)
@@ -75,7 +82,7 @@
            ((subtypep raw-result 'integer)
             (cond ((<= 0 object 1)
                    'bit)
-                  ((target-fixnump object)
+                  ((fixnump object)
                    'fixnum)
                   (t
                    'integer)))
@@ -235,7 +242,7 @@
             ;; Some types require translation between the cross-compilation
             ;; host Common Lisp and the target SBCL.
             (sb!xc:class (values (typep host-object 'sb!xc:class) t))
-            (fixnum (values (target-fixnump host-object) t))
+            (fixnum (values (fixnump host-object) t))
             ;; Some types are too hard to handle in the positive case, but at
             ;; least we can be confident in a large fraction of the negative
             ;; cases..

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 4042453..6b64686 100644 (file)
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -316,13 +316,4 @@
     (values-specifier-type-cache-clear))
   (values))
 
-;;; Is X a fixnum in the target Lisp?
-;;;
-;;; KLUDGE: not clear this really belongs in early-type.lisp, but where?
-(defun target-fixnump (x)
-  (and (integerp x)
-       (<= sb!vm:*target-most-negative-fixnum*
-          x
-          sb!vm:*target-most-positive-fixnum*)))
-
 (!defun-from-collected-cold-init-forms !early-type-cold-init)

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index f144d02..1acb874 100644 (file)
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -31,89 +31,80 @@
   "Return T if X is NIL, otherwise return NIL."
   (not object))
 
-;;; All the primitive type predicates share a parallel form..
-(macrolet
-    ((frob ()
-       `(progn
-         ,@(mapcar (lambda (pred)
-                     (let* ((name (symbol-name pred))
-                            (stem (string-right-trim name "P-"))
-                            (article (if (find (schar name 0) "AEIOU")
-                                       "an"
-                                       "a")))
-                       `(defun ,pred (object)
-                          ,(format nil
-                                   "Return T if OBJECT is ~A ~A, ~
-                                    and NIL otherwise."
-                                   article
-                                   stem)
-                          (,pred object))))
-                   '(array-header-p
-                     arrayp
-                     atom
-                     base-char-p
-                     bignump
-                     bit-vector-p
-                     characterp
-                     code-component-p
-                     consp
-                     compiled-function-p
-                     complexp
-                     complex-double-float-p
-                     complex-float-p
-                     #!+long-float complex-long-float-p
-                     complex-rational-p
-                     complex-single-float-p
-                     ;; (COMPLEX-VECTOR-P is not included here since
-                     ;; it's awkward to express the type it tests for
-                     ;; in the Common Lisp type system, and since
-                     ;; it's only used in the implementation of a few
-                     ;; specialized things.)
-                     double-float-p
-                     fdefn-p
-                     fixnump
-                     floatp
-                     functionp
-                     integerp
-                     listp
-                     long-float-p
-                     lra-p
-                     null
-                     numberp
-                     rationalp
-                     ratiop
-                     realp
-                     short-float-p
-                     sb!kernel:simple-array-p
-                     simple-bit-vector-p
-                     simple-string-p
-                     simple-vector-p
-                     single-float-p
-                     stringp
-                     %instancep
-                     symbolp
-                     system-area-pointer-p
-                     weak-pointer-p
-                     vectorp
-                     unsigned-byte-32-p
-                     signed-byte-32-p
-                     simple-array-unsigned-byte-2-p
-                     simple-array-unsigned-byte-4-p
-                     simple-array-unsigned-byte-8-p
-                     simple-array-unsigned-byte-16-p
-                     simple-array-unsigned-byte-32-p
-                     simple-array-signed-byte-8-p
-                     simple-array-signed-byte-16-p
-                     simple-array-signed-byte-30-p
-                     simple-array-signed-byte-32-p
-                     simple-array-single-float-p
-                     simple-array-double-float-p
-                     #!+long-float simple-array-long-float-p
-                     simple-array-complex-single-float-p
-                     simple-array-complex-double-float-p
-                     #!+long-float simple-array-complex-long-float-p
-                     )))))
-  (frob))
+;;; All the primitive type predicate wrappers share a parallel form..
+(macrolet ((def-type-predicate-wrapper (pred)
+            (let* ((name (symbol-name pred))
+                   (stem (string-left-trim "%" (string-right-trim "P-" name)))
+                   (article (if (position (schar name 0) "AEIOU") "an" "a")))
+              `(defun ,pred (object)
+                 ,(format nil
+                          "Return true if OBJECT is ~A ~A, and NIL otherwise."
+                          article
+                          stem)
+                 ;; (falling through to low-level implementation)
+                 (,pred object)))))
+  (def-type-predicate-wrapper array-header-p)
+  (def-type-predicate-wrapper arrayp)
+  (def-type-predicate-wrapper atom)
+  (def-type-predicate-wrapper base-char-p)
+  (def-type-predicate-wrapper bignump)
+  (def-type-predicate-wrapper bit-vector-p)
+  (def-type-predicate-wrapper characterp)
+  (def-type-predicate-wrapper code-component-p)
+  (def-type-predicate-wrapper consp)
+  (def-type-predicate-wrapper compiled-function-p)
+  (def-type-predicate-wrapper complexp)
+  (def-type-predicate-wrapper complex-double-float-p)
+  (def-type-predicate-wrapper complex-float-p)
+  #!+long-float (def-type-predicate-wrapper complex-long-float-p)
+  (def-type-predicate-wrapper complex-rational-p)
+  (def-type-predicate-wrapper complex-single-float-p)
+  ;; (COMPLEX-VECTOR-P is not included here since it's awkward to express
+  ;; the type it tests for in the Common Lisp type system, and since it's
+  ;; only used in the implementation of a few specialized things.)
+  (def-type-predicate-wrapper double-float-p)
+  (def-type-predicate-wrapper fdefn-p)
+  (def-type-predicate-wrapper fixnump)
+  (def-type-predicate-wrapper floatp)
+  (def-type-predicate-wrapper functionp)
+  (def-type-predicate-wrapper integerp)
+  (def-type-predicate-wrapper listp)
+  (def-type-predicate-wrapper long-float-p)
+  (def-type-predicate-wrapper lra-p)
+  (def-type-predicate-wrapper null)
+  (def-type-predicate-wrapper numberp)
+  (def-type-predicate-wrapper rationalp)
+  (def-type-predicate-wrapper ratiop)
+  (def-type-predicate-wrapper realp)
+  (def-type-predicate-wrapper short-float-p)
+  (def-type-predicate-wrapper sb!kernel:simple-array-p)
+  (def-type-predicate-wrapper simple-bit-vector-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)
+  (def-type-predicate-wrapper unsigned-byte-32-p)
+  (def-type-predicate-wrapper signed-byte-32-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))
 \f
 ;;; Return the specifier for the type of object. This is not simply
 ;;; (TYPE-SPECIFIER (CTYPE-OF OBJECT)) because CTYPE-OF has different

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index c852972..0a4ddd4 100644 (file)
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -100,7 +100,7 @@
        0)
    *byte-buffer*)
 
-  (let ((loc (if (target-fixnump label) label (label-position label))))
+  (let ((loc (if (fixnump label) label (label-position label))))
     (write-var-integer (- loc *previous-location*) *byte-buffer*)
     (setq *previous-location* loc))
 

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index ca355d4..e883864 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -402,7 +402,7 @@
         (if (eq x t)
             (dump-fop 'sb!impl::fop-truth file)
             (dump-non-immediate-object x file)))
-       ((target-fixnump x) (dump-integer x file))
+       ((fixnump x) (dump-integer x file))
        ((characterp x) (dump-character x file))
        (t
         (dump-non-immediate-object x file))))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index af0fbf7..ee67ba7 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1426,12 +1426,12 @@
 #!-propagate-fun-type
 (defoptimizer (ash derive-type) ((n shift))
    (flet ((ash-outer (n s)
-            (when (and (target-fixnump s)
+            (when (and (fixnump s)
                        (<= s 64)
                        (> s sb!vm:*target-most-negative-fixnum*))
               (ash n s)))
           (ash-inner (n s)
-            (if (and (target-fixnump s)
+            (if (and (fixnump s)
                      (> s sb!vm:*target-most-negative-fixnum*))
               (ash n (min s 64))
               (if (minusp n) -1 0))))
@@ -1493,7 +1493,7 @@
 (defun ash-derive-type-aux (n-type shift same-arg)
   (declare (ignore same-arg))
   (flet ((ash-outer (n s)
-          (when (and (target-fixnump s)
+          (when (and (fixnump s)
                      (<= s 64)
                      (> s sb!vm:*target-most-negative-fixnum*))
             (ash n s)))
@@ -1501,7 +1501,7 @@
          ;; symbolic machine word size values somehow.
 
         (ash-inner (n s)
-          (if (and (target-fixnump s)
+          (if (and (fixnump s)
                    (> s sb!vm:*target-most-negative-fixnum*))
              (ash n (min s 64))
              (if (minusp n) -1 0))))

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 34738f7..6441221 100644 (file)
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -709,7 +709,7 @@
                            (and (eql disp 0)
                                 (not (= (reg-tn-encoding base) #b101))))
                        #b00)
-                      ((and (target-fixnump disp) (<= -128 disp 127))
+                      ((and (fixnump disp) (<= -128 disp 127))
                        #b01)
                       (t
                        #b10)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 2e65f70..868cd5d 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.11.15"
+"0.6.11.16"