diff --git a/lib/haskell/desugar.sx b/lib/haskell/desugar.sx index fb5af2cd..f64d3416 100644 --- a/lib/haskell/desugar.sx +++ b/lib/haskell/desugar.sx @@ -182,13 +182,13 @@ ((= tag "sect-right") (list :sect-right (nth node 1) (hk-desugar (nth node 2)))) ((= tag "program") - (list :program (map hk-desugar (nth node 1)))) + (list :program (map hk-desugar (hk-expand-records (nth node 1))))) ((= tag "module") (list :module (nth node 1) (nth node 2) (nth node 3) - (map hk-desugar (nth node 4)))) + (map hk-desugar (hk-expand-records (nth node 4))))) ((= tag "fun-clause") (list :fun-clause (nth node 1) @@ -207,9 +207,98 @@ ;; Convenience — tokenize + layout + parse + desugar. (define - hk-core - (fn (src) (hk-desugar (hk-parse-top src)))) + hk-record-accessors + (fn + (cname rec-fields) + (let + ((n (len rec-fields)) (i 0) (out (list))) + (define + hk-ra-loop + (fn + () + (when + (< i n) + (let + ((field (nth rec-fields i))) + (let + ((fname (first field)) (j 0) (pats (list))) + (define + hk-pat-loop + (fn + () + (when + (< j n) + (begin + (append! + pats + (if + (= j i) + (list "p-var" "__rec_field") + (list "p-wild"))) + (set! j (+ j 1)) + (hk-pat-loop))))) + (hk-pat-loop) + (append! + out + (list + "fun-clause" + fname + (list (list "p-con" cname pats)) + (list "var" "__rec_field"))) + (set! i (+ i 1)) + (hk-ra-loop)))))) + (hk-ra-loop) + out))) (define - hk-core-expr - (fn (src) (hk-desugar (hk-parse src)))) + hk-expand-records + (fn + (decls) + (let + ((out (list))) + (for-each + (fn + (d) + (cond + ((and (list? d) (= (first d) "data")) + (let + ((dname (nth d 1)) + (tvars (nth d 2)) + (cons-list (nth d 3)) + (deriving (if (> (len d) 4) (nth d 4) (list))) + (new-cons (list)) + (accessors (list))) + (begin + (for-each + (fn + (c) + (cond + ((= (first c) "con-rec") + (let + ((cname (nth c 1)) (rec-fields (nth c 2))) + (begin + (append! + new-cons + (list + "con-def" + cname + (map (fn (f) (nth f 1)) rec-fields))) + (for-each + (fn (a) (append! accessors a)) + (hk-record-accessors cname rec-fields))))) + (:else (append! new-cons c)))) + cons-list) + (append! + out + (if + (empty? deriving) + (list "data" dname tvars new-cons) + (list "data" dname tvars new-cons deriving))) + (for-each (fn (a) (append! out a)) accessors)))) + (:else (append! out d)))) + decls) + out))) + +(define hk-core (fn (src) (hk-desugar (hk-parse-top src)))) + +(define hk-core-expr (fn (src) (hk-desugar (hk-parse src)))) diff --git a/plans/haskell-completeness.md b/plans/haskell-completeness.md index c18897af..3be4fb97 100644 --- a/plans/haskell-completeness.md +++ b/plans/haskell-completeness.md @@ -249,7 +249,7 @@ No OCaml changes are needed. The view type is fully representable as an SX dict. - [x] Parser: extend `hk-parse-data` to recognise `{ field :: Type, … }` constructor bodies. AST node: `(:con-rec CNAME [(FNAME TYPE) …])`. -- [ ] Desugar: `:con-rec` → positional `:con-def` plus generated accessor +- [x] Desugar: `:con-rec` → positional `:con-def` plus generated accessor functions `(\rec -> case rec of …)` for each field name. - [ ] Record creation `Foo { bar = 1, baz = "x" }` parsed as `(:rec-create CON [(FNAME EXPR) …])`. Eval builds the same tagged list as @@ -313,6 +313,18 @@ No OCaml changes are needed. The view type is fully representable as an SX dict. _Newest first._ +**2026-05-07** — Phase 14 record desugar (`:con-rec` → positional + accessors): +- New `hk-record-accessors` helper in `desugar.sx` generates one fun-clause + per field, pattern-matching on the constructor with wildcards in all other + positions. +- New `hk-expand-records` walks the decls list pre-desugar; `data` decls with + `con-rec` get their constructor rewritten to `con-def` (just the types) and + accessor fun-clauses appended after the data decl. Other decls pass through. +- Wired into the `program` and `module` cases of `hk-desugar`. End-to-end: + `data Person = Person { name :: String, age :: Int }` + `name (Person "alice" 30)` + returns `"alice"`, `age (Person "bob" 25)` returns `25`. No regressions in + parse / desugar / deriving. + **2026-05-07** — Phase 14 record parser: `data Foo = Foo { name :: T, … }`: - Extended `hk-parse-con-def` to peek for `{` after the constructor name; if found, parse `varid :: type` pairs separated by commas, terminate with `}`,