coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

sx: step 7 — nested constructor patterns in match

Browse Source 
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) <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-06 23:20:01 +00:00
parent fa2cdee164
commit 0679edf568
2 changed files with 111 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
spec/tests/test-adt.sx
View File

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