@tabnas/abnf 0.4.20 → 0.4.21
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- package/dist/abnf.d.ts +3 -1
- package/dist/abnf.js +4 -2
- package/dist/abnf.js.map +1 -1
- package/dist/translate.d.ts +13 -0
- package/dist/translate.js +1610 -0
- package/dist/translate.js.map +1 -0
- package/dist/tsconfig.tsbuildinfo +1 -1
- package/embed-translate.js +124 -0
- package/package.json +4 -2
- package/src/abnf.ts +4 -1
- package/src/translate.ts +1632 -0
package/src/translate.ts
ADDED
|
@@ -0,0 +1,1632 @@
|
|
|
1
|
+
/* Copyright (c) 2026 Richard Rodger and other contributors, MIT License */
|
|
2
|
+
|
|
3
|
+
// Generated by ../embed-translate.js. Edit tabnas.plugin.json or alchemy/*,
|
|
4
|
+
// then run npm run embed.
|
|
5
|
+
|
|
6
|
+
type TranslationPart = Readonly<{
|
|
7
|
+
entry: string
|
|
8
|
+
source?: string
|
|
9
|
+
}>
|
|
10
|
+
|
|
11
|
+
type TranslationParts = Readonly<{
|
|
12
|
+
manifest: string
|
|
13
|
+
lift?: TranslationPart
|
|
14
|
+
embed?: TranslationPart
|
|
15
|
+
render?: TranslationPart
|
|
16
|
+
}>
|
|
17
|
+
|
|
18
|
+
const TRANSLATION: TranslationParts = Object.freeze({
|
|
19
|
+
manifest: `{
|
|
20
|
+
"$schema": "https://tabnas.dev/schema/plugin.schema.json",
|
|
21
|
+
"name": "@tabnas/abnf",
|
|
22
|
+
"go": "github.com/tabnas/abnf/go",
|
|
23
|
+
"rust": "tabnas-abnf",
|
|
24
|
+
"description": "ABNF (RFC 5234) grammar compiler for the tabnas engine. A host reads an ABNF document by compiling it: the tree it translates is the pure-data GrammarSpec the compiler emits (schema grammar-spec), which the render writes back as ABNF.",
|
|
25
|
+
"base": "@tabnas/bnf",
|
|
26
|
+
"engine": "@tabnas/parser",
|
|
27
|
+
"extensions": [
|
|
28
|
+
".abnf"
|
|
29
|
+
],
|
|
30
|
+
"languageId": "abnf",
|
|
31
|
+
"specDir": "test/spec",
|
|
32
|
+
"clib": {
|
|
33
|
+
"dir": "go/clib",
|
|
34
|
+
"library": "libtabnasabnf",
|
|
35
|
+
"abi": "v1",
|
|
36
|
+
"errorCodes": [
|
|
37
|
+
"usage",
|
|
38
|
+
"grammar",
|
|
39
|
+
"handle",
|
|
40
|
+
"internal"
|
|
41
|
+
]
|
|
42
|
+
},
|
|
43
|
+
"errorCodes": [],
|
|
44
|
+
"docs": "https://tabnas.dev/docs/packages",
|
|
45
|
+
"repository": "https://github.com/tabnas/abnf",
|
|
46
|
+
"versionSource": "ts/package.json",
|
|
47
|
+
"translate": {
|
|
48
|
+
"reads": "tree",
|
|
49
|
+
"writes": "tree",
|
|
50
|
+
"root": "object",
|
|
51
|
+
"schema": "grammar-spec",
|
|
52
|
+
"render": "alchemy/render.alc",
|
|
53
|
+
"loss": [
|
|
54
|
+
"The grammar is written anew from its compiled spec: comments, blank lines and layout are not kept, each rule is written on one line, and the RFC 5234 core rules the compiler added (ALPHA, DIGIT and the rest) are not written, since the compiler adds them again wherever they are referenced.",
|
|
55
|
+
"A rule is written as the compiler rewrote it: a reference that led an alternative is written back where the alternatives the compiler put in its place still stand together, each followed by one same tail, and is otherwise written as those alternatives; a left recursion is written as the repetition it became, and alternatives the compiler left-factored with their shared prefix written in each of them again.",
|
|
56
|
+
"Where the compiler reordered a rule's alternatives to tell them apart (a longer lookahead ahead of a shorter one that begins with the same character, a keyword ahead of a character class that can take it), the alternatives that push a helper of the compiler's are put back in the order its numbers record, and the others are written in the compiled order: the rule compiles back the same, and the spec compiled back can differ in the order of the alternates other rules build through it, in the numbers of the compiler's helpers and in the order of its tokens, which is the order the lexer tries two tokens a place expects, so where a keyword and a class that can take it trade places the grammar compiled back accepts what the spec refused (start = ident / \\"if\\" ident with ident = %x61-7A: the spec refuses ifx, and the text compiles back to one that accepts it).",
|
|
57
|
+
"A left recursion that ran through another rule (P = Q, Q = P \\"+\\" / NR) is written as the compiler rewrote it, with the leading reference that closed the cycle left in place, and compiles back to another spec, since the compiler now substitutes that reference.",
|
|
58
|
+
"The start rule is written first, as ABNF's start rule is its first; a spec whose start rule was not its first rule compiles back with that rule moved first.",
|
|
59
|
+
"Terminals are written in RFC 5234's forms: a literal as a quoted string (with %s where it matches exactly and holds a letter) or, where a quoted string cannot hold it, as a numeric value of its code points, a range as %x and its ends, and a rule the compiler made a token of (CR = %x0D, referenced as CR) as that rule, after the others.",
|
|
60
|
+
"A rule the compiler made a token of, whose name is one the compiler could give its literal by itself (B = \\"b\\", or any name of capitals, digits and underscores where the literal holds a character past ASCII), cannot be told from that literal and is written as the literal: it compiles back with the token later in the token table, or under the name the literal gives it.",
|
|
61
|
+
"Repetitions are written in RFC 5234's forms, *A, 1*A, m*nA, [ A ] for an option over a group and 0*1A for an option over anything else; a repetition of a repetition, which another notation can write and RFC 5234 cannot, is put in a group of its own and compiles back with one more group.",
|
|
62
|
+
"An empty alternative, which RFC 5234 has no syntax for, is written as nothing between its slashes, which the compiler reads as one; in a rule whose alternatives the compiler emits as its open alternates, where it puts the empty one last wherever it stood, it is written first.",
|
|
63
|
+
"A spec compiled from another notation compiles back under ABNF's own settings: the group tag on every alternate, and lexer options the other notation adds (GBNF's exact lexing), are ABNF's, and a class of several members, which RFC 5234 cannot write, is written as the alternation of its members, each range a range and each character a string or a range of one, and compiles back as that alternation.",
|
|
64
|
+
"A spec the render cannot write as ABNF is refused with TARGET_VALUE_UNREPRESENTABLE, naming what it met: an action (a value annotation's builders, a user action, the probe dispatcher of an optional prefix), a condition or a counter other than a repetition's, an error generator or an alternate modifier, a function reference where a rule or a count is due, a set of tokens at one place, a removal, a clear or the form that edits a rule already installed, a token no ABNF terminal matches (a negated class, a class holding a character past ASCII alone, a class whose flags change what it matches, a pattern that is neither one class nor an escaped literal, a case-sensitive literal holding a letter and a character no quoted string holds, a character past U+FFFF), a rule name ABNF cannot spell, the empty name among them, a repetition bounded past what the compiler numbers, a repetition of no copies, whose item the spec does not keep, or a spec that gives its match tokens' order as a list of its own (Go's tokenOrder), whose rules' order, which ranks the tokens, is lost."
|
|
65
|
+
]
|
|
66
|
+
}
|
|
67
|
+
}
|
|
68
|
+
`,
|
|
69
|
+
render: Object.freeze({ entry: "abnf-render", source: `; ABNF's render: a grammar-spec tree, the GrammarSpec the tabnas BNF
|
|
70
|
+
; compiler (tabnas-bnf) emits for a grammar, written back as RFC 5234
|
|
71
|
+
; ABNF. This is a library of definitions, each named \`abnf-...\`, which a
|
|
72
|
+
; host links with its own program (alchemy's \`compile_sources\`); its entry
|
|
73
|
+
; point is \`abnf-render\`, and nothing else here is the host's to call.
|
|
74
|
+
;
|
|
75
|
+
; A host reads an ABNF document by compiling it: the grammar-spec tree is
|
|
76
|
+
; the pure-data GrammarSpec that \`abnfCompile(src, {recognition: false,
|
|
77
|
+
; strict: true})\` writes (\`abnf_compile\` in Rust, \`AbnfCompile\` in Go;
|
|
78
|
+
; the same text in all three runtimes, which tabnas-bnf's oracle tests
|
|
79
|
+
; hold byte for byte), parsed as JSON. Its schema is \`grammar-spec\`,
|
|
80
|
+
; shared with EBNF and GBNF, whose compilers emit the same shape; the
|
|
81
|
+
; contract is the round trip: the text written here compiles back to the
|
|
82
|
+
; spec it was written from.
|
|
83
|
+
;
|
|
84
|
+
; The spec is a compiled grammar, not the grammar's text, so the render
|
|
85
|
+
; reads the compiler's shapes back into the notation:
|
|
86
|
+
;
|
|
87
|
+
; - A rule the author wrote is a rule of the spec that the spec's
|
|
88
|
+
; \`meta.provenance\` does not name; every rule it names is the
|
|
89
|
+
; compiler's: a repetition's, an option's or a group's helper
|
|
90
|
+
; (\`_gen<n>_star_...\`, \`_plus_\`, \`_opt_\`, \`_rep_\`, \`_group\`), a
|
|
91
|
+
; sequence's chain steps (\`$alt<i>\`, \`$step<j>\`), a left-factored tail
|
|
92
|
+
; (\`$fact<k>\`) and the start wrapper. A helper is written where it is
|
|
93
|
+
; referenced, as the construct it compiles: a repeat loop (the replace
|
|
94
|
+
; loop every \`*A\` compiles to, its entry \`{c: {n.rep: 0}, r: <self>}\`)
|
|
95
|
+
; as \`*A\`, a plus as \`1*A\`, an option over a group as \`[ ... ]\` and over
|
|
96
|
+
; anything else as \`0*1A\`, a counted repetition as \`m*nA\` (its nested
|
|
97
|
+
; optionals counted), a group as \`( ... )\`. A factored tail is expanded
|
|
98
|
+
; back into the alternatives it was factored from, which the compiler
|
|
99
|
+
; factors again, and alternatives that were each a group, which the
|
|
100
|
+
; compiler factored into the first, are read back as the groups they
|
|
101
|
+
; were.
|
|
102
|
+
; - An alternative of a rule is read from the alternates the compiler
|
|
103
|
+
; emitted for it: a chain of steps, one per segment of terminals and a
|
|
104
|
+
; reference; a dispatcher's \`$alt<i>\` rules, the gap in their numbers
|
|
105
|
+
; the empty alternative; or, for a rule whose every alternative is one
|
|
106
|
+
; segment, its open alternates, each read as the tokens it consumes
|
|
107
|
+
; (its \`s\` less the \`b\` it gives back) and the rule it pushes, the
|
|
108
|
+
; lookahead copies the dispatch made of one alternative read as one,
|
|
109
|
+
; the empty alternative first (the compiler puts it last wherever it
|
|
110
|
+
; stood), and those that push a helper in the order of the helpers'
|
|
111
|
+
; numbers, which the compiler gives them before it reorders the
|
|
112
|
+
; alternatives to tell them apart.
|
|
113
|
+
; - A leading reference the compiler substituted by the referenced rule's
|
|
114
|
+
; alternatives is written back where those alternatives, each followed
|
|
115
|
+
; by one same tail, still stand together.
|
|
116
|
+
; - A token is written as the terminal it matches: a fixed token as a
|
|
117
|
+
; quoted string, \`%s"..."\` where it holds a letter, a case-folding
|
|
118
|
+
; match token as a quoted string, a range as \`%x<lo>-<hi>\` (a token set
|
|
119
|
+
; the compiler laid over a contested range read back from its name),
|
|
120
|
+
; and the engine's \`#TX\`, \`#NR\`, \`#ST\` and \`#VL\` by their names. A
|
|
121
|
+
; string a quoted string cannot hold is written as a numeric value,
|
|
122
|
+
; \`%x<hex>.<hex>\`. A token named for a rule the compiler lifted to it
|
|
123
|
+
; (\`CR = %x0D\` becomes the token \`#CR\`) is written as that rule, after
|
|
124
|
+
; the others, and referenced by name.
|
|
125
|
+
; - An RFC 5234 core rule (ALPHA, DIGIT, ...) in the spec is not written,
|
|
126
|
+
; since the compiler adds it again wherever it is referenced, and a
|
|
127
|
+
; leading reference to one is written back as any other is.
|
|
128
|
+
;
|
|
129
|
+
; What a rule cannot be read back to is refused with
|
|
130
|
+
; TARGET_VALUE_UNREPRESENTABLE, naming the rule: an action other than the
|
|
131
|
+
; tree builders every compiled grammar carries (a value annotation's
|
|
132
|
+
; builders, a user action, the probe dispatcher's), a condition or a
|
|
133
|
+
; counter other than a repeat loop's, an error generator or an alternate
|
|
134
|
+
; modifier (\`e\`, \`h\`), a function reference where a rule or a count is
|
|
135
|
+
; due, a set of tokens at one place, the form that edits a rule already
|
|
136
|
+
; installed (\`{alts, inject}\`), a removal, and a token no ABNF terminal
|
|
137
|
+
; matches (a negated class, a class holding a character past ASCII alone,
|
|
138
|
+
; a class whose flags change what it matches, a pattern that is neither
|
|
139
|
+
; one class nor an escaped literal). A spec serialized by Go, which writes
|
|
140
|
+
; its rules in name order and its match tokens' order as a list of its
|
|
141
|
+
; own (\`options.match.tokenOrder\`), is refused when that list holds two
|
|
142
|
+
; tokens or more: the rules' order, which ranks the tokens (the order the
|
|
143
|
+
; lexer tries two tokens a place expects), is lost.
|
|
144
|
+
;
|
|
145
|
+
; A spec compiled from another notation is written as far as ABNF can say
|
|
146
|
+
; it: a class of several members (GBNF's and EBNF's \`[a-zA-Z_]\`) as the
|
|
147
|
+
; alternation of its members, each range a range and each character a
|
|
148
|
+
; string that matches it exactly, and an engine token by its name.
|
|
149
|
+
;
|
|
150
|
+
; The whole spec is materialized before a line is written: a rule's
|
|
151
|
+
; alternatives are spread over its chain rules and helpers, which the
|
|
152
|
+
; spec keeps elsewhere in its \`rule\` object.
|
|
153
|
+
|
|
154
|
+
; ---- text and vectors
|
|
155
|
+
|
|
156
|
+
def abnf-at [v i]
|
|
157
|
+
get-path (as-path [i]) v
|
|
158
|
+
|
|
159
|
+
def abnf-num [n]
|
|
160
|
+
scalar-text csv-options n
|
|
161
|
+
|
|
162
|
+
def abnf-empty [s]
|
|
163
|
+
match s
|
|
164
|
+
case "" true
|
|
165
|
+
case _ false
|
|
166
|
+
|
|
167
|
+
def abnf-full [s]
|
|
168
|
+
match s
|
|
169
|
+
case "" false
|
|
170
|
+
case _ true
|
|
171
|
+
|
|
172
|
+
; Whether the strings a and b are the same: a string cut by itself is two
|
|
173
|
+
; empty strings, and by any other string it is not.
|
|
174
|
+
def abnf-same [a b]
|
|
175
|
+
match b
|
|
176
|
+
case "" (abnf-empty a)
|
|
177
|
+
case _
|
|
178
|
+
match (split b a)
|
|
179
|
+
case ["" ""] true
|
|
180
|
+
case _ false
|
|
181
|
+
|
|
182
|
+
def abnf-not [x]
|
|
183
|
+
match x
|
|
184
|
+
case true false
|
|
185
|
+
case false true
|
|
186
|
+
|
|
187
|
+
def abnf-less [a b]
|
|
188
|
+
match (compare a b)
|
|
189
|
+
case :less true
|
|
190
|
+
case _ false
|
|
191
|
+
|
|
192
|
+
def abnf-some [v]
|
|
193
|
+
match (count v)
|
|
194
|
+
case 0 false
|
|
195
|
+
case _ true
|
|
196
|
+
|
|
197
|
+
def abnf-none [v]
|
|
198
|
+
match (count v)
|
|
199
|
+
case 0 true
|
|
200
|
+
case _ false
|
|
201
|
+
|
|
202
|
+
def abnf-rest [v]
|
|
203
|
+
map (fn [i] (abnf-at v i)) (filter (fn [i] (match i (case 0 false) (case _ true))) (indices v))
|
|
204
|
+
|
|
205
|
+
def abnf-take [n v]
|
|
206
|
+
map (fn [i] (abnf-at v i)) (filter (fn [i] (abnf-less i n)) (indices v))
|
|
207
|
+
|
|
208
|
+
def abnf-drop [n v]
|
|
209
|
+
map (fn [i] (abnf-at v i)) (filter (fn [i] (abnf-not (abnf-less i n))) (indices v))
|
|
210
|
+
|
|
211
|
+
; Whether s begins with the non-empty p, ends with it; s after its first
|
|
212
|
+
; p, before its last.
|
|
213
|
+
def abnf-starts [p s]
|
|
214
|
+
match s
|
|
215
|
+
case "" false
|
|
216
|
+
case _ (abnf-empty (abnf-at (split p s) 0))
|
|
217
|
+
|
|
218
|
+
def abnf-ends [p s]
|
|
219
|
+
match s
|
|
220
|
+
case "" false
|
|
221
|
+
case _ (abnf-empty (top (split p s)))
|
|
222
|
+
|
|
223
|
+
def abnf-after [p s]
|
|
224
|
+
string-join p (abnf-rest (split p s))
|
|
225
|
+
|
|
226
|
+
def abnf-before [p s]
|
|
227
|
+
string-join p (pop (split p s))
|
|
228
|
+
|
|
229
|
+
def abnf-digits [s]
|
|
230
|
+
match s
|
|
231
|
+
case "" false
|
|
232
|
+
case _ (chars-within [[48 57]] s)
|
|
233
|
+
|
|
234
|
+
; The items of two vectors, and of a vector of vectors, in order: each
|
|
235
|
+
; item is named by its place, the places joined as text and read back.
|
|
236
|
+
def abnf-cat [a b]
|
|
237
|
+
abnf-flat [a b]
|
|
238
|
+
|
|
239
|
+
def abnf-flat [vv]
|
|
240
|
+
map
|
|
241
|
+
fn [t]
|
|
242
|
+
let [p (split "." t)]
|
|
243
|
+
get-path (as-path [(number (abnf-at p 0)) (number (abnf-at p 1))]) vv
|
|
244
|
+
filter abnf-full
|
|
245
|
+
split ","
|
|
246
|
+
string-join ","
|
|
247
|
+
map
|
|
248
|
+
fn [j]
|
|
249
|
+
string-join "," (map (fn [i] (string-join "." [(abnf-num j) (abnf-num i)])) (indices (abnf-at vv j)))
|
|
250
|
+
indices vv
|
|
251
|
+
|
|
252
|
+
; Whether the string s is among the strings of v.
|
|
253
|
+
def abnf-among [s v]
|
|
254
|
+
abnf-some (filter (fn [x] (abnf-same x s)) v)
|
|
255
|
+
|
|
256
|
+
; The items of v whose key is the first of its kind, in order.
|
|
257
|
+
def abnf-unique [keyf v]
|
|
258
|
+
let [ks (map keyf v)]
|
|
259
|
+
let [prev (abnf-cat ["\\u0000"] (pop (abnf-cat ks ["\\u0000"])))]
|
|
260
|
+
let [runs (filter (fn [i] (abnf-not (abnf-same (abnf-at ks i) (abnf-at prev i)))) (indices ks))]
|
|
261
|
+
map
|
|
262
|
+
fn [i] (abnf-at v i)
|
|
263
|
+
filter
|
|
264
|
+
fn [i]
|
|
265
|
+
abnf-none (filter (fn [j] (match (abnf-less j i) (case true (abnf-same (abnf-at ks j) (abnf-at ks i))) (case false false))) runs)
|
|
266
|
+
runs
|
|
267
|
+
|
|
268
|
+
def abnf-plus [a b]
|
|
269
|
+
length (string-join "" [(repeat a "x") (repeat b "x")])
|
|
270
|
+
|
|
271
|
+
def abnf-ones [n]
|
|
272
|
+
pop (split "x" (repeat n "x"))
|
|
273
|
+
|
|
274
|
+
def abnf-even [j]
|
|
275
|
+
abnf-some (filter (fn [d] (abnf-ends d (abnf-num j))) ["0" "2" "4" "6" "8"])
|
|
276
|
+
|
|
277
|
+
def abnf-fail [what]
|
|
278
|
+
fail :unrepresentable (string-join "" ["the grammar spec cannot be written as ABNF: " what])
|
|
279
|
+
|
|
280
|
+
; ---- the spec
|
|
281
|
+
|
|
282
|
+
def abnf-rec [v]
|
|
283
|
+
match (kind v)
|
|
284
|
+
case :record v
|
|
285
|
+
case _ (record)
|
|
286
|
+
|
|
287
|
+
def abnf-vec [v]
|
|
288
|
+
match (kind v)
|
|
289
|
+
case :vector (as-vector v)
|
|
290
|
+
case _ []
|
|
291
|
+
|
|
292
|
+
def abnf-str [v]
|
|
293
|
+
match (kind v)
|
|
294
|
+
case :string v
|
|
295
|
+
case _ ""
|
|
296
|
+
|
|
297
|
+
def abnf-context [spec]
|
|
298
|
+
let [o (abnf-rec (get "options" spec))]
|
|
299
|
+
record
|
|
300
|
+
entry :rules (abnf-rec (get "rule" spec))
|
|
301
|
+
entry :fixed (abnf-rec (get-path (as-path ["fixed" "token"]) o))
|
|
302
|
+
entry :match (abnf-rec (get-path (as-path ["match" "token"]) o))
|
|
303
|
+
entry :sets (abnf-rec (get "tokenSet" o))
|
|
304
|
+
entry :prov (get-path (as-path ["meta" "provenance"]) spec)
|
|
305
|
+
entry :start (abnf-str (get-path (as-path ["rule" "start"]) o))
|
|
306
|
+
|
|
307
|
+
def abnf-rule [cx name]
|
|
308
|
+
get-path (as-path [name]) (get :rules cx)
|
|
309
|
+
|
|
310
|
+
def abnf-has [cx name]
|
|
311
|
+
match (kind (abnf-rule cx name))
|
|
312
|
+
case :record true
|
|
313
|
+
case _ false
|
|
314
|
+
|
|
315
|
+
; A rule's alternates in one phase, the falsy placeholders the engine
|
|
316
|
+
; skips left out.
|
|
317
|
+
def abnf-open [r]
|
|
318
|
+
filter (fn [alt] (match (kind alt) (case :record true) (case _ false))) (abnf-vec (get "open" r))
|
|
319
|
+
|
|
320
|
+
def abnf-close [r]
|
|
321
|
+
filter (fn [alt] (match (kind alt) (case :record true) (case _ false))) (abnf-vec (get "close" r))
|
|
322
|
+
|
|
323
|
+
; The tokens an alternate matches: its \`s\`, a string of token names
|
|
324
|
+
; between spaces or a list of them.
|
|
325
|
+
def abnf-s [alt]
|
|
326
|
+
let [s (get "s" alt)]
|
|
327
|
+
match (kind s)
|
|
328
|
+
case :string (filter abnf-full (split " " s))
|
|
329
|
+
case :vector (map abnf-str (as-vector s))
|
|
330
|
+
case _ []
|
|
331
|
+
|
|
332
|
+
def abnf-b [alt]
|
|
333
|
+
match (kind (get "b" alt))
|
|
334
|
+
case :number (get "b" alt)
|
|
335
|
+
case _ 0
|
|
336
|
+
|
|
337
|
+
def abnf-p [alt]
|
|
338
|
+
abnf-str (get "p" alt)
|
|
339
|
+
|
|
340
|
+
def abnf-r [alt]
|
|
341
|
+
abnf-str (get "r" alt)
|
|
342
|
+
|
|
343
|
+
def abnf-a [alt]
|
|
344
|
+
match (kind (get "a" alt))
|
|
345
|
+
case :string (get "a" alt)
|
|
346
|
+
case :missing ""
|
|
347
|
+
case :null ""
|
|
348
|
+
case _ "?"
|
|
349
|
+
|
|
350
|
+
; Whether the compiler made the rule: provenance names every rule it
|
|
351
|
+
; synthesized, and a spec without provenance is read by the names it
|
|
352
|
+
; gives them.
|
|
353
|
+
def abnf-made [cx name]
|
|
354
|
+
match (kind (get :prov cx))
|
|
355
|
+
case :record
|
|
356
|
+
match (kind (get-path (as-path [name]) (get :prov cx)))
|
|
357
|
+
case :string true
|
|
358
|
+
case _ false
|
|
359
|
+
case _
|
|
360
|
+
match (abnf-starts "_gen" name)
|
|
361
|
+
case true true
|
|
362
|
+
case false (abnf-some (abnf-rest (split "$" name)))
|
|
363
|
+
|
|
364
|
+
; The kind the tree builders give a rule the author wrote: "user", or
|
|
365
|
+
; "core" for an RFC 5234 core rule the compiler added.
|
|
366
|
+
def abnf-kind [r]
|
|
367
|
+
let [o (abnf-open r)]
|
|
368
|
+
match (count o)
|
|
369
|
+
case 0 "user"
|
|
370
|
+
case _
|
|
371
|
+
match (abnf-str (get-path (as-path ["k" "node$" "kind"]) (abnf-at o 0)))
|
|
372
|
+
case "core" "core"
|
|
373
|
+
case _ "user"
|
|
374
|
+
|
|
375
|
+
; ---- what the spec may hold
|
|
376
|
+
|
|
377
|
+
; Every alternate is one the compiler's tree-building grammars are made
|
|
378
|
+
; of: the tokens it matches and gives back (\`s\`, \`b\`), the rule it pushes
|
|
379
|
+
; or replaces itself with (\`p\`, \`r\`), the tree builders (\`a\`, \`k\`), group
|
|
380
|
+
; tags, marks and per-rule scratch (\`g\`, \`m\`, \`u\`), and, in a repeat loop
|
|
381
|
+
; alone, the loop's guard and counter (\`c\`, \`n\`). Anything more is a
|
|
382
|
+
; construct the notation does not write: an error generator (\`e\`), an
|
|
383
|
+
; alternate modifier (\`h\`), a function in place of a rule or a count, an
|
|
384
|
+
; action other than the tree builders, another condition or counter.
|
|
385
|
+
def abnf-alt-keys ["s" "b" "p" "r" "a" "c" "n" "k" "g" "m" "u"]
|
|
386
|
+
|
|
387
|
+
def abnf-key-text [key]
|
|
388
|
+
match key
|
|
389
|
+
case "e" "e (an error generator)"
|
|
390
|
+
case "h" "h (an alternate modifier)"
|
|
391
|
+
case _ key
|
|
392
|
+
|
|
393
|
+
def abnf-check-alt [cx name alt]
|
|
394
|
+
let [extra (filter (fn [key] (match (abnf-among key abnf-alt-keys) (case true false) (case false (abnf-given (get key alt))))) (keys alt))]
|
|
395
|
+
match (count extra)
|
|
396
|
+
case 0 (abnf-check-parts cx name alt)
|
|
397
|
+
case _ (abnf-fail (string-join "" ["rule " name " has an alternate carrying " (string-join ", " (map abnf-key-text extra)) ", which is not written"]))
|
|
398
|
+
|
|
399
|
+
def abnf-check-parts [cx name alt]
|
|
400
|
+
let [a (abnf-a alt)]
|
|
401
|
+
match (abnf-among a ["" "@node$" "@capture$" "@bubble$" "@fold$"])
|
|
402
|
+
case false
|
|
403
|
+
match (abnf-starts "@probe" (abnf-action-text alt))
|
|
404
|
+
case true (abnf-fail (string-join "" ["rule " name " is the probe dispatcher the compiler makes for an optional prefix ([ X D ] Y), which is not read back"]))
|
|
405
|
+
case false (abnf-fail (string-join "" ["rule " name " carries an action (" (abnf-action-text alt) "), which is not written"]))
|
|
406
|
+
case true
|
|
407
|
+
let [tokens (abnf-check-s name (get "s" alt))]
|
|
408
|
+
let [next (count (map (fn [key] (abnf-check-next name key (get key alt))) ["p" "r"]))]
|
|
409
|
+
let [back (abnf-check-back name (get "b" alt))]
|
|
410
|
+
abnf-check-loop cx name alt
|
|
411
|
+
|
|
412
|
+
; The tokens: a string of names between spaces, or a list of names, one
|
|
413
|
+
; place each; a place holding a set of tokens (names between spaces, or a
|
|
414
|
+
; list) chooses among them, which the render does not read back.
|
|
415
|
+
def abnf-check-s [name s]
|
|
416
|
+
match (kind s)
|
|
417
|
+
case :missing true
|
|
418
|
+
case :null true
|
|
419
|
+
case :string true
|
|
420
|
+
case :vector
|
|
421
|
+
match (abnf-none (filter (fn [t] (match (kind t) (case :string (abnf-some (abnf-rest (split " " t)))) (case _ true))) (as-vector s)))
|
|
422
|
+
case true true
|
|
423
|
+
case false (abnf-fail (string-join "" ["rule " name " has an alternate whose s holds, at one place, a set of tokens or something other than a token's name, which is not written"]))
|
|
424
|
+
case _ (abnf-fail (string-join "" ["rule " name " has an alternate whose s is not tokens, which is not written"]))
|
|
425
|
+
|
|
426
|
+
; The rule an alternate pushes or replaces itself with: a name, or none;
|
|
427
|
+
; a function reference (\`@name\`) chooses at run time and is not written.
|
|
428
|
+
def abnf-check-next [name key v]
|
|
429
|
+
match (kind v)
|
|
430
|
+
case :missing true
|
|
431
|
+
case :null true
|
|
432
|
+
case :boolean (match v (case false true) (case _ (abnf-fail (string-join "" ["rule " name " has an alternate whose " key " is not a rule, which is not written"]))))
|
|
433
|
+
case :string
|
|
434
|
+
match (abnf-starts "@" v)
|
|
435
|
+
case true (abnf-fail (string-join "" ["rule " name " has an alternate whose " key " is the function reference " v ", which is not written"]))
|
|
436
|
+
case false true
|
|
437
|
+
case _ (abnf-fail (string-join "" ["rule " name " has an alternate whose " key " is not a rule, which is not written"]))
|
|
438
|
+
|
|
439
|
+
def abnf-check-back [name v]
|
|
440
|
+
match (kind v)
|
|
441
|
+
case :missing true
|
|
442
|
+
case :null true
|
|
443
|
+
case :number true
|
|
444
|
+
case :boolean (match v (case false true) (case _ (abnf-fail (string-join "" ["rule " name " has an alternate whose b is not a count, which is not written"]))))
|
|
445
|
+
case _ (abnf-fail (string-join "" ["rule " name " has an alternate whose b is not a count (" (abnf-str v) "), which is not written"]))
|
|
446
|
+
|
|
447
|
+
; A repeat loop's guard (\`c: {n.rep: 0}\`) and counter (\`n: {rep: 0}\` or
|
|
448
|
+
; \`{rep: 1}\`), in the loop the compiler makes for a repetition and the
|
|
449
|
+
; steps of its item, and nowhere else.
|
|
450
|
+
def abnf-loop-rule [cx name]
|
|
451
|
+
abnf-same (abnf-helper-kind cx (abnf-at (split "$" name) 0)) "star"
|
|
452
|
+
|
|
453
|
+
def abnf-check-loop [cx name alt]
|
|
454
|
+
let [c (get "c" alt)]
|
|
455
|
+
let [n (get "n" alt)]
|
|
456
|
+
match (match (abnf-given c) (case true true) (case false (abnf-given n)))
|
|
457
|
+
case false true
|
|
458
|
+
case true
|
|
459
|
+
match (abnf-loop-rule cx name)
|
|
460
|
+
case false (abnf-fail (string-join "" ["rule " name " carries a condition or a counter outside a repetition's loop, which is not written"]))
|
|
461
|
+
case true
|
|
462
|
+
match (match (abnf-given c) (case false true) (case true (match (kind c) (case :record (abnf-loop-value c "n.rep" [0])) (case _ false))))
|
|
463
|
+
case false (abnf-fail (string-join "" ["rule " name " carries a condition other than its loop's, which is not written"]))
|
|
464
|
+
case true
|
|
465
|
+
match (match (abnf-given n) (case false true) (case true (match (kind n) (case :record (abnf-loop-value n "rep" [0 1])) (case _ false))))
|
|
466
|
+
case false (abnf-fail (string-join "" ["rule " name " carries a counter other than its loop's, which is not written"]))
|
|
467
|
+
case true true
|
|
468
|
+
|
|
469
|
+
; Whether an alternate gives a field: the engine reads a field that is
|
|
470
|
+
; missing, null or false as one it does not give.
|
|
471
|
+
def abnf-given [v]
|
|
472
|
+
match (kind v)
|
|
473
|
+
case :missing false
|
|
474
|
+
case :null false
|
|
475
|
+
case :boolean (match v (case false false) (case _ true))
|
|
476
|
+
case _ true
|
|
477
|
+
|
|
478
|
+
def abnf-loop-value [rec key allowed]
|
|
479
|
+
match (keys rec)
|
|
480
|
+
case [only]
|
|
481
|
+
match (abnf-same only key)
|
|
482
|
+
case false false
|
|
483
|
+
case true
|
|
484
|
+
let [v (get-path (as-path [key]) rec)]
|
|
485
|
+
abnf-some (filter (fn [x] (match (compare v x) (case :equal true) (case _ false))) allowed)
|
|
486
|
+
case _ false
|
|
487
|
+
|
|
488
|
+
def abnf-action-text [alt]
|
|
489
|
+
match (kind (get "a" alt))
|
|
490
|
+
case :string (get "a" alt)
|
|
491
|
+
case :vector (string-join " " (map abnf-str (as-vector (get "a" alt))))
|
|
492
|
+
case _ "a function"
|
|
493
|
+
|
|
494
|
+
; A rule's phases: a list of alternates each, or none; the form that edits
|
|
495
|
+
; a rule already installed (\`{alts, inject}\`) is not written.
|
|
496
|
+
def abnf-check-phase [name phase v]
|
|
497
|
+
match (kind v)
|
|
498
|
+
case :missing true
|
|
499
|
+
case :null true
|
|
500
|
+
case :vector true
|
|
501
|
+
case :record (abnf-fail (string-join "" ["rule " name " gives its " phase " alternates as alts and an inject, which edits a rule already installed and is not written"]))
|
|
502
|
+
case _ (abnf-fail (string-join "" ["rule " name " gives its " phase " alternates in a form that is not a list, which is not written"]))
|
|
503
|
+
|
|
504
|
+
def abnf-check-rule [cx name]
|
|
505
|
+
let [r (abnf-rule cx name)]
|
|
506
|
+
match (kind r)
|
|
507
|
+
case :record
|
|
508
|
+
let [phases (count (map (fn [phase] (abnf-check-phase name phase (get phase r))) ["open" "close"]))]
|
|
509
|
+
count (map (fn [alt] (abnf-check-alt cx name alt)) (abnf-cat (abnf-open r) (abnf-close r)))
|
|
510
|
+
case :null (abnf-fail (string-join "" ["rule " name " is removed, which is not written"]))
|
|
511
|
+
case _ (abnf-fail (string-join "" ["rule " name " is not a rule's alternates, which is not written"]))
|
|
512
|
+
|
|
513
|
+
; A spec serialized by Go writes its keys in name order and its match
|
|
514
|
+
; tokens' order in a list of its own (\`options.match.tokenOrder\`): the
|
|
515
|
+
; rules' order, which decides the order the compiler gives the tokens
|
|
516
|
+
; again, is lost, and with it which of two tokens that both match wins.
|
|
517
|
+
def abnf-check-order [spec]
|
|
518
|
+
let [order (get-path (as-path ["options" "match" "tokenOrder"]) spec)]
|
|
519
|
+
match (kind order)
|
|
520
|
+
case :vector
|
|
521
|
+
match (abnf-less (count (as-vector order)) 2)
|
|
522
|
+
case true true
|
|
523
|
+
case false (abnf-fail "it gives its match tokens' order as a list of its own (tokenOrder, Go's serialization, whose keys are in name order), and the order of the rules, which their precedence follows, is lost")
|
|
524
|
+
case _ true
|
|
525
|
+
|
|
526
|
+
def abnf-check [spec cx]
|
|
527
|
+
match (get "clear" spec)
|
|
528
|
+
case true (abnf-fail "it clears the grammar it is installed on, which is not written")
|
|
529
|
+
case _
|
|
530
|
+
let [order (abnf-check-order spec)]
|
|
531
|
+
count (map (fn [name] (abnf-check-rule cx name)) (keys (get :rules cx)))
|
|
532
|
+
|
|
533
|
+
; ---- tokens
|
|
534
|
+
|
|
535
|
+
def abnf-bare [t]
|
|
536
|
+
abnf-after "#" t
|
|
537
|
+
|
|
538
|
+
def abnf-lit [text cs]
|
|
539
|
+
record
|
|
540
|
+
entry :k :lit
|
|
541
|
+
entry :text text
|
|
542
|
+
entry :cs cs
|
|
543
|
+
|
|
544
|
+
def abnf-class [pat flags]
|
|
545
|
+
record
|
|
546
|
+
entry :k :class
|
|
547
|
+
entry :pat pat
|
|
548
|
+
entry :flags flags
|
|
549
|
+
|
|
550
|
+
; A pattern's escapes taken back off: an escaped backslash is a pair, any
|
|
551
|
+
; other escape one backslash before the character it escapes.
|
|
552
|
+
def abnf-unescape [s]
|
|
553
|
+
string-join "\\\\" (map (fn [piece] (string-join "" (split "\\\\" piece))) (split "\\\\\\\\" s))
|
|
554
|
+
|
|
555
|
+
; A match token's source, \`@~/^.../flags\`: a class, or a case-folding
|
|
556
|
+
; literal.
|
|
557
|
+
def abnf-match-token [t m]
|
|
558
|
+
let [parts (split "/" m)]
|
|
559
|
+
let [flags (top parts)]
|
|
560
|
+
let [src (string-join "/" (pop (abnf-rest parts)))]
|
|
561
|
+
match (abnf-starts "^" src)
|
|
562
|
+
case false (abnf-fail (string-join "" ["the token " t " is the pattern " m ", which no ABNF terminal matches"]))
|
|
563
|
+
case true
|
|
564
|
+
let [body (abnf-after "^" src)]
|
|
565
|
+
match (abnf-starts "[" body)
|
|
566
|
+
case true
|
|
567
|
+
match (abnf-class-pattern body)
|
|
568
|
+
case false (abnf-fail (string-join "" ["the token " t " is the pattern " m ", which is not one class the render reads, and no ABNF terminal matches it"]))
|
|
569
|
+
case true
|
|
570
|
+
match (abnf-among flags ["" "u"])
|
|
571
|
+
case true (abnf-class body flags)
|
|
572
|
+
case false (abnf-fail (string-join "" ["the token " t " is the class " m ", whose flags (" flags ") change what it matches, and no ABNF terminal matches it"]))
|
|
573
|
+
case false
|
|
574
|
+
match flags
|
|
575
|
+
case "i"
|
|
576
|
+
match (abnf-escaped-literal body)
|
|
577
|
+
case true (abnf-lit (abnf-unescape body) false)
|
|
578
|
+
case false (abnf-fail (string-join "" ["the token " t " is the pattern " m ", which is not a literal the render reads, and no ABNF terminal matches it"]))
|
|
579
|
+
case _ (abnf-fail (string-join "" ["the token " t " is the pattern " m ", which no ABNF terminal matches"]))
|
|
580
|
+
|
|
581
|
+
; Whether a pattern's body is one class as the compiler writes one:
|
|
582
|
+
; \`[\`, an optional \`^\`, members each a \`\\uXXXX\` or \`\\u{X...}\` escape, alone
|
|
583
|
+
; or the low end of a range, and \`]\` ending it; or \`[\\s\\S]\`, which
|
|
584
|
+
; another notation's \`.\` compiles to.
|
|
585
|
+
def abnf-class-pattern [body]
|
|
586
|
+
match body
|
|
587
|
+
case "[\\\\s\\\\S]" true
|
|
588
|
+
case _
|
|
589
|
+
match (abnf-ends "]" body)
|
|
590
|
+
case false false
|
|
591
|
+
case true
|
|
592
|
+
let [inner (abnf-before "]" (abnf-after "[" body))]
|
|
593
|
+
match (abnf-some (filter (fn [c] (abnf-some (abnf-rest (split c inner)))) ["[" "]"]))
|
|
594
|
+
case true false
|
|
595
|
+
case false
|
|
596
|
+
let [pieces (split "\\\\u" (match (abnf-starts "^" inner) (case true (abnf-after "^" inner)) (case false inner)))]
|
|
597
|
+
match (abnf-empty (abnf-at pieces 0))
|
|
598
|
+
case false false
|
|
599
|
+
case true
|
|
600
|
+
let [members (abnf-rest pieces)]
|
|
601
|
+
match (count members)
|
|
602
|
+
case 0 false
|
|
603
|
+
case _
|
|
604
|
+
match (abnf-ends "-" (top members))
|
|
605
|
+
case true false
|
|
606
|
+
case false (abnf-none (filter (fn [m] (abnf-not (abnf-member-piece m))) members))
|
|
607
|
+
|
|
608
|
+
def abnf-member-piece [piece]
|
|
609
|
+
let [core (match (abnf-ends "-" piece) (case true (abnf-before "-" piece)) (case false piece))]
|
|
610
|
+
match (abnf-starts "{" core)
|
|
611
|
+
case true
|
|
612
|
+
match (abnf-ends "}" core)
|
|
613
|
+
case false false
|
|
614
|
+
case true
|
|
615
|
+
let [h (abnf-before "}" (abnf-after "{" core))]
|
|
616
|
+
match (abnf-among (abnf-num (length h)) ["1" "2" "3" "4" "5" "6"])
|
|
617
|
+
case false false
|
|
618
|
+
case true (abnf-hex-only h)
|
|
619
|
+
case false
|
|
620
|
+
match (length core)
|
|
621
|
+
case 4 (abnf-hex-only core)
|
|
622
|
+
case _ false
|
|
623
|
+
|
|
624
|
+
def abnf-hex-only [h]
|
|
625
|
+
match h
|
|
626
|
+
case "" false
|
|
627
|
+
case _ (chars-within [[48 57] [65 70] [97 102]] h)
|
|
628
|
+
|
|
629
|
+
; Whether a pattern's body is a literal as the compiler escapes one: every
|
|
630
|
+
; character a pattern reads otherwise (\`\\ ^ $ . * + ? ( ) [ ] { } |\`)
|
|
631
|
+
; after a backslash, and a backslash before nothing else.
|
|
632
|
+
def abnf-meta-chars ["^" "$" "." "*" "+" "?" "(" ")" "[" "]" "{" "}" "|"]
|
|
633
|
+
|
|
634
|
+
def abnf-escaped-literal [body]
|
|
635
|
+
let [rest (abnf-strip-escapes abnf-strip-escapes abnf-meta-chars (string-join "" (split "\\\\\\\\" body)))]
|
|
636
|
+
match (abnf-some (abnf-rest (split "\\\\" rest)))
|
|
637
|
+
case true false
|
|
638
|
+
case false (abnf-none (filter (fn [c] (abnf-some (abnf-rest (split c rest)))) abnf-meta-chars))
|
|
639
|
+
|
|
640
|
+
def abnf-strip-escapes [self cs s]
|
|
641
|
+
match (count cs)
|
|
642
|
+
case 0 s
|
|
643
|
+
case _ (self self (pop cs) (string-join "" (split (string-join "" ["\\\\" (top cs)]) s)))
|
|
644
|
+
|
|
645
|
+
; A token set's class, read back from its name, which the compiler gives
|
|
646
|
+
; the class it lays over the atoms (\`rx_\` and the pattern, each character
|
|
647
|
+
; that is not a letter or a digit an underscore, in capitals). Each member
|
|
648
|
+
; of the pattern is a \`\\u\` escape, \`\\uXXXX\` or \`\\u{X...}\`, alone or the
|
|
649
|
+
; low end of a range; the name keeps their digits and order.
|
|
650
|
+
def abnf-hex-lower [h]
|
|
651
|
+
string-join "a" (split "A" (string-join "b" (split "B" (string-join "c" (split "C" (string-join "d" (split "D" (string-join "e" (split "E" (string-join "f" (split "F" h)))))))))))
|
|
652
|
+
|
|
653
|
+
def abnf-hex-upper [h]
|
|
654
|
+
string-join "A" (split "a" (string-join "B" (split "b" (string-join "C" (split "c" (string-join "D" (split "d" (string-join "E" (split "e" (string-join "F" (split "f" h)))))))))))
|
|
655
|
+
|
|
656
|
+
def abnf-set-member [piece]
|
|
657
|
+
let [parts (split "_" piece)]
|
|
658
|
+
match (abnf-empty (abnf-at parts 0))
|
|
659
|
+
case true
|
|
660
|
+
record
|
|
661
|
+
entry :text (string-join "" ["\\\\u{" (abnf-hex-lower (abnf-at parts 1)) "}"])
|
|
662
|
+
entry :braced true
|
|
663
|
+
entry :range (match (count parts) (case 4 true) (case _ false))
|
|
664
|
+
case false
|
|
665
|
+
record
|
|
666
|
+
entry :text (string-join "" ["\\\\u" (abnf-hex-lower (abnf-at parts 0))])
|
|
667
|
+
entry :braced false
|
|
668
|
+
entry :range (match (count parts) (case 2 true) (case _ false))
|
|
669
|
+
|
|
670
|
+
def abnf-set-token [t]
|
|
671
|
+
let [rest (abnf-after "RX_" (abnf-bare t))]
|
|
672
|
+
match rest
|
|
673
|
+
case "__S_S" (abnf-class "[\\\\s\\\\S]" "u")
|
|
674
|
+
case _
|
|
675
|
+
let [pieces (split "_U" rest)]
|
|
676
|
+
let [members (map abnf-set-member (abnf-rest pieces))]
|
|
677
|
+
let [negated (abnf-same (abnf-at pieces 0) "__")]
|
|
678
|
+
let [body (string-join "" (map (fn [m] (string-join "" [(get :text m) (match (get :range m) (case true "-") (case false ""))])) members))]
|
|
679
|
+
let [pat (string-join "" ["[" (match negated (case true "^") (case false "")) body "]"])]
|
|
680
|
+
match (abnf-same (abnf-class-name pat) (abnf-bare t))
|
|
681
|
+
case false (abnf-fail (string-join "" ["the token set " t " names no class the render can read back"]))
|
|
682
|
+
case true
|
|
683
|
+
match negated
|
|
684
|
+
case true (abnf-class pat "u")
|
|
685
|
+
case false (abnf-class pat (match (abnf-some (filter (fn [m] (get :braced m)) members)) (case true "u") (case false "")))
|
|
686
|
+
|
|
687
|
+
; The name the compiler gives a class's token: \`rx_\` and its pattern, every
|
|
688
|
+
; character but a letter or a digit an underscore, in capitals, with the
|
|
689
|
+
; underscores at the end taken off.
|
|
690
|
+
def abnf-class-name [pat]
|
|
691
|
+
let [u (abnf-hex-upper (string-join "U" (split "u" (string-join "S" (split "s" pat)))))]
|
|
692
|
+
let [n (string-join "_" (split "[" (string-join "_" (split "]" (string-join "_" (split "^" (string-join "_" (split "-" (string-join "_" (split "\\\\" (string-join "_" (split "{" (string-join "_" (split "}" u))))))))))))))]
|
|
693
|
+
abnf-trim-end (string-join "" ["RX_" n])
|
|
694
|
+
|
|
695
|
+
def abnf-trim-end [s]
|
|
696
|
+
match (abnf-ends "_" s)
|
|
697
|
+
case true (abnf-trim-end-once (abnf-before "_" s))
|
|
698
|
+
case false s
|
|
699
|
+
|
|
700
|
+
def abnf-trim-end-once [s]
|
|
701
|
+
match (abnf-ends "_" s)
|
|
702
|
+
case true (abnf-before "_" s)
|
|
703
|
+
case false s
|
|
704
|
+
|
|
705
|
+
def abnf-engine-token [t]
|
|
706
|
+
match t
|
|
707
|
+
case "#TX" (record (entry :k :engine) (entry :name "TX"))
|
|
708
|
+
case "#NR" (record (entry :k :engine) (entry :name "NR"))
|
|
709
|
+
case "#ST" (record (entry :k :engine) (entry :name "ST"))
|
|
710
|
+
case "#VL" (record (entry :k :engine) (entry :name "VL"))
|
|
711
|
+
case _ (abnf-fail (string-join "" ["the token " t " is defined nowhere in the spec"]))
|
|
712
|
+
|
|
713
|
+
def abnf-token [cx t]
|
|
714
|
+
let [f (get-path (as-path [t]) (get :fixed cx))]
|
|
715
|
+
match (kind f)
|
|
716
|
+
case :string (abnf-lit f true)
|
|
717
|
+
case _
|
|
718
|
+
let [m (get-path (as-path [t]) (get :match cx))]
|
|
719
|
+
match (kind m)
|
|
720
|
+
case :string (abnf-match-token t m)
|
|
721
|
+
case _
|
|
722
|
+
match (kind (get-path (as-path [(abnf-bare t)]) (get :sets cx)))
|
|
723
|
+
case :vector (abnf-set-token t)
|
|
724
|
+
case _ (abnf-engine-token t)
|
|
725
|
+
|
|
726
|
+
; ---- reading a rule's alternatives
|
|
727
|
+
|
|
728
|
+
; An element of an alternative as the spec holds it: a token, or a
|
|
729
|
+
; reference to a rule (the compiler's helpers among them).
|
|
730
|
+
def abnf-tok-el [t]
|
|
731
|
+
record
|
|
732
|
+
entry :k :tok
|
|
733
|
+
entry :name t
|
|
734
|
+
|
|
735
|
+
def abnf-ref-el [n]
|
|
736
|
+
record
|
|
737
|
+
entry :k :ref
|
|
738
|
+
entry :name n
|
|
739
|
+
|
|
740
|
+
; The tokens an alternate consumes, and the rule it hands over to.
|
|
741
|
+
def abnf-consumed [alt]
|
|
742
|
+
let [s (abnf-s alt)]
|
|
743
|
+
let [b (abnf-b alt)]
|
|
744
|
+
abnf-take (count (filter (fn [j] (abnf-not (abnf-less j b))) (indices s))) s
|
|
745
|
+
|
|
746
|
+
def abnf-target [alt]
|
|
747
|
+
match (abnf-p alt)
|
|
748
|
+
case "" (abnf-r alt)
|
|
749
|
+
case p p
|
|
750
|
+
|
|
751
|
+
def abnf-entry-els [alt]
|
|
752
|
+
let [toks (map abnf-tok-el (abnf-consumed alt))]
|
|
753
|
+
match (abnf-target alt)
|
|
754
|
+
case "" toks
|
|
755
|
+
case to (push (abnf-ref-el to) toks)
|
|
756
|
+
|
|
757
|
+
def abnf-entry-key [alt]
|
|
758
|
+
string-join "" [(string-join " " (abnf-consumed alt)) "|" (abnf-target alt)]
|
|
759
|
+
|
|
760
|
+
; A rule whose alternatives are each one segment: its open alternates,
|
|
761
|
+
; each read as what it consumes and pushes, a dispatch's lookahead copies
|
|
762
|
+
; of one alternative read as one; the empty alternative first, which the
|
|
763
|
+
; compiler puts last wherever it stood, so that either place compiles
|
|
764
|
+
; back the same. An alternate that consumes nothing and pushes nothing is
|
|
765
|
+
; the empty alternative, or a guard that ends it on what may follow; two
|
|
766
|
+
; or more bare ones (\`a ::= | \`) are as many empty alternatives.
|
|
767
|
+
def abnf-simple-alts [r]
|
|
768
|
+
let [alts (map abnf-entry-els (abnf-unique abnf-entry-key (abnf-open r)))]
|
|
769
|
+
let [bare (count (filter abnf-bare-empty (abnf-open r)))]
|
|
770
|
+
let [empties (match (abnf-some (filter abnf-none alts)) (case false []) (case true (map (fn [i] []) (indices (abnf-ones (match (abnf-less bare 2) (case true 1) (case false bare)))))))]
|
|
771
|
+
abnf-cat empties (abnf-number-order (filter abnf-some alts))
|
|
772
|
+
|
|
773
|
+
def abnf-bare-empty [alt]
|
|
774
|
+
match (abnf-some (abnf-s alt))
|
|
775
|
+
case true false
|
|
776
|
+
case false (abnf-empty (abnf-target alt))
|
|
777
|
+
|
|
778
|
+
; The compiler reorders a rule's alternatives to tell them apart (a
|
|
779
|
+
; longer lookahead first, a keyword ahead of a class that takes it), and
|
|
780
|
+
; numbers the helpers it makes for them, in the order the alternatives
|
|
781
|
+
; were written, before it does. So the alternatives that push a helper
|
|
782
|
+
; are put back in the order of the helpers' numbers, among their own
|
|
783
|
+
; places; the others keep theirs.
|
|
784
|
+
def abnf-alt-number [alt]
|
|
785
|
+
match (count alt)
|
|
786
|
+
case 0 -1
|
|
787
|
+
case _
|
|
788
|
+
let [last (top alt)]
|
|
789
|
+
match (get :k last)
|
|
790
|
+
case :ref
|
|
791
|
+
match (abnf-starts "_gen" (get :name last))
|
|
792
|
+
case true
|
|
793
|
+
let [d (abnf-at (split "_" (abnf-after "_gen" (get :name last))) 0)]
|
|
794
|
+
match (abnf-digits d)
|
|
795
|
+
case true (number d)
|
|
796
|
+
case false -1
|
|
797
|
+
case false -1
|
|
798
|
+
case _ -1
|
|
799
|
+
|
|
800
|
+
def abnf-number-order [alts]
|
|
801
|
+
let [nums (map abnf-alt-number alts)]
|
|
802
|
+
let [slots (filter (fn [i] (abnf-not (abnf-less (abnf-at nums i) 0))) (indices alts))]
|
|
803
|
+
let [rank (fn [i] (count (filter (fn [j] (match (compare (abnf-at nums j) (abnf-at nums i)) (case :less true) (case :equal (abnf-less j i)) (case _ false))) slots)))]
|
|
804
|
+
let [ranks (map rank slots)]
|
|
805
|
+
map (fn [i] (abnf-number-at alts nums slots ranks i)) (indices alts)
|
|
806
|
+
|
|
807
|
+
def abnf-number-at [alts nums slots ranks i]
|
|
808
|
+
match (abnf-less (abnf-at nums i) 0)
|
|
809
|
+
case true (abnf-at alts i)
|
|
810
|
+
case false
|
|
811
|
+
let [k (count (filter (fn [j] (abnf-less j i)) slots))]
|
|
812
|
+
abnf-at alts (abnf-at slots (abnf-at (filter (fn [m] (match (compare (abnf-at ranks m) k) (case :equal true) (case _ false))) (indices slots)) 0))
|
|
813
|
+
|
|
814
|
+
; The first alternative that is not empty: an option's.
|
|
815
|
+
def abnf-filled [alts]
|
|
816
|
+
abnf-at (filter abnf-some alts) 0
|
|
817
|
+
|
|
818
|
+
; The steps of a chain, each a segment: the tokens its open alternate
|
|
819
|
+
; consumes and the rule it pushes, the next step named in its close.
|
|
820
|
+
def abnf-chain-walk [self cx name depth acc]
|
|
821
|
+
let [r (abnf-rule cx name)]
|
|
822
|
+
let [els (abnf-cat acc (abnf-entry-els (abnf-at (abnf-open r) 0)))]
|
|
823
|
+
match (count (abnf-close r))
|
|
824
|
+
case 0 els
|
|
825
|
+
case _
|
|
826
|
+
match (abnf-r (abnf-at (abnf-close r) 0))
|
|
827
|
+
case "" els
|
|
828
|
+
case next
|
|
829
|
+
match (abnf-less (count depth) 200)
|
|
830
|
+
case false (abnf-fail (string-join "" ["rule " name " is a sequence of more than 200 segments, which the render does not follow"]))
|
|
831
|
+
case true (self self cx next (push 1 depth) els)
|
|
832
|
+
|
|
833
|
+
def abnf-chain [cx name]
|
|
834
|
+
abnf-chain-walk abnf-chain-walk cx name [] []
|
|
835
|
+
|
|
836
|
+
; A dispatcher's alternatives: one rule per alternative, \`<rule>$alt<i>\`,
|
|
837
|
+
; and the empty one where a number is missing, or last.
|
|
838
|
+
def abnf-head-name [name i]
|
|
839
|
+
string-join "" [name "$alt" (abnf-num i)]
|
|
840
|
+
|
|
841
|
+
def abnf-dispatch-alts [cx name r]
|
|
842
|
+
let [nums (indices (push 0 (abnf-open r)))]
|
|
843
|
+
let [present (filter (fn [i] (abnf-has cx (abnf-head-name name i))) nums)]
|
|
844
|
+
let [last (top present)]
|
|
845
|
+
let [gaps (filter (fn [i] (match (abnf-less i last) (case true (abnf-not (abnf-among (abnf-num i) (map abnf-num present)))) (case false false))) nums)]
|
|
846
|
+
let [empty (abnf-some (filter (fn [alt] (abnf-empty (abnf-target alt))) (abnf-open r)))]
|
|
847
|
+
match (count gaps)
|
|
848
|
+
case 0
|
|
849
|
+
abnf-cat (map (fn [i] (abnf-chain cx (abnf-head-name name i))) present) (match empty (case true [[]]) (case false []))
|
|
850
|
+
case 1
|
|
851
|
+
map
|
|
852
|
+
fn [i]
|
|
853
|
+
match (abnf-has cx (abnf-head-name name i))
|
|
854
|
+
case true (abnf-chain cx (abnf-head-name name i))
|
|
855
|
+
case false []
|
|
856
|
+
filter (fn [i] (abnf-not (abnf-less last i))) nums
|
|
857
|
+
case _ (abnf-fail (string-join "" ["rule " name " dispatches to alternatives the render cannot place"]))
|
|
858
|
+
|
|
859
|
+
; Whether the rule dispatches to \`$alt\` rules of its own.
|
|
860
|
+
def abnf-dispatches [cx name r]
|
|
861
|
+
abnf-some (filter (fn [alt] (abnf-starts (string-join "" [name "$alt"]) (abnf-target alt))) (abnf-open r))
|
|
862
|
+
|
|
863
|
+
; A loop's item: what its continue alternate takes, a token it consumes,
|
|
864
|
+
; or the rule its iteration (\`<loop>$alt0\`) pushes.
|
|
865
|
+
def abnf-loop-item [cx name r]
|
|
866
|
+
let [conts (filter (fn [alt] (abnf-full (abnf-r alt))) (abnf-rest (abnf-open r)))]
|
|
867
|
+
match (count conts)
|
|
868
|
+
case 0 (abnf-fail (string-join "" ["the repetition " name " repeats nothing"]))
|
|
869
|
+
case _
|
|
870
|
+
let [c (abnf-at conts 0)]
|
|
871
|
+
match (abnf-same (abnf-r c) name)
|
|
872
|
+
case true
|
|
873
|
+
match (abnf-consumed c)
|
|
874
|
+
case [t] (abnf-tok-el t)
|
|
875
|
+
case _ (abnf-fail (string-join "" ["the repetition " name " repeats more than one token"]))
|
|
876
|
+
case false
|
|
877
|
+
match (abnf-p (abnf-at (abnf-open (abnf-rule cx (abnf-r c))) 0))
|
|
878
|
+
case "" (abnf-fail (string-join "" ["the repetition " name " repeats nothing"]))
|
|
879
|
+
case item (abnf-ref-el item)
|
|
880
|
+
|
|
881
|
+
; A tail repeat, \`X = prefix [ sep X ]\`, which the compiler makes a loop
|
|
882
|
+
; in the rule's close: the separator matched and the rule replaced.
|
|
883
|
+
def abnf-is-tail [name r]
|
|
884
|
+
match (count (abnf-close r))
|
|
885
|
+
case 2
|
|
886
|
+
let [c (abnf-at (abnf-close r) 0)]
|
|
887
|
+
match (abnf-a c)
|
|
888
|
+
case "@fold$" (abnf-same (abnf-r c) name)
|
|
889
|
+
case _ false
|
|
890
|
+
case _ false
|
|
891
|
+
|
|
892
|
+
; The alternatives of a rule as the spec holds them, each a vector of
|
|
893
|
+
; elements; a tail repeat as its prefix and the option around its
|
|
894
|
+
; separator and itself.
|
|
895
|
+
def abnf-raw-alts [cx name]
|
|
896
|
+
let [r (abnf-rule cx name)]
|
|
897
|
+
match (abnf-is-tail name r)
|
|
898
|
+
case true
|
|
899
|
+
let [prefix (map abnf-tok-el (abnf-consumed (abnf-at (abnf-open r) 0)))]
|
|
900
|
+
let [sep (map abnf-tok-el (abnf-consumed (abnf-at (abnf-close r) 0)))]
|
|
901
|
+
vector
|
|
902
|
+
push
|
|
903
|
+
record
|
|
904
|
+
entry :k :tail
|
|
905
|
+
entry :seq (push (abnf-ref-el name) sep)
|
|
906
|
+
prefix
|
|
907
|
+
case false
|
|
908
|
+
match (abnf-dispatches cx name r)
|
|
909
|
+
case true (abnf-dispatch-alts cx name r)
|
|
910
|
+
case false
|
|
911
|
+
match (count (abnf-close r))
|
|
912
|
+
case 0 (abnf-simple-alts r)
|
|
913
|
+
case _
|
|
914
|
+
match (abnf-r (abnf-at (abnf-close r) 0))
|
|
915
|
+
case "" (abnf-simple-alts r)
|
|
916
|
+
case _ (vector (abnf-chain cx name))
|
|
917
|
+
|
|
918
|
+
; ---- the compiler's helpers, read back
|
|
919
|
+
|
|
920
|
+
; The kind of a helper the compiler named: \`_gen<n>_<kind>...\`.
|
|
921
|
+
def abnf-helper-kind [cx name]
|
|
922
|
+
match (abnf-made cx name)
|
|
923
|
+
case false ""
|
|
924
|
+
case true
|
|
925
|
+
match (abnf-starts "_gen" name)
|
|
926
|
+
case true
|
|
927
|
+
let [parts (split "_" (abnf-after "_gen" name))]
|
|
928
|
+
match (abnf-digits (abnf-at parts 0))
|
|
929
|
+
case true (abnf-at parts 1)
|
|
930
|
+
case false ""
|
|
931
|
+
case false
|
|
932
|
+
match (abnf-among "fact" (map (fn [p] (abnf-before-digits p)) (abnf-rest (split "$" name))))
|
|
933
|
+
case true "fact"
|
|
934
|
+
case false ""
|
|
935
|
+
|
|
936
|
+
def abnf-before-digits [p]
|
|
937
|
+
match (abnf-starts "fact" p)
|
|
938
|
+
case true (match (abnf-digits (abnf-after "fact" p)) (case true "fact") (case false p))
|
|
939
|
+
case false p
|
|
940
|
+
|
|
941
|
+
; An alternative with its factored tails expanded back: one whose last
|
|
942
|
+
; element is a left-factored tail (\`<rule>$fact<k>\`) is the prefix before
|
|
943
|
+
; it followed by each of the tail's alternatives in turn.
|
|
944
|
+
def abnf-expand [self cx alt]
|
|
945
|
+
match (count alt)
|
|
946
|
+
case 0 [alt]
|
|
947
|
+
case _
|
|
948
|
+
let [last (top alt)]
|
|
949
|
+
match (get :k last)
|
|
950
|
+
case :ref
|
|
951
|
+
match (abnf-helper-kind cx (get :name last))
|
|
952
|
+
case "fact"
|
|
953
|
+
let [prefix (pop alt)]
|
|
954
|
+
abnf-flat (map (fn [tail] (self self cx (abnf-cat prefix tail))) (abnf-raw-alts cx (get :name last)))
|
|
955
|
+
case _ [alt]
|
|
956
|
+
case _ [alt]
|
|
957
|
+
|
|
958
|
+
def abnf-alts [cx name]
|
|
959
|
+
abnf-flat (map (fn [alt] (abnf-split-group cx name alt)) (abnf-flat (map (fn [alt] (abnf-expand abnf-expand cx alt)) (abnf-raw-alts cx name))))
|
|
960
|
+
|
|
961
|
+
; The compiler factors a rule's alternatives that are each one group
|
|
962
|
+
; (\`( A x ) | ( A y )\`) into the first group, whose sequence then ends in
|
|
963
|
+
; the rule's own factored tail (\`<rule>$fact<k>\`); such an alternative is
|
|
964
|
+
; read back as the groups it was, one alternative each.
|
|
965
|
+
def abnf-split-group [cx name alt]
|
|
966
|
+
match (count alt)
|
|
967
|
+
case 1
|
|
968
|
+
let [el (abnf-at alt 0)]
|
|
969
|
+
match (get :k el)
|
|
970
|
+
case :ref
|
|
971
|
+
match (abnf-helper-kind cx (get :name el))
|
|
972
|
+
case "group"
|
|
973
|
+
let [inner (abnf-raw-alts cx (get :name el))]
|
|
974
|
+
match (count inner)
|
|
975
|
+
case 1
|
|
976
|
+
let [seq (abnf-at inner 0)]
|
|
977
|
+
match (abnf-owned-fact cx name seq)
|
|
978
|
+
case true (map (fn [one] [(abnf-grp-el one)]) (abnf-expand abnf-expand cx seq))
|
|
979
|
+
case false [alt]
|
|
980
|
+
case _ [alt]
|
|
981
|
+
case _ [alt]
|
|
982
|
+
case _ [alt]
|
|
983
|
+
case _ [alt]
|
|
984
|
+
|
|
985
|
+
def abnf-owned-fact [cx name seq]
|
|
986
|
+
match (count seq)
|
|
987
|
+
case 0 false
|
|
988
|
+
case _
|
|
989
|
+
let [last (top seq)]
|
|
990
|
+
match (get :k last)
|
|
991
|
+
case :ref
|
|
992
|
+
match (abnf-helper-kind cx (get :name last))
|
|
993
|
+
case "fact" (abnf-starts (string-join "" [name "$fact"]) (get :name last))
|
|
994
|
+
case _ false
|
|
995
|
+
case _ false
|
|
996
|
+
|
|
997
|
+
; A group read back from a factored alternative: an element of its own,
|
|
998
|
+
; written as a group is.
|
|
999
|
+
def abnf-grp-el [seq]
|
|
1000
|
+
record
|
|
1001
|
+
entry :k :grp
|
|
1002
|
+
entry :seq seq
|
|
1003
|
+
|
|
1004
|
+
; The parts a repetition counts: the item, how many at least, how many
|
|
1005
|
+
; at most ("" for no bound). A bounded one ends in nested options, each
|
|
1006
|
+
; over a group of the item and the next option, the innermost over the
|
|
1007
|
+
; item alone: \`[ A [ A [ A ] ] ]\`. The compiler numbers them as it makes
|
|
1008
|
+
; them, the innermost group first, under the number it gave the
|
|
1009
|
+
; repetition: group n, option n+1 over it, group n+2, ..., so the
|
|
1010
|
+
; outermost option's number says how deep they go.
|
|
1011
|
+
def abnf-gen-number [name]
|
|
1012
|
+
number (abnf-at (split "_" (abnf-after "_gen" name)) 0)
|
|
1013
|
+
|
|
1014
|
+
def abnf-rep-chain [cx rep opt]
|
|
1015
|
+
let [n (abnf-gen-number rep)]
|
|
1016
|
+
let [inner-name (string-join "" ["_gen" (abnf-num n) "_group"])]
|
|
1017
|
+
match (abnf-has cx inner-name)
|
|
1018
|
+
case false (abnf-fail (string-join "" ["the repetition " rep " is not numbered as the compiler numbers one"]))
|
|
1019
|
+
case true
|
|
1020
|
+
let [inner (abnf-raw-alts cx inner-name)]
|
|
1021
|
+
match (count (abnf-at inner 0))
|
|
1022
|
+
case 1
|
|
1023
|
+
let [span (count (filter (fn [j] (abnf-not (abnf-less j n))) (indices (abnf-ones (abnf-plus (abnf-gen-number opt) 1)))))]
|
|
1024
|
+
record
|
|
1025
|
+
entry :item (abnf-at (abnf-at inner 0) 0)
|
|
1026
|
+
entry :depth (count (filter abnf-even (indices (abnf-ones span))))
|
|
1027
|
+
case _ (abnf-fail (string-join "" ["the repetition " rep " is not numbered as the compiler numbers one"]))
|
|
1028
|
+
|
|
1029
|
+
def abnf-rep-parts [cx name]
|
|
1030
|
+
let [seq (abnf-at (abnf-raw-alts cx name) 0)]
|
|
1031
|
+
let [last (match (count seq) (case 0 (abnf-fail (string-join "" ["the repetition " name " repeats its item no times, and the spec does not keep the item"]))) (case _ (top seq)))]
|
|
1032
|
+
let [lead (pop seq)]
|
|
1033
|
+
match (abnf-helper-kind cx (abnf-str (get :name last)))
|
|
1034
|
+
case "star"
|
|
1035
|
+
record
|
|
1036
|
+
entry :item (abnf-loop-item cx (get :name last) (abnf-rule cx (get :name last)))
|
|
1037
|
+
entry :min (count lead)
|
|
1038
|
+
entry :max ""
|
|
1039
|
+
case "opt"
|
|
1040
|
+
let [chain (abnf-rep-chain cx name (get :name last))]
|
|
1041
|
+
record
|
|
1042
|
+
entry :item (get :item chain)
|
|
1043
|
+
entry :min (count lead)
|
|
1044
|
+
entry :max (abnf-num (abnf-plus (count lead) (get :depth chain)))
|
|
1045
|
+
case _
|
|
1046
|
+
record
|
|
1047
|
+
entry :item (abnf-at seq 0)
|
|
1048
|
+
entry :min (count seq)
|
|
1049
|
+
entry :max (abnf-num (count seq))
|
|
1050
|
+
|
|
1051
|
+
; Whether an option is over a group.
|
|
1052
|
+
def abnf-opt-group [cx name]
|
|
1053
|
+
let [alts (abnf-raw-alts cx name)]
|
|
1054
|
+
let [inner (abnf-at (abnf-filled alts) 0)]
|
|
1055
|
+
match (get :k inner)
|
|
1056
|
+
case :ref (abnf-same (abnf-helper-kind cx (get :name inner)) "group")
|
|
1057
|
+
case _ false
|
|
1058
|
+
|
|
1059
|
+
; An element's structure as one string, a helper by what it compiles (a
|
|
1060
|
+
; counted repetition by its item and counts, not by the nested options
|
|
1061
|
+
; it compiles to, which are as deep as its count).
|
|
1062
|
+
def abnf-key [self cx el]
|
|
1063
|
+
match (get :k el)
|
|
1064
|
+
case :tok (get :name el)
|
|
1065
|
+
case :tail "[tail]"
|
|
1066
|
+
case :grp (string-join "" ["group(" (abnf-key-seq self cx (get :seq el)) ")"])
|
|
1067
|
+
case :ref
|
|
1068
|
+
let [name (get :name el)]
|
|
1069
|
+
match (abnf-helper-kind cx name)
|
|
1070
|
+
case "" (string-join "" ["@" name])
|
|
1071
|
+
case "star" (string-join "" ["*(" (self self cx (abnf-loop-item cx name (abnf-rule cx name))) ")"])
|
|
1072
|
+
case "rep"
|
|
1073
|
+
let [parts (abnf-rep-parts cx name)]
|
|
1074
|
+
string-join "" ["rep(" (abnf-num (get :min parts)) "," (get :max parts) "," (self self cx (get :item parts)) ")"]
|
|
1075
|
+
case kind (string-join "" [kind "(" (string-join "|" (map (fn [seq] (abnf-key-seq self cx seq)) (abnf-alts cx name))) ")"])
|
|
1076
|
+
|
|
1077
|
+
def abnf-key-seq [self cx seq]
|
|
1078
|
+
string-join " " (map (fn [e] (self self cx e)) seq)
|
|
1079
|
+
|
|
1080
|
+
def abnf-seq-keys [cx seq]
|
|
1081
|
+
map (fn [el] (abnf-key abnf-key cx el)) seq
|
|
1082
|
+
|
|
1083
|
+
; ---- characters
|
|
1084
|
+
|
|
1085
|
+
; A literal's characters as their code points, which a notation writes
|
|
1086
|
+
; where a quoted string cannot hold a character, and the names the
|
|
1087
|
+
; compiler derives from a literal's text.
|
|
1088
|
+
|
|
1089
|
+
; The ASCII characters, each with its two hexadecimal digits.
|
|
1090
|
+
def abnf-ascii [["\\u0000" "00"] ["\\u0001" "01"] ["\\u0002" "02"] ["\\u0003" "03"] ["\\u0004" "04"] ["\\u0005" "05"] ["\\u0006" "06"] ["\\u0007" "07"] ["\\b" "08"] ["\\t" "09"] ["\\n" "0A"] ["\\u000b" "0B"] ["\\f" "0C"] ["\\r" "0D"] ["\\u000e" "0E"] ["\\u000f" "0F"] ["\\u0010" "10"] ["\\u0011" "11"] ["\\u0012" "12"] ["\\u0013" "13"] ["\\u0014" "14"] ["\\u0015" "15"] ["\\u0016" "16"] ["\\u0017" "17"] ["\\u0018" "18"] ["\\u0019" "19"] ["\\u001a" "1A"] ["\\u001b" "1B"] ["\\u001c" "1C"] ["\\u001d" "1D"] ["\\u001e" "1E"] ["\\u001f" "1F"] [" " "20"] ["!" "21"] ["\\"" "22"] ["#" "23"] ["$" "24"] ["%" "25"] ["&" "26"] ["'" "27"] ["(" "28"] [")" "29"] ["*" "2A"] ["+" "2B"] ["," "2C"] ["-" "2D"] ["." "2E"] ["/" "2F"] ["0" "30"] ["1" "31"] ["2" "32"] ["3" "33"] ["4" "34"] ["5" "35"] ["6" "36"] ["7" "37"] ["8" "38"] ["9" "39"] [":" "3A"] [";" "3B"] ["<" "3C"] ["=" "3D"] [">" "3E"] ["?" "3F"] ["@" "40"] ["A" "41"] ["B" "42"] ["C" "43"] ["D" "44"] ["E" "45"] ["F" "46"] ["G" "47"] ["H" "48"] ["I" "49"] ["J" "4A"] ["K" "4B"] ["L" "4C"] ["M" "4D"] ["N" "4E"] ["O" "4F"] ["P" "50"] ["Q" "51"] ["R" "52"] ["S" "53"] ["T" "54"] ["U" "55"] ["V" "56"] ["W" "57"] ["X" "58"] ["Y" "59"] ["Z" "5A"] ["[" "5B"] ["\\\\" "5C"] ["]" "5D"] ["^" "5E"] ["_" "5F"] ["\`" "60"] ["a" "61"] ["b" "62"] ["c" "63"] ["d" "64"] ["e" "65"] ["f" "66"] ["g" "67"] ["h" "68"] ["i" "69"] ["j" "6A"] ["k" "6B"] ["l" "6C"] ["m" "6D"] ["n" "6E"] ["o" "6F"] ["p" "70"] ["q" "71"] ["r" "72"] ["s" "73"] ["t" "74"] ["u" "75"] ["v" "76"] ["w" "77"] ["x" "78"] ["y" "79"] ["z" "7A"] ["{" "7B"] ["|" "7C"] ["}" "7D"] ["~" "7E"] ["\\u007f" "7F"]]
|
|
1091
|
+
|
|
1092
|
+
; A piece of a literal's text: a run of its characters (\`:raw\`), or one
|
|
1093
|
+
; character as its code point (\`:cp\`). A run is cut at each place it
|
|
1094
|
+
; holds a character, which is put back as its code point between the
|
|
1095
|
+
; pieces, and the empty runs are left out.
|
|
1096
|
+
def abnf-raw-seg [s]
|
|
1097
|
+
record
|
|
1098
|
+
entry :raw s
|
|
1099
|
+
|
|
1100
|
+
def abnf-cp-seg [h]
|
|
1101
|
+
record
|
|
1102
|
+
entry :cp h
|
|
1103
|
+
|
|
1104
|
+
def abnf-cut-seg [c h seg]
|
|
1105
|
+
match (kind (get :raw seg))
|
|
1106
|
+
case :string
|
|
1107
|
+
let [pieces (split c (get :raw seg))]
|
|
1108
|
+
abnf-flat (map (fn [i] (match i (case 0 [(abnf-raw-seg (abnf-at pieces 0))]) (case _ [(abnf-cp-seg h) (abnf-raw-seg (abnf-at pieces i))]))) (indices pieces))
|
|
1109
|
+
case _ [seg]
|
|
1110
|
+
|
|
1111
|
+
; A string's pieces with each of the characters given cut out as its code
|
|
1112
|
+
; point, in turn.
|
|
1113
|
+
def abnf-code-walk [self chars segs]
|
|
1114
|
+
match (count chars)
|
|
1115
|
+
case 0 segs
|
|
1116
|
+
case _
|
|
1117
|
+
let [ch (top chars)]
|
|
1118
|
+
self self (pop chars) (filter abnf-kept-seg (abnf-flat (map (fn [seg] (abnf-cut-seg (abnf-at ch 0) (abnf-at ch 1) seg)) segs)))
|
|
1119
|
+
|
|
1120
|
+
def abnf-kept-seg [seg]
|
|
1121
|
+
match (get :raw seg)
|
|
1122
|
+
case "" false
|
|
1123
|
+
case _ true
|
|
1124
|
+
|
|
1125
|
+
; A literal's characters as their code points, in order: its ASCII
|
|
1126
|
+
; characters cut out first, then each run of other characters taken
|
|
1127
|
+
; apart.
|
|
1128
|
+
def abnf-codes [text]
|
|
1129
|
+
let [present (filter (fn [ch] (abnf-some (abnf-rest (split (abnf-at ch 0) text)))) abnf-ascii)]
|
|
1130
|
+
let [segs (abnf-code-walk abnf-code-walk present [(abnf-raw-seg text)])]
|
|
1131
|
+
abnf-flat (map (fn [seg] (abnf-wide-codes text seg)) segs)
|
|
1132
|
+
|
|
1133
|
+
; The sixteen hexadecimal digits, and the 256 pairs of them.
|
|
1134
|
+
def abnf-hex-digits ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]
|
|
1135
|
+
|
|
1136
|
+
def abnf-hex-pairs
|
|
1137
|
+
abnf-flat (map (fn [a] (map (fn [b] (string-join "" [a b])) abnf-hex-digits)) abnf-hex-digits)
|
|
1138
|
+
|
|
1139
|
+
; The start of each block of 256 code points in the Basic Multilingual
|
|
1140
|
+
; Plane, by which a character past ASCII is found.
|
|
1141
|
+
def abnf-blocks [0 256 512 768 1024 1280 1536 1792 2048 2304 2560 2816 3072 3328 3584 3840 4096 4352 4608 4864 5120 5376 5632 5888 6144 6400 6656 6912 7168 7424 7680 7936 8192 8448 8704 8960 9216 9472 9728 9984 10240 10496 10752 11008 11264 11520 11776 12032 12288 12544 12800 13056 13312 13568 13824 14080 14336 14592 14848 15104 15360 15616 15872 16128 16384 16640 16896 17152 17408 17664 17920 18176 18432 18688 18944 19200 19456 19712 19968 20224 20480 20736 20992 21248 21504 21760 22016 22272 22528 22784 23040 23296 23552 23808 24064 24320 24576 24832 25088 25344 25600 25856 26112 26368 26624 26880 27136 27392 27648 27904 28160 28416 28672 28928 29184 29440 29696 29952 30208 30464 30720 30976 31232 31488 31744 32000 32256 32512 32768 33024 33280 33536 33792 34048 34304 34560 34816 35072 35328 35584 35840 36096 36352 36608 36864 37120 37376 37632 37888 38144 38400 38656 38912 39168 39424 39680 39936 40192 40448 40704 40960 41216 41472 41728 41984 42240 42496 42752 43008 43264 43520 43776 44032 44288 44544 44800 45056 45312 45568 45824 46080 46336 46592 46848 47104 47360 47616 47872 48128 48384 48640 48896 49152 49408 49664 49920 50176 50432 50688 50944 51200 51456 51712 51968 52224 52480 52736 52992 53248 53504 53760 54016 54272 54528 54784 55040 55296 55552 55808 56064 56320 56576 56832 57088 57344 57600 57856 58112 58368 58624 58880 59136 59392 59648 59904 60160 60416 60672 60928 61184 61440 61696 61952 62208 62464 62720 62976 63232 63488 63744 64000 64256 64512 64768 65024 65280]
|
|
1142
|
+
|
|
1143
|
+
; A piece of a literal that holds no ASCII character: characters of the
|
|
1144
|
+
; Basic Multilingual Plane, each as its code point, in order. The run is
|
|
1145
|
+
; cut at each character it holds, found a block of 256 at a time: the
|
|
1146
|
+
; block of its least character is the last whose start that character is
|
|
1147
|
+
; not below, the characters of that block the run holds are the escapes
|
|
1148
|
+
; there it holds, and the rest of the run is taken the same way.
|
|
1149
|
+
def abnf-wide-codes [text seg]
|
|
1150
|
+
match (kind (get :raw seg))
|
|
1151
|
+
case :string
|
|
1152
|
+
let [raw (get :raw seg)]
|
|
1153
|
+
match (chars-within [[128 55295] [57344 65535]] raw)
|
|
1154
|
+
case false (abnf-fail (string-join "" ["the literal " (quoted text) " holds a character past U+FFFF, which the render does not spell as a numeric value"]))
|
|
1155
|
+
case true
|
|
1156
|
+
let [found (abnf-wide-chars abnf-wide-chars text raw [])]
|
|
1157
|
+
map (fn [piece] (get :cp piece)) (abnf-code-walk abnf-code-walk found [(abnf-raw-seg raw)])
|
|
1158
|
+
case _ [(get :cp seg)]
|
|
1159
|
+
|
|
1160
|
+
def abnf-wide-chars [self text run acc]
|
|
1161
|
+
match run
|
|
1162
|
+
case "" acc
|
|
1163
|
+
case _
|
|
1164
|
+
let [b (top (filter (fn [i] (chars-within [[(abnf-at abnf-blocks i) 65535]] run)) (indices abnf-blocks)))]
|
|
1165
|
+
let [hh (abnf-at abnf-hex-pairs b)]
|
|
1166
|
+
let [found (filter (fn [ch] (abnf-some (abnf-rest (split (abnf-at ch 0) run)))) (map (fn [l] [(unquoted (string-join "" ["\\"\\\\u" (abnf-hex-lower hh) (abnf-hex-lower l) "\\""])) (abnf-point-hex hh l)]) abnf-hex-pairs))]
|
|
1167
|
+
match (count found)
|
|
1168
|
+
case 0 (abnf-fail (string-join "" ["the literal " (quoted text) " holds a character the render cannot spell"]))
|
|
1169
|
+
case _ (self self text (abnf-strip-chars abnf-strip-chars found run) (abnf-cat acc found))
|
|
1170
|
+
|
|
1171
|
+
; A code point's digits as ABNF writes them, without leading zeros.
|
|
1172
|
+
def abnf-point-hex [hh l]
|
|
1173
|
+
match hh
|
|
1174
|
+
case "00" l
|
|
1175
|
+
case _
|
|
1176
|
+
match (abnf-starts "0" hh)
|
|
1177
|
+
case true (string-join "" [(abnf-after "0" hh) l])
|
|
1178
|
+
case false (string-join "" [hh l])
|
|
1179
|
+
|
|
1180
|
+
def abnf-strip-chars [self chars s]
|
|
1181
|
+
match (count chars)
|
|
1182
|
+
case 0 s
|
|
1183
|
+
case _ (self self (pop chars) (string-join "" (split (abnf-at (top chars) 0) s)))
|
|
1184
|
+
|
|
1185
|
+
def abnf-has-letter [text]
|
|
1186
|
+
abnf-not (chars-within [[0 64] [91 96] [123 1114111]] text)
|
|
1187
|
+
|
|
1188
|
+
; ---- token names
|
|
1189
|
+
|
|
1190
|
+
; The name the compiler derives for a literal's token: the text in
|
|
1191
|
+
; capitals, each character that is not a letter or a digit an underscore,
|
|
1192
|
+
; the underscores at either end taken off, \`T\` when nothing is left, and a
|
|
1193
|
+
; number after it when the name is taken. A token with any other name is a
|
|
1194
|
+
; rule the compiler lifted to a token.
|
|
1195
|
+
def abnf-upper-pairs [["a" "A"] ["b" "B"] ["c" "C"] ["d" "D"] ["e" "E"] ["f" "F"] ["g" "G"] ["h" "H"] ["i" "I"] ["j" "J"] ["k" "K"] ["l" "L"] ["m" "M"] ["n" "N"] ["o" "O"] ["p" "P"] ["q" "Q"] ["r" "R"] ["s" "S"] ["t" "T"] ["u" "U"] ["v" "V"] ["w" "W"] ["x" "X"] ["y" "Y"] ["z" "Z"]]
|
|
1196
|
+
|
|
1197
|
+
def abnf-swap-walk [self pairs s]
|
|
1198
|
+
match (count pairs)
|
|
1199
|
+
case 0 s
|
|
1200
|
+
case _
|
|
1201
|
+
let [pair (top pairs)]
|
|
1202
|
+
self self (pop pairs) (string-join (abnf-at pair 1) (split (abnf-at pair 0) s))
|
|
1203
|
+
|
|
1204
|
+
def abnf-word-chars [[48 57] [65 90] [97 122]]
|
|
1205
|
+
|
|
1206
|
+
def abnf-base-name [text]
|
|
1207
|
+
let [up (abnf-swap-walk abnf-swap-walk abnf-upper-pairs text)]
|
|
1208
|
+
let [others (filter (fn [ch] (abnf-not (chars-within abnf-word-chars (abnf-at ch 0)))) abnf-ascii)]
|
|
1209
|
+
let [under (abnf-swap-walk abnf-swap-walk (map (fn [ch] [(abnf-at ch 0) "_"]) others) up)]
|
|
1210
|
+
let [pieces (split "_" under)]
|
|
1211
|
+
let [full (filter (fn [i] (abnf-full (abnf-at pieces i))) (indices pieces))]
|
|
1212
|
+
match (count full)
|
|
1213
|
+
case 0 "T"
|
|
1214
|
+
case _
|
|
1215
|
+
let [lo (abnf-at full 0)]
|
|
1216
|
+
let [hi (top full)]
|
|
1217
|
+
string-join "_" (map (fn [i] (abnf-at pieces i)) (filter (fn [i] (match (abnf-less i lo) (case true false) (case false (abnf-not (abnf-less hi i))))) (indices pieces)))
|
|
1218
|
+
|
|
1219
|
+
def abnf-derived [bare text]
|
|
1220
|
+
match (chars-within [[48 57] [65 90] [95 95]] bare)
|
|
1221
|
+
case false false
|
|
1222
|
+
case true
|
|
1223
|
+
match (chars-within [[0 127]] text)
|
|
1224
|
+
case false true
|
|
1225
|
+
case true
|
|
1226
|
+
let [base (abnf-base-name text)]
|
|
1227
|
+
match (abnf-same bare base)
|
|
1228
|
+
case true true
|
|
1229
|
+
case false
|
|
1230
|
+
match (abnf-starts base bare)
|
|
1231
|
+
case true (abnf-digits (abnf-after base bare))
|
|
1232
|
+
case false false
|
|
1233
|
+
|
|
1234
|
+
; Every token name the alternates match, one string.
|
|
1235
|
+
def abnf-used [cx]
|
|
1236
|
+
let [rules (get :rules cx)]
|
|
1237
|
+
string-join ""
|
|
1238
|
+
vector
|
|
1239
|
+
" "
|
|
1240
|
+
string-join " "
|
|
1241
|
+
map
|
|
1242
|
+
fn [name]
|
|
1243
|
+
let [r (get-path (as-path [name]) rules)]
|
|
1244
|
+
string-join " " (abnf-flat (map abnf-s (abnf-cat (abnf-open r) (abnf-close r))))
|
|
1245
|
+
keys rules
|
|
1246
|
+
" "
|
|
1247
|
+
|
|
1248
|
+
; ---- references written back
|
|
1249
|
+
|
|
1250
|
+
; The compiler substitutes a reference that leads an alternative by the
|
|
1251
|
+
; referenced rule's alternatives, each followed by what followed the
|
|
1252
|
+
; reference (\`a = b "x"\`, \`b = "y" / "z"\` compiles \`a\` as \`"y" "x" / "z"
|
|
1253
|
+
; "x"\`), and compiles the reference back to the same alternatives. So
|
|
1254
|
+
; where a run of a rule's alternatives is another rule's alternatives,
|
|
1255
|
+
; each followed by one same tail, the reference is written back in their
|
|
1256
|
+
; place. A candidate is a rule the written file can name, with its
|
|
1257
|
+
; alternatives' keys; a rule that is one reference (\`a = b\`) is none,
|
|
1258
|
+
; since the compiler leaves such a rule a reference rather than
|
|
1259
|
+
; substituting it.
|
|
1260
|
+
def abnf-candidates [cx names]
|
|
1261
|
+
filter
|
|
1262
|
+
fn [c] (abnf-not (abnf-alias-keys (get :keys c)))
|
|
1263
|
+
map (fn [n] (record (entry :name n) (entry :keys (map (fn [seq] (abnf-seq-keys cx seq)) (abnf-alts cx n))))) names
|
|
1264
|
+
|
|
1265
|
+
def abnf-alias-keys [ks]
|
|
1266
|
+
match (count ks)
|
|
1267
|
+
case 1
|
|
1268
|
+
match (count (abnf-at ks 0))
|
|
1269
|
+
case 1 (abnf-starts "@" (abnf-at (abnf-at ks 0) 0))
|
|
1270
|
+
case _ false
|
|
1271
|
+
case _ false
|
|
1272
|
+
|
|
1273
|
+
; Whether alternatives are one alternative of one reference to a rule:
|
|
1274
|
+
; a rule the compiler leaves as it is.
|
|
1275
|
+
def abnf-alias [cx alts]
|
|
1276
|
+
match (count alts)
|
|
1277
|
+
case 1
|
|
1278
|
+
let [seq (abnf-at alts 0)]
|
|
1279
|
+
match (count seq)
|
|
1280
|
+
case 1
|
|
1281
|
+
match (get :k (abnf-at seq 0))
|
|
1282
|
+
case :ref (abnf-empty (abnf-helper-kind cx (get :name (abnf-at seq 0))))
|
|
1283
|
+
case _ false
|
|
1284
|
+
case _ false
|
|
1285
|
+
case _ false
|
|
1286
|
+
|
|
1287
|
+
; Whether the alternative's keys begin with the candidate alternative's,
|
|
1288
|
+
; and what follows them ("\\u0000" where they do not).
|
|
1289
|
+
def abnf-prefix-tail [ks cs]
|
|
1290
|
+
match (abnf-less (count ks) (count cs))
|
|
1291
|
+
case true "\\u0000"
|
|
1292
|
+
case false
|
|
1293
|
+
match (abnf-same (string-join "\\u0001" (abnf-take (count cs) ks)) (string-join "\\u0001" cs))
|
|
1294
|
+
case true (string-join "\\u0001" (abnf-drop (count cs) ks))
|
|
1295
|
+
case false "\\u0000"
|
|
1296
|
+
|
|
1297
|
+
; Whether the candidate's alternatives, each followed by one same tail,
|
|
1298
|
+
; are the alternatives from position i on.
|
|
1299
|
+
def abnf-cand-matches [c ka i]
|
|
1300
|
+
let [k (count (get :keys c))]
|
|
1301
|
+
match (abnf-less (count ka) (abnf-plus i k))
|
|
1302
|
+
case true false
|
|
1303
|
+
case false
|
|
1304
|
+
let [first (abnf-prefix-tail (abnf-at ka i) (abnf-at (get :keys c) 0))]
|
|
1305
|
+
match first
|
|
1306
|
+
case "\\u0000" false
|
|
1307
|
+
case _ (abnf-none (filter (fn [j] (abnf-not (abnf-same (abnf-prefix-tail (abnf-at ka (abnf-plus i j)) (abnf-at (get :keys c) j)) first))) (indices (get :keys c))))
|
|
1308
|
+
|
|
1309
|
+
; The candidate, other than the rule itself, whose alternatives stand at
|
|
1310
|
+
; position i: where several do, the one with the most alternatives, and
|
|
1311
|
+
; among those the one the spec defines first. The spec cannot tell \`a = b
|
|
1312
|
+
; ";"\` with \`b = c "("\` from \`a = c "(" ";"\`, nor a reference from two
|
|
1313
|
+
; rules that begin alike by chance; a grammar written from the top down
|
|
1314
|
+
; defines the rule an author named before the ones it is made of.
|
|
1315
|
+
def abnf-cand-at [cands ka i self]
|
|
1316
|
+
let [hits (filter (fn [c] (match (abnf-same (get :name c) self) (case true false) (case false (abnf-cand-matches c ka i)))) cands)]
|
|
1317
|
+
let [most (filter (fn [c] (abnf-none (filter (fn [d] (abnf-less (count (get :keys c)) (count (get :keys d)))) hits))) hits)]
|
|
1318
|
+
match (count most)
|
|
1319
|
+
case 0 null
|
|
1320
|
+
case _ (abnf-at most 0)
|
|
1321
|
+
|
|
1322
|
+
; A rule's alternatives with the references written back: each run a
|
|
1323
|
+
; candidate covers, from the first position one stands at that no other
|
|
1324
|
+
; run covers, written as the reference and the tail; the alternatives
|
|
1325
|
+
; as they are where no run is found, and where writing one back would
|
|
1326
|
+
; leave the rule one reference, which the compiler would not substitute.
|
|
1327
|
+
def abnf-unsub [cx cands self alts]
|
|
1328
|
+
match (count cands)
|
|
1329
|
+
case 0 alts
|
|
1330
|
+
case _
|
|
1331
|
+
let [ka (map (fn [seq] (abnf-seq-keys cx seq)) alts)]
|
|
1332
|
+
let [best (map (fn [i] (abnf-cand-at cands ka i self)) (indices alts))]
|
|
1333
|
+
let [covers (fn [j i] (match (kind (abnf-at best j)) (case :record (match (abnf-less j i) (case true (abnf-less i (abnf-plus j (count (get :keys (abnf-at best j)))))) (case false false))) (case _ false)))]
|
|
1334
|
+
let [accepted (map (fn [i] (match (kind (abnf-at best i)) (case :record (abnf-none (filter (fn [j] (covers j i)) (indices alts)))) (case _ false))) (indices alts))]
|
|
1335
|
+
let [out (abnf-flat (map (fn [i] (abnf-unsub-at cx alts best accepted covers i)) (indices alts)))]
|
|
1336
|
+
match (abnf-alias cx out)
|
|
1337
|
+
case true alts
|
|
1338
|
+
case false out
|
|
1339
|
+
|
|
1340
|
+
def abnf-unsub-at [cx alts best accepted covers i]
|
|
1341
|
+
match (abnf-at accepted i)
|
|
1342
|
+
case true
|
|
1343
|
+
let [c (abnf-at best i)]
|
|
1344
|
+
vector (abnf-cat [(abnf-ref-el (get :name c))] (abnf-drop (count (abnf-at (get :keys c) 0)) (abnf-at alts i)))
|
|
1345
|
+
case false
|
|
1346
|
+
match (abnf-some (filter (fn [j] (match (abnf-at accepted j) (case true (covers j i)) (case false false))) (indices alts)))
|
|
1347
|
+
case true []
|
|
1348
|
+
case false [(abnf-at alts i)]
|
|
1349
|
+
|
|
1350
|
+
; ---- ABNF's terminals
|
|
1351
|
+
|
|
1352
|
+
; A literal: a quoted string where it can hold the text (\`%s\` before it
|
|
1353
|
+
; when the match is exact and the text holds a letter), and otherwise a
|
|
1354
|
+
; numeric value, \`%x\` and each character's code point, which ABNF reads
|
|
1355
|
+
; as a case-insensitive string.
|
|
1356
|
+
def abnf-lit-text [text cs]
|
|
1357
|
+
match text
|
|
1358
|
+
case "" "\\"\\""
|
|
1359
|
+
case _
|
|
1360
|
+
match (chars-within [[32 33] [35 126]] text)
|
|
1361
|
+
case true
|
|
1362
|
+
match cs
|
|
1363
|
+
case true
|
|
1364
|
+
match (abnf-has-letter text)
|
|
1365
|
+
case true (string-join "" ["%s\\"" text "\\""])
|
|
1366
|
+
case false (string-join "" ["\\"" text "\\""])
|
|
1367
|
+
case false (string-join "" ["\\"" text "\\""])
|
|
1368
|
+
case false
|
|
1369
|
+
match cs
|
|
1370
|
+
case true
|
|
1371
|
+
match (abnf-has-letter text)
|
|
1372
|
+
case true (abnf-fail (string-join "" ["the case-sensitive literal " (quoted text) " holds a character a quoted string cannot hold, and a numeric value matches case-insensitively"]))
|
|
1373
|
+
case false (string-join "" ["%x" (string-join "." (abnf-codes text))])
|
|
1374
|
+
case false (string-join "" ["%x" (string-join "." (abnf-codes text))])
|
|
1375
|
+
|
|
1376
|
+
; A code point of a class's pattern, \`\\uXXXX\` or \`\\u{X...}\`, as ABNF's
|
|
1377
|
+
; hexadecimal digits.
|
|
1378
|
+
def abnf-escape-hex [e]
|
|
1379
|
+
match (abnf-starts "\\\\u" e)
|
|
1380
|
+
case false ""
|
|
1381
|
+
case true
|
|
1382
|
+
let [h (abnf-after "\\\\u" e)]
|
|
1383
|
+
match (abnf-starts "{" h)
|
|
1384
|
+
case true (abnf-hex-upper (abnf-before "}" (abnf-after "{" h)))
|
|
1385
|
+
case false
|
|
1386
|
+
match (abnf-starts "00" h)
|
|
1387
|
+
case true (abnf-hex-upper (abnf-after "00" h))
|
|
1388
|
+
case false (abnf-hex-upper h)
|
|
1389
|
+
|
|
1390
|
+
; A class: one range as \`%x<lo>-<hi>\`, the only class ABNF writes; a
|
|
1391
|
+
; class of several members, which another notation writes, as the
|
|
1392
|
+
; alternation of its members, each range a range and each character a
|
|
1393
|
+
; string that matches it exactly, or a range of one where a string cannot
|
|
1394
|
+
; hold it. A negated class has no ABNF form.
|
|
1395
|
+
def abnf-class-text [pat flags]
|
|
1396
|
+
let [body (abnf-before "]" (abnf-after "[" pat))]
|
|
1397
|
+
match (abnf-starts "^" body)
|
|
1398
|
+
case true (abnf-fail (string-join "" ["the class " pat " is negated, which ABNF has no form for"]))
|
|
1399
|
+
case false
|
|
1400
|
+
let [members (abnf-class-members body)]
|
|
1401
|
+
match (abnf-none (filter (fn [m] (abnf-empty (get :lo m))) members))
|
|
1402
|
+
case false (abnf-fail (string-join "" ["the class " pat " is not a range ABNF writes"]))
|
|
1403
|
+
case true
|
|
1404
|
+
match (count members)
|
|
1405
|
+
case 0 (abnf-fail (string-join "" ["the class " pat " is empty"]))
|
|
1406
|
+
case 1 (abnf-member-text pat (abnf-at members 0))
|
|
1407
|
+
case _ (string-join "" ["( " (string-join " / " (map (fn [m] (abnf-member-text pat m)) members)) " )"])
|
|
1408
|
+
|
|
1409
|
+
; A class's members, each \`\\uXXXX\` or \`\\u{X...}\` alone or the low end of a
|
|
1410
|
+
; range: its digits and its high end's, ABNF's hexadecimal digits.
|
|
1411
|
+
def abnf-class-members [body]
|
|
1412
|
+
let [pieces (abnf-rest (split "\\\\u" body))]
|
|
1413
|
+
let [prev (abnf-cat [""] pieces)]
|
|
1414
|
+
map
|
|
1415
|
+
fn [i]
|
|
1416
|
+
let [piece (abnf-at pieces i)]
|
|
1417
|
+
match (abnf-ends "-" piece)
|
|
1418
|
+
case true
|
|
1419
|
+
record
|
|
1420
|
+
entry :lo (abnf-escape-hex (string-join "" ["\\\\u" (abnf-before "-" piece)]))
|
|
1421
|
+
entry :hi (abnf-escape-hex (string-join "" ["\\\\u" (abnf-str (abnf-at pieces (abnf-plus i 1)))]))
|
|
1422
|
+
case false
|
|
1423
|
+
record
|
|
1424
|
+
entry :lo (abnf-escape-hex (string-join "" ["\\\\u" piece]))
|
|
1425
|
+
entry :hi (abnf-escape-hex (string-join "" ["\\\\u" piece]))
|
|
1426
|
+
filter (fn [i] (abnf-not (abnf-ends "-" (abnf-at prev i)))) (indices pieces)
|
|
1427
|
+
|
|
1428
|
+
; A member: a range as a range; a character as a string that matches it
|
|
1429
|
+
; exactly where a string can hold it, and otherwise, below U+0080, as a
|
|
1430
|
+
; range of one, which the compiler reads as that character. A character
|
|
1431
|
+
; past ASCII that no string holds is refused, since a range of one is read
|
|
1432
|
+
; without regard to case.
|
|
1433
|
+
def abnf-member-text [pat m]
|
|
1434
|
+
match (abnf-same (get :lo m) (get :hi m))
|
|
1435
|
+
case false (string-join "" ["%x" (get :lo m) "-" (get :hi m)])
|
|
1436
|
+
case true
|
|
1437
|
+
let [h (get :lo m)]
|
|
1438
|
+
let [h4 (string-join "" [(match (length h) (case 1 "000") (case 2 "00") (case 3 "0") (case _ "")) (abnf-hex-lower h)])]
|
|
1439
|
+
match (abnf-ascii-code h4)
|
|
1440
|
+
case false (abnf-fail (string-join "" ["the class " pat " holds U+" (abnf-hex-upper h4) " alone, which ABNF writes only as a numeric value, read without regard to case"]))
|
|
1441
|
+
case true
|
|
1442
|
+
let [c (unquoted (string-join "" ["\\"\\\\u" h4 "\\""]))]
|
|
1443
|
+
match (chars-within [[32 33] [35 126]] c)
|
|
1444
|
+
case true (abnf-lit-text c true)
|
|
1445
|
+
case false (string-join "" ["%x" h "-" h])
|
|
1446
|
+
|
|
1447
|
+
; Whether four hexadecimal digits name an ASCII character.
|
|
1448
|
+
def abnf-ascii-code [h4]
|
|
1449
|
+
match (abnf-starts "00" h4)
|
|
1450
|
+
case false false
|
|
1451
|
+
case true (abnf-some (filter (fn [d] (abnf-starts d (abnf-after "00" h4))) ["0" "1" "2" "3" "4" "5" "6" "7"]))
|
|
1452
|
+
|
|
1453
|
+
; ---- ABNF's elements
|
|
1454
|
+
|
|
1455
|
+
; Alternatives' text without the space an empty first or last one leaves
|
|
1456
|
+
; at either end (\`a = / "x"\`).
|
|
1457
|
+
def abnf-trim-ends [t]
|
|
1458
|
+
let [lead (match (abnf-starts " " t) (case true (abnf-after " " t)) (case false t))]
|
|
1459
|
+
match (abnf-ends " " lead)
|
|
1460
|
+
case true (abnf-before " " lead)
|
|
1461
|
+
case false lead
|
|
1462
|
+
|
|
1463
|
+
; A rule name ABNF can spell: a letter, then letters, digits and hyphens.
|
|
1464
|
+
def abnf-legal-name [name]
|
|
1465
|
+
match name
|
|
1466
|
+
case "" false
|
|
1467
|
+
case _
|
|
1468
|
+
match (chars-within [[45 45] [48 57] [65 90] [97 122]] name)
|
|
1469
|
+
case false false
|
|
1470
|
+
case true
|
|
1471
|
+
match (abnf-starts "-" name)
|
|
1472
|
+
case true false
|
|
1473
|
+
case false (abnf-none (filter (fn [d] (abnf-starts d name)) ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]))
|
|
1474
|
+
|
|
1475
|
+
def abnf-ref-text [name]
|
|
1476
|
+
match (abnf-legal-name name)
|
|
1477
|
+
case true name
|
|
1478
|
+
case false (abnf-fail (string-join "" ["the rule " (quoted name) " has a name ABNF cannot spell"]))
|
|
1479
|
+
|
|
1480
|
+
; Whether a token is a rule the compiler lifted: a literal's token whose
|
|
1481
|
+
; name is not the one the literal gives it, or that nothing references.
|
|
1482
|
+
def abnf-lifted [cx used t]
|
|
1483
|
+
let [info (abnf-token cx t)]
|
|
1484
|
+
match (get :k info)
|
|
1485
|
+
case :lit
|
|
1486
|
+
match (abnf-legal-name (abnf-bare t))
|
|
1487
|
+
case false false
|
|
1488
|
+
case true
|
|
1489
|
+
match (abnf-derived (abnf-bare t) (get :text info))
|
|
1490
|
+
case false true
|
|
1491
|
+
case true (abnf-not (abnf-some (abnf-rest (split (string-join "" [" " t " "]) used))))
|
|
1492
|
+
case _ false
|
|
1493
|
+
|
|
1494
|
+
def abnf-token-text [cx lifted t]
|
|
1495
|
+
match (abnf-among t lifted)
|
|
1496
|
+
case true (abnf-bare t)
|
|
1497
|
+
case false
|
|
1498
|
+
let [info (abnf-token cx t)]
|
|
1499
|
+
match (get :k info)
|
|
1500
|
+
case :lit (abnf-lit-text (get :text info) (get :cs info))
|
|
1501
|
+
case :class (abnf-class-text (get :pat info) (get :flags info))
|
|
1502
|
+
case :engine (get :name info)
|
|
1503
|
+
|
|
1504
|
+
def abnf-rep-text [self cx lifted name]
|
|
1505
|
+
let [parts (abnf-rep-parts cx name)]
|
|
1506
|
+
let [min (abnf-num (get :min parts))]
|
|
1507
|
+
let [count-text (match (get :max parts) (case "" (string-join "" [min "*"])) (case max (match (abnf-same min max) (case true min) (case false (string-join "" [(match min (case "0" "") (case _ min)) "*" max])))))]
|
|
1508
|
+
string-join "" [count-text (self self cx lifted :atom (get :item parts))]
|
|
1509
|
+
|
|
1510
|
+
; The element a repetition applies to: a terminal, a rule, a group or an
|
|
1511
|
+
; option; any other construct is put in a group of its own.
|
|
1512
|
+
def abnf-atom-text [self cx lifted el]
|
|
1513
|
+
match (get :k el)
|
|
1514
|
+
case :tok (abnf-token-text cx lifted (get :name el))
|
|
1515
|
+
case :grp (self self cx lifted :el el)
|
|
1516
|
+
case :ref
|
|
1517
|
+
match (abnf-helper-kind cx (get :name el))
|
|
1518
|
+
case "group" (self self cx lifted :el el)
|
|
1519
|
+
case "opt"
|
|
1520
|
+
match (abnf-opt-group cx (get :name el))
|
|
1521
|
+
case true (self self cx lifted :el el)
|
|
1522
|
+
case false (string-join "" ["( " (self self cx lifted :el el) " )"])
|
|
1523
|
+
case "" (self self cx lifted :el el)
|
|
1524
|
+
case _ (string-join "" ["( " (self self cx lifted :el el) " )"])
|
|
1525
|
+
case _ (string-join "" ["( " (self self cx lifted :el el) " )"])
|
|
1526
|
+
|
|
1527
|
+
def abnf-el-text [self cx lifted el]
|
|
1528
|
+
match (get :k el)
|
|
1529
|
+
case :tok (abnf-token-text cx lifted (get :name el))
|
|
1530
|
+
case :tail (string-join "" ["[ " (self self cx lifted :alts [(get :seq el)]) " ]"])
|
|
1531
|
+
case :grp (string-join "" ["( " (self self cx lifted :alts [(get :seq el)]) " )"])
|
|
1532
|
+
case :ref
|
|
1533
|
+
let [name (get :name el)]
|
|
1534
|
+
match (abnf-helper-kind cx name)
|
|
1535
|
+
case "" (abnf-ref-text name)
|
|
1536
|
+
case "star" (string-join "" ["*" (self self cx lifted :atom (abnf-loop-item cx name (abnf-rule cx name)))])
|
|
1537
|
+
case "plus"
|
|
1538
|
+
let [seq (abnf-at (abnf-alts cx name) 0)]
|
|
1539
|
+
string-join "" ["1*" (self self cx lifted :atom (abnf-at seq 0))]
|
|
1540
|
+
case "opt"
|
|
1541
|
+
let [inner (abnf-at (abnf-filled (abnf-alts cx name)) 0)]
|
|
1542
|
+
match (abnf-opt-group cx name)
|
|
1543
|
+
case true (string-join "" ["[ " (self self cx lifted :alts (abnf-alts cx (get :name inner))) " ]"])
|
|
1544
|
+
case false (string-join "" ["0*1" (self self cx lifted :atom inner)])
|
|
1545
|
+
case "rep" (abnf-rep-text self cx lifted name)
|
|
1546
|
+
case "group" (string-join "" ["( " (self self cx lifted :alts (abnf-alts cx name)) " )"])
|
|
1547
|
+
case kind (abnf-fail (string-join "" ["the rule " name " is a helper of a kind the render does not read (" kind ")"]))
|
|
1548
|
+
|
|
1549
|
+
def abnf-seq-text [self cx lifted seq]
|
|
1550
|
+
string-join " " (map (fn [el] (self self cx lifted :el el)) seq)
|
|
1551
|
+
|
|
1552
|
+
; The text of a rule's or a group's alternatives (\`:alts\`, ABNF's \`/\`
|
|
1553
|
+
; between them), of an element (\`:el\`) and of the element a repetition
|
|
1554
|
+
; applies to (\`:atom\`): the one function the render recurses through, as
|
|
1555
|
+
; \`self\`, a helper's alternatives a level deeper.
|
|
1556
|
+
def abnf-text [self cx lifted mode x]
|
|
1557
|
+
match mode
|
|
1558
|
+
case :alts (abnf-trim-ends (string-join " / " (map (fn [seq] (abnf-seq-text self cx lifted seq)) x)))
|
|
1559
|
+
case :el (abnf-el-text self cx lifted x)
|
|
1560
|
+
case :atom (abnf-atom-text self cx lifted x)
|
|
1561
|
+
|
|
1562
|
+
; ---- core rules
|
|
1563
|
+
|
|
1564
|
+
; The RFC 5234 core rules, in the order the compiler adds them: a pass
|
|
1565
|
+
; over them in this order adds every one the grammar references, and
|
|
1566
|
+
; another pass every one those reference, until none is missing. So the
|
|
1567
|
+
; core rules a spec holds, in its order, rise through this list for the
|
|
1568
|
+
; ones the grammar itself referenced, and fall back at the first the core
|
|
1569
|
+
; rules referenced instead.
|
|
1570
|
+
def abnf-core-order ["ALPHA" "BIT" "CHAR" "CR" "LF" "CRLF" "CTL" "DIGIT" "DQUOTE" "HEXDIG" "HTAB" "OCTET" "SP" "VCHAR" "WSP" "LWSP"]
|
|
1571
|
+
|
|
1572
|
+
def abnf-core-index [name]
|
|
1573
|
+
let [found (filter (fn [i] (abnf-same (abnf-at abnf-core-order i) name)) (indices abnf-core-order))]
|
|
1574
|
+
match (count found)
|
|
1575
|
+
case 0 99
|
|
1576
|
+
case _ (abnf-at found 0)
|
|
1577
|
+
|
|
1578
|
+
; The core rules the grammar referenced itself: the ones a written rule
|
|
1579
|
+
; can name, which the compiler adds again.
|
|
1580
|
+
def abnf-direct-core [cx]
|
|
1581
|
+
let [core (filter (fn [n] (match (abnf-made cx n) (case true false) (case false (abnf-same (abnf-kind (abnf-rule cx n)) "core")))) (keys (get :rules cx)))]
|
|
1582
|
+
let [idx (map abnf-core-index core)]
|
|
1583
|
+
let [prev (abnf-cat [-1] idx)]
|
|
1584
|
+
let [falls (filter (fn [i] (abnf-less (abnf-at idx i) (abnf-at prev i))) (indices idx))]
|
|
1585
|
+
match (count falls)
|
|
1586
|
+
case 0 core
|
|
1587
|
+
case _ (abnf-take (abnf-at falls 0) core)
|
|
1588
|
+
|
|
1589
|
+
; ---- the file
|
|
1590
|
+
|
|
1591
|
+
def abnf-production [cx cands lifted name]
|
|
1592
|
+
string-join "" [(abnf-ref-text name) " = " (abnf-text abnf-text cx lifted :alts (abnf-unsub cx cands name (abnf-alts cx name)))]
|
|
1593
|
+
|
|
1594
|
+
def abnf-lifted-production [cx t]
|
|
1595
|
+
let [info (abnf-token cx t)]
|
|
1596
|
+
string-join "" [(abnf-ref-text (abnf-bare t)) " = " (abnf-lit-text (get :text info) (get :cs info))]
|
|
1597
|
+
|
|
1598
|
+
def abnf-start-rule [cx]
|
|
1599
|
+
abnf-p (abnf-at (abnf-open (abnf-rule cx (get :start cx))) 0)
|
|
1600
|
+
|
|
1601
|
+
def abnf-file [spec]
|
|
1602
|
+
let [cx (abnf-context spec)]
|
|
1603
|
+
let [checked (abnf-check spec cx)]
|
|
1604
|
+
let [names (filter (fn [n] (match (abnf-made cx n) (case true false) (case false (abnf-same (abnf-kind (abnf-rule cx n)) "user")))) (keys (get :rules cx)))]
|
|
1605
|
+
let [start (abnf-start-rule cx)]
|
|
1606
|
+
let [ordered (abnf-cat [start] (filter (fn [n] (abnf-not (abnf-same n start))) names))]
|
|
1607
|
+
let [used (abnf-used cx)]
|
|
1608
|
+
let [tokens (abnf-cat (keys (get :fixed cx)) (keys (get :match cx)))]
|
|
1609
|
+
let [lifted (filter (fn [t] (abnf-lifted cx used t)) tokens)]
|
|
1610
|
+
let [cands (abnf-candidates cx (abnf-cat ordered (abnf-direct-core cx)))]
|
|
1611
|
+
string-join ""
|
|
1612
|
+
vector
|
|
1613
|
+
string-join "\\n" (abnf-cat (map (fn [n] (abnf-production cx cands lifted n)) ordered) (map (fn [t] (abnf-lifted-production cx t)) lifted))
|
|
1614
|
+
"\\n"
|
|
1615
|
+
|
|
1616
|
+
def abnf-render [input]
|
|
1617
|
+
concat-map abnf-file (select root input)
|
|
1618
|
+
` })
|
|
1619
|
+
})
|
|
1620
|
+
|
|
1621
|
+
function translate (): TranslationParts | undefined {
|
|
1622
|
+
return TRANSLATION
|
|
1623
|
+
}
|
|
1624
|
+
|
|
1625
|
+
export {
|
|
1626
|
+
translate,
|
|
1627
|
+
}
|
|
1628
|
+
|
|
1629
|
+
export type {
|
|
1630
|
+
TranslationPart,
|
|
1631
|
+
TranslationParts,
|
|
1632
|
+
}
|