(when ,constraints
(let ((,min (conset-min ,conset))
(,max (conset-max ,conset)))
+ (declare (optimize speed))
(map nil (lambda (constraint)
(declare (type constraint constraint))
(let ((number (constraint-number constraint)))
(precise-add-test-constraint fun x y not-p constraints
consequent-constraints)
(precise-add-test-constraint fun x y (not not-p) constraints
- alternative-constraints))
+ alternative-constraints))
(values))
(defun quick-add-complement-constraints (fun x y not-p
(var2 (ok-lvar-lambda-var arg2 constraints)))
;; The code below assumes that the constant is the
;; second argument in case of variable to constant
- ;; comparision which is sometimes true (see source
+ ;; comparison which is sometimes true (see source
;; transformations for EQ, EQL and CHAR=). Fixing
;; that would result in more constant substitutions
;; which is not a universally good thing, thus the
(add 'eql var1 var2 nil))
((constant-lvar-p arg2)
(add 'eql var1
- (let ((use (principal-lvar-use arg2)))
- (if (ref-p use)
- (ref-leaf use)
- (find-constant (lvar-value arg2))))
+ (find-constant (lvar-value arg2))
nil))
(t
(add-test-constraint quick-p
(eq (numeric-type-complexp x) :real)))
;;; Exactly the same as CONSTRAIN-INTEGER-TYPE, but for float numbers.
+;;;
+;;; In contrast to the integer version, here the input types can have
+;;; open bounds in addition to closed ones and we don't increment or
+;;; decrement a bound to honor OR-EQUAL being NIL but put an open bound
+;;; into the result instead, if appropriate.
(defun constrain-float-type (x y greater or-equal)
(declare (type numeric-type x y))
(declare (ignorable x y greater or-equal)) ; for CROSS-FLOAT-INFINITY-KLUDGE
(tighter-p (x ref)
(cond ((null x) nil)
((null ref) t)
- ((and or-equal
- (= (type-bound-number x) (type-bound-number ref)))
- ;; X is tighter if REF is not an open bound and X is
- (and (not (consp ref)) (consp x)))
+ ((= (type-bound-number x) (type-bound-number ref))
+ ;; X is tighter if X is an open bound and REF is not
+ (and (consp x) (not (consp ref))))
(greater
(< (type-bound-number ref) (type-bound-number x)))
(t
(add-test-constraints use node gen))))))
;;; Starting from IN compute OUT and (consequent/alternative
-;;; constraints if the block ends with and IF). Return the list of
+;;; constraints if the block ends with an IF). Return the list of
;;; successors that may need to be recomputed.
(defun find-block-type-constraints (block final-pass-p)
(declare (type cblock block))