1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.
(.require
[library
[lux (.except nat int rev local global symbol)
[abstract
[equivalence (.only Equivalence)]]
[data
["[0]" product]
["[0]" bit]
["[0]" text (.use "[1]#[0]" monoid equivalence)]
[collection
["[0]" list (.use "[1]#[0]" functor mix)]]]
[math
[number
["[0]" nat]
["[0]" int]
["[0]" rev]
["[0]" frac]]]
[meta
["[0]" location]
["[0]" symbol]]]])
... (type (Code' w)
... {.#Bit Bit}
... {.#Nat Nat}
... {.#Int Int}
... {.#Rev Rev}
... {.#Frac Frac}
... {.#Text Text}
... {.#Symbol Symbol}
... {.#Form (List (w (Code' w)))}
... {.#Variant (List (w (Code' w)))}
... {.#Tuple (List (w (Code' w)))})
... (type Code
... (Ann Location (Code' (Ann Location))))
(with_template [<name> <type> <tag>]
[(def .public (<name> x)
(-> <type> Code)
[location.dummy {<tag> x}])]
[bit Bit .#Bit]
[nat Nat .#Nat]
[int Int .#Int]
[rev Rev .#Rev]
[frac Frac .#Frac]
[text Text .#Text]
[symbol Symbol .#Symbol]
[form (List Code) .#Form]
[variant (List Code) .#Variant]
[tuple (List Code) .#Tuple]
)
(with_template [<name> <tag>]
[(def .public (<name> name)
(-> Text Code)
[location.dummy {<tag> ["" name]}])]
[local .#Symbol])
(`` (def .public equivalence
(Equivalence Code)
(implementation
(def (= x y)
(when [x y]
(,, (with_template [<tag> <eq>]
[[[_ {<tag> x'}] [_ {<tag> y'}]]
(of <eq> = x' y')]
[.#Bit bit.equivalence]
[.#Nat nat.equivalence]
[.#Int int.equivalence]
[.#Rev rev.equivalence]
[.#Frac frac.equivalence]
[.#Text text.equivalence]
[.#Symbol symbol.equivalence]))
(,, (with_template [<tag>]
[[[_ {<tag> xs'}] [_ {<tag> ys'}]]
(of (list.equivalence =) = xs' ys')]
[.#Form]
[.#Variant]
[.#Tuple]))
_
false)))))
(`` (def .public (format ast)
(-> Code Text)
(when ast
(,, (with_template [<tag> <struct>]
[[_ {<tag> value}]
(of <struct> encoded value)]
[.#Bit bit.codec]
[.#Nat nat.decimal]
[.#Int int.decimal]
[.#Rev rev.decimal]
[.#Frac frac.decimal]
[.#Symbol symbol.absolute]))
[_ {.#Text value}]
(text.format value)
(,, (with_template [<tag> <open> <close>]
[[_ {<tag> members}]
(all text#composite
<open>
(list#mix (function (_ next prev)
(let [next (format next)]
(if (text#= "" prev)
next
(all text#composite prev " " next))))
""
members)
<close>)]
[.#Form "(" ")"]
[.#Variant "{" "}"]
[.#Tuple "[" "]"]))
)))
(`` (def .public (replaced original substitute ast)
(-> Code Code Code Code)
(if (of ..equivalence = original ast)
substitute
(when ast
(,, (with_template [<tag>]
[[location {<tag> parts}]
[location {<tag> (list#each (replaced original substitute) parts)}]]
[.#Form]
[.#Variant]
[.#Tuple]))
_
ast))))
|
