(defn -validate-loop-locals*
[analyze {:keys [body env loop-id] :as ast} key]
(if validating
ast
(binding [mismatch? (atom #{})]
(let [bindings (key ast)]
(find-mismatches body bindings)
(if-let [mismatches (seq @mismatch?)]
(let [bindings-form (apply mapv
(fn [{:keys [form tag]} & mismatches]
(when-not (every? #{tag} mismatches)
(let [tags (conj mismatches tag)]
(with-meta form {:tag (or (and (some primitive? tags)
(wider-tag tags))
Object)}))))
bindings mismatches)
loop-locals (mapv :name bindings)
binds (zipmap loop-locals (mapv (comp maybe-class :tag meta) bindings-form))
analyze* (fn [ast]
(analyze (postwalk ast
(fn [ast]
(when-let [atom (:atom ast)]
(swap! atom dissoc :dirty?))
ast))))]
(binding [validating loop-id
*loop-locals* loop-locals]
(analyze* (dissoc (postwalk (assoc ast key
(mapv (fn [{:keys [atom] :as bind} f]
(if f
(do
(swap! atom assoc :dirty? true)
(assoc (dissoc bind :tag) :form f))
bind))
(key ast) bindings-form))
(comp -cleanup-dirty-nodes
(fn [ast] (assoc-in ast [:env :loop-locals-casts] binds))))
:dirty?))))
ast)))))