(ns selfhost.check
  (:require [selfhost.rt :as rt]
            [clojure.string :as str]))

(def ANY {"kind" "prim" "name" "Any"})

(def NIL-TYPE {"kind" "prim" "name" "Nil"})

(defn make-prim [^String name]
  {"kind" "prim" "name" name})

(defn make-fn [params rest-type ret]
  {"kind" "fn" "params" params "rest" rest-type "ret" ret})

(defn make-app [^String ctor args]
  {"kind" "app" "name" ctor "args" args})

(defn make-union [members]
  {"kind" "union" "members" members})

(defn make-var [^String name]
  {"kind" "var" "name" name})

(defn make-poly [vars body bounds]
  {"kind" "poly" "vars" vars "body" body "bounds" bounds})

(def INT-TYPE {"kind" "prim" "name" "Int"})

(def FLOAT-TYPE {"kind" "prim" "name" "Float"})

(def NUMBER-TYPE {"kind" "union" "members" [{"kind" "prim" "name" "Int"} {"kind" "prim" "name" "Float"}]})

(def VEC-ACCESS-POLY (make-poly ["A"] (make-fn [(make-app "Vec" [(make-var "A")])] nil (make-var "A")) nil))

(def NTH-POLY (make-poly ["A"] (make-fn [(make-app "Vec" [(make-var "A")]) (make-prim "Int")] (make-prim "Any") (make-var "A")) nil))

(def MAPV-POLY (make-poly ["A" "B"] (make-fn [(make-fn [(make-var "A")] nil (make-var "B")) ANY] nil (make-app "Vec" [(make-var "B")])) nil))

(def FILTERV-POLY (make-poly ["A"] (make-fn [(make-fn [(make-var "A")] nil ANY) ANY] nil (make-app "Vec" [(make-var "A")])) nil))

(defn ^Boolean prim? [t]
  (and (not (nil? t)) (not= (get t "kind") nil) (= (get t "kind") "prim")))

(defn ^Boolean fn-type? [t]
  (and (not (nil? t)) (= (get t "kind") "fn")))

(defn ^Boolean app-type? [t]
  (and (not (nil? t)) (= (get t "kind") "app")))

(defn ^Boolean union-type? [t]
  (and (not (nil? t)) (= (get t "kind") "union")))

(defn ^Boolean var-type? [t]
  (and (not (nil? t)) (= (get t "kind") "var")))

(defn ^Boolean poly-type? [t]
  (and (not (nil? t)) (= (get t "kind") "poly")))

(defn ^Boolean any-type? [t]
  (and (prim? t) (= (get t "name") "Any")))

(defn ^Boolean nil-type? [t]
  (and (prim? t) (= (get t "name") "Nil")))

(defn ^String type->string [t]
  (cond
  (nil? t) "?"
  (prim? t) (get t "name")
  (fn-type? t) (let [params (get t "params")
   rest-t (get t "rest")
   ret (get t "ret")
   param-strs (mapv (fn [p] (type->string p)) params)]
  (if (not (nil? rest-t)) (str "[" (str/join " " param-strs) " & " (type->string rest-t) " -> " (type->string ret) "]") (str "[" (str/join " " param-strs) " -> " (type->string ret) "]")))
  (app-type? t) (let [ctor (get t "name")
   args (get t "args")
   arg-strs (mapv (fn [a] (type->string a)) args)]
  (str "(" ctor " " (str/join " " arg-strs) ")"))
  (union-type? t) (let [members (get t "members")]
  (cond
  (and (= (count members) 2) (every? prim? members) (boolean (some (fn [m] (= (get m "name") "Int")) members)) (boolean (some (fn [m] (= (get m "name") "Float")) members))) "Number"
  (and (= (count members) 2) (boolean (some nil-type? members))) (let [non-nil (first (filterv (fn [m] (not (nil-type? m))) members))]
  (str (type->string non-nil) "?"))
  :else (str "(U " (str/join " " (mapv (fn [m] (type->string m)) members)) ")")))
  (var-type? t) (get t "name")
  (poly-type? t) (str "(forall [" (str/join " " (get t "vars")) "] " (type->string (get t "body")) ")")
  :else "?"))

(defn ^String unqualify-name [^String name]
  (let [idx (str/index-of name "/")]
  (if (some? idx) (subs name (+ idx 1)) name)))

(defn ^Boolean type-compatible? [actual expected]
  (cond
  (or (nil? actual) (nil? expected)) true
  (any-type? actual) true
  (any-type? expected) true
  (var-type? actual) true
  (var-type? expected) true
  (poly-type? expected) (type-compatible? actual (get expected "body"))
  (poly-type? actual) (type-compatible? (get actual "body") expected)
  (and (union-type? actual) (union-type? expected)) (every? (fn [a-alt] (boolean (some (fn [e-alt] (type-compatible? a-alt e-alt)) (get expected "members")))) (get actual "members"))
  (union-type? expected) (boolean (some (fn [alt] (type-compatible? actual alt)) (get expected "members")))
  (union-type? actual) (every? (fn [alt] (type-compatible? alt expected)) (get actual "members"))
  (and (prim? actual) (prim? expected)) (or (= (get actual "name") (get expected "name")) (and (= (get expected "name") "Float") (= (get actual "name") "Int")) (and (= (get actual "name") "Int") (or (= (get expected "name") "I8") (= (get expected "name") "I16") (= (get expected "name") "I32") (= (get expected "name") "U8") (= (get expected "name") "U16") (= (get expected "name") "U32") (= (get expected "name") "U64") (= (get expected "name") "F32"))) (and (= (get actual "name") "Float") (= (get expected "name") "F32")) (= (unqualify-name (get actual "name")) (unqualify-name (get expected "name"))))
  (and (fn-type? actual) (fn-type? expected)) (let [ap (get actual "params")
   ep (get expected "params")
   ar (get actual "rest")
   er (get expected "rest")]
  (and (= (count ap) (count ep)) (every? (fn [i] (type-compatible? (nth ap i) (nth ep i))) (range (count ap))) (= (nil? ar) (nil? er)) (or (nil? ar) (type-compatible? ar er)) (type-compatible? (get actual "ret") (get expected "ret"))))
  (and (app-type? actual) (app-type? expected)) (and (= (get actual "name") (get expected "name")) (= (count (get actual "args")) (count (get expected "args"))) (every? (fn [i] (type-compatible? (nth (get actual "args") i) (nth (get expected "args") i))) (range (count (get actual "args")))))
  :else false))

(defn ^Boolean type-equal? [a b]
  (and (prim? a) (prim? b) (= (get a "name") (get b "name"))))

(defn merge-types [t1 t2]
  (cond
  (and (any-type? t1) (any-type? t2)) ANY
  (any-type? t1) t2
  (any-type? t2) t1
  (type-compatible? t2 t1) t1
  :else (let [flat1 (if (union-type? t1) (get t1 "members") [t1])
   flat2 (if (union-type? t2) (get t2 "members") [t2])
   all (into (vec flat1) flat2)
   deduped (reduce (fn [acc t] (if (boolean (some (fn [a] (type-compatible? t a)) acc)) acc (conj acc t))) [] all)]
  (if (= (count deduped) 1) (nth deduped 0) (make-union deduped)))))

(defn merge-types-list [types]
  (if (= (count types) 0) ANY (reduce (fn [acc t] (merge-types acc t)) (nth types 0) types)))

(defn remove-from-union [current-type remove-type]
  (cond
  (any-type? current-type) current-type
  (union-type? current-type) (let [alts (get current-type "members")
   remaining (filterv (fn [alt] (not (type-equal? alt remove-type))) alts)]
  (cond
  (= (count remaining) (count alts)) current-type
  (= (count remaining) 0) current-type
  (= (count remaining) 1) (nth remaining 0)
  :else (make-union remaining)))
  :else current-type))

(defn infer-literal-type [e]
  (let [kind (get e "kind")]
  (cond
  (= kind "string") (make-prim "String")
  (= kind "bool") (make-prim "Bool")
  (= kind "number") (make-prim "Int")
  (= kind "float") (make-prim "Float")
  (= kind "nil") (make-prim "Nil")
  (= kind "keyword") (make-prim "Keyword")
  (= kind "symbol") (make-prim "Symbol")
  (= kind "char") (make-prim "Char")
  :else nil)))

(defn ^Boolean synthetic-absent-else? [e]
  (and (not (nil? e)) (= (get e "node") "literal") (= (get e "kind") "bool") (= (get e "value") false)))

(defn collection-elem-type [types]
  (if (and (> (count types) 0) (not (any-type? (nth types 0))) (every? (fn [t] (type-compatible? t (nth types 0))) (drop 1 types))) (nth types 0) ANY))

(defn ^Boolean numeric-preserving-op? [^String op]
  (or (= op "+") (= op "-") (= op "*") (= op "inc") (= op "dec") (= op "min") (= op "max") (= op "abs")))

(defn ^String numeric-class [t]
  (cond
  (and (prim? t) (= (get t "name") "Int")) "int"
  (and (prim? t) (= (get t "name") "Float")) "float"
  (and (prim? t) (= (get t "name") "Number")) "number"
  (and (union-type? t) (> (count (get t "members")) 0) (every? (fn [a] (let [c (numeric-class a)]
  (or (= c "int") (= c "float") (= c "number")))) (get t "members"))) "number"
  :else "other"))

(defn numeric-refine [^String op arg-types declared]
  (cond
  (not (numeric-preserving-op? op)) declared
  (not (or (any-type? declared) (and (prim? declared) (or (= (get declared "name") "Int") (= (get declared "name") "Float") (= (get declared "name") "Number"))))) declared
  :else (let [classes (mapv (fn [t] (numeric-class t)) arg-types)]
  (cond
  (boolean (some (fn [c] (= c "other")) classes)) declared
  (boolean (some (fn [c] (= c "float")) classes)) FLOAT-TYPE
  (boolean (some (fn [c] (= c "number")) classes)) NUMBER-TYPE
  :else INT-TYPE))))

