blob: 26669fd6e23c5ec7c82ed44ddc31626f1cbbe9ad (
plain)
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
|
@(name file)
@
@
@
@(define check-synb ())
.synb
@ (assert bad ln `bad .synb block`)
@ (repeat :gap 0 :min 1)
.mets @(skip)
@ (maybe)
@ (repeat :gap 0 :mintimes 1)
.mets \ \ @(skip)
@ (last :mandatory)
@ (trailer)
.mets @(skip)
@ (end)
@ (end)
@ (last :mandatory)
.syne
@ (end)
@ (assert bad ln `missing .desc`)
.desc
@(end)
@
@
@
@(define check-var ())
@ (cases)
@
.coNP Variables @@, s-ifmt @(skip)
@ (or)
@
.coNP Variables @@, *0 @(skip)
@ (or)
.coNP Variables@(assert bad ln `bad Variables heading`)@(rep :gap 0) @@, @{x /\S+/}@(last :mandatory) @@ @y and @@ @{z /\S+/}@(end)
@ (assert bad ln `no .desc after variables heading`)
.desc
@ (or)
.coNP Variable@(assert bad ln `bad Variable heading`) @{x /\S+/}
@ (assert bad ln `no .desc after variable heading`)
.desc
@ (end)
@(end)
@
@
@
@(define check-func ())
@ (cases)
.coNP Operator/function @(skip)
@ (or)
.coNP @{type /Function|Operator|Macro/}s@(assert bad ln `bad @{type}s heading`)@(rep :gap 0) @@, @{x /\S+/}@(last :mandatory) @@ @y and @@ @{z /\S+/}@(end)
@ (assert bad ln `no .synb after @{type}s heading`)
@ (check-synb)
@ (or)
.coNP @{type /Function|Operator|Macro/}@(assert bad ln `bad @type heading`) @{x /\S+/}
@ (assert bad ln `no .synb after @type heading`)
@ (check-synb)
@ (end)
@(end)
@
@
@
@(define check-code ())
@ (cases)
.@{type /code|meta/} "@(assert bad ln `.@type needs one argument`)@x"@(eol)
@ (or)
.@{type /code|meta/} @(assert bad ln `.@type needs one argument`)@{x /\S+/}@(eol)
@ (or)
.cod3 @(assert bad ln `.cod3 needs three arguments`)@x @y @{z /\S+/}@(eol)
@ (or)
.@{type /codn|cod2|metn/} @(assert bad ln `.@type needs two arguments`)@(cases)"@x"@(or)@{x /\S+/}@(end) @{y /\S+/}@(eol)
@ (assert bad ln `.codn second argument doesn't begin with punctuation`)
@ (require (or (not (memqual type '("codn" "metn")))
(chr-ispunct [y 0])))
@ (end)
@(end)
@
@
@
@(bind errors 0)
@(repeat)
@ (line ln)
@ (try)
@ (cases)
@ (check-var)
@ (or)
@ (check-func)
@ (or)
@ (check-code)
@ (end)
@ (catch bad (line msg))
@ (do (inc errors)
(put-line `@file:@line:@msg`))
@ (end)
@(end)
@(do (exit (zerop errors)))
|