haskell: type-sig checking — hk-ast-type + hk-check-sig + sig-aware infer-prog (+6 tests, 470/470)

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

lib/haskell/infer.sx

@@ -560,13 +560,76 @@
 
 ;; hk-infer-prog : program-ast × env → list of ("ok" name type) | ("err" msg)
 
+(define
+  hk-ast-type
+  (fn
+    (ast)
+    (let
+      ((tag (first ast)))
+      (cond
+        ((= tag "t-con") (list "TCon" (nth ast 1)))
+        ((= tag "t-var") (list "TVar" (nth ast 1)))
+        ((= tag "t-fun")
+          (list "TArr" (hk-ast-type (nth ast 1)) (hk-ast-type (nth ast 2))))
+        ((= tag "t-app")
+          (list "TApp" (hk-ast-type (nth ast 1)) (hk-ast-type (nth ast 2))))
+        ((= tag "t-list")
+          (list "TApp" (list "TCon" "[]") (hk-ast-type (nth ast 1))))
+        ((= tag "t-tuple") (list "TTuple" (map hk-ast-type (nth ast 1))))
+        (:else (raise (str "unknown type node: " (first ast))))))))
+
+;; ─── Convenience ─────────────────────────────────────────────────────────────
+;; hk-infer-type : Haskell expression source → inferred type string
+
+(define
+  hk-collect-tvars
+  (fn
+    (t acc)
+    (cond
+      ((= (first t) "TVar")
+        (if
+          (some (fn (v) (= v (nth t 1))) acc)
+          acc
+          (begin (append! acc (nth t 1)) acc)))
+      ((= (first t) "TArr")
+        (hk-collect-tvars (nth t 2) (hk-collect-tvars (nth t 1) acc)))
+      ((= (first t) "TApp")
+        (hk-collect-tvars (nth t 2) (hk-collect-tvars (nth t 1) acc)))
+      ((= (first t) "TTuple")
+        (reduce (fn (a elem) (hk-collect-tvars elem a)) acc (nth t 1)))
+      (:else acc))))
+
+(define
+  hk-check-sig
+  (fn
+    (declared-ast inferred-type)
+    (let
+      ((declared (hk-ast-type declared-ast)))
+      (let
+        ((tvars (hk-collect-tvars declared (list))))
+        (let
+          ((scheme (if (empty? tvars) declared (list "TScheme" tvars declared))))
+          (let
+            ((inst (hk-instantiate scheme)))
+            (hk-unify inst inferred-type)))))))
+
 (define
   hk-infer-prog
   (fn
     (prog env)
     (let
       ((decls (cond ((and (list? prog) (= (first prog) "program")) (nth prog 1)) ((and (list? prog) (= (first prog) "module")) (nth prog 3)) (:else (list))))
-        (results (list)))
+        (results (list))
+        (sigs (dict)))
+      (for-each
+        (fn
+          (d)
+          (when
+            (= (first d) "type-sig")
+            (let
+              ((names (nth d 1)) (type-ast (nth d 2)))
+              (for-each (fn (n) (dict-set! sigs n type-ast)) names))))
+        decls)
       (for-each
         (fn
           (d)
@@ -574,22 +637,22 @@
             ((r (hk-infer-decl env d)))
             (when
               (not (nil? r))
-              (append! results r)
+              (let
-              (when
+                ((checked (if (and (= (first r) "ok") (has-key? sigs (nth r 1))) (guard (e (true (list "err" (str "in '" (nth r 1) "': declared type mismatch: " e)))) (begin (hk-check-sig (get sigs (nth r 1)) (nth r 3)) r)) r)))
-                (= (first r) "ok")
+                (append! results checked)
-                (dict-set! env (nth r 1) (nth r 3))))))
+                (when
+                  (= (first checked) "ok")
+                  (dict-set! env (nth checked 1) (nth checked 3)))))))
         decls)
       results)))
 