(defn infer-type-var-bindings! [expected actual bindings]
  (cond
  (or (nil? expected) (nil? actual)) nil
  (any-type? actual) nil
  (var-type? expected) (do
  (if (nil? (get (deref bindings) (get expected "name"))) (do
  (swap! bindings assoc (get expected "name") actual)))
  nil)
  (and (fn-type? expected) (fn-type? actual)) (do
  (if (= (count (get expected "params")) (count (get actual "params"))) (do
  (doseq [i (range (count (get expected "params")))]
  (infer-type-var-bindings! (nth (get expected "params") i) (nth (get actual "params") i) bindings))))
  (if (and (not (nil? (get expected "rest"))) (not (nil? (get actual "rest")))) (do
  (infer-type-var-bindings! (get expected "rest") (get actual "rest") bindings)))
  (infer-type-var-bindings! (get expected "ret") (get actual "ret") bindings)
  nil)
  (and (app-type? expected) (app-type? actual) (= (get expected "name") (get actual "name"))) (do
  (doseq [i (range (count (get expected "args")))]
  (infer-type-var-bindings! (nth (get expected "args") i) (nth (get actual "args") i) bindings))
  nil)
  :else nil))

(defn apply-type-bindings [t bindings]
  (cond
  (nil? t) nil
  (var-type? t) (let [bound (get (deref bindings) (get t "name"))]
  (if (nil? bound) (make-prim "Any") bound))
  (prim? t) t
  (fn-type? t) (make-fn (mapv (fn [p] (apply-type-bindings p bindings)) (get t "params")) (if (nil? (get t "rest")) nil (apply-type-bindings (get t "rest") bindings)) (apply-type-bindings (get t "ret") bindings))
  (app-type? t) (make-app (get t "name") (mapv (fn [a] (apply-type-bindings a bindings)) (get t "args")))
  (union-type? t) (make-union (mapv (fn [m] (apply-type-bindings m bindings)) (get t "members")))
  (poly-type? t) t
  :else t))

(def STATE (atom {"record-fields" {} "record-field-order" {} "union-members" {} "parametric-unions" {} "diagnostics" []}))

(defn emit-diag! [^String msg]
  (swap! STATE update "diagnostics" conj msg)
  nil)

(def STDLIB {"true" (make-prim "Bool") "false" (make-prim "Bool") "int?" (make-fn [ANY] nil (make-prim "Bool")) "nil?" (make-fn [ANY] nil (make-prim "Bool")) "some?" (make-fn [ANY] nil (make-prim "Bool")) "string?" (make-fn [ANY] nil (make-prim "Bool")) "number?" (make-fn [ANY] nil (make-prim "Bool")) "integer?" (make-fn [ANY] nil (make-prim "Bool")) "keyword?" (make-fn [ANY] nil (make-prim "Bool")) "symbol?" (make-fn [ANY] nil (make-prim "Bool")) "boolean?" (make-fn [ANY] nil (make-prim "Bool")) "float?" (make-fn [ANY] nil (make-prim "Bool")) "map?" (make-fn [ANY] nil (make-prim "Bool")) "vector?" (make-fn [ANY] nil (make-prim "Bool")) "empty?" (make-fn [ANY] nil (make-prim "Bool")) "not" (make-fn [(make-prim "Bool")] nil (make-prim "Bool")) "=" (make-fn [ANY] ANY (make-prim "Bool")) "not=" (make-fn [ANY] ANY (make-prim "Bool")) ">" (make-fn [NUMBER-TYPE NUMBER-TYPE] nil (make-prim "Bool")) "<" (make-fn [NUMBER-TYPE NUMBER-TYPE] nil (make-prim "Bool")) ">=" (make-fn [NUMBER-TYPE NUMBER-TYPE] nil (make-prim "Bool")) "<=" (make-fn [NUMBER-TYPE NUMBER-TYPE] nil (make-prim "Bool")) "and" (make-fn [] ANY ANY) "or" (make-fn [] ANY ANY) "+" (make-fn [] ANY ANY) "-" (make-fn [ANY] ANY ANY) "*" (make-fn [] ANY ANY) "max" (make-fn [NUMBER-TYPE] NUMBER-TYPE INT-TYPE) "min" (make-fn [NUMBER-TYPE] NUMBER-TYPE INT-TYPE) "inc" (make-fn [NUMBER-TYPE] nil INT-TYPE) "dec" (make-fn [NUMBER-TYPE] nil INT-TYPE) "count" (make-fn [ANY] nil (make-prim "Int")) "str" (make-fn [] ANY (make-prim "String")) "get" (make-fn [ANY ANY] ANY ANY) "get-in" (make-fn [ANY ANY] ANY ANY) "assoc" (make-fn [ANY ANY ANY] ANY ANY) "assoc-in" (make-fn [ANY ANY ANY] nil ANY) "update" (make-fn [ANY ANY ANY] ANY ANY) "dissoc" (make-fn [ANY ANY] ANY ANY) "conj" (make-fn [ANY] ANY ANY) "cons" (make-fn [ANY ANY] nil ANY) "into" (make-fn [ANY ANY] nil ANY) "vec" (make-fn [ANY] nil ANY) "vals" (make-fn [ANY] nil ANY) "keys" (make-fn [ANY] nil ANY) "first" VEC-ACCESS-POLY "second" VEC-ACCESS-POLY "rest" (make-fn [ANY] nil ANY) "nth" NTH-POLY "reduce" (make-fn [ANY ANY] ANY ANY) "map" (make-fn [ANY] ANY ANY) "mapv" MAPV-POLY "filter" (make-fn [ANY ANY] nil ANY) "filterv" FILTERV-POLY "remove" (make-fn [ANY ANY] nil ANY) "some" (make-fn [ANY ANY] nil ANY) "every?" (make-fn [ANY ANY] nil (make-prim "Bool"))})

(defn opt-field [x]
  (if (= x false) nil x))

(defn param-type-or-any [p]
  (let [t (get p "type")]
  (cond
  (= t "param") (if (nil? (get p "ann")) ANY (get p "ann"))
  (= t "map-destructure") ANY
  (= t "seq-destructure") ANY
  :else ANY)))

(defn extend-with-params [env params rest-param]
  (let [env1 (reduce (fn [out p] (let [t (get p "type")]
  (cond
  (= t "param") (assoc out (get p "name") (param-type-or-any p))
  (= t "map-destructure") (let [out1 (reduce (fn [o k] (assoc o k ANY)) out (get p "keys"))]
  (if (not (nil? (get p "as"))) (assoc out1 (get p "as") ANY) out1))
  (= t "seq-destructure") (let [out1 (reduce (fn [o n] (assoc o n ANY)) out (get p "names"))]
  (if (not (nil? (get p "rest"))) (assoc out1 (get p "rest") ANY) out1))
  :else out))) env params)]
  (if (and (not (nil? rest-param)) (= (get rest-param "type") "param")) (assoc env1 (get rest-param "name") (param-type-or-any rest-param)) env1)))

(declare infer-expr!)

(defn extend-with-let-bindings! [env bindings]
  (reduce (fn [out b] (let [inferred (infer-expr! (get b "value") out)
   declared (get b "ann")
   bname (get b "name")]
  (if (and (not (nil? declared)) (not (type-compatible? inferred declared))) (do
  (emit-diag! (str "beagle: let binding " bname ": expected " (type->string declared) ", got " (type->string inferred)))))
  (assoc out bname (if (not (nil? declared)) declared inferred)))) env bindings))

(def TYPE-PREDICATES {"nil?" "Nil" "string?" "String" "number?" "Int" "integer?" "Int" "keyword?" "Keyword" "symbol?" "Symbol" "boolean?" "Bool"})

(defn extract-narrowing [cond-expr]
  (cond
  (not= (get cond-expr "node") "call") {"var" nil "type" nil "negated" false}
  :else (let [fn-ref (get cond-expr "fn")
   fn-name (if (and (not (nil? fn-ref)) (= (get fn-ref "node") "ref")) (get fn-ref "name") (if (string? fn-ref) fn-ref nil))
   args (get cond-expr "args")]
  (cond
  (and (not (nil? fn-name)) (not (nil? (get TYPE-PREDICATES fn-name))) (= (count args) 1) (= (get (nth args 0) "node") "ref")) {"var" (get (nth args 0) "name") "type" (make-prim (get TYPE-PREDICATES fn-name)) "negated" false}
  (and (not (nil? fn-name)) (= fn-name "some?") (= (count args) 1) (= (get (nth args 0) "node") "ref")) {"var" (get (nth args 0) "name") "type" (make-prim "Nil") "negated" true}
  (and (not (nil? fn-name)) (or (= fn-name "=") (= fn-name "not=")) (= (count args) 2)) (let [a1 (nth args 0)
   a2 (nth args 1)
   neg (= fn-name "not=")]
  (cond
  (and (= (get a1 "node") "ref") (= (get a2 "node") "literal") (= (get a2 "kind") "nil")) {"var" (get a1 "name") "type" (make-prim "Nil") "negated" neg}
  (and (= (get a1 "node") "literal") (= (get a1 "kind") "nil") (= (get a2 "node") "ref")) {"var" (get a2 "name") "type" (make-prim "Nil") "negated" neg}
  :else {"var" nil "type" nil "negated" false}))
  (and (not (nil? fn-name)) (= fn-name "not") (= (count args) 1)) (let [inner (extract-narrowing (nth args 0))]
  (if (not (nil? (get inner "var"))) {"var" (get inner "var") "type" (get inner "type") "negated" (not (get inner "negated"))} {"var" nil "type" nil "negated" false}))
  :else {"var" nil "type" nil "negated" false}))))

