(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))
- (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)
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
(policy-quality-name-p (lvar-value quality-name)))
(give-up-ir1-transform))
'(%policy-quality policy quality-name))
+\f
+(deftransform encode-universal-time
+ ((second minute hour date month year &optional time-zone)
+ ((constant-arg (mod 60)) (constant-arg (mod 60))
+ (constant-arg (mod 24))
+ (constant-arg (integer 1 31))
+ (constant-arg (integer 1 12))
+ (constant-arg (integer 1899))
+ (constant-arg (rational -24 24))))
+ (let ((second (lvar-value second))
+ (minute (lvar-value minute))
+ (hour (lvar-value hour))
+ (date (lvar-value date))
+ (month (lvar-value month))
+ (year (lvar-value year))
+ (time-zone (lvar-value time-zone)))
+ (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)))))