;; Haskell 98 expression parser.
;;
;; Input: the post-layout token list from (hk-layout (hk-tokenize src)).
;; Output: an AST. Nodes are plain lists tagged by a keyword head
;; (keywords evaluate to their string name, so `(list :var "x")` is
;; indistinguishable from `(list "var" "x")` at runtime — this lets
;; tests literally write `(list :var "x")` on both sides).
;;
;; Scope (this iteration — expressions only):
;;   atoms         int/float/string/char/var/con, parens, tuple, list, range
;;   application   left-associative, f x y z
;;   prefix -      unary negation on an lexp
;;   infix ops     precedence-climbing, full Haskell 98 default table
;;   lambda        \x y -> body
;;   if            if c then t else e
;;   let           let { x = e ; y = e } in body   (uses layout braces)
;;
;; AST shapes:
;;   (:int N)
;;   (:float F)
;;   (:string S)
;;   (:char C)
;;   (:var NAME)
;;   (:con NAME)
;;   (:app FN ARG)                 — binary, chain for multi-arg
;;   (:op OP LHS RHS)              — binary infix
;;   (:neg E)
;;   (:tuple ITEMS)                — ITEMS is a list of AST nodes
;;   (:list ITEMS)                 — enumerated list
;;   (:range FROM TO)              — [from..to]
;;   (:range-step FROM NEXT TO)    — [from,next..to]
;;   (:if C T E)
;;   (:lambda PARAMS BODY)         — PARAMS is list of varids
;;   (:let BINDS BODY)             — BINDS is list of (:bind NAME EXPR)

;; ── Operator precedence table (Haskell 98 defaults) ──────────────
(define
  hk-op-prec-table
  (let
    ((t (dict)))
    (dict-set! t "!!" {:prec 9 :assoc "left"})
    (dict-set! t "." {:prec 9 :assoc "right"})
    (dict-set! t "^" {:prec 8 :assoc "right"})
    (dict-set! t "^^" {:prec 8 :assoc "right"})
    (dict-set! t "**" {:prec 8 :assoc "right"})
    (dict-set! t "*" {:prec 7 :assoc "left"})
    (dict-set! t "/" {:prec 7 :assoc "left"})
    (dict-set! t "+" {:prec 6 :assoc "left"})
    (dict-set! t "-" {:prec 6 :assoc "left"})
    (dict-set! t ":" {:prec 5 :assoc "right"})
    (dict-set! t "++" {:prec 5 :assoc "right"})
    (dict-set! t "==" {:prec 4 :assoc "non"})
    (dict-set! t "/=" {:prec 4 :assoc "non"})
    (dict-set! t "<" {:prec 4 :assoc "non"})
    (dict-set! t "<=" {:prec 4 :assoc "non"})
    (dict-set! t ">" {:prec 4 :assoc "non"})
    (dict-set! t ">=" {:prec 4 :assoc "non"})
    (dict-set! t "&&" {:prec 3 :assoc "right"})
    (dict-set! t "||" {:prec 2 :assoc "right"})
    (dict-set! t ">>" {:prec 1 :assoc "left"})
    (dict-set! t ">>=" {:prec 1 :assoc "left"})
    (dict-set! t "=<<" {:prec 1 :assoc "right"})
    (dict-set! t "$" {:prec 0 :assoc "right"})
    (dict-set! t "$!" {:prec 0 :assoc "right"})
    t))

(define
  hk-op-info
  (fn
    (op)
    (if
      (has-key? hk-op-prec-table op)
      (get hk-op-prec-table op)
      {:prec 9 :assoc "left"})))

;; ── Atom-start predicate ─────────────────────────────────────────
(define
  hk-atom-start?
  (fn
    (tok)
    (if
      (nil? tok)
      false
      (let
        ((ty (get tok "type")))
        (or
          (= ty "integer")
          (= ty "float")
          (= ty "string")
          (= ty "char")
          (= ty "varid")
          (= ty "conid")
          (= ty "qvarid")
          (= ty "qconid")
          (= ty "lparen")
          (= ty "lbracket"))))))

;; apat-start? — what can begin an atomic pattern
(define
  hk-apat-start?
  (fn
    (tok)
    (if
      (nil? tok)
      false
      (let
        ((ty (get tok "type")) (val (get tok "value")))
        (or
          (and (= ty "reserved") (= val "_"))
          (= ty "integer")
          (= ty "float")
          (= ty "string")
          (= ty "char")
          (= ty "varid")
          (= ty "conid")
          (= ty "qconid")
          (= ty "lparen")
          (= ty "lbracket")
          (and (= ty "varsym") (= val "-"))
          (and (= ty "reservedop") (= val "~")))))))

;; ── Atype-start predicate (types) ───────────────────────────────
(define
  hk-atype-start?
  (fn
    (tok)
    (if
      (nil? tok)
      false
      (let
        ((ty (get tok "type")))
        (or
          (= ty "conid")
          (= ty "qconid")
          (= ty "varid")
          (= ty "lparen")
          (= ty "lbracket"))))))

