haskell: module header + imports (+16 tests, 189/189)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-24 20:08:30 +00:00
parent defbe0a612
commit bf0d72fd2f
3 changed files with 497 additions and 10 deletions

View File

@@ -1421,13 +1421,238 @@
((hk-has-top-dcolon?) (hk-parse-type-sig)) ((hk-has-top-dcolon?) (hk-parse-type-sig))
(:else (hk-parse-fun-clause))))) (: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 (define
hk-parse-program hk-parse-ent-member
(fn (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 (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 (fn
() ()
(or (or
@@ -1436,11 +1661,11 @@
(hk-match? "vrbrace" nil) (hk-match? "vrbrace" nil)
(hk-match? "rbrace" nil)))) (hk-match? "rbrace" nil))))
(when (when
(not (hk-prog-at-end?)) (not (hk-body-at-end?))
(do (do
(append! decls (hk-parse-decl)) (append! decls (hk-parse-decl))
(define (define
hk-prog-loop hk-body-loop
(fn (fn
() ()
(when (when
@@ -1450,11 +1675,46 @@
(do (do
(hk-advance!) (hk-advance!)
(when (when
(not (hk-prog-at-end?)) (not (hk-body-at-end?))
(append! decls (hk-parse-decl))) (append! decls (hk-parse-decl)))
(hk-prog-loop))))) (hk-body-loop)))))
(hk-prog-loop))) (hk-body-loop)))
(list :program decls)))) (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 ─ ;; ── Top-level: strip leading/trailing module-level braces ─
(let (let

View File

@@ -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}

View File

@@ -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] 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] 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) - [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 - [ ] List comprehensions + operator sections
- [ ] AST design modelled on GHC's HsSyn at a surface level - [ ] 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) - [x] Unit tests in `lib/haskell/tests/parse.sx` (43 tokenizer tests, all green)
@@ -114,6 +114,31 @@ Key mappings:
_Newest first._ _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 - **2026-04-24** — Phase 1: guards + where clauses. Factored a single
`hk-parse-rhs sep` that all body-producing sites now share: it reads `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 a plain `sep expr` body or a chain of `| cond sep expr` guards, then