#! /usr/bin/perl use autodie; my %LABEL; sub scansyms (\%$) { my ($labels, $f) = @_; my $st = LIMBO; my $func = undef; my $file = undef; open my $fh, "<", $f; while (<$fh>) { chomp; if (/^---/) { $st = NEWPKG; } elsif ($st eq NEWPKG && /^Package `[-\w]+'/) { $st = LIST; } elsif ($st eq LIST && /^(Classes|Leaked slot names):/) { $st = LIMBO; } elsif ($st eq LIMBO && /^Methods:/) { $st = METHODS; } elsif (/^\s*$/) { } elsif ($st eq LIMBO) { } elsif (/^([-\w]+\.lisp)$/) { $file = $1; } elsif ($st eq LIST) { my @F = split; (my $sym = shift @F) =~ s/^(.+)://; $labels->{"sym:$sym"} = 1 unless @F; for my $t (@F) { if ($t eq 'constant') { $labels->{"const:$sym"} = $file; } elsif ($t eq 'variable') { $labels->{"var:$sym"} = $file; } elsif ($t eq 'macro') { $labels->{"mac:$sym"} = $file; } elsif ($t eq 'function') { $labels->{"fun:$sym"} = $file; } elsif ($t eq 'setf-function') { $labels->{"fun:setf/$sym"} = $file; } elsif ($t eq 'generic') { $labels->{"gf:$sym"} = $file; } elsif ($t eq 'setf-generic') { $labels->{"gf:setf/$sym"} = $file; } elsif ($t eq 'class') { $labels->{"cls:$sym"} = $file; } elsif ($t eq 'c-type-spec') { $labels->{"cty:$sym"} = $file; } elsif ($t eq 'c-type-form') { $labels->{"cty:$sym"} = $file; } elsif ($t eq 'parser-spec') { $labels->{"parse:$sym"} = $file; } elsif ($t eq 'parser-form') { $labels->{"parseform:$sym"} = $file; } elsif ($t eq 'opthandler') { $labels->{"opt:$sym"} = $file; } elsif ($t eq 'optmacro') { $labels->{"optmac:$sym"} = $file; } else { die "unknown symbol category `$t'"; } } } } close $fh; } my %DEF = map { $_ => 1 } "cls:array", "cls:class", "cls:error", "cls:float", "cls:function", "cls:list", "cls:string", "const:nil", "fun:*", "fun:char", "fun:setf/char", "fun:error", "fun:float", "fun:function", "fun:list", "fun:not", "fun:read", "fun:schar", "fun:setf/schar", "fun:string", "fun:set", "fun:union", "mac:and", "mac:or", "var:*"; my %CAT = map { $_ => 1 } 'sym', 'const', 'var', 'mac', 'fun', 'gf', 'cls', 'modvar', 'const', 'meth', 'ar-meth', 'be-meth', 'af-meth', 'msg', 'feat', 'rst', 'ty', 'lmac', 'parse', 'parseform', 'opt', 'optmac', 'plug'; my $AUXDIR = "build/doc/"; sub scanaux (\%$) { my ($def, $f) = @_; (my $s = $f) =~ s/\.aux$/.tex/; open my $fh, "<", "$AUXDIR$f"; while (<$fh>) { chomp; if (/^\\\@input\{([^}]*\.aux)\}$/) { scanaux($def, $1); } elsif (/^\\newlabel\{([^:]+):([^}]+)\}/ && $CAT{$1}) { $def->{"$1:$2"} = $s; } } close $fh; } scansyms %LABEL, "doc/SYMBOLS"; scanaux %DEF, "sod.aux"; my $BAD = 0; sub bad ($) { my ($what) = @_; print STDERR "$0: $what\n"; $BAD = 2; } SYM: for my $sym (sort keys %LABEL) { if ($DEF{$sym}) { next SYM; } my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/; if ($tag eq "cls" && $DEF{"ty:$name"}) { } elsif ($tag eq "gf" && $DEF{"fun:$name"}) { } elsif ($tag eq "var" && $DEF{"const:$name"}) { } elsif ($tag eq "sym" && $DEF{"plug:$name"}) { } elsif ($tag eq "sym" && $DEF{"lmac:$name"}) { } elsif ($sym eq "sym:alignas" && $DEF{"cls:alignas-storage-specifier"}) { } elsif ($sym eq "fun:main" && $DEF{"fun:sod-frontend:main"}) { } elsif ($sym eq "fun:augment-options" && $DEF{"fun:sod-frontend:augment-options"}) { } elsif ($sym eq "gf:setf/generic-function-methods") { } elsif ($tag eq "cty") { } else { bad "missing $tag:$name (defined in $LABEL{$sym})"; } } SYM: for my $sym (sort keys %DEF) { if ($LABEL{$sym}) { next SYM; } my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/; if ($tag eq "ty" && $LABEL{"cls:$name"}) { } elsif ($tag eq "const" && $LABEL{"var:$name"}) { } elsif ($tag eq "fun" && $LABEL{"gf:$name"}) { } elsif ($DEF{$sym} eq "runtime.tex") { } elsif ($DEF{$sym} eq "structures.tex") { } elsif ($sym eq "lmac:parse") { } elsif ($sym eq "rst:noted") { } elsif ($tag eq "meth" || $tag eq "ar-meth" || $tag eq "be-meth" || $tag eq "af-meth") { } elsif ($sym eq "parse::any" || $sym eq "parse::eof" || $sym eq "parse::whitespace" || $sym eq "parse:atom" || $sym eq "parse:char" || $sym eq "parse:string" || $sym eq "parse:t" || $sym eq "parseform:t" || $sym eq "parseform:when") { } elsif ($sym eq "plug:class-item" || $sym eq "plug:module") { } elsif ($sym eq "sym:int") { } elsif ($name =~ /^sod-frontend:(.*)$/ && $LABEL{"$tag:$1"}) { } else { bad "unexpected $tag:$name (described in $DEF{$sym})"; } } exit $BAD;