From bf0d72fd2fcfea0f1a6ee48b25a707833d4655d8 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Fri, 24 Apr 2026 20:08:30 +0000
Subject: [PATCH] haskell: module header + imports (+16 tests, 189/189)

---
 lib/haskell/parser.sx              | 278 ++++++++++++++++++++++++++++-
 lib/haskell/tests/parser-module.sx | 202 +++++++++++++++++++++
 plans/haskell-on-sx.md             |  27 ++-
 3 files changed, 497 insertions(+), 10 deletions(-)
 create mode 100644 lib/haskell/tests/parser-module.sx

diff --git a/lib/haskell/parser.sx b/lib/haskell/parser.sx
index 07c8cc0b..fbbcb31f 100644
--- a/lib/haskell/parser.sx
+++ b/lib/haskell/parser.sx
@@ -1421,13 +1421,238 @@
             ((hk-has-top-dcolon?) (hk-parse-type-sig))
             (:else (hk-parse-fun-clause)))))
 
+      ;; ── Module header + imports ─────────────────────────────
+      ;; Import/export entity references:
+      ;;   (:ent-var NAME)        — bare var/type name (incl. (op) form)
+      ;;   (:ent-all NAME)        — Tycon(..)
+      ;;   (:ent-with NAME MEMS)  — Tycon(m1, m2, …)
+      ;;   (:ent-module NAME)     — module M (exports only)
+      ;; Member names inside Tycon(…) are bare strings.
+
       (define
-        hk-parse-program
+        hk-parse-ent-member
         (fn
           ()
-          (let ((decls (list)))
+          (cond
+            ((hk-match? "varid" nil)
+              (get (hk-advance!) "value"))
+            ((hk-match? "conid" nil)
+              (get (hk-advance!) "value"))
+            ((hk-match? "lparen" nil)
+              (do
+                (hk-advance!)
+                (let
+                  ((op-name
+                      (cond
+                        ((hk-match? "varsym" nil)
+                          (get (hk-advance!) "value"))
+                        ((hk-match? "consym" nil)
+                          (get (hk-advance!) "value"))
+                        ((and
+                            (hk-match? "reservedop" nil)
+                            (= (hk-peek-value) ":"))
+                          (do (hk-advance!) ":"))
+                        (:else
+                          (hk-err "expected operator in member list")))))
+                  (hk-expect! "rparen" nil)
+                  op-name)))
+            (:else (hk-err "expected identifier in member list")))))
+
+      (define
+        hk-parse-ent
+        (fn
+          (allow-module?)
+          (cond
+            ((hk-match? "varid" nil)
+              (list :ent-var (get (hk-advance!) "value")))
+            ((hk-match? "qvarid" nil)
+              (list :ent-var (get (hk-advance!) "value")))
+            ((and allow-module? (hk-match? "reserved" "module"))
+              (do
+                (hk-advance!)
+                (cond
+                  ((or
+                      (hk-match? "conid" nil)
+                      (hk-match? "qconid" nil))
+                    (list :ent-module (get (hk-advance!) "value")))
+                  (:else (hk-err "expected module name in export")))))
+            ((or (hk-match? "conid" nil) (hk-match? "qconid" nil))
+              (let ((name (get (hk-advance!) "value")))
+                (cond
+                  ((hk-match? "lparen" nil)
+                    (do
+                      (hk-advance!)
+                      (cond
+                        ((hk-match? "reservedop" "..")
+                          (do
+                            (hk-advance!)
+                            (hk-expect! "rparen" nil)
+                            (list :ent-all name)))
+                        ((hk-match? "rparen" nil)
+                          (do
+                            (hk-advance!)
+                            (list :ent-with name (list))))
+                        (:else
+                          (let ((mems (list)))
+                            (append! mems (hk-parse-ent-member))
+                            (define
+                              hk-mem-loop
+                              (fn
+                                ()
+                                (when
+                                  (hk-match? "comma" nil)
+                                  (do
+                                    (hk-advance!)
+                                    (when
+                                      (not (hk-match? "rparen" nil))
+                                      (append!
+                                        mems
+                                        (hk-parse-ent-member)))
+                                    (hk-mem-loop)))))
+                            (hk-mem-loop)
+                            (hk-expect! "rparen" nil)
+                            (list :ent-with name mems))))))
+                  (:else (list :ent-var name)))))
+            ((hk-match? "lparen" nil)
+              (do
+                (hk-advance!)
+                (let
+                  ((op-name
+                      (cond
+                        ((hk-match? "varsym" nil)
+                          (get (hk-advance!) "value"))
+                        ((hk-match? "consym" nil)
+                          (get (hk-advance!) "value"))
+                        ((and
+                            (hk-match? "reservedop" nil)
+                            (= (hk-peek-value) ":"))
+                          (do (hk-advance!) ":"))
+                        (:else
+                          (hk-err "expected operator in parens")))))
+                  (hk-expect! "rparen" nil)
+                  (list :ent-var op-name))))
+            (:else (hk-err "expected entity in import/export list")))))
+
+      (define
+        hk-parse-ent-list
+        (fn
+          (allow-module?)
+          (hk-expect! "lparen" nil)
+          (cond
+            ((hk-match? "rparen" nil)
+              (do (hk-advance!) (list)))
+            (:else
+              (let ((items (list)))
+                (append! items (hk-parse-ent allow-module?))
+                (define
+                  hk-el-loop
+                  (fn
+                    ()
+                    (when
+                      (hk-match? "comma" nil)
+                      (do
+                        (hk-advance!)
+                        (when
+                          (not (hk-match? "rparen" nil))
+                          (append!
+                            items
+                            (hk-parse-ent allow-module?)))
+                        (hk-el-loop)))))
+                (hk-el-loop)
+                (hk-expect! "rparen" nil)
+                items)))))
+
+      ;; (:import QUALIFIED NAME AS SPEC)
+      ;;   QUALIFIED: bool
+      ;;   NAME     : module name string (may contain dots)
+      ;;   AS       : alias module name string or nil
+      ;;   SPEC     : nil | (:spec-items ENTS) | (:spec-hiding ENTS)
+      (define
+        hk-parse-import
+        (fn
+          ()
+          (hk-expect! "reserved" "import")
+          (let
+            ((qualified false)
+              (modname nil)
+              (as-name nil)
+              (spec nil))
+            (when
+              (hk-match? "varid" "qualified")
+              (do (hk-advance!) (set! qualified true)))
+            (cond
+              ((or
+                  (hk-match? "conid" nil)
+                  (hk-match? "qconid" nil))
+                (set! modname (get (hk-advance!) "value")))
+              (:else (hk-err "expected module name in import")))
+            (when
+              (hk-match? "varid" "as")
+              (do
+                (hk-advance!)
+                (cond
+                  ((or
+                      (hk-match? "conid" nil)
+                      (hk-match? "qconid" nil))
+                    (set! as-name (get (hk-advance!) "value")))
+                  (:else (hk-err "expected name after 'as'")))))
+            (cond
+              ((hk-match? "varid" "hiding")
+                (do
+                  (hk-advance!)
+                  (set!
+                    spec
+                    (list :spec-hiding (hk-parse-ent-list false)))))
+              ((hk-match? "lparen" nil)
+                (set!
+                  spec
+                  (list :spec-items (hk-parse-ent-list false)))))
+            (list :import qualified modname as-name spec))))
+
+      ;; (:module NAME EXPORTS IMPORTS DECLS)
+      ;;   NAME    : module name string or nil (no header)
+      ;;   EXPORTS : list of ent-refs, or nil (no export list)
+      ;;   IMPORTS : list of :import records
+      ;;   DECLS   : list of top-level decls
+      (define
+        hk-parse-module-header
+        (fn
+          ()
+          (hk-expect! "reserved" "module")
+          (let ((modname nil) (exports nil))
+            (cond
+              ((or
+                  (hk-match? "conid" nil)
+                  (hk-match? "qconid" nil))
+                (set! modname (get (hk-advance!) "value")))
+              (:else (hk-err "expected module name")))
+            (when
+              (hk-match? "lparen" nil)
+              (set! exports (hk-parse-ent-list true)))
+            (hk-expect! "reserved" "where")
+            (list modname exports))))
+
+      (define
+        hk-collect-module-body
+        (fn
+          ()
+          (let ((imports (list)) (decls (list)))
             (define
-              hk-prog-at-end?
+              hk-imp-loop
+              (fn
+                ()
+                (when
+                  (hk-match? "reserved" "import")
+                  (do
+                    (append! imports (hk-parse-import))
+                    (when
+                      (or
+                        (hk-match? "vsemi" nil)
+                        (hk-match? "semi" nil))
+                      (do (hk-advance!) (hk-imp-loop)))))))
+            (hk-imp-loop)
+            (define
+              hk-body-at-end?
               (fn
                 ()
                 (or
@@ -1436,11 +1661,11 @@
                   (hk-match? "vrbrace" nil)
                   (hk-match? "rbrace" nil))))
             (when
-              (not (hk-prog-at-end?))
+              (not (hk-body-at-end?))
               (do
                 (append! decls (hk-parse-decl))
                 (define
-                  hk-prog-loop
+                  hk-body-loop
                   (fn
                     ()
                     (when
@@ -1450,11 +1675,46 @@
                       (do
                         (hk-advance!)
                         (when
-                          (not (hk-prog-at-end?))
+                          (not (hk-body-at-end?))
                           (append! decls (hk-parse-decl)))
-                        (hk-prog-loop)))))
-                (hk-prog-loop)))
-            (list :program decls))))
+                        (hk-body-loop)))))
+                (hk-body-loop)))
+            (list imports decls))))
+
+      (define
+        hk-parse-program
+        (fn
+          ()
+          (cond
+            ((hk-match? "reserved" "module")
+              (let ((header (hk-parse-module-header)))
+                (let ((explicit (hk-match? "lbrace" nil)))
+                  (if
+                    explicit
+                    (hk-advance!)
+                    (hk-expect! "vlbrace" nil))
+                  (let ((body (hk-collect-module-body)))
+                    (if
+                      explicit
+                      (hk-expect! "rbrace" nil)
+                      (hk-expect! "vrbrace" nil))
+                    (list
+                      :module
+                      (nth header 0)
+                      (nth header 1)
+                      (nth body 0)
+                      (nth body 1))))))
+            (:else
+              (let ((body (hk-collect-module-body)))
+                (if
+                  (empty? (nth body 0))
+                  (list :program (nth body 1))
+                  (list
+                    :module
+                    nil
+                    nil
+                    (nth body 0)
+                    (nth body 1))))))))
 
       ;; ── Top-level: strip leading/trailing module-level braces ─
       (let
diff --git a/lib/haskell/tests/parser-module.sx b/lib/haskell/tests/parser-module.sx
new file mode 100644
index 00000000..6f683d26
--- /dev/null
+++ b/lib/haskell/tests/parser-module.sx
@@ -0,0 +1,202 @@
+;; Module header + imports. The parser switches from (:program DECLS)
+;; to (:module NAME EXPORTS IMPORTS DECLS) as soon as a module header
+;; or any `import` decl appears.
+
+;; ── Module header ──
+(hk-test
+  "simple module, no exports"
+  (hk-parse-top "module M where\n  f = 1")
+  (list
+    :module
+    "M"
+    nil
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module with dotted name"
+  (hk-parse-top "module Data.Map where\nf = 1")
+  (list
+    :module
+    "Data.Map"
+    nil
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module with empty export list"
+  (hk-parse-top "module M () where\nf = 1")
+  (list
+    :module
+    "M"
+    (list)
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module with exports (var, tycon-all, tycon-with)"
+  (hk-parse-top "module M (f, g, Maybe(..), List(Cons, Nil)) where\nf = 1\ng = 2")
+  (list
+    :module
+    "M"
+    (list
+      (list :ent-var "f")
+      (list :ent-var "g")
+      (list :ent-all "Maybe")
+      (list :ent-with "List" (list "Cons" "Nil")))
+    (list)
+    (list
+      (list :fun-clause "f" (list) (list :int 1))
+      (list :fun-clause "g" (list) (list :int 2)))))
+
+(hk-test
+  "module export list including another module"
+  (hk-parse-top "module M (module Foo, f) where\nf = 1")
+  (list
+    :module
+    "M"
+    (list (list :ent-module "Foo") (list :ent-var "f"))
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module export with operator"
+  (hk-parse-top "module M ((+:), f) where\nf = 1")
+  (list
+    :module
+    "M"
+    (list (list :ent-var "+:") (list :ent-var "f"))
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "empty module body"
+  (hk-parse-top "module M where")
+  (list :module "M" nil (list) (list)))
+
+;; ── Imports ──
+(hk-test
+  "plain import"
+  (hk-parse-top "import Foo")
+  (list
+    :module
+    nil
+    nil
+    (list (list :import false "Foo" nil nil))
+    (list)))
+
+(hk-test
+  "qualified import"
+  (hk-parse-top "import qualified Data.Map")
+  (list
+    :module
+    nil
+    nil
+    (list (list :import true "Data.Map" nil nil))
+    (list)))
+
+(hk-test
+  "import with alias"
+  (hk-parse-top "import Data.Map as M")
+  (list
+    :module
+    nil
+    nil
+    (list (list :import false "Data.Map" "M" nil))
+    (list)))
+
+(hk-test
+  "import with explicit list"
+  (hk-parse-top "import Foo (bar, Baz(..), Quux(X, Y))")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list
+        :import
+        false
+        "Foo"
+        nil
+        (list
+          :spec-items
+          (list
+            (list :ent-var "bar")
+            (list :ent-all "Baz")
+            (list :ent-with "Quux" (list "X" "Y"))))))
+    (list)))
+
+(hk-test
+  "import hiding"
+  (hk-parse-top "import Foo hiding (x, y)")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list
+        :import
+        false
+        "Foo"
+        nil
+        (list
+          :spec-hiding
+          (list (list :ent-var "x") (list :ent-var "y")))))
+    (list)))
+
+(hk-test
+  "qualified + alias + hiding"
+  (hk-parse-top "import qualified Data.List as L hiding (sort)")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list
+        :import
+        true
+        "Data.List"
+        "L"
+        (list :spec-hiding (list (list :ent-var "sort")))))
+    (list)))
+
+;; ── Combinations ──
+(hk-test
+  "module with multiple imports and a decl"
+  (hk-parse-top "module M where\nimport Foo\nimport qualified Bar as B\nf = 1")
+  (list
+    :module
+    "M"
+    nil
+    (list
+      (list :import false "Foo" nil nil)
+      (list :import true "Bar" "B" nil))
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "headerless file with imports"
+  (hk-parse-top "import Foo\nimport Bar (baz)\nf = 1")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list :import false "Foo" nil nil)
+      (list
+        :import
+        false
+        "Bar"
+        nil
+        (list :spec-items (list (list :ent-var "baz")))))
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "plain program (no header, no imports) still uses :program"
+  (hk-parse-top "f = 1\ng = 2")
+  (list
+    :program
+    (list
+      (list :fun-clause "f" (list) (list :int 1))
+      (list :fun-clause "g" (list) (list :int 2)))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
diff --git a/plans/haskell-on-sx.md b/plans/haskell-on-sx.md
index ae1e59eb..9f611647 100644
--- a/plans/haskell-on-sx.md
+++ b/plans/haskell-on-sx.md
@@ -62,7 +62,7 @@ Key mappings:
   - [x] Patterns — full: `as` patterns, nested, negative literal, `~` lazy, infix constructor (`:` / consym), extend lambdas/let with non-var patterns
   - [x] Top-level decls: function clauses (simple — no guards/where yet), pattern bindings, multi-name type signatures, `data` with type vars and recursive constructors, `type` synonyms, `newtype`, fixity (`infix`/`infixl`/`infixr` with optional precedence, comma-separated ops, backtick names). Types: vars / constructors / application / `->` (right-assoc) / tuples / lists. `hk-parse-top` entry.
   - [x] `where` clauses + guards (on fun-clauses, case alts, and let/do-let bindings — with the let funclause shorthand `let f x = …` now supported)
-  - [ ] Module header + imports (stub)
+  - [x] Module header + imports — `module NAME [exports] where …`, qualified/as/hiding/explicit imports, operator exports, `module Foo` exports, dotted names, headerless-with-imports
   - [ ] List comprehensions + operator sections
 - [ ] AST design modelled on GHC's HsSyn at a surface level
 - [x] Unit tests in `lib/haskell/tests/parse.sx` (43 tokenizer tests, all green)
@@ -114,6 +114,31 @@ Key mappings:
 
 _Newest first._
 
+- **2026-04-24** — Phase 1: module header + imports. Added
+  `hk-parse-module-header`, `hk-parse-import`, plus shared helpers for
+  import/export entity lists (`hk-parse-ent`, `hk-parse-ent-member`,
+  `hk-parse-ent-list`). New AST:
+  - `(:module NAME EXPORTS IMPORTS DECLS)` — NAME `nil` means no header,
+    EXPORTS `nil` means no export list (distinct from empty `()`)
+  - `(:import QUALIFIED NAME AS SPEC)` — QUALIFIED bool, AS alias or nil,
+    SPEC nil / `(:spec-items ENTS)` / `(:spec-hiding ENTS)`
+  - Entity refs: `:ent-var`, `:ent-all` (`Tycon(..)`), `:ent-with`
+    (`Tycon(m1, m2, …)`), `:ent-module` (exports only).
+  `hk-parse-program` now dispatches on the leading token: `module`
+  keyword → full header-plus-body parse (consuming the `where` layout
+  brace around the module body); otherwise collect any leading
+  `import` decls and then remaining decls with the existing logic.
+  The outer shell is `(:module …)` as soon as any header or import is
+  present, and stays as `(:program DECLS)` otherwise — preserving every
+  previous test expectation untouched. Handles operator exports `((+:))`,
+  dotted module names (`Data.Map`), and the Haskell-98 context-sensitive
+  keywords `qualified`/`as`/`hiding` (all lexed as ordinary varids and
+  matched only in import position). 16 new tests in
+  `lib/haskell/tests/parser-module.sx` covering simple/exports/empty
+  headers, dotted names, operator exports, `module Foo` exports,
+  qualified/aliased/items/hiding imports, and a headerless-with-imports
+  file. 189/189 green.
+
 - **2026-04-24** — Phase 1: guards + where clauses. Factored a single
   `hk-parse-rhs sep` that all body-producing sites now share: it reads
   a plain `sep expr` body or a chain of `| cond sep expr` guards, then