:defun-only t
:when :both)
(cond ((same-leaf-ref-p x y)
- 't)
- ((not (types-intersect (continuation-type x) (continuation-type y)))
- 'nil)
+ t)
+ ((not (types-equal-or-intersect (continuation-type x)
+ (continuation-type y)))
+ nil)
(t
(give-up-ir1-transform))))
(char-type (specifier-type 'character))
(number-type (specifier-type 'number)))
(cond ((same-leaf-ref-p x y)
- 't)
- ((not (types-intersect x-type y-type))
- 'nil)
+ t)
+ ((not (types-equal-or-intersect x-type y-type))
+ nil)
((and (csubtypep x-type char-type)
(csubtypep y-type char-type))
'(char= x y))
- ((or (not (types-intersect x-type number-type))
- (not (types-intersect y-type number-type)))
+ ((or (not (types-equal-or-intersect x-type number-type))
+ (not (types-equal-or-intersect y-type number-type)))
'(eq x y))
((and (not (constant-continuation-p y))
(or (constant-continuation-p x)
#!-sb-propagate-float-type
(defun ir1-transform-< (x y first second inverse)
(if (same-leaf-ref-p x y)
- 'nil
+ nil
(let* ((x-type (numeric-type-or-lose x))
(x-lo (numeric-type-low x-type))
(x-hi (numeric-type-high x-type))
#!+sb-propagate-float-type
(defun ir1-transform-< (x y first second inverse)
(if (same-leaf-ref-p x y)
- 'nil
+ nil
(let ((xi (numeric-type->interval (numeric-type-or-lose x)))
(yi (numeric-type->interval (numeric-type-or-lose y))))
(cond ((interval-< xi yi)
(last nil current)
(current (gensym) (gensym))
(vars (list current) (cons current vars))
- (result 't (if not-p
- `(if (,predicate ,current ,last)
- nil ,result)
- `(if (,predicate ,current ,last)
- ,result nil))))
+ (result t (if not-p
+ `(if (,predicate ,current ,last)
+ nil ,result)
+ `(if (,predicate ,current ,last)
+ ,result nil))))
((zerop i)
`((lambda ,vars ,result) . ,args)))))))
((= nargs 1) `(progn ,@args t))
((= nargs 2)
`(if (,predicate ,(first args) ,(second args)) nil t))
- ((not (policy nil (and (>= speed space)
- (>= speed compilation-speed))))
+ ((not (policy *lexenv*
+ (and (>= speed space)
+ (>= speed compilation-speed))))
(values nil t))
(t
(let ((vars (make-gensym-list nargs)))
(do ((var vars next)
(next (cdr vars) (cdr next))
- (result 't))
+ (result t))
((null next)
`((lambda ,vars ,result) . ,args))
(let ((v1 (first var)))
;;;; N-arg arithmetic and logic functions are associated into two-arg
;;;; versions, and degenerate cases are flushed.
-;;; Left-associate First-Arg and More-Args using Function.
+;;; Left-associate FIRST-ARG and MORE-ARGS using FUNCTION.
(declaim (ftype (function (symbol t list) list) associate-arguments))
(defun associate-arguments (function first-arg more-args)
(let ((next (rest more-args))