(defn ^Boolean type-could-be-false? [t]
  (cond
  (any-type? t) true
  (prim? t) (= (get t "name") "Bool")
  (union-type? t) (reduce (fn [acc m] (or acc (type-could-be-false? m))) false (get t "members"))
  :else false))

(defn call-fn-name [e]
  (if (= (get e "node") "call") (let [fn-ref (get e "fn")]
  (if (and (not (nil? fn-ref)) (= (get fn-ref "node") "ref")) (get fn-ref "name") (if (string? fn-ref) fn-ref nil))) nil))

(defn test-narrowings [cond-expr env]
  (let [fn-name (call-fn-name cond-expr)
   args (get cond-expr "args")
   fold-branch (fn [xs pick-then] (reduce (fn [acc a] (let [tn (test-narrowings a (merge env acc))]
  (merge acc (get tn (if pick-then "then" "else"))))) {} xs))]
  (cond
  (and (= fn-name "not") (= (count args) 1)) (let [tn (test-narrowings (nth args 0) env)]
  {"then" (get tn "else") "else" (get tn "then")})
  (and (= fn-name "and") (> (count args) 0)) (if (= (count args) 1) (test-narrowings (nth args 0) env) {"then" (fold-branch args true) "else" {}})
  (and (= fn-name "or") (> (count args) 0)) (if (= (count args) 1) (test-narrowings (nth args 0) env) {"then" {} "else" (fold-branch args false)})
  (= (get cond-expr "node") "ref") (let [v (get cond-expr "name")
   cur (get env v)]
  (if (nil? cur) {"then" {} "else" {}} (let [non-nil (remove-from-union cur (make-prim "Nil"))]
  {"then" {v non-nil} "else" (if (type-could-be-false? non-nil) {} {v (make-prim "Nil")})})))
  :else (let [info (extract-narrowing cond-expr)
   v (get info "var")]
  (if (nil? v) {"then" {} "else" {}} (let [cur (get env v)]
  (if (nil? cur) {"then" {} "else" {}} (let [pos {v (get info "type")}
   neg {v (remove-from-union cur (get info "type"))}]
  (if (get info "negated") {"then" neg "else" pos} {"then" pos "else" neg})))))))))

(defn narrow-env-for-condition [env cond-expr]
  (let [tn (test-narrowings cond-expr env)]
  {"then" (merge env (get tn "then")) "else" (merge env (get tn "else"))}))

(defn narrow-env-for-match [clause target-type env]
  (let [pat (get clause "pattern")]
  (cond
  (= (get pat "type") "record") (let [rec-name (get pat "name")
   bindings (get pat "bindings")
   field-map (get-in (deref STATE) ["record-fields" rec-name])
   field-order (get-in (deref STATE) ["record-field-order" rec-name])]
  (if (not (nil? field-map)) (reduce (fn [arm-env i] (let [b (nth bindings i)
   kw (if (not (nil? field-order)) (if (< i (count field-order)) (nth field-order i) nil) nil)
   raw-type (if (and (not (nil? kw)) (not (nil? (get field-map kw)))) (get field-map kw) ANY)
   bname (if (string? b) b (get b "name"))]
  (assoc arm-env bname raw-type))) env (range (count bindings))) (if (= (count bindings) 1) (let [b0 (nth bindings 0)
   bname (if (string? b0) b0 (get b0 "name"))]
  (assoc env bname (make-prim rec-name))) env)))
  (= (get pat "type") "var") (assoc env (get pat "name") target-type)
  :else env)))

(defn check-match-exhaustiveness! [target-type clauses]
  (let [union-name (cond
  (prim? target-type) (get target-type "name")
  (app-type? target-type) (get target-type "name")
  :else nil)
   union-members (if (not (nil? union-name)) (get-in (deref STATE) ["union-members" union-name]) nil)]
  (if (not (nil? union-members)) (do
  (let [matched-types (reduce (fn [acc c] (let [pat (get c "pattern")]
  (if (= (get pat "type") "record") (conj acc (get pat "name")) acc))) [] clauses)
   missing (filterv (fn [m] (nil? (some (fn [x] (= x m)) matched-types))) union-members)]
  (if (> (count missing) 0) (do
  (emit-diag! (str "beagle: match on " union-name " is not exhaustive; missing cases: " (str/join ", " missing))))))))
  nil))

(defn lookup-kw-field-type [^String kw target-type]
  (cond
  (and (prim? target-type) (not (nil? (get-in (deref STATE) ["record-fields" (get target-type "name")])))) (let [field-map (get-in (deref STATE) ["record-fields" (get target-type "name")])
   result (get field-map kw)]
  (if (nil? result) ANY result))
  :else ANY))

(defn resolve-poly-call! [poly-t args env]
  (let [body (get poly-t "body")
   bindings (atom {})
   arg-types (mapv (fn [a] (infer-expr! a env)) args)
   fixed (get body "params")
   rest-t (get body "rest")
   n-fixed (count fixed)]
  (doseq [i (range (count fixed))]
  (if (< i (count arg-types)) (do
  (infer-type-var-bindings! (nth fixed i) (nth arg-types i) bindings))))
  (if (and (not (nil? rest-t)) (> (count arg-types) n-fixed)) (do
  (doseq [at (drop n-fixed arg-types)]
  (infer-type-var-bindings! rest-t at bindings))))
  (apply-type-bindings body bindings)))

(defn ^Boolean bare-swallowed-ref? [e env]
  (and (= (get e "node") "ref") (nil? (get env (get e "name"))) (nil? (str/index-of (get e "name") "/")) (nil? (str/index-of (get e "name") "."))))

(defn last-expr-type! [body env]
  (let [n (count body)]
  (if (= n 0) ANY (reduce (fn [acc i] (let [e (nth body i)]
  (if (and (< i (- n 1)) (bare-swallowed-ref? e env)) (do
  (emit-diag! (str "beagle: bare symbol `" (get e "name") "` in non-final statement position resolves to nothing" " and has no effect — usually a binding name swallowed by" " an imbalanced paren in a previous `let` binding's value." " Check the enclosing `let` bindings for a missing `)`." " If you meant a call, write `(" (get e "name") " ...)`."))))
  (infer-expr! e env))) ANY (range n)))))

(defn check-args! [^String fn-name fn-t args env]
  (let [fixed (get fn-t "params")
   rest-t (get fn-t "rest")
   n-fixed (count fixed)
   n-args (count args)
   check-slot (fn [i] (let [actual (infer-expr! (nth args i) env)
   expected (if (< i n-fixed) (nth fixed i) rest-t)]
  (if (not (type-compatible? actual expected)) (do
  (emit-diag! (str "beagle: call to " fn-name ": arg " (+ i 1) " expected " (type->string expected) ", got " (type->string actual)))))
  actual))]
  (cond
  (not (nil? rest-t)) (do
  (if (< n-args n-fixed) (do
  (emit-diag! (str "beagle: call to " fn-name ": expected at least " n-fixed " arg(s), got " n-args))))
  (mapv check-slot (range n-args)))
  :else (do
  (if (not= n-fixed n-args) (do
  (emit-diag! (str "beagle: call to " fn-name ": expected " n-fixed " arg(s), got " n-args))))
  (mapv check-slot (range (if (< n-fixed n-args) n-fixed n-args)))))))

(defn infer-cond-clauses! [clauses env]
  (let [final (reduce (fn [state c] (let [test (get c "test")
   cur-env (get state "env")]
  (infer-expr! test cur-env)
  (let [narrowed (narrow-env-for-condition cur-env test)
   then-env (get narrowed "then")
   else-env (get narrowed "else")
   body-type (last-expr-type! (get c "body") then-env)]
  {"result" (merge-types (get state "result") body-type) "env" else-env}))) {"result" ANY "env" env} clauses)]
  (get final "result")))

(defn register-record! [^String name fields env]
  (let [rec-type (make-prim name)
   name-lower (str/lower-case name)
   field-map (reduce (fn [m f] (assoc m (str ":" (get f "name")) (if (nil? (get f "ann")) ANY (get f "ann")))) {} fields)
   field-order (mapv (fn [f] (str ":" (get f "name"))) fields)
   env1 (reduce (fn [e f] (assoc e (str name-lower "-" (get f "name")) (make-fn [rec-type] nil (if (nil? (get f "ann")) ANY (get f "ann"))))) env fields)
   env2 (assoc env1 (str "->" name) (make-fn (mapv (fn [f] (if (nil? (get f "ann")) ANY (get f "ann"))) fields) nil rec-type))]
  (swap! STATE assoc-in ["record-fields" name] field-map)
  (swap! STATE assoc-in ["record-field-order" name] field-order)
  env2))

