sourcework/xetal-libraries/libs/Check/src/Check.xtlm
1⍝│ Check: its macro library -- c_ases<, table-driven checks named by
2⍝│ their own source text.
3⍝│ Imported with the functions, under one alias: "ch:" u_se< "Check".
4⍝│ A macro is a function from the source text written left and right of
5⍝│ its call to the source that replaces the call, run before the program
6⍝│ is compiled (X_eTaL MC10). Names with m: are macros; those under h: are
7⍝│ private to this file.
8
9"t:" u̲se< "Strings"
10"pa:" u̲se< "Parsing"
11
12bs ← "\\"
13dq ← "\""
14
15⍝━━ Rows
16
17⍝│ A text as the inside of an X_eTaL string literal: \ and " escaped.
18ʰe̲scaped ← { s → ((e̲nclose dq) c̲at e̲nclose bs c̲at dq) ᵗr̲eplace ((e̲nclose bs) c̲at e̲nclose bs c̲at bs) ᵗr̲eplace s }
19
20⍝│ Whether a row is "input -> expected".
21ʰr̲ow? ← { r → 1 = t̲ally "->" ᵗf̲ind r }
22
23⍝│ One check: f applied to the row's input, compared (m_atch) with its
24⍝│ expected value, both evaluated where the call is (hygiene: the
25⍝│ lambda's w and g only receive them); a line like Check's own.
26ʰc̲heck ← { f r →
27 at ← "->" ᵖᵃa̲t r
28 input ← ᵗt̲rim (at − 1) t̲ake r
29 want ← ᵗt̲rim (at + 1) d̲rop r
30 label ← ʰe̲scaped f c̲at " " c̲at input
31 "(" c̲at want c̲at ") { w g -> w m_atch g ? \"ok: " c̲at label c̲at "\"; \"FAIL: " c̲at label c̲at ": expected \" c_at (f_ormat w) c_at \", got \" c_at f_ormat g } (" c̲at f c̲at " (" c̲at input c̲at "))"
32}
33
34⍝━━ The macro
35
36⍝│ "u:s_quare" ch:c_ases< "2 -> 4; 3 -> 9; -1 -> 1": a table of checks of
37⍝│ one function, a row per case, input -> expected. When the program is
38⍝│ compiled it writes one check per row, named by its own source text
39⍝│ ("ok: u:s_quare 2", or "FAIL: u:s_quare 3: expected 9, got 10"), so
40⍝│ a failing case says which, without writing the expression twice.
41⍝│ Expected and actual values must share a type: a mismatch is a type
42⍝│ error at compile time. It stands as a statement of its own. A row
43⍝│ without one -> stops the compiler: error[bad-cases]. Rows are cut
44⍝│ at ; outside brackets (Parsing's pa:s_plit, as any list here is),
45⍝│ not that it can matter today: a ; only ever occurs inside a lambda
46⍝│ body, whose own -> would already make the row ambiguous.
47⍝│ takes: code text
48⍝│ uses: parsed
49ᵐc̲ases< ← { f body →
50 all ← '{ r → ᵗt̲rim d̲isclose r } m̲ap ";" ᵖᵃs̲plit body
51 rs ← (0 < '{ t̲ally d̲isclose ⍵ } e̲ach all) r̲eplicate all
52 0 = t̲ally rs ? "bad-cases right" ⎕R̲EJECT "no cases: write input -> expected; ..."
53 bad ← (n̲ot '{ ʰr̲ow? d̲isclose ⍵ } e̲ach rs) r̲eplicate rs
54 0 < t̲ally bad ? "bad-cases right" ⎕R̲EJECT (d̲isclose f̲irst bad) c̲at " is not a case: write input -> expected"
55 "\n" ᵗj̲oin '{ r → f ʰc̲heck d̲isclose r } m̲ap rs
56}