;; ── Main entry ───────────────────────────────────────────────────
(define
  hk-parser
  (fn
    (tokens mode)
    (let
      ((toks tokens) (pos 0) (n (len tokens)))

      (define hk-peek (fn () (if (< pos n) (nth toks pos) nil)))
      (define
        hk-peek-at
        (fn
          (offset)
          (if (< (+ pos offset) n) (nth toks (+ pos offset)) nil)))
      (define
        hk-advance!
        (fn () (let ((t (hk-peek))) (set! pos (+ pos 1)) t)))
      (define
        hk-peek-type
        (fn () (let ((t (hk-peek))) (if (nil? t) "<eof>" (get t "type")))))
      (define
        hk-peek-value
        (fn () (let ((t (hk-peek))) (if (nil? t) nil (get t "value")))))
      (define
        hk-match?
        (fn
          (ty v)
          (let
            ((t (hk-peek)))
            (and
              (not (nil? t))
              (= (get t "type") ty)
              (or (nil? v) (= (get t "value") v))))))
      (define
        hk-err
        (fn
          (msg)
          (raise
            (str
              "parse error: "
              msg
              " (at "
              (hk-peek-type)
              (if (nil? (hk-peek-value)) "" (str " " (hk-peek-value)))
              ")"))))
      (define
        hk-expect!
        (fn
          (ty v)
          (if
            (hk-match? ty v)
            (hk-advance!)
            (hk-err
              (str "expected " ty (if (nil? v) "" (str " '" v "'")))))))

      ;; ── Atoms ────────────────────────────────────────────────
      (define
        hk-parse-aexp
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((nil? t) (hk-err "unexpected end of input"))
              ((= (get t "type") "integer")
                (do (hk-advance!) (list :int (get t "value"))))
              ((= (get t "type") "float")
                (do (hk-advance!) (list :float (get t "value"))))
              ((= (get t "type") "string")
                (do (hk-advance!) (list :string (get t "value"))))
              ((= (get t "type") "char")
                (do (hk-advance!) (list :char (get t "value"))))
              ((= (get t "type") "varid")
                (do (hk-advance!) (list :var (get t "value"))))
              ((= (get t "type") "conid")
                (do (hk-advance!) (list :con (get t "value"))))
              ((= (get t "type") "qvarid")
                (do (hk-advance!) (list :var (get t "value"))))
              ((= (get t "type") "qconid")
                (do (hk-advance!) (list :con (get t "value"))))
              ((= (get t "type") "lparen") (hk-parse-parens))
              ((= (get t "type") "lbracket") (hk-parse-list-lit))
              (:else (hk-err "unexpected token in expression"))))))

      ;; Returns {:name N :len L} if the current token begins an
      ;; infix operator (varsym / consym / reservedop ":" / backtick),
      ;; else nil. `len` is the number of tokens the operator occupies.
      (define
        hk-section-op-info
        (fn
          ()
          (let ((t (hk-peek)))
            (cond
              ((nil? t) nil)
              ((= (get t "type") "varsym")
                {:name (get t "value") :len 1})
              ((= (get t "type") "consym")
                {:name (get t "value") :len 1})
              ((and
                  (= (get t "type") "reservedop")
                  (= (get t "value") ":"))
                {:name ":" :len 1})
              ((= (get t "type") "backtick")
                (let ((varid-t (hk-peek-at 1)))
                  (cond
                    ((and
                        (not (nil? varid-t))
                        (= (get varid-t "type") "varid"))
                      {:name (get varid-t "value") :len 3})
                    (:else nil))))
              (:else nil)))))

      ;; ── Parens / tuple / unit / operator sections ───────────
      ;; Forms recognised inside parens:
      ;;   ()           → unit               : (:con "()")
      ;;   (op)         → operator reference : (:var OP)
      ;;   (op e)       → right section      : (:sect-right OP E)  (op ≠ "-")
      ;;   (e)          → plain parens       : unwrapped E
      ;;   (e1, … , en) → tuple              : (:tuple ITEMS)
      ;;   (e op)       → left section       : (:sect-left  OP E)
      ;; `-` is excluded from right sections because `-e` always means
      ;; `negate e`; `(-)` is still a valid operator reference.
      (define
        hk-parse-parens
        (fn
          ()
          (hk-expect! "lparen" nil)
          (cond
            ((hk-match? "rparen" nil)
              (do (hk-advance!) (list :con "()")))
            (:else
              (let ((op-info (hk-section-op-info)))
                (cond
                  ;; Operator reference / right section
                  ((and
                      (not (nil? op-info))
                      (let
                        ((after
                            (hk-peek-at (get op-info "len"))))
                        (or
                          (and
                            (not (nil? after))
                            (= (get after "type") "rparen"))
                          (not (= (get op-info "name") "-")))))
                    (let
                      ((op-name (get op-info "name"))
                        (op-len (get op-info "len"))
                        (after
                          (hk-peek-at (get op-info "len"))))
                      (hk-consume-op!)
                      (cond
                        ((and
                            (not (nil? after))
                            (= (get after "type") "rparen"))
                          (do (hk-advance!) (list :var op-name)))
                        (:else
                          (let ((expr-e (hk-parse-expr-inner)))
                            (hk-expect! "rparen" nil)
                            (list :sect-right op-name expr-e))))))
                  (:else
                    (let
                      ((first-e (hk-parse-expr-inner))
                        (items (list))
                        (is-tuple false))
                      (append! items first-e)
                      (define
                        hk-tup-loop
                        (fn
                          ()
                          (when
                            (hk-match? "comma" nil)
                            (do
                              (hk-advance!)
                              (set! is-tuple true)
                              (append! items (hk-parse-expr-inner))
                              (hk-tup-loop)))))
                      (hk-tup-loop)
                      (cond
                        ((hk-match? "rparen" nil)
                          (do
                            (hk-advance!)
                            (if
                              is-tuple
                              (list :tuple items)
                              first-e)))
                        (:else
                          (let
                            ((op-info2 (hk-section-op-info)))
                            (cond
                              ((and
                                  (not (nil? op-info2))
                                  (not is-tuple)
                                  (let
                                    ((after2
                                        (hk-peek-at
                                          (get op-info2 "len"))))
                                    (and
                                      (not (nil? after2))
                                      (= (get after2 "type") "rparen"))))
                                (let
                                  ((op-name (get op-info2 "name")))
                                  (hk-consume-op!)
                                  (hk-advance!)
                                  (list :sect-left op-name first-e)))
                              (:else
                                (hk-err
                                  "expected ')' after expression"))))))))))))))

      ;; ── List comprehension qualifiers ──────────────────────
      ;; (:list-comp E QUALS) where each qualifier is one of:
      ;;   (:q-gen PAT E)    — `pat <- expr`
      ;;   (:q-guard E)      — bare boolean expression
      ;;   (:q-let DECLS)    — `let decls`
      (define
        hk-comp-qual-is-gen?
        (fn
          ()
          (let
            ((j pos) (depth 0) (found false) (done false))
            (define
              hk-qsc-loop
              (fn
                ()
                (when
                  (and (not done) (< j n))
                  (let
                    ((t (nth toks j)) (ty (get t "type")))
                    (cond
                      ((and
                          (= depth 0)
                          (or
                            (= ty "comma")
                            (= ty "rbracket")))
                        (set! done true))
                      ((and
                          (= depth 0)
                          (= ty "reservedop")
                          (= (get t "value") "<-"))
                        (do (set! found true) (set! done true)))
                      ((or
                          (= ty "lparen")
                          (= ty "lbracket")
                          (= ty "lbrace")
                          (= ty "vlbrace"))
                        (set! depth (+ depth 1)))
                      ((or
                          (= ty "rparen")
                          (= ty "rbrace")
                          (= ty "vrbrace"))
                        (set! depth (- depth 1)))
                      (:else nil))
                    (set! j (+ j 1))
                    (hk-qsc-loop)))))
            (hk-qsc-loop)
            found)))

      (define
        hk-parse-comp-let
        (fn
          ()
          (hk-expect! "reserved" "let")
          (let ((explicit (hk-match? "lbrace" nil)))
            (if
              explicit
              (hk-advance!)
              (hk-expect! "vlbrace" nil))
            (let
              ((binds (list)))
              (when
                (not
                  (if
                    explicit
                    (hk-match? "rbrace" nil)
                    (hk-match? "vrbrace" nil)))
                (do
                  (append! binds (hk-parse-bind))
                  (define
                    hk-cl-loop
                    (fn
                      ()
                      (when
                        (or
                          (hk-match? "semi" nil)
                          (hk-match? "vsemi" nil))
                        (do
                          (hk-advance!)
                          (when
                            (not
                              (if
                                explicit
                                (hk-match? "rbrace" nil)
                                (hk-match? "vrbrace" nil)))
                            (append! binds (hk-parse-bind)))
                          (hk-cl-loop)))))
                  (hk-cl-loop)))
              (cond
                (explicit (hk-expect! "rbrace" nil))
                ((hk-match? "vrbrace" nil) (hk-advance!))
                ;; In a single-line comprehension, `]` or `,`
                ;; terminates the qualifier before layout's implicit
                ;; vrbrace arrives — leave them for the outer parser.
                ((or
                    (hk-match? "rbracket" nil)
                    (hk-match? "comma" nil))
                  nil)
                (:else
                  (hk-err "expected end of let block in comprehension")))
              (list :q-let binds)))))

      (define
        hk-parse-qual
        (fn
          ()
          (cond
            ((hk-match? "reserved" "let") (hk-parse-comp-let))
            ((hk-comp-qual-is-gen?)
              (let ((pat (hk-parse-pat)))
                (hk-expect! "reservedop" "<-")
                (list :q-gen pat (hk-parse-expr-inner))))
            (:else (list :q-guard (hk-parse-expr-inner))))))

      ;; ── List literal / range / comprehension ───────────────
      (define
        hk-parse-list-lit
        (fn
          ()
          (hk-expect! "lbracket" nil)
          (cond
            ((hk-match? "rbracket" nil)
              (do (hk-advance!) (list :list (list))))
            (:else
              (let
                ((first-e (hk-parse-expr-inner)))
                (cond
                  ((hk-match? "reservedop" "..")
                    (do
                      (hk-advance!)
                      (let
                        ((end-e (hk-parse-expr-inner)))
                        (hk-expect! "rbracket" nil)
                        (list :range first-e end-e))))
                  ((hk-match? "reservedop" "|")
                    (do
                      (hk-advance!)
                      (let ((quals (list)))
                        (append! quals (hk-parse-qual))
                        (define
                          hk-lc-loop
                          (fn
                            ()
                            (when
                              (hk-match? "comma" nil)
                              (do
                                (hk-advance!)
                                (append! quals (hk-parse-qual))
                                (hk-lc-loop)))))
                        (hk-lc-loop)
                        (hk-expect! "rbracket" nil)
                        (list :list-comp first-e quals))))
                  ((hk-match? "comma" nil)
                    (do
                      (hk-advance!)
                      (let
                        ((second-e (hk-parse-expr-inner)))
                        (cond
                          ((hk-match? "reservedop" "..")
                            (do
                              (hk-advance!)
                              (let
                                ((end-e (hk-parse-expr-inner)))
                                (hk-expect! "rbracket" nil)
                                (list
                                  :range-step
                                  first-e
                                  second-e
                                  end-e))))
                          (:else
                            (let
                              ((items (list)))
                              (append! items first-e)
                              (append! items second-e)
                              (define
                                hk-list-loop
                                (fn
                                  ()
                                  (when
                                    (hk-match? "comma" nil)
                                    (do
                                      (hk-advance!)
                                      (append!
                                        items
                                        (hk-parse-expr-inner))
                                      (hk-list-loop)))))
                              (hk-list-loop)
                              (hk-expect! "rbracket" nil)
                              (list :list items)))))))
                  (:else
                    (do
                      (hk-expect! "rbracket" nil)
                      (list :list (list first-e))))))))))

      ;; ── Application: left-assoc aexp chain ───────────────────
      (define
        hk-parse-fexp
        (fn
          ()
          (let
            ((fn-e (hk-parse-aexp)))
            (define
              hk-app-loop
              (fn
                ()
                (when
                  (hk-atom-start? (hk-peek))
                  (let
                    ((arg (hk-parse-aexp)))
                    (set! fn-e (list :app fn-e arg))
                    (hk-app-loop)))))
            (hk-app-loop)
            fn-e)))

      ;; ── Lambda: \ apat1 apat2 ... apatn -> body ──────────────
      (define
        hk-parse-lambda
        (fn
          ()
          (hk-expect! "reservedop" "\\")
          (let
            ((params (list)))
            (when
              (not (hk-apat-start? (hk-peek)))
              (hk-err "lambda needs at least one pattern parameter"))
            (define
              hk-lam-loop
              (fn
                ()
                (when
                  (hk-apat-start? (hk-peek))
                  (do
                    (append! params (hk-parse-apat))
                    (hk-lam-loop)))))
            (hk-lam-loop)
            (hk-expect! "reservedop" "->")
            (list :lambda params (hk-parse-expr-inner)))))

      ;; ── if-then-else ────────────────────────────────────────
      (define
        hk-parse-if
        (fn
          ()
          (hk-expect! "reserved" "if")
          (let
            ((c (hk-parse-expr-inner)))
            (hk-expect! "reserved" "then")
            (let
              ((th (hk-parse-expr-inner)))
              (hk-expect! "reserved" "else")
              (let
                ((el (hk-parse-expr-inner)))
                (list :if c th el))))))

      ;; ── Let expression ──────────────────────────────────────
      (define
        hk-parse-let
        (fn
          ()
          (hk-expect! "reserved" "let")
          (let ((explicit (hk-match? "lbrace" nil)))
            (if
              explicit
              (hk-advance!)
              (hk-expect! "vlbrace" nil))
            (let
              ((binds (list)))
              (when
                (not
                  (if
                    explicit
                    (hk-match? "rbrace" nil)
                    (hk-match? "vrbrace" nil)))
                (do
                  (append! binds (hk-parse-bind))
                  (define
                    hk-let-loop
                    (fn
                      ()
                      (when
                        (or
                          (hk-match? "semi" nil)
                          (hk-match? "vsemi" nil))
                        (do
                          (hk-advance!)
                          (when
                            (not
                              (if
                                explicit
                                (hk-match? "rbrace" nil)
                                (hk-match? "vrbrace" nil)))
                            (append! binds (hk-parse-bind)))
                          (hk-let-loop)))))
                  (hk-let-loop)))
              (if
                explicit
                (hk-expect! "rbrace" nil)
                (hk-expect! "vrbrace" nil))
              (hk-expect! "reserved" "in")
              (list :let binds (hk-parse-expr-inner))))))

      ;; ── RHS: guards + optional where ─────────────────────────
      ;; A rhs is either a plain body after `=`/`->`, or a list of
      ;; guarded bodies (`| cond = e | cond = e …`), optionally
      ;; followed by a `where` block of local decls. Shapes:
      ;;   plain:   <expr>
      ;;   guards:  (:guarded ((:guard C1 E1) (:guard C2 E2) …))
      ;;   where:   (:where <plain|guarded> DECLS)
      ;; Used by fun-clauses, let/do-let bindings, and case alts.
      (define
        hk-parse-where-decls
        (fn
          ()
          (let ((explicit (hk-match? "lbrace" nil)))
            (if
              explicit
              (hk-advance!)
              (hk-expect! "vlbrace" nil))
            (let ((decls (list)))
              (when
                (not
                  (if
                    explicit
                    (hk-match? "rbrace" nil)
                    (hk-match? "vrbrace" nil)))
                (do
                  (append! decls (hk-parse-decl))
                  (define
                    hk-wd-loop
                    (fn
                      ()
                      (when
                        (or
                          (hk-match? "vsemi" nil)
                          (hk-match? "semi" nil))
                        (do
                          (hk-advance!)
                          (when
                            (not
                              (if
                                explicit
                                (hk-match? "rbrace" nil)
                                (hk-match? "vrbrace" nil)))
                            (append! decls (hk-parse-decl)))
                          (hk-wd-loop)))))
                  (hk-wd-loop)))
              (if
                explicit
                (hk-expect! "rbrace" nil)
                (hk-expect! "vrbrace" nil))
              decls))))

      (define
        hk-parse-guarded
        (fn
          (sep)
          (let ((guards (list)))
            (define
              hk-g-loop
              (fn
                ()
                (when
                  (hk-match? "reservedop" "|")
                  (do
                    (hk-advance!)
                    (let
                      ((cond-e (hk-parse-expr-inner)))
                      (hk-expect! "reservedop" sep)
                      (let
                        ((expr-e (hk-parse-expr-inner)))
                        (append! guards (list :guard cond-e expr-e))
                        (hk-g-loop)))))))
            (hk-g-loop)
            (list :guarded guards))))

      (define
        hk-parse-rhs
        (fn
          (sep)
          (let
            ((body
                (cond
                  ((hk-match? "reservedop" "|")
                    (hk-parse-guarded sep))
                  (:else
                    (do
                      (hk-expect! "reservedop" sep)
                      (hk-parse-expr-inner))))))
            (cond
              ((hk-match? "reserved" "where")
                (do
                  (hk-advance!)
                  (list :where body (hk-parse-where-decls))))
              (:else body)))))

      ;; Binding LHS is a pattern (for pat-binds), a varid alone
      ;; (simple `x = e`), or a varid followed by apats (the
      ;; `let f x = …` / `let f x | g = … | g = …` funclause form).
      (define
        hk-parse-bind
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((and
                  (not (nil? t))
                  (= (get t "type") "varid"))
                (let
                  ((name (get (hk-advance!) "value"))
                    (pats (list)))
                  (define
                    hk-b-loop
                    (fn
                      ()
                      (when
                        (hk-apat-start? (hk-peek))
                        (do
                          (append! pats (hk-parse-apat))
                          (hk-b-loop)))))
                  (hk-b-loop)
                  (if
                    (= (len pats) 0)
                    (list
                      :bind
                      (list :p-var name)
                      (hk-parse-rhs "="))
                    (list
                      :fun-clause
                      name
                      pats
                      (hk-parse-rhs "=")))))
              (:else
                (let
                  ((pat (hk-parse-pat)))
                  (list :bind pat (hk-parse-rhs "="))))))))

      ;; ── Patterns ─────────────────────────────────────────────
      (define
        hk-parse-apat
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((nil? t) (hk-err "unexpected end of input in pattern"))
              ((and
                  (= (get t "type") "reserved")
                  (= (get t "value") "_"))
                (do (hk-advance!) (list :p-wild)))
              ((and
                  (= (get t "type") "reservedop")
                  (= (get t "value") "~"))
                (do (hk-advance!) (list :p-lazy (hk-parse-apat))))
              ((and
                  (= (get t "type") "varsym")
                  (= (get t "value") "-"))
                (do
                  (hk-advance!)
                  (let
                    ((n (hk-peek)))
                    (cond
                      ((nil? n)
                        (hk-err "expected numeric literal after '-'"))
                      ((= (get n "type") "integer")
                        (do
                          (hk-advance!)
                          (list :p-int (- 0 (get n "value")))))
                      ((= (get n "type") "float")
                        (do
                          (hk-advance!)
                          (list :p-float (- 0 (get n "value")))))
                      (:else
                        (hk-err
                          "only numeric literals may follow '-' in a pattern"))))))
              ((= (get t "type") "integer")
                (do (hk-advance!) (list :p-int (get t "value"))))
              ((= (get t "type") "float")
                (do (hk-advance!) (list :p-float (get t "value"))))
              ((= (get t "type") "string")
                (do (hk-advance!) (list :p-string (get t "value"))))
              ((= (get t "type") "char")
                (do (hk-advance!) (list :p-char (get t "value"))))
              ((= (get t "type") "varid")
                (let
                  ((next-t (hk-peek-at 1)))
                  (cond
                    ((and
                        (not (nil? next-t))
                        (= (get next-t "type") "reservedop")
                        (= (get next-t "value") "@"))
                      (do
                        (hk-advance!)
                        (hk-advance!)
                        (list :p-as (get t "value") (hk-parse-apat))))
                    (:else
                      (do (hk-advance!) (list :p-var (get t "value")))))))
              ((= (get t "type") "conid")
                (do
                  (hk-advance!)
                  (list :p-con (get t "value") (list))))
              ((= (get t "type") "qconid")
                (do
                  (hk-advance!)
                  (list :p-con (get t "value") (list))))
              ((= (get t "type") "lparen") (hk-parse-paren-pat))
              ((= (get t "type") "lbracket") (hk-parse-list-pat))
              (:else (hk-err "unexpected token in pattern"))))))

      (define
        hk-parse-paren-pat
        (fn
          ()
          (hk-expect! "lparen" nil)
          (cond
            ((hk-match? "rparen" nil)
              (do (hk-advance!) (list :p-con "()" (list))))
            (:else
              (let
                ((first-p (hk-parse-pat))
                  (items (list))
                  (is-tup false))
                (append! items first-p)
                (define
                  hk-ppt-loop
                  (fn
                    ()
                    (when
                      (hk-match? "comma" nil)
                      (do
                        (hk-advance!)
                        (set! is-tup true)
                        (append! items (hk-parse-pat))
                        (hk-ppt-loop)))))
                (hk-ppt-loop)
                (hk-expect! "rparen" nil)
                (if is-tup (list :p-tuple items) first-p))))))

      (define
        hk-parse-list-pat
        (fn
          ()
          (hk-expect! "lbracket" nil)
          (cond
            ((hk-match? "rbracket" nil)
              (do (hk-advance!) (list :p-list (list))))
            (:else
              (let
                ((items (list)))
                (append! items (hk-parse-pat))
                (define
                  hk-plt-loop
                  (fn
                    ()
                    (when
                      (hk-match? "comma" nil)
                      (do
                        (hk-advance!)
                        (append! items (hk-parse-pat))
                        (hk-plt-loop)))))
                (hk-plt-loop)
                (hk-expect! "rbracket" nil)
                (list :p-list items))))))

      (define
        hk-parse-pat-lhs
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((and
                  (not (nil? t))
                  (or
                    (= (get t "type") "conid")
                    (= (get t "type") "qconid")))
                (let
                  ((name (get (hk-advance!) "value")) (args (list)))
                  (define
                    hk-pca-loop
                    (fn
                      ()
                      (when
                        (hk-apat-start? (hk-peek))
                        (do
                          (append! args (hk-parse-apat))
                          (hk-pca-loop)))))
                  (hk-pca-loop)
                  (list :p-con name args)))
              (:else (hk-parse-apat))))))

      ;; Infix constructor patterns: `x : xs`, `a `Cons` b`, etc.
      ;; Right-associative, single precedence band.
      (define
        hk-parse-pat
        (fn
          ()
          (let
            ((left (hk-parse-pat-lhs)))
            (cond
              ((or
                  (= (hk-peek-type) "consym")
                  (and
                    (= (hk-peek-type) "reservedop")
                    (= (hk-peek-value) ":")))
                (let
                  ((op (get (hk-advance!) "value")))
                  (let
                    ((right (hk-parse-pat)))
                    (list :p-con op (list left right)))))
              (:else left)))))

      ;; ── case ─ of { pat -> expr ; ... } ─────────────────────
      (define
        hk-parse-alt
        (fn
          ()
          (let
            ((pat (hk-parse-pat)))
            (list :alt pat (hk-parse-rhs "->")))))

      (define
        hk-parse-case
        (fn
          ()
          (hk-expect! "reserved" "case")
          (let
            ((scrut (hk-parse-expr-inner)))
            (hk-expect! "reserved" "of")
            (let
              ((explicit (hk-match? "lbrace" nil)))
              (if
                explicit
                (hk-advance!)
                (hk-expect! "vlbrace" nil))
              (let
                ((alts (list)))
                (when
                  (not
                    (if
                      explicit
                      (hk-match? "rbrace" nil)
                      (hk-match? "vrbrace" nil)))
                  (do
                    (append! alts (hk-parse-alt))
                    (define
                      hk-case-loop
                      (fn
                        ()
                        (when
                          (or
                            (hk-match? "semi" nil)
                            (hk-match? "vsemi" nil))
                          (do
                            (hk-advance!)
                            (when
                              (not
                                (if
                                  explicit
                                  (hk-match? "rbrace" nil)
                                  (hk-match? "vrbrace" nil)))
                              (append! alts (hk-parse-alt)))
                            (hk-case-loop)))))
                    (hk-case-loop)))
                (if
                  explicit
                  (hk-expect! "rbrace" nil)
                  (hk-expect! "vrbrace" nil))
                (list :case scrut alts))))))

      ;; ── do { stmt ; stmt ; ... } ────────────────────────────
      ;; Scan ahead (respecting paren/bracket/brace depth) for a `<-`
      ;; before the next `;` / `}` — distinguishes `pat <- e` from a
      ;; bare expression statement.
      (define
        hk-do-stmt-is-bind?
        (fn
          ()
          (let
            ((j pos) (depth 0) (found false) (done false))
            (define
              hk-scan-loop
              (fn
                ()
                (when
                  (and (not done) (< j n))
                  (let
                    ((t (nth toks j)) (ty nil))
                    (set! ty (get t "type"))
                    (cond
                      ((and
                          (= depth 0)
                          (or
                            (= ty "semi")
                            (= ty "vsemi")
                            (= ty "rbrace")
                            (= ty "vrbrace")))
                        (set! done true))
                      ((and
                          (= depth 0)
                          (= ty "reservedop")
                          (= (get t "value") "<-"))
                        (do (set! found true) (set! done true)))
                      ((or
                          (= ty "lparen")
                          (= ty "lbracket")
                          (= ty "lbrace")
                          (= ty "vlbrace"))
                        (set! depth (+ depth 1)))
                      ((or
                          (= ty "rparen")
                          (= ty "rbracket"))
                        (set! depth (- depth 1)))
                      (:else nil))
                    (set! j (+ j 1))
                    (hk-scan-loop)))))
            (hk-scan-loop)
            found)))

      (define
        hk-parse-do-let
        (fn
          ()
          (hk-expect! "reserved" "let")
          (let ((explicit (hk-match? "lbrace" nil)))
            (if
              explicit
              (hk-advance!)
              (hk-expect! "vlbrace" nil))
            (let
              ((binds (list)))
              (when
                (not
                  (if
                    explicit
                    (hk-match? "rbrace" nil)
                    (hk-match? "vrbrace" nil)))
                (do
                  (append! binds (hk-parse-bind))
                  (define
                    hk-dlet-loop
                    (fn
                      ()
                      (when
                        (or
                          (hk-match? "semi" nil)
                          (hk-match? "vsemi" nil))
                        (do
                          (hk-advance!)
                          (when
                            (not
                              (if
                                explicit
                                (hk-match? "rbrace" nil)
                                (hk-match? "vrbrace" nil)))
                            (append! binds (hk-parse-bind)))
                          (hk-dlet-loop)))))
                  (hk-dlet-loop)))
              (if
                explicit
                (hk-expect! "rbrace" nil)
                (hk-expect! "vrbrace" nil))
              (list :do-let binds)))))

      (define
        hk-parse-do-stmt
        (fn
          ()
          (cond
            ((hk-match? "reserved" "let") (hk-parse-do-let))
            ((hk-do-stmt-is-bind?)
              (let
                ((pat (hk-parse-pat)))
                (hk-expect! "reservedop" "<-")
                (list :do-bind pat (hk-parse-expr-inner))))
            (:else (list :do-expr (hk-parse-expr-inner))))))

      (define
        hk-parse-do
        (fn
          ()
          (hk-expect! "reserved" "do")
          (let
            ((explicit (hk-match? "lbrace" nil)))
            (if
              explicit
              (hk-advance!)
              (hk-expect! "vlbrace" nil))
            (let
              ((stmts (list)))
              (when
                (not
                  (if
                    explicit
                    (hk-match? "rbrace" nil)
                    (hk-match? "vrbrace" nil)))
                (do
                  (append! stmts (hk-parse-do-stmt))
                  (define
                    hk-do-loop
                    (fn
                      ()
                      (when
                        (or
                          (hk-match? "semi" nil)
                          (hk-match? "vsemi" nil))
                        (do
                          (hk-advance!)
                          (when
                            (not
                              (if
                                explicit
                                (hk-match? "rbrace" nil)
                                (hk-match? "vrbrace" nil)))
                            (append! stmts (hk-parse-do-stmt)))
                          (hk-do-loop)))))
                  (hk-do-loop)))
              (if
                explicit
                (hk-expect! "rbrace" nil)
                (hk-expect! "vrbrace" nil))
              (list :do stmts)))))

      ;; ── lexp: lambda | if | let | case | do | fexp ──────────
      (define
        hk-parse-lexp
        (fn
          ()
          (cond
            ((hk-match? "reservedop" "\\") (hk-parse-lambda))
            ((hk-match? "reserved" "if") (hk-parse-if))
            ((hk-match? "reserved" "let") (hk-parse-let))
            ((hk-match? "reserved" "case") (hk-parse-case))
            ((hk-match? "reserved" "do") (hk-parse-do))
            (:else (hk-parse-fexp)))))

      ;; ── Prefix: unary - ─────────────────────────────────────
      (define
        hk-parse-prefix
        (fn
          ()
          (cond
            ((and (hk-match? "varsym" "-"))
              (do (hk-advance!) (list :neg (hk-parse-lexp))))
            (:else (hk-parse-lexp)))))

      ;; ── Infix: precedence climbing ──────────────────────────
      (define
        hk-is-infix-op?
        (fn
          (tok)
          (if
            (nil? tok)
            false
            (or
              (= (get tok "type") "varsym")
              (= (get tok "type") "consym")
              (and
                (= (get tok "type") "reservedop")
                (= (get tok "value") ":"))
              (= (get tok "type") "backtick")))))

      (define
        hk-consume-op!
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((= (get t "type") "backtick")
                (do
                  (hk-advance!)
                  (let
                    ((v (hk-expect! "varid" nil)))
                    (hk-expect! "backtick" nil)
                    (get v "value"))))
              (:else (do (hk-advance!) (get t "value")))))))

      (define
        hk-parse-infix
        (fn
          (min-prec)
          (let
            ((left (hk-parse-prefix)))
            (define
              hk-inf-loop
              (fn
                ()
                (when
                  (hk-is-infix-op? (hk-peek))
                  (let
                    ((op-tok (hk-peek)))
                    (let
                      ((op-len
                          (if
                            (= (get op-tok "type") "backtick")
                            3
                            1))
                        (op-name
                          (if
                            (= (get op-tok "type") "backtick")
                            (get (hk-peek-at 1) "value")
                            (get op-tok "value"))))
                      (let
                        ((after-op (hk-peek-at op-len))
                          (info (hk-op-info op-name)))
                        (cond
                          ;; Bail on `op )` — let the paren parser claim
                          ;; it as a left section (e op).
                          ((and
                              (not (nil? after-op))
                              (= (get after-op "type") "rparen"))
                            nil)
                          ((>= (get info "prec") min-prec)
                            (do
                              (hk-consume-op!)
                              (let
                                ((next-min
                                    (cond
                                      ((= (get info "assoc") "left")
                                        (+ (get info "prec") 1))
                                      ((= (get info "assoc") "right")
                                        (get info "prec"))
                                      (:else (+ (get info "prec") 1)))))
                                (let
                                  ((right (hk-parse-infix next-min)))
                                  (set!
                                    left
                                    (list :op op-name left right))
                                  (hk-inf-loop)))))
                          (:else nil))))))))
            (hk-inf-loop)
            left)))

      (define hk-parse-expr-inner (fn () (hk-parse-infix 0)))

      ;; ── Types ────────────────────────────────────────────────
      ;; AST: (:t-var N) | (:t-con N) | (:t-app F A)
      ;;      (:t-fun A B) | (:t-tuple ITEMS) | (:t-list T)
      (define
        hk-parse-paren-type
        (fn
          ()
          (hk-expect! "lparen" nil)
          (cond
            ((hk-match? "rparen" nil)
              (do (hk-advance!) (list :t-con "()")))
            (:else
              (let
                ((first-t (hk-parse-type))
                  (items (list))
                  (is-tup false))
                (append! items first-t)
                (define
                  hk-pt-loop
                  (fn
                    ()
                    (when
                      (hk-match? "comma" nil)
                      (do
                        (hk-advance!)
                        (set! is-tup true)
                        (append! items (hk-parse-type))
                        (hk-pt-loop)))))
                (hk-pt-loop)
                (hk-expect! "rparen" nil)
                (if is-tup (list :t-tuple items) first-t))))))

      (define
        hk-parse-list-type
        (fn
          ()
          (hk-expect! "lbracket" nil)
          (cond
            ((hk-match? "rbracket" nil)
              (do (hk-advance!) (list :t-con "[]")))
            (:else
              (let
                ((inner (hk-parse-type)))
                (hk-expect! "rbracket" nil)
                (list :t-list inner))))))

      (define
        hk-parse-atype
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((nil? t) (hk-err "unexpected end of input in type"))
              ((= (get t "type") "conid")
                (do (hk-advance!) (list :t-con (get t "value"))))
              ((= (get t "type") "qconid")
                (do (hk-advance!) (list :t-con (get t "value"))))
              ((= (get t "type") "varid")
                (do (hk-advance!) (list :t-var (get t "value"))))
              ((= (get t "type") "lparen") (hk-parse-paren-type))
              ((= (get t "type") "lbracket") (hk-parse-list-type))
              (:else (hk-err "unexpected token in type"))))))

      (define
        hk-parse-btype
        (fn
          ()
          (let
            ((head (hk-parse-atype)))
            (define
              hk-bt-loop
              (fn
                ()
                (when
                  (hk-atype-start? (hk-peek))
                  (do
                    (set! head (list :t-app head (hk-parse-atype)))
                    (hk-bt-loop)))))
            (hk-bt-loop)
            head)))

      (define
        hk-parse-type
        (fn
          ()
          (let
            ((left (hk-parse-btype)))
            (cond
              ((hk-match? "reservedop" "->")
                (do (hk-advance!) (list :t-fun left (hk-parse-type))))
              (:else left)))))

      ;; ── Top-level declarations ──────────────────────────────
      ;; AST:
      ;;   (:fun-clause NAME APATS BODY)
      ;;   (:pat-bind PAT BODY)
      ;;   (:type-sig NAMES TYPE)
      ;;   (:data NAME TVARS CONS)  — CONS is list of :con-def
      ;;   (:con-def CNAME FIELDS)  — FIELDS is list of types
      ;;   (:type-syn NAME TVARS TYPE)
      ;;   (:newtype NAME TVARS CNAME FIELD)
      ;;   (:fixity ASSOC PREC OPS) — ASSOC ∈ "l" | "r" | "n"
      ;;   (:program DECLS)

      ;; Scan ahead for a top-level `::` (respecting paren/bracket
      ;; depth) before the next statement terminator. Used to tell a
      ;; type signature apart from a function clause.
      (define
        hk-has-top-dcolon?
        (fn
          ()
          (let
            ((j pos) (depth 0) (found false) (done false))
            (define
              hk-dcol-loop
              (fn
                ()
                (when
                  (and (not done) (< j n))
                  (let
                    ((t (nth toks j)) (ty (get t "type")))
                    (cond
                      ((and
                          (= depth 0)
                          (or
                            (= ty "vsemi")
                            (= ty "semi")
                            (= ty "rbrace")
                            (= ty "vrbrace")))
                        (set! done true))
                      ((and
                          (= depth 0)
                          (= ty "reservedop")
                          (= (get t "value") "::"))
                        (do (set! found true) (set! done true)))
                      ((or
                          (= ty "lparen")
                          (= ty "lbracket")
                          (= ty "lbrace")
                          (= ty "vlbrace"))
                        (set! depth (+ depth 1)))
                      ((or
                          (= ty "rparen")
                          (= ty "rbracket"))
                        (set! depth (- depth 1)))
                      (:else nil))
                    (set! j (+ j 1))
                    (hk-dcol-loop)))))
            (hk-dcol-loop)
            found)))

      (define
        hk-parse-type-sig
        (fn
          ()
          (let
            ((names (list)))
            (when
              (not (hk-match? "varid" nil))
              (hk-err "type signature must start with a variable"))
            (append! names (get (hk-advance!) "value"))
            (define
              hk-sig-loop
              (fn
                ()
                (when
                  (hk-match? "comma" nil)
                  (do
                    (hk-advance!)
                    (when
                      (not (hk-match? "varid" nil))
                      (hk-err "expected name after ','"))
                    (append! names (get (hk-advance!) "value"))
                    (hk-sig-loop)))))
            (hk-sig-loop)
            (hk-expect! "reservedop" "::")
            (list :type-sig names (hk-parse-type)))))

      (define
        hk-parse-fun-clause
        (fn
          ()
          (let
            ((t (hk-peek)))
            (cond
              ((and
                  (not (nil? t))
                  (= (get t "type") "varid"))
                (let
                  ((name (get (hk-advance!) "value"))
                    (pats (list)))
                  (define
                    hk-fc-loop
                    (fn
                      ()
                      (when
                        (hk-apat-start? (hk-peek))
                        (do
                          (append! pats (hk-parse-apat))
                          (hk-fc-loop)))))
                  (hk-fc-loop)
                  (list :fun-clause name pats (hk-parse-rhs "="))))
              (:else
                (let
                  ((pat (hk-parse-pat)))
                  (list :pat-bind pat (hk-parse-rhs "="))))))))

      (define
        hk-parse-con-def
        (fn
          ()
          (when
            (not (hk-match? "conid" nil))
            (hk-err "expected constructor name"))
          (let
            ((name (get (hk-advance!) "value")) (fields (list)))
            (define
              hk-cd-loop
              (fn
                ()
                (when
                  (hk-atype-start? (hk-peek))
                  (do
                    (append! fields (hk-parse-atype))
                    (hk-cd-loop)))))
            (hk-cd-loop)
            (list :con-def name fields))))

      (define
        hk-parse-tvars
        (fn
          ()
          (let ((vs (list)))
            (define
              hk-tv-loop
              (fn
                ()
                (when
                  (hk-match? "varid" nil)
                  (do
                    (append! vs (get (hk-advance!) "value"))
                    (hk-tv-loop)))))
            (hk-tv-loop)
            vs)))

      (define
        hk-parse-data
        (fn
          ()
          (hk-expect! "reserved" "data")
          (when
            (not (hk-match? "conid" nil))
            (hk-err "data declaration needs a type name"))
          (let
            ((name (get (hk-advance!) "value"))
              (tvars (hk-parse-tvars))
              (cons-list (list)))
            (when
              (hk-match? "reservedop" "=")
              (do
                (hk-advance!)
                (append! cons-list (hk-parse-con-def))
                (define
                  hk-dc-loop
                  (fn
                    ()
                    (when
                      (hk-match? "reservedop" "|")
                      (do
                        (hk-advance!)
                        (append! cons-list (hk-parse-con-def))
                        (hk-dc-loop)))))
                (hk-dc-loop)))
            (list :data name tvars cons-list))))

      (define
        hk-parse-type-syn
        (fn
          ()
          (hk-expect! "reserved" "type")
          (when
            (not (hk-match? "conid" nil))
            (hk-err "type synonym needs a name"))
          (let
            ((name (get (hk-advance!) "value"))
              (tvars (hk-parse-tvars)))
            (hk-expect! "reservedop" "=")
            (list :type-syn name tvars (hk-parse-type)))))

      (define
        hk-parse-newtype
        (fn
          ()
          (hk-expect! "reserved" "newtype")
          (when
            (not (hk-match? "conid" nil))
            (hk-err "newtype needs a type name"))
          (let
            ((name (get (hk-advance!) "value"))
              (tvars (hk-parse-tvars)))
            (hk-expect! "reservedop" "=")
            (when
              (not (hk-match? "conid" nil))
              (hk-err "newtype needs a constructor name"))
            (let
              ((cname (get (hk-advance!) "value")))
              (when
                (not (hk-atype-start? (hk-peek)))
                (hk-err "newtype constructor needs one field"))
              (list :newtype name tvars cname (hk-parse-atype))))))

      (define
        hk-parse-op
        (fn
          ()
          (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!) ":"))
            ((hk-match? "backtick" nil)
              (do
                (hk-advance!)
                (let
                  ((v (hk-expect! "varid" nil)))
                  (hk-expect! "backtick" nil)
                  (get v "value"))))
            (:else (hk-err "expected operator name in fixity decl")))))

      (define
        hk-parse-fixity
        (fn
          ()
          (let ((assoc "n"))
            (cond
              ((hk-match? "reserved" "infixl") (set! assoc "l"))
              ((hk-match? "reserved" "infixr") (set! assoc "r"))
              ((hk-match? "reserved" "infix") (set! assoc "n"))
              (:else (hk-err "expected fixity keyword")))
            (hk-advance!)
            (let ((prec 9))
              (when
                (hk-match? "integer" nil)
                (set! prec (get (hk-advance!) "value")))
              (let ((ops (list)))
                (append! ops (hk-parse-op))
                (define
                  hk-fx-loop
                  (fn
                    ()
                    (when
                      (hk-match? "comma" nil)
                      (do
                        (hk-advance!)
                        (append! ops (hk-parse-op))
                        (hk-fx-loop)))))
                (hk-fx-loop)
                (list :fixity assoc prec ops))))))

      (define
        hk-parse-decl
        (fn
          ()
          (cond
            ((hk-match? "reserved" "data") (hk-parse-data))
            ((hk-match? "reserved" "type") (hk-parse-type-syn))
            ((hk-match? "reserved" "newtype") (hk-parse-newtype))
            ((or
                (hk-match? "reserved" "infix")
                (hk-match? "reserved" "infixl")
                (hk-match? "reserved" "infixr"))
              (hk-parse-fixity))
            ((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-ent-member
        (fn
          ()
          (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-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
                  (nil? (hk-peek))
                  (= (hk-peek-type) "eof")
                  (hk-match? "vrbrace" nil)
                  (hk-match? "rbrace" nil))))
            (when
              (not (hk-body-at-end?))
              (do
                (append! decls (hk-parse-decl))
                (define
                  hk-body-loop
                  (fn
                    ()
                    (when
                      (or
                        (hk-match? "vsemi" nil)
                        (hk-match? "semi" nil))
                      (do
                        (hk-advance!)
                        (when
                          (not (hk-body-at-end?))
                          (append! decls (hk-parse-decl)))
                        (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
        ((start-brace
            (or
              (hk-match? "vlbrace" nil)
              (hk-match? "lbrace" nil))))
        (when start-brace (hk-advance!))
        (let
          ((result
              (cond
                ((= mode :expr) (hk-parse-expr-inner))
                ((= mode :module) (hk-parse-program))
                (:else (hk-err "unknown parser mode")))))
          (when start-brace
            (when
              (or
                (hk-match? "vrbrace" nil)
                (hk-match? "rbrace" nil))
              (hk-advance!)))
          result)))))

(define hk-parse-expr (fn (tokens) (hk-parser tokens :expr)))
(define hk-parse-module (fn (tokens) (hk-parser tokens :module)))

;; ── Convenience: tokenize + layout + parse ───────────────────────
(define
  hk-parse
  (fn (src) (hk-parse-expr (hk-layout (hk-tokenize src)))))

(define
  hk-parse-top
  (fn (src) (hk-parse-module (hk-layout (hk-tokenize src)))))