From 0679edf56828c0d5de48ec39a5ef11f3717f8a0e Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 23:20:01 +0000 Subject: [PATCH] =?UTF-8?q?sx:=20step=207=20=E2=80=94=20nested=20construct?= =?UTF-8?q?or=20patterns=20in=20match?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Extend the ADT test suite with nested-pattern coverage. The spec-level match-pattern function in spec/evaluator.sx already recurses through constructor sub-patterns via the dict-shape shim ((get value :_adt| :_ctor|:_fields)), and already handles _ wildcards, quoted literals, and bare-symbol variable bindings. Step 5+6 added the AdtValue native type with the same dict-key access surface, so no host changes are needed for nesting. Added 8 new deftests covering: - nested constructor sanity (Just x / Nothing) - nested constructor binds inner fields ((Just (Pair a b)) -> a+b) - nested wildcard ((Just _) -> "yes") - nested literal equality ((Just 42) literal vs (else) var) - nested literal-vs-var fall-through (literal fails, var binds) - deeply nested constructors (W1(W2(L3 n)) -> n) - mixed bind+wildcard ((BoxM (PairM x _)) -> x) - nested ctor fail-through (WX (LeftX) vs WX (RightX)) Tests: OCaml 4532 -> 4540 (+8), JS 2578 -> 2586 (+8). Zero regressions on either host (failures unchanged at 1339 / 2465 baselines). Co-Authored-By: Claude Opus 4.7 (1M context) --- plans/sx-improvements.md | 12 ++++- spec/tests/test-adt.sx | 101 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 111 insertions(+), 2 deletions(-) diff --git a/plans/sx-improvements.md b/plans/sx-improvements.md index d4edba19..fa8568e3 100644 --- a/plans/sx-improvements.md +++ b/plans/sx-improvements.md @@ -126,6 +126,16 @@ Both OCaml and JS `MatchFrame`: replace linear binding with recursive Extend `spec/tests/test-adt.sx` with nested pattern tests. +**Outcome:** No host-side changes needed. The spec-level `match-pattern` function +in `spec/evaluator.sx` (≈line 2835) already recurses through constructor +sub-patterns via the dict-shape shim (`(get value :_adt|:_ctor|:_fields)`), +handles `_` wildcards, literals, and variable bindings. Step 7 added 8 new +deftests to `spec/tests/test-adt.sx` covering: nested constructor sanity, +nested constructor with field binding, nested wildcard, nested literal +equality, nested literal-vs-var clause fall-through, deeply nested constructors, +mixed bind+wildcard, and nested ctor fail-through. Both hosts: +8 tests pass, +zero regressions (OCaml 4532→4540, JS 2578→2586). + ### Step 8: Exhaustiveness warnings (Phase 6c) `_adt_registry: type_name → [ctor_names]` global populated by `define-type`. @@ -191,7 +201,7 @@ these when operands are known numbers/lists. | 4 — parser spans complete | [x] | b7ad5152 (subsumed by 023bc2d8) | | 5 — OCaml AdtValue + define-type + match | [x] | 1f49242a | | 6 — JS AdtValue + define-type + match | [x] | fc8a3916 | -| 7 — nested patterns | [ ] | — | +| 7 — nested patterns | [x] | (pending) | | 8 — exhaustiveness warnings | [ ] | — | | 9 — parser feature registry | [ ] | — | | 10 — compiler + as converter registry | [ ] | — | diff --git a/spec/tests/test-adt.sx b/spec/tests/test-adt.sx index 2f6ab479..78301d15 100644 --- a/spec/tests/test-adt.sx +++ b/spec/tests/test-adt.sx @@ -355,4 +355,103 @@ (define-type Inner (Inner-of n)) (assert= 5 - (match (Box2-of (Inner-of 5)) ((Box2-of (Inner-of n)) n)))))) + (match (Box2-of (Inner-of 5)) ((Box2-of (Inner-of n)) n))))) + (deftest + "match nested constructor sanity (Phase 6b)" + (do + (define-type MaybeP6b (JustP6b v) (NothingP6b)) + (assert= 42 (match (JustP6b 42) ((JustP6b x) x) (else 0))) + (assert= 0 (match (NothingP6b) ((JustP6b x) x) (else 0))))) + (deftest + "match nested constructor binds inner fields" + (do + (define-type MaybeN (JustN v) (NothingN)) + (define-type PairN (PairN-of a b)) + (assert= + 3 + (match + (JustN (PairN-of 1 2)) + ((JustN (PairN-of a b)) (+ a b)) + (else 0))) + (assert= + 0 + (match + (NothingN) + ((JustN (PairN-of a b)) (+ a b)) + (else 0))))) + (deftest + "match nested wildcard ignores inner field" + (do + (define-type MaybeW (JustW v) (NothingW)) + (assert= + "yes" + (match (JustW 42) ((JustW _) "yes") (else "no"))) + (assert= + "no" + (match (NothingW) ((JustW _) "yes") (else "no"))))) + (deftest + "match nested literal pattern requires equality" + (do + (define-type MaybeL (JustL v) (NothingL)) + (assert= + "literal" + (match (JustL 42) ((JustL 42) "literal") (else "var"))) + (assert= + "var" + (match (JustL 7) ((JustL 42) "literal") (else "var"))))) + (deftest + "match falls through nested literal to variable clause" + (do + (define-type MaybeF (JustF v) (NothingF)) + (assert= + 1 + (match (JustF 1) ((JustF 99) "wrong") ((JustF x) x))) + (assert= + "wrong" + (match (JustF 99) ((JustF 99) "wrong") ((JustF x) x))))) + (deftest + "match deeply nested constructors bind innermost" + (do + (define-type Wrap1 (W1 inner)) + (define-type Wrap2 (W2 inner)) + (define-type Leaf3 (L3 n)) + (assert= + 7 + (match + (W1 (W2 (L3 7))) + ((W1 (W2 (L3 n))) n) + (else 0))))) + (deftest + "match nested constructor mixed bind and wildcard" + (do + (define-type PairM (PairM-of a b)) + (define-type BoxM (BoxM-of inner)) + (assert= + 10 + (match + (BoxM-of (PairM-of 10 99)) + ((BoxM-of (PairM-of x _)) x) + (else 0))) + (assert= + 99 + (match + (BoxM-of (PairM-of 10 99)) + ((BoxM-of (PairM-of _ y)) y) + (else 0))))) + (deftest + "match nested pattern fails when inner ctor differs" + (do + (define-type EitherX (LeftX v) (RightX v)) + (define-type WrapX (WX inner)) + (assert= + "right-1" + (match + (WX (RightX 1)) + ((WX (LeftX v)) (str "left-" v)) + ((WX (RightX v)) (str "right-" v)))) + (assert= + "left-9" + (match + (WX (LeftX 9)) + ((WX (LeftX v)) (str "left-" v)) + ((WX (RightX v)) (str "right-" v)))))))