0.6.9.11:

[sbcl.git] / src / compiler / srctran.lisp

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 0492451..148e700 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -13,9 +13,6 @@
 
 (in-package "SB!C")
 
-(file-comment
-  "$Header$")
-
 ;;; Convert into an IF so that IF optimizations will eliminate redundant
 ;;; negations.
 (def-source-transform not (x) `(if ,x nil t))
@@ -35,8 +32,7 @@
 
 ;;; Bind the values and make a closure that returns them.
 (def-source-transform constantly (value &rest values)
-  (let ((temps (loop repeat (1+ (length values))
-                    collect (gensym)))
+  (let ((temps (make-gensym-list (1+ (length values))))
        (dum (gensym)))
     `(let ,(loop for temp in temps and
                 value in (list* value values)
@@ -55,7 +51,7 @@
       (function-type-nargs (continuation-type fun))
     (cond
      ((and min (eql min max))
-      (let ((dums (loop repeat min collect (gensym))))
+      (let ((dums (make-gensym-list min)))
        `#'(lambda ,dums (not (funcall fun ,@dums)))))
      ((let* ((cont (node-cont node))
             (dest (continuation-dest cont)))
@@ -131,7 +127,7 @@
     (give-up-ir1-transform))
   (let ((n (continuation-value n)))
     (when (> n
-            (if (policy node (= speed 3) (= space 0))
+            (if (policy node (and (= speed 3) (= space 0)))
                 *extreme-nthcdr-open-code-limit*
                 *default-nthcdr-open-code-limit*))
       (give-up-ir1-transform))
@@ -2486,6 +2482,27 @@
   (frob logior)
   (frob logxor))
 
+(defoptimizer (integer-length derive-type) ((x))
+  (let ((x-type (continuation-type x)))
+    (when (and (numeric-type-p x-type)
+               (csubtypep x-type (specifier-type 'integer)))
+      ;; If the X is of type (INTEGER LO HI), then the integer-length
+      ;; of X is (INTEGER (min lo hi) (max lo hi), basically.  Be
+      ;; careful about LO or HI being NIL, though.  Also, if 0 is
+      ;; contained in X, the lower bound is obviously 0.
+      (flet ((null-or-min (a b)
+               (and a b (min (integer-length a)
+                             (integer-length b))))
+             (null-or-max (a b)
+               (and a b (max (integer-length a)
+                             (integer-length b)))))
+        (let* ((min (numeric-type-low x-type))
+               (max (numeric-type-high x-type))
+               (min-len (null-or-min min max))
+               (max-len (null-or-max min max)))
+          (when (ctypep 0 x-type)
+            (setf min-len 0))
+          (specifier-type `(integer ,(or min-len '*) ,(or max-len '*))))))))
 ) ; PROGN
 \f
 ;;;; miscellaneous derive-type methods
@@ -3245,16 +3262,16 @@
          ((= nargs 1) `(progn ,@args t))
          ((= nargs 2)
           `(if (,predicate ,(first args) ,(second args)) nil t))
-         ((not (policy nil (>= speed space) (>= speed cspeed)))
+         ((not (policy nil (and (>= speed space)
+                                (>= speed compilation-speed))))
           (values nil t))
          (t
-          (collect ((vars))
-            (dotimes (i nargs) (vars (gensym)))
-            (do ((var (vars) next)
-                 (next (cdr (vars)) (cdr next))
+          (let ((vars (make-gensym-list nargs)))
+            (do ((var vars next)
+                 (next (cdr vars) (cdr next))
                  (result 't))
                 ((null next)
-                 `((lambda ,(vars) ,result) . ,args))
+                 `((lambda ,vars ,result) . ,args))
               (let ((v1 (first var)))
                 (dolist (v2 next)
                   (setq result `(if (,predicate ,v1 ,v2) nil ,result))))))))))
@@ -3370,28 +3387,28 @@
 ;;;; If the control string is a compile-time constant, then replace it
 ;;;; with a use of the FORMATTER macro so that the control string is
 ;;;; ``compiled.'' Furthermore, if the destination is either a stream
-;;;; or T and the control string is a function (i.e. formatter), then
-;;;; convert the call to format to just a funcall of that function.
+;;;; or T and the control string is a function (i.e. FORMATTER), then
+;;;; convert the call to FORMAT to just a FUNCALL of that function.
 
 (deftransform format ((dest control &rest args) (t simple-string &rest t) *
                      :policy (> speed space))
   (unless (constant-continuation-p control)
     (give-up-ir1-transform "The control string is not a constant."))
-  (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args)))
+  (let ((arg-names (make-gensym-list (length args))))
     `(lambda (dest control ,@arg-names)
        (declare (ignore control))
        (format dest (formatter ,(continuation-value control)) ,@arg-names))))
 
 (deftransform format ((stream control &rest args) (stream function &rest t) *
                      :policy (> speed space))
-  (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args)))
+  (let ((arg-names (make-gensym-list (length args))))
     `(lambda (stream control ,@arg-names)
        (funcall control stream ,@arg-names)
        nil)))
 
 (deftransform format ((tee control &rest args) ((member t) function &rest t) *
                      :policy (> speed space))
-  (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args)))
+  (let ((arg-names (make-gensym-list (length args))))
     `(lambda (tee control ,@arg-names)
        (declare (ignore tee))
        (funcall control *standard-output* ,@arg-names)