(defn register-union! [^String name members type-params member-fields env]
  (do
  (swap! STATE assoc-in ["union-members" name] members)
  (if (or (nil? type-params) (= (count type-params) 0)) (let [env1 (assoc env name (make-union (mapv (fn [m] (make-prim m)) members)))]
  (if (not (nil? member-fields)) (reduce (fn [e m] (let [fields (get member-fields m)]
  (if (not (nil? fields)) (register-record! m fields e) e))) env1 members) env1)) (let [env1 (assoc env name (make-prim name))]
  (swap! STATE assoc-in ["parametric-unions" name] {"params" type-params "members" members "member-fields" member-fields})
  (if (not (nil? member-fields)) (reduce (fn [e m] (let [fields (get member-fields m)]
  (if (not (nil? fields)) (let [m-type (make-prim m)
   m-lower (str/lower-case m)
   field-map (reduce (fn [fm f] (assoc fm (str ":" (get f "name")) (if (nil? (get f "ann")) ANY (get f "ann")))) {} fields)
   field-order (mapv (fn [f] (str ":" (get f "name"))) fields)
   ctor-fn (make-fn (mapv (fn [f] (if (nil? (get f "ann")) ANY (get f "ann"))) fields) nil m-type)
   e1 (assoc e (str "->" m) (make-poly type-params ctor-fn nil))
   e2 (reduce (fn [ee f] (assoc ee (str m-lower "-" (get f "name")) (make-poly type-params (make-fn [m-type] nil (if (nil? (get f "ann")) ANY (get f "ann"))) nil))) e1 fields)]
  (swap! STATE assoc-in ["record-fields" m] field-map)
  (swap! STATE assoc-in ["record-field-order" m] field-order)
  e2) e))) env1 members) env1)))))

