diff --git a/lib/haskell/desugar.sx b/lib/haskell/desugar.sx index 923e2c90..65ab5c6f 100644 --- a/lib/haskell/desugar.sx +++ b/lib/haskell/desugar.sx @@ -142,6 +142,13 @@ (list :app (hk-desugar (nth node 1)) (hk-desugar (nth node 2)))) + ((= tag "rec-update") + (list + :rec-update + (hk-desugar (nth node 1)) + (map + (fn (p) (list (first p) (hk-desugar (nth p 1)))) + (nth node 2)))) ((= tag "rec-create") (let ((cname (nth node 1)) diff --git a/lib/haskell/eval.sx b/lib/haskell/eval.sx index beae9eca..fb74cfef 100644 --- a/lib/haskell/eval.sx +++ b/lib/haskell/eval.sx @@ -246,6 +246,42 @@ (hk-apply (hk-eval (nth node 1) env) (hk-mk-thunk (nth node 2) env))) + ((= tag "rec-update") + (let + ((rec-val (hk-force (hk-eval (nth node 1) env))) + (updates (nth node 2))) + (let + ((cname (first rec-val)) + (args (rest rec-val)) + (new-args (list))) + (begin + (let + ((i 0)) + (for-each + (fn + (a) + (let + ((fname-at-i + (cond + ((nil? (hk-record-field-names cname)) nil) + (:else + (nth (hk-record-field-names cname) i))))) + (let + ((override + (cond + ((nil? fname-at-i) nil) + (:else + (hk-find-rec-pair updates fname-at-i))))) + (begin + (append! + new-args + (cond + ((nil? override) a) + (:else + (hk-mk-thunk (nth override 1) env)))) + (set! i (+ i 1)))))) + args)) + (cons cname new-args))))) ((= tag "op") (hk-eval-op (nth node 1) (nth node 2) (nth node 3) env)) ((= tag "case") (hk-eval-case (nth node 1) (nth node 2) env)) diff --git a/lib/haskell/parser.sx b/lib/haskell/parser.sx index 1283ab30..d61916f5 100644 --- a/lib/haskell/parser.sx +++ b/lib/haskell/parser.sx @@ -208,7 +208,12 @@ ((= (get t "type") "char") (do (hk-advance!) (list :char (get t "value")))) ((= (get t "type") "varid") - (do (hk-advance!) (list :var (get t "value")))) + (do + (hk-advance!) + (cond + ((hk-match? "lbrace" nil) + (hk-parse-rec-update (list :var (get t "value")))) + (:else (list :var (get t "value")))))) ((= (get t "type") "conid") (do (hk-advance!) @@ -489,6 +494,34 @@ (hk-rc-loop) (hk-expect! "rbrace" nil) (list :rec-create cname fields))))) + (define + hk-parse-rec-update + (fn + (rec-expr) + (begin + (hk-expect! "lbrace" nil) + (let + ((fields (list))) + (define + hk-ru-loop + (fn + () + (when + (hk-match? "varid" nil) + (let + ((fname (get (hk-advance!) "value"))) + (begin + (hk-expect! "reservedop" "=") + (let + ((fexpr (hk-parse-expr-inner))) + (begin + (append! fields (list fname fexpr)) + (when + (hk-match? "comma" nil) + (begin (hk-advance!) (hk-ru-loop)))))))))) + (hk-ru-loop) + (hk-expect! "rbrace" nil) + (list :rec-update rec-expr fields))))) (define hk-parse-fexp (fn diff --git a/plans/haskell-completeness.md b/plans/haskell-completeness.md index c05aa834..e6d9733b 100644 --- a/plans/haskell-completeness.md +++ b/plans/haskell-completeness.md @@ -254,9 +254,11 @@ No OCaml changes are needed. The view type is fully representable as an SX dict. - [x] Record creation `Foo { bar = 1, baz = "x" }` parsed as `(:rec-create CON [(FNAME EXPR) …])`. Eval builds the same tagged list as positional construction (field order from the data decl). -- [ ] Record update `r { field = v }` parsed as `(:rec-update EXPR [(FNAME EXPR)])`. +- [x] Record update `r { field = v }` parsed as `(:rec-update EXPR [(FNAME EXPR)])`. Eval forces the record, replaces the relevant positional slot, returns a new tagged list. Field → index mapping stored in `hk-constructors` at registration. + _Field map lives in `hk-record-fields` (desugar.sx) for load-order reasons, + not `hk-constructors`._ - [ ] Exhaustive record patterns: `Foo { bar = b }` in case binds `b`, wildcards remaining fields. - [ ] Tests in `lib/haskell/tests/records.sx` (≥ 12 tests: creation, accessor, @@ -313,6 +315,20 @@ No OCaml changes are needed. The view type is fully representable as an SX dict. _Newest first._ +**2026-05-07** — Phase 14 record-update syntax `r { field = v }`: +- Parser: `varid {` after a primary expression now triggers + `hk-parse-rec-update` returning `(:rec-update record-expr [(fname expr) …])`. + (Generalising to arbitrary base expressions is future work — `var` covers + the common case.) +- Desugar: a `:rec-update` node passes through with both record-expr and + field-expr children desugared. +- Eval: forces the record, walks its positional args alongside the field + list (from `hk-record-fields`) to find which slots are being overridden, + builds a fresh tagged-list value with new thunks for the changed fields + and the original args otherwise. Multi-field update works. Verified end- + to-end on `alice { age = 31 }` (only age changes; name preserved). No + regressions in eval / match / desugar suites. + **2026-05-07** — Phase 14 record-creation syntax `Foo { f = e, … }`: - Parser: post-`conid` peek for `{` triggers `hk-parse-rec-create`, returning `(:rec-create cname [(fname expr) …])`.