+
+(declaim (inline conset-lvar-lambda-var-eql-p conset-add-lvar-lambda-var-eql))
+(defun conset-lvar-lambda-var-eql-p (conset lvar lambda-var)
+ (let ((constraint (find-constraint 'eql lambda-var lvar nil)))
+ (and constraint
+ (conset-member constraint conset))))
+
+(defun conset-add-lvar-lambda-var-eql (conset lvar lambda-var)
+ (let ((constraint (find-or-create-constraint 'eql lambda-var lvar nil)))
+ (conset-adjoin constraint conset)))
+
+(declaim (inline conset-add-constraint conset-add-constraint-to-eql))
+(defun conset-add-constraint (conset kind x y not-p)
+ (declare (type conset conset)
+ (type lambda-var x))
+ (conset-adjoin (find-or-create-constraint kind x y not-p)
+ conset))
+
+(defun conset-add-constraint-to-eql (conset kind x y not-p &optional (target conset))
+ (declare (type conset target conset)
+ (type lambda-var x))
+ (do-eql-vars (x (x conset))
+ (conset-add-constraint target kind x y not-p)))
+
+(declaim (inline conset-clear-lambda-var))
+(defun conset-clear-lambda-var (conset var)
+ (conset-difference conset (lambda-var-constraints var)))
+
+;;; Copy all CONSTRAINTS involving FROM-VAR - except the (EQL VAR
+;;; LVAR) ones - to all of the variables in the VARS list.
+(defun inherit-constraints (vars from-var constraints target)
+ (do-inheritable-constraints (con (constraints from-var))
+ (let ((eq-x (eq from-var (constraint-x con)))
+ (eq-y (eq from-var (constraint-y con))))
+ (dolist (var vars)
+ (conset-add-constraint target
+ (constraint-kind con)
+ (if eq-x var (constraint-x con))
+ (if eq-y var (constraint-y con))
+ (constraint-not-p con))))))
+
+;; Add an (EQL LAMBDA-VAR LAMBDA-VAR) constraint on VAR1 and VAR2 and
+;; inherit each other's constraints.
+(defun add-eql-var-var-constraint (var1 var2 constraints
+ &optional (target constraints))
+ (let ((constraint (find-or-create-constraint 'eql var1 var2 nil)))
+ (unless (conset-member constraint target)
+ (conset-adjoin constraint target)
+ (collect ((eql1) (eql2))
+ (do-eql-vars (var1 (var1 constraints))
+ (eql1 var1))
+ (do-eql-vars (var2 (var2 constraints))
+ (eql2 var2))
+ (inherit-constraints (eql1) var2 constraints target)
+ (inherit-constraints (eql2) var1 constraints target))
+ t)))
+\f
+;;; If REF is to a LAMBDA-VAR with CONSTRAINTs (i.e. we can do flow
+;;; analysis on it), then return the LAMBDA-VAR, otherwise NIL.
+#!-sb-fluid (declaim (inline ok-ref-lambda-var))
+(defun ok-ref-lambda-var (ref)
+ (declare (type ref ref))
+ (let ((leaf (ref-leaf ref)))
+ (when (and (lambda-var-p leaf)
+ (lambda-var-constraints leaf))
+ leaf)))
+
+;;; See if LVAR's single USE is a REF to a LAMBDA-VAR and they are EQL
+;;; according to CONSTRAINTS. Return LAMBDA-VAR if so.
+(defun ok-lvar-lambda-var (lvar constraints)
+ (declare (type lvar lvar))
+ (let ((use (lvar-uses lvar)))
+ (cond ((ref-p use)
+ (let ((lambda-var (ok-ref-lambda-var use)))
+ (and lambda-var
+ (conset-lvar-lambda-var-eql-p constraints lvar lambda-var)
+ lambda-var)))
+ ((cast-p use)
+ (ok-lvar-lambda-var (cast-value use) constraints)))))