(defn infer-expr! [e env]
  (cond
  (nil? e) ANY
  (= (get e "node") "threading") (infer-expr! (get e "desugared") env)
  (= (get e "node") "literal") (let [t (infer-literal-type e)]
  (if (nil? t) ANY t))
  (= (get e "node") "ref") (let [found (get env (get e "name"))]
  (if (nil? found) ANY found))
  (= (get e "node") "def") (let [inferred (infer-expr! (get e "value") env)
   expected (get e "ann")]
  (if (and (not (nil? expected)) (not (type-compatible? inferred expected))) (do
  (emit-diag! (str "beagle: def " (get e "name") ": expected " (type->string expected) ", got " (type->string inferred)))))
  inferred)
  (= (get e "node") "defonce") (let [inferred (infer-expr! (get e "value") env)
   expected (get e "ann")]
  (if (and (not (nil? expected)) (not (type-compatible? inferred expected))) (do
  (emit-diag! (str "beagle: defonce " (get e "name") ": expected " (type->string expected) ", got " (type->string inferred)))))
  inferred)
  (= (get e "node") "defn") (let [params (get e "params")
   rest-param (opt-field (get e "rest"))
   expected-ret (get e "ret")
   body-env (extend-with-params env params rest-param)
   body-type (last-expr-type! (get e "body") body-env)]
  (if (and (not (nil? expected-ret)) (not (type-compatible? body-type expected-ret))) (do
  (let [is-promise (and (app-type? expected-ret) (= (get expected-ret "name") "Promise") (= (count (get expected-ret "args")) 1) (type-compatible? body-type (nth (get expected-ret "args") 0)))]
  (if (not is-promise) (do
  (emit-diag! (str "beagle: defn " (get e "name") ": expected return " (type->string expected-ret) ", got " (type->string body-type))))))))
  ANY)
  (= (get e "node") "defn-multi") (do
  (doseq [a (get e "arities")]
  (let [body-env (extend-with-params env (get a "params") (opt-field (get a "rest")))
   body-type (last-expr-type! (get a "body") body-env)
   expected-ret (get a "ret")]
  (if (and (not (nil? expected-ret)) (not (type-compatible? body-type expected-ret))) (do
  (emit-diag! (str "beagle: defn " (get e "name") " (" (count (get a "params")) "-arity): expected return " (type->string expected-ret) ", got " (type->string body-type)))))))
  ANY)
  (= (get e "node") "fn") (let [params (get e "params")
   p-types (mapv param-type-or-any params)
   body-env (extend-with-params env params (opt-field (get e "rest")))
   ret (if (not (nil? (get e "ret"))) (get e "ret") (last-expr-type! (get e "body") body-env))]
  (make-fn p-types nil ret))
  (= (get e "node") "let") (let [body-env (extend-with-let-bindings! env (get e "bindings"))]
  (last-expr-type! (get e "body") body-env))
  (= (get e "node") "binding") (do
  (doseq [b (get e "bindings")]
  (let [vt (infer-expr! (get b "value") env)
   nm (get b "name")
   dyn-vars (get env "#%dynamic-vars")
   declared (get env nm)]
  (if (nil? (get dyn-vars nm)) (do
  (emit-diag! (str "beagle: binding: " nm " is not a dynamic var — only `(def ^:dynamic " nm " ...)` vars can be rebound with `binding`"))))
  (if (and (not (nil? declared)) (not (type-compatible? vt declared))) (do
  (emit-diag! (str "beagle: binding " nm ": expected " (type->string declared) ", got " (type->string vt)))))))
  (last-expr-type! (get e "body") env))
  (= (get e "node") "letfn") (let [body-env (reduce (fn [be f] (let [rp (opt-field (get f "rest"))
   p-types (mapv param-type-or-any (get f "params"))
   rtype (if (not (nil? rp)) (param-type-or-any rp) nil)
   ret (if (not (nil? (get f "ret"))) (get f "ret") ANY)]
  (assoc be (get f "name") (make-fn p-types rtype ret)))) env (get e "fns"))]
  (doseq [f (get e "fns")]
  (let [fn-env (extend-with-params body-env (get f "params") (opt-field (get f "rest")))]
  (last-expr-type! (get f "body") fn-env)))
  (last-expr-type! (get e "body") body-env))
  (= (get e "node") "if") (do
  (infer-expr! (get e "cond") env)
  (let [narrowed (narrow-env-for-condition env (get e "cond"))
   then-env (get narrowed "then")
   else-env (get narrowed "else")
   tt (infer-expr! (get e "then") then-env)
   et (if (or (nil? (get e "else")) (synthetic-absent-else? (get e "else"))) NIL-TYPE (infer-expr! (get e "else") else-env))]
  (merge-types tt et)))
  (= (get e "node") "when") (do
  (infer-expr! (get e "cond") env)
  (let [narrowed (narrow-env-for-condition env (get e "cond"))
   then-env (get narrowed "then")]
  (last-expr-type! (get e "body") then-env)))
  (= (get e "node") "do") (last-expr-type! (get e "body") env)
  (= (get e "node") "cond") (let [clauses (get e "clauses")]
  (if (= (count clauses) 0) ANY (infer-cond-clauses! clauses env)))
  (= (get e "node") "loop") (let [body-env (extend-with-let-bindings! env (get e "bindings"))]
  (last-expr-type! (get e "body") body-env))
  (= (get e "node") "recur") (do
  (doseq [a (get e "args")]
  (infer-expr! a env))
  ANY)
  (= (get e "node") "set!") (let [target (get e "target")
   tnode (get target "node")
   tgt (get (deref STATE) "target")]
  (if (not (or (= tnode "ref") (= tnode "method-call") (= tgt "odin") (= tgt "zig"))) (do
  (let [target-desc (if (and (= tnode "call") (= (get (get target "fn") "node") "ref")) (str "(" (get (get target "fn") "name") " …)") "that form")]
  (emit-diag! (str "beagle: set! target must be a local variable or a field access (.-field); " target-desc " is not an assignable place on the " (str tgt) " target")))))
  (infer-expr! target env)
  (infer-expr! (get e "value") env)
  ANY)
  (= (get e "node") "await") (let [inner-type (infer-expr! (get e "expr") env)]
  (if (and (app-type? inner-type) (= (get inner-type "name") "Promise") (= (count (get inner-type "args")) 1)) (nth (get inner-type "args") 0) ANY))
  (= (get e "node") "vec") (let [items (get e "items")]
  (if (= (count items) 0) (make-app "Vec" [ANY]) (let [elem-types (mapv (fn [it] (infer-expr! it env)) items)]
  (make-app "Vec" [(collection-elem-type elem-types)]))))
  (= (get e "node") "map") (let [pairs (get e "pairs")]
  (if (= (count pairs) 0) (make-app "Map" [ANY ANY]) (let [key-types (mapv (fn [p] (infer-expr! (get p "key") env)) pairs)
   val-types (mapv (fn [p] (infer-expr! (get p "val") env)) pairs)]
  (make-app "Map" [(collection-elem-type key-types) (collection-elem-type val-types)]))))
  (= (get e "node") "set") (let [items (get e "items")]
  (if (= (count items) 0) (make-app "Set" [ANY]) (let [elem-types (mapv (fn [it] (infer-expr! it env)) items)
   first-t (nth elem-types 0)
   all-same (and (not (any-type? first-t)) (every? (fn [t] (type-compatible? t first-t)) (drop 1 elem-types)))]
  (if all-same (make-app "Set" [first-t]) (make-app "Set" [ANY])))))
  (= (get e "node") "quoted") ANY
  (= (get e "node") "regex") ANY
  (or (= (get e "node") "unsafe") (= (get e "node") "unsafe-raw")) ANY
  (= (get e "node") "when-let") (let [val-type (infer-expr! (get e "expr") env)
   body-env (assoc env (get e "name") val-type)]
  (last-expr-type! (get e "body") body-env)
  NIL-TYPE)
  (= (get e "node") "if-let") (let [val-type (infer-expr! (get e "expr") env)
   then-env (assoc env (get e "name") val-type)
   then-type (infer-expr! (get e "then") then-env)
   els (opt-field (get e "else"))
   else-type (if (not (nil? els)) (infer-expr! els env) NIL-TYPE)]
  (merge-types then-type else-type))
  (= (get e "node") "when-some") (let [val-type (infer-expr! (get e "expr") env)
   body-env (assoc env (get e "name") val-type)]
  (last-expr-type! (get e "body") body-env)
  NIL-TYPE)
  (= (get e "node") "if-some") (let [val-type (infer-expr! (get e "expr") env)
   then-env (assoc env (get e "name") val-type)
   then-type (infer-expr! (get e "then") then-env)
   else-type (infer-expr! (get e "else") env)]
  (merge-types then-type else-type))
  (= (get e "node") "condp") (do
  (infer-expr! (get e "pred") env)
  (infer-expr! (get e "test") env)
  (let [clause-types (mapv (fn [c] (infer-expr! (get c "test") env)
  (infer-expr! (get c "body") env)) (get e "clauses"))
   dflt (opt-field (get e "default"))]
  (if (not (nil? dflt)) (merge-types-list (conj clause-types (infer-expr! dflt env))) (if (= (count clause-types) 0) ANY (merge-types-list clause-types)))))
  (= (get e "node") "for") (let [body-env (reduce (fn [be c] (let [ct (get c "type")]
  (cond
  (= ct "binding") (let [coll-type (infer-expr! (get c "expr") be)
   elem-type (if (and (app-type? coll-type) (or (= (get coll-type "name") "Vec") (= (get coll-type "name") "List") (= (get coll-type "name") "Set")) (= (count (get coll-type "args")) 1)) (nth (get coll-type "args") 0) ANY)]
  (assoc be (get c "name") elem-type))
  (= ct "when") (do
  (infer-expr! (get c "test") be)
  be)
  (= ct "let") (reduce (fn [be2 b] (assoc be2 (get b "name") (infer-expr! (get b "value") be2))) be (get c "bindings"))
  :else be))) env (get e "clauses"))
   body-type (last-expr-type! (get e "body") body-env)]
  (if (any-type? body-type) (make-app "Vec" [ANY]) (make-app "Vec" [body-type])))
  (= (get e "node") "doseq") (let [body-env (reduce (fn [be c] (let [ct (get c "type")]
  (cond
  (= ct "binding") (let [coll-type (infer-expr! (get c "expr") be)
   elem-type (if (and (app-type? coll-type) (or (= (get coll-type "name") "Vec") (= (get coll-type "name") "List") (= (get coll-type "name") "Set")) (= (count (get coll-type "args")) 1)) (nth (get coll-type "args") 0) ANY)]
  (assoc be (get c "name") elem-type))
  (= ct "when") (do
  (infer-expr! (get c "test") be)
  be)
  (= ct "let") (reduce (fn [be2 b] (assoc be2 (get b "name") (infer-expr! (get b "value") be2))) be (get c "bindings"))
  :else be))) env (get e "clauses"))]
  (last-expr-type! (get e "body") body-env)
  ANY)
  (= (get e "node") "match") (let [target-type (infer-expr! (get e "target") env)
   clauses (get e "clauses")
   arm-types (mapv (fn [c] (let [arm-env (narrow-env-for-match c target-type env)]
  (last-expr-type! (get c "body") arm-env))) clauses)]
  (check-match-exhaustiveness! target-type clauses)
  (if (= (count arm-types) 0) ANY (merge-types-list arm-types)))
  (= (get e "node") "try") (let [body-type (last-expr-type! (get e "body") env)
   catch-types (mapv (fn [c] (let [catch-env (if (not (nil? (get c "name"))) (assoc env (get c "name") ANY) env)]
  (last-expr-type! (get c "body") catch-env))) (get e "catches"))
   fin (opt-field (get e "finally"))]
  (if (not (nil? fin)) (do
  (last-expr-type! fin env)))
  (merge-types-list (into [body-type] catch-types)))
  (= (get e "node") "new") (do
  (doseq [a (get e "args")]
  (infer-expr! a env))
  ANY)
  (= (get e "node") "kw-access") (let [target-type (infer-expr! (get e "target") env)
   dflt (opt-field (get e "default"))]
  (if (not (nil? dflt)) (do
  (infer-expr! dflt env)))
  (lookup-kw-field-type (get e "kw") target-type))
  (= (get e "node") "with") (let [target-type (infer-expr! (get e "target") env)]
  (cond
  (and (prim? target-type) (not (nil? (get-in (deref STATE) ["record-fields" (get target-type "name")])))) (let [rec-name (get target-type "name")
   field-map (get-in (deref STATE) ["record-fields" rec-name])]
  (doseq [u (get e "updates")]
  (let [kw (get u "field")
   val-type (infer-expr! (get u "value") env)
   expected (get field-map kw)]
  (cond
  (not (nil? expected)) (if (not (type-compatible? val-type expected)) (do
  (emit-diag! (str "beagle: with " rec-name ": field " kw " expected " (type->string expected) ", got " (type->string val-type)))))
  :else (emit-diag! (str "beagle: with " rec-name ": no field " kw)))))
  target-type)
  :else (do
  (doseq [u (get e "updates")]
  (infer-expr! (get u "value") env))
  ANY)))
  (= (get e "node") "record") (make-prim (get e "name"))
  (= (get e "node") "defrecord") (do
  (register-record! (get e "name") (get e "fields") env)
  ANY)
  (= (get e "node") "defunion") (do
  (register-union! (get e "name") (get e "members") (get e "type-params") (get e "member-fields") env)
  ANY)
  (= (get e "node") "defenum") ANY
  (= (get e "node") "block-string") (make-prim "String")
  (= (get e "node") "method-call") (let [method-name (get e "method")
   all-args (into [(get e "target")] (get e "args"))
   raw-type (get env method-name)]
  (infer-expr! (get e "target") env)
  (cond
  (and (not (nil? raw-type)) (poly-type? raw-type)) (let [resolved (resolve-poly-call! raw-type all-args env)]
  (if (fn-type? resolved) (do
  (check-args! method-name resolved all-args env)
  (get resolved "ret")) (do
  (doseq [a (get e "args")]
  (infer-expr! a env))
  ANY)))
  (and (not (nil? raw-type)) (fn-type? raw-type)) (do
  (check-args! method-name raw-type all-args env)
  (get raw-type "ret"))
  :else (do
  (doseq [a (get e "args")]
  (infer-expr! a env))
  ANY)))
  (= (get e "node") "static-call") (let [sym (get e "name")
   raw-type (get env sym)]
  (cond
  (and (not (nil? raw-type)) (poly-type? raw-type)) (let [resolved (resolve-poly-call! raw-type (get e "args") env)]
  (if (fn-type? resolved) (do
  (check-args! sym resolved (get e "args") env)
  (get resolved "ret")) (do
  (doseq [a (get e "args")]
  (infer-expr! a env))
  ANY)))
  (and (not (nil? raw-type)) (fn-type? raw-type)) (do
  (check-args! sym raw-type (get e "args") env)
  (get raw-type "ret"))
  :else (do
  (doseq [a (get e "args")]
  (infer-expr! a env))
  ANY)))
  (and (= (get e "node") "call") (or (= (call-fn-name e) "and") (= (call-fn-name e) "or"))) (do
  (reduce (fn [acc a] (let [env* (merge env acc)]
  (infer-expr! a env*)
  (let [tn (test-narrowings a env*)]
  (merge acc (get tn (if (= (call-fn-name e) "and") "then" "else")))))) {} (get e "args"))
  ANY)
  (= (get e "node") "call") (let [fn-ref (get e "fn")
   fn-name (cond
  (and (not (nil? fn-ref)) (= (get fn-ref "node") "ref")) (get fn-ref "name")
  (string? fn-ref) fn-ref
  :else nil)
   args (get e "args")]
  (if (nil? fn-name) (do
  (if (not (nil? fn-ref)) (do
  (infer-expr! fn-ref env)))
  (doseq [a args]
  (infer-expr! a env))
  ANY) (let [raw-type (get env fn-name)]
  (cond
  (and (not (nil? raw-type)) (poly-type? raw-type)) (let [resolved (resolve-poly-call! raw-type args env)]
  (if (fn-type? resolved) (do
  (check-args! fn-name resolved args env)
  (get resolved "ret")) (do
  (doseq [a args]
  (infer-expr! a env))
  ANY)))
  (and (not (nil? raw-type)) (fn-type? raw-type)) (let [arg-types (check-args! fn-name raw-type args env)]
  (numeric-refine fn-name arg-types (get raw-type "ret")))
  (and (not (nil? raw-type)) (union-type? raw-type) (every? (fn [m] (fn-type? m)) (get raw-type "members"))) (let [n-args (count args)
   matching (first (filter (fn [alt] (= (count (get alt "params")) n-args)) (get raw-type "members")))]
  (if (not (nil? matching)) (do
  (check-args! fn-name matching args env)
  (get matching "ret")) (do
  (emit-diag! (str "beagle: call to " fn-name ": no arity accepts " n-args " arg(s)"))
  ANY)))
  :else (do
  (doseq [a args]
  (infer-expr! a env))
  ANY)))))
  (= (get e "node") "dynamic-var") (let [found (get env (get e "name"))]
  (if (nil? found) ANY found))
  (= (get e "node") "target-case") (do
  (doseq [c (get e "cases")]
  (infer-expr! (get c "body") env))
  ANY)
  (= (get e "node") "defscalar") ANY
  (= (get e "node") "deferror") ANY
  (= (get e "node") "with-meta") (infer-expr! (get e "expr") env)
  (or (= (get e "node") "protocol") (= (get e "node") "deftype") (= (get e "node") "extend-type")) ANY
  (or (= (get e "node") "defmulti") (= (get e "node") "defmethod")) ANY
  (= (get e "node") "check") (let [inner-type (infer-expr! (get e "expr") env)]
  (if (and (app-type? inner-type) (>= (count (get inner-type "args")) 1)) (nth (get inner-type "args") 0) ANY))
  (= (get e "node") "rescue") (let [inner-type (infer-expr! (get e "expr") env)
   fallback-env (if (not (nil? (get e "err"))) (assoc env (get e "err") ANY) env)
   fallback-type (infer-expr! (get e "fallback") fallback-env)]
  (if (and (app-type? inner-type) (>= (count (get inner-type "args")) 1)) (nth (get inner-type "args") 0) fallback-type))
  (= (get e "node") "ns") ANY
  (or (= (get e "node") "nix-inherit") (= (get e "node") "nix-inherit-from") (= (get e "node") "nix-with") (= (get e "node") "nix-rec-attrs") (= (get e "node") "nix-assert") (= (get e "node") "nix-get-or") (= (get e "node") "nix-has-attr") (= (get e "node") "nix-search-path") (= (get e "node") "nix-interpolated-string") (= (get e "node") "nix-multiline-string") (= (get e "node") "nix-indented-string") (= (get e "node") "nix-path") (= (get e "node") "nix-fn-set") (= (get e "node") "nix-pipe") (= (get e "node") "nix-impl")) ANY
  :else ANY))