-;; ─── Convenience ─────────────────────────────────────────────────────────────
-;; hk-infer-type : Haskell expression source → inferred type string
-
 (define
   hk-infer-type
   (fn
     (src)
     (hk-reset-fresh)
-    (let ((ast (hk-core-expr src))
+    (let
-          (env (hk-type-env0)))
+      ((ast (hk-core-expr src)) (env (hk-type-env0)))
-      (let ((r (hk-w env ast)))
+      (let
+        ((r (hk-w env ast)))
         (hk-type->str (hk-subst-apply (first r) (nth r 1)))))))

lib/haskell/tests/typecheck.sx

@@ -41,4 +41,42 @@
 ;; Function body type error: applying non-function.
 (hk-tc-err "reject: apply non-function" "f x = 1 x" "Int")
 
+(define prog-sig1 (hk-core "f :: Int -> Int\nf x = x + 1"))
+
+(define prog-sig2 (hk-core "f :: Bool -> Bool\nf x = x + 1"))
+
+(define prog-sig3 (hk-core "id :: a -> a\nid x = x"))
+
+(hk-test
+  "sig ok: Int->Int accepted"
+  (first (nth (hk-infer-prog prog-sig1 (hk-type-env0)) 0))
+  "ok")
+
+(hk-test
+  "sig fail: Bool->Bool rejected"
+  (first (nth (hk-infer-prog prog-sig2 (hk-type-env0)) 0))
+  "err")
+
+(hk-test
+  "sig fail: error mentions mismatch"
+  (hk-str-has?
+    (nth (nth (hk-infer-prog prog-sig2 (hk-type-env0)) 0) 1)
+    "mismatch")
+  true)
+
+(hk-test
+  "sig ok: polymorphic a->a accepted"
+  (first (nth (hk-infer-prog prog-sig3 (hk-type-env0)) 0))
+  "ok")
+
+(hk-tc-err
+  "run-typed sig fail: Bool declared, Int inferred"
+  "main :: Bool\nmain = 1 + 2"
+  "mismatch")
+
+(hk-test
+  "run-typed sig ok: Int declared matches"
+  (hk-run-typed "main :: Int\nmain = 1 + 2")
+  3)
+
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

plans/haskell-on-sx.md

@@ -94,7 +94,7 @@ Key mappings:
 - [x] Algorithm W: unification + type schemes + generalisation + instantiation
 - [x] Report type errors with meaningful positions
 - [x] Reject untypeable programs that phase 3 was accepting
-- [ ] Type-sig checking: user writes `f :: Int -> Int`; verify
+- [x] Type-sig checking: user writes `f :: Int -> Int`; verify
 - [ ] Let-polymorphism
 - [ ] Unit tests: inference for 50+ expressions
 
@@ -114,6 +114,17 @@ Key mappings:
 
 _Newest first._
 
+- **2026-05-05** — Phase 4 type-sig checking. `hk-ast-type` converts parsed type
+  AST nodes (`t-con`/`t-var`/`t-fun`/`t-app`/`t-list`/`t-tuple`) to internal
+  type values. `hk-collect-tvars` gathers free type variable names. `hk-check-sig`
+  wraps declared type in a scheme (if polymorphic), instantiates with fresh vars,
+  and unifies against the inferred type. `hk-infer-prog` updated: first pass
+  collects `type-sig` declarations into a `sigs` dict; second pass checks each
+  successful fun-clause inference against its declared sig, returning
+  `("err" "... declared type mismatch: ...")` on mismatch. 6 new tests in
+  `typecheck.sx` cover monomorphic sig match, sig mismatch (error message),
+  polymorphic `a->a` sig, and `hk-run-typed` with and without sig. 470/470 green.
+
 - **2026-05-05** — Phase 4 reject untypeable programs. `hk-typecheck` runs
   `hk-infer-prog` on a program AST and raises the first type error found.
   `hk-run-typed` is a drop-in for `hk-run` that gates evaluation on a