| 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|Leaked slot names):/) { $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 | |
| 81 | my $BAD = 0; |
| 82 | |
| 83 | sub bad ($) { |
| 84 | my ($what) = @_; |
| 85 | print STDERR "$0: $what\n"; |
| 86 | $BAD = 2; |
| 87 | } |
| 88 | |
| 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") { } |
| 103 | else { bad "missing $tag:$name (defined in $LABEL{$sym})"; } |
| 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"}) { } |
| 126 | else { bad "unexpected $tag:$name (described in $DEF{$sym})"; } |
| 127 | } |
| 128 | |
| 129 | exit $BAD; |