X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=997e50b12083b32fe41ed9831f1a6398203b9ef4;hb=a6661cdaac013752213d381aa469cb0919a6ce4c;hp=c90ca445fbdfc288c960f5abb10d7f46ea5ff04a;hpb=1cdc827b3ae2b9a9952f0d497d630c15054015cd;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index c90ca44..997e50b 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -176,15 +176,11 @@
             (loop for (arg next) on args
                   while next
                   do
-                  (let ((lvar-type (lvar-type arg)))
-                    (unless (or (csubtypep list-type lvar-type)
-                                (csubtypep lvar-type list-type)
-                                ;; Check for NIL specifically, because
-                                ;; SYMBOL or ATOM won't satisfie the above
-                                (csubtypep null-type lvar-type))
-                      (assert-lvar-type arg list-type
-                                        (lexenv-policy *lexenv*))
-                      (return *empty-type*))))
+                  (when (eq (type-intersection (lvar-type arg) list-type)
+                            *empty-type*)
+                    (assert-lvar-type arg list-type
+                                      (lexenv-policy *lexenv*))
+                    (return *empty-type*)))
             (loop with all-nil = t
                   for (arg next) on args
                   for lvar-type = (lvar-type arg)
@@ -192,7 +188,7 @@
                   do
                   (cond
                     ;; Cons in the middle guarantees the result will be a cons
-                    ((csubtypep lvar-type cons-type)
+                    ((not (csubtypep null-type lvar-type))
                      (return cons-type))
                     ;; If all but the last are NIL the type of the last arg
                     ;; can be used
@@ -4677,3 +4673,16 @@
     (if (zerop (rem time-zone 1/3600))
         (encode-universal-time second minute hour date month year time-zone)
         (give-up-ir1-transform))))
+
+#!-(and win32 (not sb-thread))
+(deftransform sleep ((seconds) ((integer 0 #.(expt 10 8))))
+  `(sb!unix:nanosleep seconds 0))
+
+#!-(and win32 (not sb-thread))
+(deftransform sleep ((seconds) ((constant-arg (real 0))))
+  (let ((seconds-value (lvar-value seconds)))
+    (multiple-value-bind (seconds nano)
+        (sb!impl::split-seconds-for-sleep seconds-value)
+      (if (> seconds (expt 10 8))
+          (give-up-ir1-transform)
+          `(sb!unix:nanosleep ,seconds ,nano)))))