Commit | Line | Data |
---|---|---|
f4b4d9ef MW |
1 | #! /usr/bin/perl |
2 | ||
3 | use autodie; | |
4 | ||
5 | my %LABEL; | |
6 | ||
7 | sub scansyms (\%$) { | |
8 | my ($labels, $f) = @_; | |
9 | my $st = LIMBO; | |
10 | my $func = undef; | |
11 | my $file = undef; | |
12 | open my $fh, "<", $f; | |
13 | while (<$fh>) { | |
14 | chomp; | |
15 | if (/^---/) { $st = NEWPKG; } | |
16 | elsif ($st eq NEWPKG && /^Package `[-\w]+'/) { $st = LIST; } | |
17 | elsif ($st eq LIST && /^Classes:/) { $st = LIMBO; } | |
18 | elsif ($st eq LIMBO && /^Methods:/) { $st = METHODS; } | |
19 | elsif (/^\s*$/) { } | |
20 | elsif ($st eq LIMBO) { } | |
21 | elsif (/^([-\w]+\.lisp)$/) { $file = $1; } | |
22 | elsif ($st eq LIST) { | |
23 | my @F = split; | |
24 | (my $sym = shift @F) =~ s/^(.+)://; | |
25 | $labels->{"sym:$sym"} = 1 unless @F; | |
26 | for my $t (@F) { | |
27 | if ($t eq 'constant') { $labels->{"const:$sym"} = $file; } | |
28 | elsif ($t eq 'variable') { $labels->{"var:$sym"} = $file; } | |
29 | elsif ($t eq 'macro') { $labels->{"mac:$sym"} = $file; } | |
30 | elsif ($t eq 'function') { $labels->{"fun:$sym"} = $file; } | |
31 | elsif ($t eq 'setf-function') { $labels->{"fun:setf/$sym"} = $file; } | |
32 | elsif ($t eq 'generic') { $labels->{"gf:$sym"} = $file; } | |
33 | elsif ($t eq 'setf-generic') { $labels->{"gf:setf/$sym"} = $file; } | |
34 | elsif ($t eq 'class') { $labels->{"cls:$sym"} = $file; } | |
35 | elsif ($t eq 'c-type-spec') { $labels->{"cty:$sym"} = $file; } | |
36 | elsif ($t eq 'c-type-form') { $labels->{"cty:$sym"} = $file; } | |
37 | elsif ($t eq 'parser-spec') { $labels->{"parse:$sym"} = $file; } | |
38 | elsif ($t eq 'parser-form') { $labels->{"parseform:$sym"} = $file; } | |
39 | elsif ($t eq 'opthandler') { $labels->{"opt:$sym"} = $file; } | |
40 | elsif ($t eq 'optmacro') { $labels->{"optmac:$sym"} = $file; } | |
41 | else { die "unknown symbol category `$t'"; } | |
42 | } | |
43 | } | |
44 | } | |
45 | close $fh; | |
46 | } | |
47 | ||
48 | my %DEF = map { $_ => 1 } | |
49 | "cls:array", "cls:class", "cls:error", "cls:float", "cls:function", | |
50 | "cls:list", "cls:string", | |
51 | "const:nil", | |
52 | "fun:*", "fun:char", "fun:setf/char", "fun:error", "fun:float", | |
53 | "fun:function", "fun:list", "fun:not", "fun:read", | |
54 | "fun:schar", "fun:setf/schar", "fun:string", "fun:set", "fun:union", | |
55 | "mac:and", "mac:or", | |
56 | "var:*"; | |
57 | my %CAT = map { $_ => 1 } | |
58 | 'sym', 'const', 'var', 'mac', 'fun', 'gf', 'cls', 'modvar', 'const', | |
59 | 'meth', 'ar-meth', 'be-meth', 'af-meth', | |
60 | 'msg', 'feat', | |
61 | 'rst', 'ty', 'lmac', 'parse', 'parseform', 'opt', 'optmac', 'plug'; | |
62 | ||
63 | my $AUXDIR = "build/doc/"; | |
64 | ||
65 | sub scanaux (\%$) { | |
66 | my ($def, $f) = @_; | |
67 | (my $s = $f) =~ s/\.aux$/.tex/; | |
68 | open my $fh, "<", "$AUXDIR$f"; | |
69 | while (<$fh>) { | |
70 | chomp; | |
71 | if (/^\\\@input\{([^}]*\.aux)\}$/) { scanaux($def, $1); } | |
72 | elsif (/^\\newlabel\{([^:]+):([^}]+)\}/ && $CAT{$1}) | |
73 | { $def->{"$1:$2"} = $s; } | |
74 | } | |
75 | close $fh; | |
76 | } | |
77 | ||
78 | scansyms %LABEL, "doc/SYMBOLS"; | |
79 | scanaux %DEF, "sod.aux"; | |
80 | ||
9252626a MW |
81 | my $BAD = 0; |
82 | ||
83 | sub bad ($) { | |
84 | my ($what) = @_; | |
85 | print STDERR "$0: $what\n"; | |
86 | $BAD = 2; | |
87 | } | |
88 | ||
f4b4d9ef MW |
89 | SYM: for my $sym (sort keys %LABEL) { |
90 | if ($DEF{$sym}) { next SYM; } | |
91 | my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/; | |
92 | if ($tag eq "cls" && $DEF{"ty:$name"}) { } | |
93 | elsif ($tag eq "gf" && $DEF{"fun:$name"}) { } | |
94 | elsif ($tag eq "var" && $DEF{"const:$name"}) { } | |
95 | elsif ($tag eq "sym" && $DEF{"plug:$name"}) { } | |
96 | elsif ($tag eq "sym" && $DEF{"lmac:$name"}) { } | |
97 | elsif ($sym eq "sym:alignas" && $DEF{"cls:alignas-storage-specifier"}) { } | |
98 | elsif ($sym eq "fun:main" && $DEF{"fun:sod-frontend:main"}) { } | |
99 | elsif ($sym eq "fun:augment-options" && | |
100 | $DEF{"fun:sod-frontend:augment-options"}) { } | |
101 | elsif ($sym eq "gf:setf/generic-function-methods") { } | |
102 | elsif ($tag eq "cty") { } | |
9252626a | 103 | else { bad "missing $tag:$name (defined in $LABEL{$sym})"; } |
f4b4d9ef MW |
104 | } |
105 | ||
106 | SYM: for my $sym (sort keys %DEF) { | |
107 | if ($LABEL{$sym}) { next SYM; } | |
108 | my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/; | |
109 | if ($tag eq "ty" && $LABEL{"cls:$name"}) { } | |
110 | elsif ($tag eq "const" && $LABEL{"var:$name"}) { } | |
111 | elsif ($tag eq "fun" && $LABEL{"gf:$name"}) { } | |
112 | elsif ($DEF{$sym} eq "runtime.tex") { } | |
113 | elsif ($DEF{$sym} eq "structures.tex") { } | |
114 | elsif ($sym eq "lmac:parse") { } | |
115 | elsif ($sym eq "rst:noted") { } | |
116 | elsif ($tag eq "meth" || $tag eq "ar-meth" || | |
117 | $tag eq "be-meth" || $tag eq "af-meth") { } | |
118 | elsif ($sym eq "parse::any" || $sym eq "parse::eof" || | |
119 | $sym eq "parse::whitespace" || $sym eq "parse:atom" || | |
120 | $sym eq "parse:char" || $sym eq "parse:string" || | |
121 | $sym eq "parse:t" || $sym eq "parseform:t" || | |
122 | $sym eq "parseform:when") { } | |
123 | elsif ($sym eq "plug:class-item" || $sym eq "plug:module") { } | |
124 | elsif ($sym eq "sym:int") { } | |
125 | elsif ($name =~ /^sod-frontend:(.*)$/ && $LABEL{"$tag:$1"}) { } | |
9252626a | 126 | else { bad "unexpected $tag:$name (described in $DEF{$sym})"; } |
f4b4d9ef | 127 | } |
9252626a MW |
128 | |
129 | exit $BAD; |