(def CLJ-BUILTIN-DYNAMIC-VARS ["*out*" "*err*" "*in*" "*ns*" "*print-length*" "*print-level*" "*print-readably*" "*print-dup*" "*print-meta*" "*flush-on-newline*" "*warn-on-reflection*" "*unchecked-math*" "*math-context*" "*read-eval*" "*command-line-args*" "*file*" "*assert*" "*data-readers*" "*default-data-reader-fn*" "*compile-path*" "*source-path*" "*clojure-version*" "*agent*"])

(defn build-initial-env! [prog]
  (let [externs (get prog "externs")
   forms (get prog "forms")
   env-with-externs (if (not (nil? externs)) (reduce (fn [env ext] (assoc env (get ext "name") (get ext "type"))) STDLIB externs) STDLIB)
   dyn-from-defs (reduce (fn [acc f] (if (and (= (get f "node") "def") (= (get f "dynamic") true)) (assoc acc (get f "name") true) acc)) {} forms)
   dyn-vars (if (= (get prog "target") "clj") (reduce (fn [acc nm] (assoc acc nm true)) dyn-from-defs CLJ-BUILTIN-DYNAMIC-VARS) dyn-from-defs)
   env-with-externs (assoc env-with-externs "#%dynamic-vars" dyn-vars)
   env-with-externs (if (= (get prog "target") "clj") (reduce (fn [env nm] (if (nil? (get env nm)) (assoc env nm ANY) env)) env-with-externs CLJ-BUILTIN-DYNAMIC-VARS) env-with-externs)]
  (reduce (fn [env raw-form] (let [form (if (= (get raw-form "node") "with-meta") (get raw-form "expr") raw-form)
   node (get form "node")]
  (cond
  (= node "def") (if (not (nil? (get form "ann"))) (assoc env (get form "name") (get form "ann")) env)
  (= node "defonce") (if (not (nil? (get form "ann"))) (assoc env (get form "name") (get form "ann")) env)
  (= node "defn") (let [params (get form "params")
   rest-param (opt-field (get form "rest"))
   p-types (mapv param-type-or-any params)
   rtype (if (not (nil? rest-param)) (param-type-or-any rest-param) nil)
   ret (if (not (nil? (get form "ret"))) (get form "ret") ANY)]
  (assoc env (get form "name") (make-fn p-types rtype ret)))
  (= node "defn-multi") (let [arities (get form "arities")
   alt-types (mapv (fn [a] (let [rp (opt-field (get a "rest"))
   p-types (mapv param-type-or-any (get a "params"))
   rtype (if (not (nil? rp)) (param-type-or-any rp) nil)
   ret (if (not (nil? (get a "ret"))) (get a "ret") ANY)]
  (make-fn p-types rtype ret))) arities)]
  (assoc env (get form "name") (if (= (count alt-types) 1) (nth alt-types 0) (make-union alt-types))))
  (= node "defrecord") (register-record! (get form "name") (get form "fields") env)
  (= node "defunion") (register-union! (get form "name") (get form "members") (get form "type-params") (get form "member-fields") env)
  (= node "defenum") env
  (= node "defmulti") (assoc env (get form "name") (make-fn [ANY] nil ANY))
  :else env))) env-with-externs forms)))

(defn check-form! [form env]
  (let [node (get form "node")]
  (cond
  (= node "def") (do
  (infer-expr! form env)
  nil)
  (= node "defonce") (do
  (infer-expr! form env)
  nil)
  (= node "defn") (do
  (infer-expr! form env)
  nil)
  (= node "defn-multi") (do
  (infer-expr! form env)
  nil)
  (= node "defrecord") nil
  (= node "defunion") nil
  (= node "defenum") nil
  (= node "defscalar") nil
  (= node "deferror") nil
  (= node "protocol") nil
  (= node "deftype") nil
  (= node "defmulti") nil
  (= node "defmethod") nil
  (= node "with-meta") (check-form! (get form "expr") env)
  :else (do
  (infer-expr! form env)
  nil))))

(def NIX-QUALIFIED-PREFIXES ["lib." "builtins." "pkgs."])

(defn nix-dotted-root [^String s]
  (if (str/starts-with? s ":") nil (let [i (str/index-of s ".")]
  (if (or (nil? i) (= i 0)) nil (subs s 0 i)))))

(defn ^Boolean nix-qualified? [^String s]
  (or (str/includes? s "/") (< 0 (count (filterv (fn [p] (str/starts-with? s p)) NIX-QUALIFIED-PREFIXES)))))

(defn nix-collect-bound [x acc]
  (cond
  (map? x) (if (= (get x "node") "quoted") acc (let [nm (get x "name")
   acc1 (if (string? nm) (conj acc nm) acc)
   acc2 (if (= (get x "node") "nix-with-cfg") (conj acc1 "cfg") acc1)]
  (reduce (fn [a v] (nix-collect-bound v a)) acc2 (vals x))))
  (vector? x) (reduce (fn [a v] (nix-collect-bound v a)) acc x)
  :else acc))

(defn nix-free-dotted-walk! [x ^Boolean under-with bound]
  (cond
  (map? x) (let [node (get x "node")]
  (cond
  (= node "quoted") nil
  (= node "ref") (let [nm (get x "name")
   root (nix-dotted-root nm)]
  (if (and (some? root) (not under-with) (not (nix-qualified? nm)) (not (contains? bound root)) (not (= root "builtins"))) (do
  (emit-diag! (str "unbound name `" nm "` on the nix target: it descends into `" root "`, but `" root "` is not a nix/module formal, a let-binding, or any " "other binding in scope. It emits `${" nm "}`, which nix rejects as an " "undefined variable. Declare `" root "` as a `nix/module` formal, bind it " "with `let`, or fix the name. (Names inside `nix/with` are exempt — their " "scope is dynamic.)"))))
  nil)
  (= node "nix-with") (do
  (nix-free-dotted-walk! (get x "ns-expr") under-with bound)
  (nix-free-dotted-walk! (get x "body") true bound)
  nil)
  :else (do
  (doseq [v (vals x)]
  (nix-free-dotted-walk! v under-with bound))
  nil)))
  (vector? x) (do
  (doseq [v x]
  (nix-free-dotted-walk! v under-with bound))
  nil)
  :else nil))

