sourcelib/Combinators.xtlm
1⍝# Combinators as macros: the birds of the Combinators library written
2⍝# in at compile time instead of applied when the program runs. Import
3⍝# both under one alias: "c:" u_se< "Combinators" finds Combinators.xtl
4⍝# (c:Y_, c:B_, ...) and this file (c:Y_<, c:B_<).
5
6⍝## Recursion
7
8⍝# Define the function named on the left by the lambda on the right,
9⍝# whose first parameter is the function itself: the knot c:Y_ ties
10⍝# when the program runs is tied here, by writing the name in place of
11⍝# the self parameter. The result is plain named recursion, with no
12⍝# lazy parameter and no combinator left to run.
13⍝# >> "c:" u_se< "Combinators"
14⍝# >> "u:f_act" c:Y_< "{ ~s_elf n -> n <= 1 ? 1; n * s_elf n - 1 }"
15⍝# >> u:f_act 5
16⍝# 120
17ᵐY̲< ← { name lambda →
18 n̲ot ⎕S̲TATEMENT @ ? "misplaced-macro call" ⎕R̲EJECT "c:Y_< defines a function: it stands as a statement of its own"
19 t ← t̲rim lambda
20 a ← w̲here "->" s̲tarts t
21 (n̲ot "{" m̲atch 1 t̲ake t) ∨ (0 = t̲ally a) ? "bad-macro-argument right" ⎕R̲EJECT yShape
22 ps ← w̲ords ((f̲irst a) − 2) t̲ake 1 d̲rop t
23 2 > t̲ally ps ? "bad-macro-argument right" ⎕R̲EJECT yShape
24 self ← s̲trip d̲isclose f̲irst ps
25 rest ← j̲oin '{ p → " " c̲at d̲isclose p } m̲ap 1 d̲rop ps
26 body ← ((f̲irst a) + 1) d̲rop t
27 (t̲rim name) c̲at " := {" c̲at rest c̲at " ->" c̲at (self w̲ord t̲rim name)_ body
28}
29
30⍝## Composition
31
32⍝# The function on the left applied to the result of the one on the
33⍝# right, as one lambda written in place (the Bluebird, B f g x =
34⍝# f (g x)); either may be a name, a derived function or a lambda.
35⍝# >> "c:" u_se< "Combinators"
36⍝# >> u:s_umTo := "'+ r_/" c:B_< "r_ange"
37⍝# >> u:s_umTo 4
38⍝# 10
39ᵐB̲< ← { f g → "{ " c̲at (t̲rim f) c̲at " " c̲at (t̲rim g) c̲at " _r }" }
40
41yShape ← "c:Y_< takes a lambda whose first parameter is the function itself: { s_elf n -> ... }"
42
43⍝ The text t without white space at its ends.
44t̲rim ← { t →
45 m ← n̲ot t m̲ember? " \n\t"
46 0 = '+ r̲/ 0 + m ? ""
47 i ← w̲here m
48 (1 + (f̲irst r̲ev i) − f̲irst i) t̲ake ((f̲irst i) − 1) d̲rop t
49}
50
51⍝ The words of t: runs of characters other than white space, boxed.
52w̲ords ← { t → (n̲ot t m̲ember? " \n\t") p̲artition t }
53
54⍝ The boxed texts b joined into one text.
55j̲oin ← { b → d̲isclose '{ x y → e̲nclose (d̲isclose x) c̲at d̲isclose y } r̲/ b }
56
57⍝ A parameter's name without the lazy mark ~.
58s̲trip ← { p → (f̲irst p) = f̲irst "~" ? 1 d̲rop p◆ p }
59
60⍝ Where the text w starts in t (1 at each such position).
61s̲tarts ← { w t → '{ i → w m̲atch (t̲ally w) t̲ake (i − 1) d̲rop t } e̲ach r̲ange t̲ally t }
62
63⍝ Characters that continue a name.
64nameChars ← "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_:"
65
66⍝ t with each whole word w (not part of a longer name) replaced by r.
67w̲ord ← { w r t →
68 n ← t̲ally w
69 e ← " " c̲at t c̲at " "
70 ok̲ ← { i → (i + n − 1) > t̲ally t ? 0◆ n̲ot ((i s̲elect e) m̲ember? nameChars) ∨ (i + n + 1) s̲elect e m̲ember? nameChars }
71 h ← (w s̲tarts t) ∧ 'ok̲ e̲ach r̲ange t̲ally t
72 c ← 0 < ('+ s̲\ 0 + h) − '+ s̲\ 0 + (n r̲eshape 0) c̲at (0 − n) d̲rop 0 + h
73 p̲ ← { i → (i s̲elect h) ? r◆ (i s̲elect c) ? ""◆ i s̲elect t }
74 j̲oin 'p̲ m̲ap r̲ange t̲ally t
75}