haskell: module header + imports (+16 tests, 189/189)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -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
|
||||
|
||||
202
lib/haskell/tests/parser-module.sx
Normal file
202
lib/haskell/tests/parser-module.sx
Normal 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}
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user