0.pre7.3:

	moved more contrib/*-extras.lisp stuff to main system..
	..INDEX-OR-MINUS-1
	..FILL
	..COERCE

diff --git a/contrib/compiler-extras.lisp b/contrib/compiler-extras.lisp
index 421ad18..15fa799 100644 (file)
--- a/contrib/compiler-extras.lisp
+++ b/contrib/compiler-extras.lisp
@@ -25,27 +25,8 @@
 
 (in-package "SB-C")
 
-(deftype index-or-minus-1 () `(integer -1 ,(1- most-positive-fixnum)))
-
 (declaim (optimize (speed 1) (space 2)))
 
-(deftransform fill ((seq item &key (start 0) (end (length seq)))
-                   (vector t &key (:start t) (:end index))
-                   *
-                   :policy (> speed space))
-  "open code"
-  (let ((element-type (upgraded-element-type-specifier-or-give-up seq)))
-    `(with-array-data ((data seq)
-                      (start start)
-                      (end end))
-       (declare (type (simple-array ,element-type 1) data))
-       (do ((i start (1+ i)))
-          ((= i end) seq)
-        (declare (type index i))
-        ;; WITH-ARRAY-DATA does our range checks once and for all, so
-        ;; it'd be wasteful to check again on every AREF.
-        (declare (optimize (safety 0))) 
-        (setf (aref data i) item)))))
 ;;; TO DO for DEFTRANSFORM FILL:
 ;;;   ?? This DEFTRANSFORM, and the old DEFTRANSFORMs, should only
 ;;;      apply when SPEED > SPACE.
@@ -102,31 +83,6 @@
                       (incf index2))))))
        seq1)))
 
-(setf (function-info-transforms (info :function :info 'coerce)) nil)
-(deftransform coerce ((x type) (* *) * :when :both)
-  (unless (constant-continuation-p type)
-    (give-up-ir1-transform))
-  (let ((tspec (specifier-type (continuation-value type))))
-    (if (csubtypep (continuation-type x) tspec)
-       'x
-       ;; Note: The THE here makes sure that specifiers like
-       ;; (SINGLE-FLOAT 0.0 1.0) can raise a TYPE-ERROR.
-       `(the ,(continuation-value type)
-          ,(cond
-            ((csubtypep tspec (specifier-type 'double-float))
-             '(%double-float x))       
-            ;; FIXME: #!+long-float (t ,(error "LONG-FLOAT case needed"))
-            ((csubtypep tspec (specifier-type 'float))
-             '(%single-float x))
-            ((csubtypep tspec (specifier-type 'simple-vector))
-             '(coerce-to-simple-vector x)) ; FIXME: needs DEFKNOWN return type
-            (t
-             (give-up-ir1-transform)))))))
-(defun coerce-to-simple-vector (x)
-  (if (simple-vector-p x)
-      x
-      (replace (make-array (length x)) x)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; setting up for POSITION/FIND stuff
 

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index dd2495e..bf2ca3e 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1039,6 +1039,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
              "HAIRY-TYPE-CHECK-TEMPLATE-NAME" "HAIRY-TYPE-SPECIFIER"
              "HANDLE-CIRCULARITY" "IGNORE-IT"
              "ILL-BIN" "ILL-BOUT" "ILL-IN" "ILL-OUT"
+             "INDEX-OR-MINUS-1"
              "INDEX-TOO-LARGE-ERROR"
              "*!INITIAL-ASSEMBLER-ROUTINES*"
              "*!INITIAL-FDEFN-OBJECTS*" "*!INITIAL-FOREIGN-SYMBOLS*"

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index 7b8a2fc..dc97323 100644 (file)
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -128,6 +128,10 @@
   (etypecase object
     (list (list-to-bit-vector* object))
     (vector (vector-to-bit-vector* object))))
+(defun coerce-to-simple-vector (x)
+  (if (simple-vector-p x)
+      x
+      (replace (make-array (length x)) x)))
 (defun coerce-to-vector (object output-type-spec)
   (etypecase object
     (list (list-to-vector* object output-type-spec))

diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp
index 50bee46..9efcd36 100644 (file)
--- a/src/code/deftypes-for-target.lisp
+++ b/src/code/deftypes-for-target.lisp
@@ -98,7 +98,8 @@
 (sb!xc:deftype simple-bit-vector (&optional size)
   `(simple-array bit (,size)))
 \f
-;;;; some private types that we use in defining the standard functions
+;;;; some private types that we use in defining the standard functions,
+;;;; or implementing declarations in standard compiler transforms
 
 ;;; a type specifier
 (sb!xc:deftype type-specifier () '(or list symbol sb!xc:class))
@@ -125,6 +126,12 @@
 (sb!xc:deftype logical-host-designator ()
   '(or host string))
 
+;;; like INDEX, but augmented with -1 (useful when using the index
+;;; to count downwards to 0, e.g. LOOP FOR I FROM N DOWNTO 0, with
+;;; an implementation which terminates the loop by testing for the
+;;; index leaving the loop range)
+(sb!xc:deftype index-or-minus-1 () `(integer -1 ,(1- most-positive-fixnum)))
+
 ;;; a thing returned by the irrational functions. We assume that they
 ;;; never compute a rational result.
 (sb!xc:deftype irrational ()

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 05066fa..6e39e29 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -296,12 +296,22 @@
           (T (setq splice x)))))
 
 (deftransform fill ((seq item &key (start 0) (end (length seq)))
-                   (simple-array t &key (:start t) (:end index)))
+                   (vector t &key (:start t) (:end index))
+                   *
+                   :policy (> speed space))
   "open code"
-  '(do ((i start (1+ i)))
-       ((= i end) seq)
-     (declare (type index i))
-     (setf (aref seq i) item)))
+  (let ((element-type (upgraded-element-type-specifier-or-give-up seq)))
+    `(with-array-data ((data seq)
+                      (start start)
+                      (end end))
+       (declare (type (simple-array ,element-type 1) data))
+       (do ((i start (1+ i)))
+          ((= i end) seq)
+        (declare (type index i))
+        ;; WITH-ARRAY-DATA did our range checks once and for all, so
+        ;; it'd be wasteful to check again on every AREF.
+        (declare (optimize (safety 0))) 
+        (setf (aref data i) item)))))
 
 (deftransform position ((item list &key (test #'eql)) (t list))
   "open code"

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 25e3cf9..e569f47 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -542,54 +542,23 @@
 \f
 ;;;; coercion
 
-;;; old working version
 (deftransform coerce ((x type) (* *) * :when :both)
   (unless (constant-continuation-p type)
     (give-up-ir1-transform))
   (let ((tspec (specifier-type (continuation-value type))))
     (if (csubtypep (continuation-type x) tspec)
        'x
+       ;; Note: The THE here makes sure that specifiers like
+       ;; (SINGLE-FLOAT 0.0 1.0) can raise a TYPE-ERROR.
        `(the ,(continuation-value type)
-             ,(cond ((csubtypep tspec (specifier-type 'double-float))
-                     '(%double-float x))       
-                    ;; FIXME: If LONG-FLOAT is to be supported, we
-                    ;; need to pick it off here before falling through
-                    ;; to %SINGLE-FLOAT.
-                    ((csubtypep tspec (specifier-type 'float))
-                     '(%single-float x))
-                    (t
-                     (give-up-ir1-transform)))))))
+          ,(cond
+            ((csubtypep tspec (specifier-type 'double-float))
+             '(%double-float x))       
+            ;; FIXME: #!+long-float (t ,(error "LONG-FLOAT case needed"))
+            ((csubtypep tspec (specifier-type 'float))
+             '(%single-float x))
+            ((csubtypep tspec (specifier-type 'simple-vector))
+             '(coerce-to-simple-vector x))
+            (t
+             (give-up-ir1-transform)))))))
 
-;;; KLUDGE: new broken version -- 20000504
-;;; FIXME: should be fixed or deleted
-#+nil
-(deftransform coerce ((x type) (* *) * :when :both)
-  (unless (constant-continuation-p type)
-    (give-up-ir1-transform))
-  (let ((tspec (specifier-type (continuation-value type))))
-    (if (csubtypep (continuation-type x) tspec)
-       'x
-       `(if #+nil (typep x type) #-nil nil
-            x
-            (the ,(continuation-value type)
-                 ,(cond ((csubtypep tspec (specifier-type 'double-float))
-                         '(%double-float x))   
-                        ;; FIXME: If LONG-FLOAT is to be supported,
-                        ;; we need to pick it off here before falling
-                        ;; through to %SINGLE-FLOAT.
-                        ((csubtypep tspec (specifier-type 'float))
-                         '(%single-float x))
-                        #+nil
-                        ((csubtypep tspec (specifier-type 'list))
-                         '(coerce-to-list x))
-                        #+nil
-                        ((csubtypep tspec (specifier-type 'string))
-                         '(coerce-to-simple-string x))
-                        #+nil
-                        ((csubtypep tspec (specifier-type 'bit-vector))
-                         '(coerce-to-bit-vector x))
-                        #+nil
-                        ((csubtypep tspec (specifier-type 'vector))
-                         '(coerce-to-vector x type))
-                        (t
-                         (give-up-ir1-transform))))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 1564d8a..ca1ccf5 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -16,4 +16,4 @@
 ;;; four numeric fields, is used for versions which aren't released
 ;;; but correspond only to CVS tags or snapshots.
 
-"0.pre7.2"
+"0.pre7.3"