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)))))))