(defn check-nix-free-dotted! [prog]
  (if (and (= (get prog "target") "nix") (= (get prog "mode") "strict")) (do
  (let [forms (get prog "forms")
   bound (reduce (fn [a f] (nix-collect-bound f a)) #{} forms)]
  (doseq [form forms]
  (nix-free-dotted-walk! form false bound)))))
  nil)

(def ^String LOWER-ALPHA "abcdefghijklmnopqrstuvwxyz")

(defn- ^Boolean lower-alpha-first? [^String s]
  (and (> (count s) 0) (some? (str/index-of LOWER-ALPHA (subs s 0 1)))))

(defn collect-ref-names [x acc]
  (cond
  (map? x) (let [acc1 (if (= (get x "node") "ref") (let [nm (get x "name")]
  (if (string? nm) (conj acc nm) acc)) acc)]
  (reduce (fn [a v] (collect-ref-names v a)) acc1 (vals x)))
  (vector? x) (reduce (fn [a v] (collect-ref-names v a)) acc x)
  :else acc))

(defn check-qualified-resolution! [prog env]
  (let [target (get prog "target")]
  (if (and (= target "clj") (= (get prog "mode") "strict")) (do
  (let [required (reduce (fn [m r] (let [ns (get r "ns")
   alias (get r "alias")
   m1 (assoc m ns true)]
  (if (and (some? alias) (not (= alias false))) (assoc m1 alias true) m1))) {"str" true} (get prog "requires"))
   names (reduce (fn [a f] (collect-ref-names f a)) [] (get prog "forms"))
   seen (atom {})
   bad (atom [])]
  (doseq [s names]
  (let [idx (str/index-of s "/")]
  (if (and (some? idx) (> idx 0) (< idx (- (count s) 1)) (lower-alpha-first? s) (not (str/starts-with? s "clojure.")) (nil? (get env s))) (do
  (let [p (subs s 0 idx)]
  (if (and (nil? (get required p)) (not (= true (get (deref seen) s)))) (do
  (swap! seen assoc s true)
  (swap! bad conj {"sym" s "prefix" p}))))))))
  (if (> (count (deref bad)) 0) (do
  (let [vs (deref bad)
   plural (> (count vs) 1)
   lines (str/join "\n" (mapv (fn [v] (str "  " (get v "sym") " — alias `" (get v "prefix") "` is not required")) vs))]
  (emit-diag! (str "unresolved namespace alias" (if plural "es" "") " — these will crash at " target " load:\n" lines "\nAdd the missing (require NS :as ALIAS) form(s), or fix the alias."))))))))
  nil))

(defn type-check! [prog]
  (let [mode (get prog "mode")]
  (if (= mode "strict") (do
  (reset! STATE {"record-fields" {} "record-field-order" {} "union-members" {} "parametric-unions" {} "target" (get prog "target") "diagnostics" []})
  (let [env (build-initial-env! prog)]
  (doseq [form (get prog "forms")]
  (check-form! form env))
  (check-nix-free-dotted! prog)
  (check-qualified-resolution! prog env)))))
  (let [diags (get (deref STATE) "diagnostics")]
  {"diagnostics" diags "count" (count diags)}))

(defn check-program! [prog]
  (get (type-check! prog) "diagnostics"))

(defn make-lit [^String kind value]
  {"node" "literal" "kind" kind "value" value})

(defn make-ref [^String name]
  {"node" "ref" "name" name})

(defn make-def-node [^String name ann value]
  {"node" "def" "name" name "ann" ann "value" value})

(defn make-defn-node [^String name params ret body]
  {"node" "defn" "name" name "params" params "rest" false "ret" ret "body" body "private" false})

(defn make-param [^String name ann]
  {"type" "param" "name" name "ann" ann})

(defn make-call [^String fn-name args]
  {"node" "call" "fn" {"node" "ref" "name" fn-name} "args" args})

(defn make-if-node [cond-expr then-expr else-expr]
  {"node" "if" "cond" cond-expr "then" then-expr "else" else-expr})

(defn make-let-node [bindings body]
  {"node" "let" "bindings" bindings "body" body})

(defn make-let-binding [^String name ann value]
  {"name" name "ann" ann "value" value})

(defn make-vec-node [items]
  {"node" "vec" "items" items})

(defn make-map-node [pairs]
  {"node" "map" "pairs" pairs})

(defn make-map-pair [key val]
  {"key" key "val" val})

(defn make-prog [forms]
  {"mode" "strict" "namespace" "test" "target" "js" "forms" forms "externs" [] "requires" []})

(def passes (atom []))

(def failures (atom []))

(defn- ^Boolean json-eq [a b]
  (= a b))

(defn- expect! [^String label ^Boolean result]
  (if result (do
  (swap! passes conj true)
  nil) (do
  (swap! failures conj label)
  nil)))

(defn run-tests! []
  (reset! passes [])
  (reset! failures [])
  (expect! "lit: string" (json-eq (infer-literal-type (make-lit "string" "hi")) (make-prim "String")))
  (expect! "lit: int" (json-eq (infer-literal-type (make-lit "number" 42)) (make-prim "Int")))
  (expect! "lit: float" (json-eq (infer-literal-type (make-lit "float" 3.14)) (make-prim "Float")))
  (expect! "lit: bool" (json-eq (infer-literal-type (make-lit "bool" true)) (make-prim "Bool")))
  (expect! "lit: nil" (json-eq (infer-literal-type (make-lit "nil" nil)) (make-prim "Nil")))
  (expect! "lit: keyword" (json-eq (infer-literal-type (make-lit "keyword" ":foo")) (make-prim "Keyword")))
  (expect! "infer: string literal" (json-eq (infer-expr! (make-lit "string" "hello") {}) (make-prim "String")))
  (expect! "infer: int literal" (json-eq (infer-expr! (make-lit "number" 99) {}) (make-prim "Int")))
  (expect! "infer: ref from env" (json-eq (infer-expr! (make-ref "x") {"x" (make-prim "Bool")}) (make-prim "Bool")))
  (expect! "infer: ref missing => Any" (any-type? (infer-expr! (make-ref "y") {})))
  (expect! "def: matching annotation" (let [prog (make-prog [(make-def-node "x" (make-prim "Int") (make-lit "number" 42))])
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "def: mismatched annotation" (let [prog (make-prog [(make-def-node "x" (make-prim "String") (make-lit "number" 42))])
   result (type-check! prog)]
  (> (get result "count") 0)))
  (expect! "defn: matching return" (let [prog (make-prog [(make-defn-node "f" [(make-param "x" (make-prim "Int"))] (make-prim "Int") [(make-ref "x")])])
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "defn: mismatched return" (let [prog (make-prog [(make-defn-node "f" [(make-param "x" (make-prim "Int"))] (make-prim "String") [(make-ref "x")])])
   result (type-check! prog)]
  (> (get result "count") 0)))
  (expect! "let: basic binding inference" (let [prog (make-prog [(make-def-node "result" (make-prim "Int") (make-let-node [(make-let-binding "x" nil (make-lit "number" 42))] [(make-ref "x")]))])
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "let: mismatched binding annotation" (let [prog (make-prog [(make-def-node "result" nil (make-let-node [(make-let-binding "x" (make-prim "String") (make-lit "number" 42))] [(make-ref "x")]))])
   result (type-check! prog)]
  (> (get result "count") 0)))
  (expect! "infer: if merges branch types" (let [t1 (infer-expr! (make-if-node (make-lit "bool" true) (make-lit "string" "a") (make-lit "number" 1)) {})]
  (union-type? t1)))
  (expect! "infer: if same type no union" (let [t1 (infer-expr! (make-if-node (make-lit "bool" true) (make-lit "string" "a") (make-lit "string" "b")) {})]
  (prim? t1)))
  (expect! "call: correct args" (let [prog {"mode" "strict" "namespace" "test" "target" "js" "forms" [(make-def-node "r" (make-prim "Int") (make-call "add" [(make-lit "number" 1) (make-lit "number" 2)]))] "externs" [{"name" "add" "type" (make-fn [(make-prim "Int") (make-prim "Int")] nil (make-prim "Int"))}] "requires" []}
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "call: wrong arg type" (let [prog {"mode" "strict" "namespace" "test" "target" "js" "forms" [(make-def-node "r" nil (make-call "add" [(make-lit "string" "x") (make-lit "number" 2)]))] "externs" [{"name" "add" "type" (make-fn [(make-prim "Int") (make-prim "Int")] nil (make-prim "Int"))}] "requires" []}
   result (type-check! prog)]
  (> (get result "count") 0)))
  (expect! "call: wrong arity" (let [prog {"mode" "strict" "namespace" "test" "target" "js" "forms" [(make-def-node "r" nil (make-call "add" [(make-lit "number" 1)]))] "externs" [{"name" "add" "type" (make-fn [(make-prim "Int") (make-prim "Int")] nil (make-prim "Int"))}] "requires" []}
   result (type-check! prog)]
  (> (get result "count") 0)))
  (expect! "binding: ^:dynamic def target accepted" (let [dyn-def (assoc (make-def-node "*lvl*" (make-prim "Int") (make-lit "number" 0)) "dynamic" true)
   prog {"mode" "strict" "namespace" "test" "target" "clj" "forms" [dyn-def (make-defn-node "f" [] (make-prim "Int") [{"node" "binding" "bindings" [(make-let-binding "*lvl*" nil (make-lit "number" 5))] "body" [(make-lit "number" 1)]}])] "externs" [] "requires" []}
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "binding: non-dynamic def target rejected" (let [plain-def (make-def-node "*lvl*" (make-prim "Int") (make-lit "number" 0))
   prog {"mode" "strict" "namespace" "test" "target" "clj" "forms" [plain-def (make-defn-node "f" [] (make-prim "Int") [{"node" "binding" "bindings" [(make-let-binding "*lvl*" nil (make-lit "number" 5))] "body" [(make-lit "number" 1)]}])] "externs" [] "requires" []}
   result (type-check! prog)]
  (> (get result "count") 0)))
  (expect! "binding: clojure.core builtin *out* accepted on clj" (let [prog {"mode" "strict" "namespace" "test" "target" "clj" "forms" [(make-defn-node "f" [] (make-prim "Int") [{"node" "binding" "bindings" [(make-let-binding "*out*" nil (make-ref "*err*"))] "body" [(make-lit "number" 1)]}])] "externs" [] "requires" []}
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "compat: union target accepts member" (type-compatible? (make-prim "String") (make-union [(make-prim "String") (make-prim "Nil")])))
  (expect! "compat: union target rejects non-member" (not (type-compatible? (make-prim "Int") (make-union [(make-prim "String") (make-prim "Nil")]))))
  (expect! "infer: vec of ints" (let [t1 (infer-expr! (make-vec-node [(make-lit "number" 1) (make-lit "number" 2)]) {})]
  (and (app-type? t1) (= (get t1 "name") "Vec") (prim? (nth (get t1 "args") 0)) (= (get (nth (get t1 "args") 0) "name") "Int"))))
  (expect! "infer: empty vec" (let [t1 (infer-expr! (make-vec-node []) {})]
  (and (app-type? t1) (= (get t1 "name") "Vec"))))
  (expect! "infer: map of string->int" (let [t1 (infer-expr! (make-map-node [(make-map-pair (make-lit "string" "a") (make-lit "number" 1))]) {})]
  (and (app-type? t1) (= (get t1 "name") "Map") (= (get (nth (get t1 "args") 0) "name") "String") (= (get (nth (get t1 "args") 1) "name") "Int"))))
  (expect! "merge: same type" (prim? (merge-types (make-prim "Int") (make-prim "Int"))))
  (expect! "merge: different types -> union" (union-type? (merge-types (make-prim "Int") (make-prim "String"))))
  (expect! "merge: Any absorbs" (prim? (merge-types ANY (make-prim "Int"))))
  (expect! "narrowing: nil? predicate" (let [env {"x" (make-union [(make-prim "String") (make-prim "Nil")])}
   cond-expr (make-call "nil?" [(make-ref "x")])
   narrowed (narrow-env-for-condition env cond-expr)
   then-env (get narrowed "then")
   else-env (get narrowed "else")]
  (and (nil-type? (get then-env "x")) (prim? (get else-env "x")) (= (get (get else-env "x") "name") "String"))))
  (expect! "narrowing: some? predicate (negated nil)" (let [env {"x" (make-union [(make-prim "String") (make-prim "Nil")])}
   cond-expr (make-call "some?" [(make-ref "x")])
   narrowed (narrow-env-for-condition env cond-expr)
   then-env (get narrowed "then")
   else-env (get narrowed "else")]
  (and (prim? (get then-env "x")) (= (get (get then-env "x") "name") "String") (nil-type? (get else-env "x")))))
  (expect! "narrowing: (and (some? x) ...) compounds into then-branch" (let [env {"n" (make-union [(make-prim "Int") (make-prim "Nil")])}
   ce (make-call "and" [(make-call "some?" [(make-ref "n")]) (make-call ">" [(make-ref "n") (make-lit "number" 0)])])
   then-env (get (narrow-env-for-condition env ce) "then")]
  (and (prim? (get then-env "n")) (= (get (get then-env "n") "name") "Int"))))
  (expect! "narrowing: (or (nil? x) ...) narrows else-branch" (let [env {"x" (make-union [(make-prim "String") (make-prim "Nil")])}
   ce (make-call "or" [(make-call "nil?" [(make-ref "x")]) (make-lit "bool" false)])
   else-env (get (narrow-env-for-condition env ce) "else")]
  (and (prim? (get else-env "x")) (= (get (get else-env "x") "name") "String"))))
  (expect! "narrowing: (not= x nil) narrows then-branch" (let [env {"x" (make-union [(make-prim "Int") (make-prim "Nil")])}
   ce (make-call "not=" [(make-ref "x") (make-lit "nil" nil)])
   then-env (get (narrow-env-for-condition env ce) "then")]
  (and (prim? (get then-env "x")) (= (get (get then-env "x") "name") "Int"))))
  (expect! "narrowing: bare-ref truthiness (no else Nil when remainder falsy)" (let [env {"x" (make-union [(make-prim "String") (make-prim "Nil")]) "b" (make-union [(make-prim "Bool") (make-prim "Nil")])}
   nx (narrow-env-for-condition env (make-ref "x"))
   nb (narrow-env-for-condition env (make-ref "b"))]
  (and (= (get (get (get nx "then") "x") "name") "String") (nil-type? (get (get nx "else") "x")) (= (get (get (get nb "then") "b") "name") "Bool") (union-type? (get (get nb "else") "b")))))
  (expect! "and-call: later conjuncts checked under earlier narrows" (do
  (swap! STATE assoc "diagnostics" [])
  (infer-expr! (make-call "and" [(make-call "some?" [(make-ref "pa")]) (make-call "f" [(make-ref "pa")])]) {"pa" (make-union [(make-prim "String") (make-prim "Nil")]) "f" (make-fn [(make-prim "String")] nil (make-prim "Bool"))})
  (= 0 (count (get (deref STATE) "diagnostics")))))
  (expect! "or-call: later disjuncts checked under earlier else-narrows" (do
  (swap! STATE assoc "diagnostics" [])
  (infer-expr! (make-call "or" [(make-call "nil?" [(make-ref "pa")]) (make-call "f" [(make-ref "pa")])]) {"pa" (make-union [(make-prim "String") (make-prim "Nil")]) "f" (make-fn [(make-prim "String")] nil (make-prim "Bool"))})
  (= 0 (count (get (deref STATE) "diagnostics")))))
  (expect! "binding: returns body's last type, env unchanged" (let [e {"node" "binding" "bindings" [{"name" "*out*" "ann" nil "value" {"node" "dynamic-var" "name" "*err*"}}] "body" [(make-lit "number" 7)]}
   t1 (infer-expr! e {})]
  (and (prim? t1) (= (get t1 "name") "Int"))))
  (expect! "binding: value vs declared var type mismatch" (do
  (swap! STATE assoc "diagnostics" [])
  (infer-expr! {"node" "binding" "bindings" [{"name" "*mode*" "ann" nil "value" (make-lit "number" 1)}] "body" [(make-lit "nil" nil)]} {"*mode*" (make-prim "String")})
  (> (count (get (deref STATE) "diagnostics")) 0)))
  (expect! "match: exhaustive union check" (do
  (swap! STATE assoc "union-members" {})
  (swap! STATE assoc "record-fields" {})
  (swap! STATE assoc "record-field-order" {})
  (swap! STATE assoc "diagnostics" [])
  (swap! STATE assoc-in ["union-members" "Shape"] ["Circle" "Square" "Triangle"])
  (check-match-exhaustiveness! (make-prim "Shape") [{"pattern" {"type" "record" "name" "Circle" "bindings" []} "body" [(make-lit "string" "circle")]} {"pattern" {"type" "record" "name" "Square" "bindings" []} "body" [(make-lit "string" "square")]}])
  (> (count (get (deref STATE) "diagnostics")) 0)))
  (expect! "infer: fn returns fn type" (let [e {"node" "fn" "params" [(make-param "x" (make-prim "Int"))] "rest" false "ret" (make-prim "Bool") "body" [(make-lit "bool" true)]}
   t1 (infer-expr! e {})]
  (and (fn-type? t1) (= (count (get t1 "params")) 1) (= (get (get t1 "ret") "name") "Bool"))))
  (expect! "infer: kw-access on registered record" (do
  (swap! STATE assoc "record-fields" {})
  (swap! STATE assoc-in ["record-fields" "Person"] {":name" (make-prim "String") ":age" (make-prim "Int")})
  (let [t1 (infer-expr! {"node" "kw-access" "kw" ":name" "target" (make-ref "p") "default" nil} {"p" (make-prim "Person")})]
  (and (prim? t1) (= (get t1 "name") "String")))))
  (expect! "env: defn registers fn type" (let [prog (make-prog [(make-defn-node "greet" [(make-param "name" (make-prim "String"))] (make-prim "String") [(make-ref "name")])])
   env (build-initial-env! prog)
   ft (get env "greet")]
  (and (fn-type? ft) (= (count (get ft "params")) 1) (= (get (get ft "ret") "name") "String"))))
  (expect! "env: extern registers type" (let [prog {"mode" "strict" "namespace" "test" "target" "js" "forms" [] "externs" [{"name" "fetch" "type" (make-fn [(make-prim "String")] nil (make-prim "Any"))}] "requires" []}
   env (build-initial-env! prog)
   ft (get env "fetch")]
  (and (fn-type? ft) (= (count (get ft "params")) 1))))
  (expect! "integration: multi-form program" (let [prog (make-prog [(make-defn-node "double" [(make-param "x" (make-prim "Int"))] (make-prim "Int") [(make-call "+" [(make-ref "x") (make-ref "x")])]) (make-def-node "result" (make-prim "Int") (make-call "double" [(make-lit "number" 21)]))])
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "dynamic mode: no errors" (let [prog {"mode" "dynamic" "namespace" "test" "target" "js" "forms" [(make-def-node "x" (make-prim "String") (make-lit "number" 42))] "externs" [] "requires" []}
   result (type-check! prog)]
  (= (get result "count") 0)))
  (expect! "check-program!: accepts well-typed" (let [prog (make-prog [(make-def-node "x" (make-prim "Int") (make-lit "number" 42))])]
  (= (count (check-program! prog)) 0)))
  (expect! "check-program!: reports errors" (let [prog (make-prog [(make-def-node "x" (make-prim "String") (make-lit "number" 42))])]
  (> (count (check-program! prog)) 0)))
  (expect! "E021: free dotted root rejected" (let [prog {"mode" "strict" "namespace" "t" "target" "nix" "externs" [] "requires" [] "forms" [{"node" "nix-fn-set" "rest" true "at-name" false "formals" [{"name" "config" "default" false}] "body" {"node" "ref" "name" "vendor.id"}}]}]
  (> (count (check-program! prog)) 0)))
  (expect! "E021: formal-rooted dotted accepted" (let [prog {"mode" "strict" "namespace" "t" "target" "nix" "externs" [] "requires" [] "forms" [{"node" "nix-fn-set" "rest" true "at-name" false "formals" [{"name" "config" "default" false}] "body" {"node" "ref" "name" "config.services.foo"}}]}]
  (= (count (check-program! prog)) 0)))
  (expect! "E021: qualified lib. dotted exempt" (let [prog {"mode" "strict" "namespace" "t" "target" "nix" "externs" [] "requires" [] "forms" [{"node" "nix-fn-set" "rest" true "at-name" false "formals" [] "body" {"node" "ref" "name" "lib.mkIf"}}]}]
  (= (count (check-program! prog)) 0)))
  (expect! "E021: builtins global root exempt" (let [prog {"mode" "strict" "namespace" "t" "target" "nix" "externs" [] "requires" [] "forms" [{"node" "nix-fn-set" "rest" true "at-name" false "formals" [] "body" {"node" "ref" "name" "builtins.length"}}]}]
  (= (count (check-program! prog)) 0)))
  (expect! "E021: nix/with body exempts free root" (let [prog {"mode" "strict" "namespace" "t" "target" "nix" "externs" [] "requires" [] "forms" [{"node" "nix-fn-set" "rest" true "at-name" false "formals" [{"name" "config" "default" false}] "body" {"node" "nix-with" "ns-expr" {"node" "ref" "name" "config.boot"} "body" {"node" "ref" "name" "framework.foo"}}}]}]
  (= (count (check-program! prog)) 0)))
  (expect! "E021: not fired on clj target" (let [prog {"mode" "strict" "namespace" "t" "target" "clj" "externs" [] "requires" [] "forms" [{"node" "def" "name" "x" "ann" nil "dynamic" false "value" {"node" "ref" "name" "vendor.id"}}]}]
  (= (count (check-program! prog)) 0)))
  (doseq [f (deref failures)]
  (selfhost.rt/eprint (str "  FAIL: " f "\n")))
  (println (str "  CHECK: " (count (deref passes)) " passed, " (count (deref failures)) " failed"))
  (count (deref failures)))
