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: "k:" 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ᵗ⁼u̲se< "Strings"
10
11bs ← "\\"
12dq ← "\""
13
14⍝## Rows
15
16⍝# A text as the inside of an X_eTaL string literal: \ and " escaped.
17ʰ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 }
18
19⍝# Whether a row is "input -> expected".
20ʰr̲ow? ← { r → 1 = t̲ally "->" ᵗf̲ind r }
21
22⍝# One check: f applied to the row's input, compared (m_atch) with its
23⍝# expected value, both evaluated where the call is (hygiene: the
24⍝# lambda's w and g only receive them); a line like Check's own.
25ʰc̲heck ← { f r →
26  at ← f̲irst "->" ᵗf̲ind r
27  input ← ᵗt̲rim (at − 1) t̲ake r
28  want ← ᵗt̲rim (at + 1) d̲rop r
29  label ← ʰe̲scaped f c̲at " " c̲at input
30  "(" 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 "))"
31}
32
33⍝## The macro
34
35⍝# "u:s_quare" k:c_ases< "2 -> 4; 3 -> 9; -1 -> 1": a table of checks of
36⍝# one function, a row per case, input -> expected. When the program is
37⍝# compiled it writes one check per row, named by its own source text
38⍝# ("ok: u:s_quare 2", or "FAIL: u:s_quare 3: expected 9, got 10"), so
39⍝# a failing case says which, without writing the expression twice.
40⍝# Expected and actual values must share a type: a mismatch is a type
41⍝# error at compile time. It stands as a statement of its own. A row
42⍝# without one -> stops the compiler: error[bad-cases].
43ᵐc̲ases< ← { f body →
44  rs ← '{ r → ᵗt̲rim d̲isclose r } m̲ap ";" ᵗs̲plit body
45  rs ← (0 < '{ t̲ally d̲isclose ⍵ } e̲ach rs) r̲eplicate rs
46  0 = t̲ally rs ? "bad-cases right" ⎕R̲EJECT "no cases: write input -> expected; ..."
47  bad ← (n̲ot '{ ʰr̲ow? d̲isclose ⍵ } e̲ach rs) r̲eplicate rs
48  0 < t̲ally bad ? "bad-cases right" ⎕R̲EJECT (d̲isclose f̲irst bad) c̲at " is not a case: write input -> expected"
49  "\n" ᵗj̲oin '{ r → f ʰc̲heck d̲isclose r } m̲ap rs
50}