haskell: Phase 14 — record update r { field = v } (parser + desugar + eval)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m6s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m6s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -142,6 +142,13 @@
|
|||||||
(list
|
(list
|
||||||
:app (hk-desugar (nth node 1))
|
:app (hk-desugar (nth node 1))
|
||||||
(hk-desugar (nth node 2))))
|
(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")
|
((= tag "rec-create")
|
||||||
(let
|
(let
|
||||||
((cname (nth node 1))
|
((cname (nth node 1))
|
||||||
|
|||||||
@@ -246,6 +246,42 @@
|
|||||||
(hk-apply
|
(hk-apply
|
||||||
(hk-eval (nth node 1) env)
|
(hk-eval (nth node 1) env)
|
||||||
(hk-mk-thunk (nth node 2) 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")
|
((= tag "op")
|
||||||
(hk-eval-op (nth node 1) (nth node 2) (nth node 3) env))
|
(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))
|
((= tag "case") (hk-eval-case (nth node 1) (nth node 2) env))
|
||||||
|
|||||||
@@ -208,7 +208,12 @@
|
|||||||
((= (get t "type") "char")
|
((= (get t "type") "char")
|
||||||
(do (hk-advance!) (list :char (get t "value"))))
|
(do (hk-advance!) (list :char (get t "value"))))
|
||||||
((= (get t "type") "varid")
|
((= (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")
|
((= (get t "type") "conid")
|
||||||
(do
|
(do
|
||||||
(hk-advance!)
|
(hk-advance!)
|
||||||
@@ -489,6 +494,34 @@
|
|||||||
(hk-rc-loop)
|
(hk-rc-loop)
|
||||||
(hk-expect! "rbrace" nil)
|
(hk-expect! "rbrace" nil)
|
||||||
(list :rec-create cname fields)))))
|
(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
|
(define
|
||||||
hk-parse-fexp
|
hk-parse-fexp
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -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
|
- [x] Record creation `Foo { bar = 1, baz = "x" }` parsed as
|
||||||
`(:rec-create CON [(FNAME EXPR) …])`. Eval builds the same tagged list as
|
`(:rec-create CON [(FNAME EXPR) …])`. Eval builds the same tagged list as
|
||||||
positional construction (field order from the data decl).
|
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
|
Eval forces the record, replaces the relevant positional slot, returns a new
|
||||||
tagged list. Field → index mapping stored in `hk-constructors` at registration.
|
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`,
|
- [ ] Exhaustive record patterns: `Foo { bar = b }` in case binds `b`,
|
||||||
wildcards remaining fields.
|
wildcards remaining fields.
|
||||||
- [ ] Tests in `lib/haskell/tests/records.sx` (≥ 12 tests: creation, accessor,
|
- [ ] 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._
|
_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, … }`:
|
**2026-05-07** — Phase 14 record-creation syntax `Foo { f = e, … }`:
|
||||||
- Parser: post-`conid` peek for `{` triggers `hk-parse-rec-create`, returning
|
- Parser: post-`conid` peek for `{` triggers `hk-parse-rec-create`, returning
|
||||||
`(:rec-create cname [(fname expr) …])`.
|
`(:rec-create cname [(fname expr) …])`.
|
||||||
|
|||||||
Reference in New Issue
Block a user