haskell: type error reporting — hk-expr->brief + hk-infer-decl/prog (+21 tests, 455/455)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/haskell/tests/infer.sx

@@ -66,4 +66,72 @@
 (hk-t "null []"             "Bool")
 (hk-t "head [1, 2, 3]"     "Int")
 
+;; ─── hk-expr->brief ──────────────────────────────────────────────────────────
+(hk-test "brief var"    (hk-expr->brief (list "var" "x"))           "x")
+(hk-test "brief con"    (hk-expr->brief (list "con" "Just"))        "Just")
+(hk-test "brief int"    (hk-expr->brief (list "int" 42))            "42")
+(hk-test "brief app"    (hk-expr->brief (list "app" (list "var" "f") (list "var" "x"))) "(f x)")
+(hk-test "brief op"     (hk-expr->brief (list "op" "+" (list "int" 1) (list "int" 2))) "(1 + 2)")
+(hk-test "brief lambda" (hk-expr->brief (list "lambda" (list) (list "var" "x"))) "(\\ ...)")
+(hk-test "brief loc"    (hk-expr->brief (list "loc" 3 7 (list "var" "x"))) "x")
+
+;; ─── Type error messages ─────────────────────────────────────────────────────
+;; Helper: catch the error and check it contains a substring.
+(define hk-str-has? (fn (s sub) (>= (index-of s sub) 0)))
+
+(define hk-te
+  (fn (label src sub)
+    (hk-test label
+      (guard (e (#t (hk-str-has? e sub)))
+        (begin (hk-infer-type src) false))
+      true)))
+
+;; Unbound variable error includes the variable name.
+(hk-te "error unbound name" "foo + 1"    "foo")
+(hk-te "error unbound unk"  "unknown"    "unknown")
+
+;; Unification error mentions the conflicting types.
+(hk-te "error unify int-bool-1" "1 + True"  "Int")
+(hk-te "error unify int-bool-2" "1 + True"  "Bool")
+
+;; ─── Loc node: passes through to inner (position decorates outer context) ────
+(define hk-loc-err-msg
+  (fn ()
+    (guard (e (#t e))
+      (begin
+        (hk-reset-fresh)
+        (hk-w (hk-type-env0) (list "loc" 5 10 (list "var" "mystery")))
+        "no-error"))))
+(hk-test "loc passes through to var error"
+  (hk-str-has? (hk-loc-err-msg) "mystery")
+  true)
+
+;; ─── hk-infer-decl ───────────────────────────────────────────────────────────
+;; Returns ("ok" name type) | ("err" msg)
+(define hk-env0-t (hk-type-env0))
+
+(define prog1 (hk-core "f x = x + 1"))
+(define decl1 (first (nth prog1 1)))
+(define res1 (hk-infer-decl hk-env0-t decl1))
+(hk-test "decl result tag"  (first res1)    "ok")
+(hk-test "decl result name" (nth res1 1)    "f")
+(hk-test "decl result type" (nth res1 2)    "Int -> Int")
+
+;; Error decl: result is ("err" "in 'g': ...")
+(define prog2 (hk-core "g x = x + True"))
+(define decl2 (first (nth prog2 1)))
+(define res2 (hk-infer-decl hk-env0-t decl2))
+(hk-test "decl error tag"    (first res2)                  "err")
+(hk-test "decl error has g"  (hk-str-has? (nth res2 1) "g")   true)
+(hk-test "decl error has msg" (hk-str-has? (nth res2 1) "unify") true)
+
+;; ─── hk-infer-prog ───────────────────────────────────────────────────────────
+;; Returns list of ("ok"/"err" ...) tagged results.
+(define prog3 (hk-core "double x = x + x\ntwice f x = f (f x)"))
+(define results3 (hk-infer-prog prog3 hk-env0-t))
+;; results3 = (("ok" "double" "Int -> Int") ("ok" "twice" "..."))
+(hk-test "infer-prog count"  (len results3)               2)
+(hk-test "infer-prog double" (nth (nth results3 0) 2)     "Int -> Int")
+(hk-test "infer-prog twice"  (nth (nth results3 1) 2)     "(t3 -> t3) -> t3 -> t3")
+
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}