chiark - git - mdw - sod/blob - doc/check-docs

   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"} = $file;
  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 'c-storage-spec') { $labels->{"cstg:$sym"} = $file; }
  38         elsif ($t eq 'c-storage-form') { $labels->{"cstg:$sym"} = $file; }
  39         elsif ($t eq 'parser-spec') { $labels->{"parse:$sym"} = $file; }
  40         elsif ($t eq 'parser-form') { $labels->{"parseform:$sym"} = $file; }
  41         elsif ($t eq 'opthandler') { $labels->{"opt:$sym"} = $file; }
  42         elsif ($t eq 'optmacro') { $labels->{"optmac:$sym"} = $file; }
  43         else { die "unknown symbol category `$t'"; }
  44       }
  45     }
  46   }
  47   close $fh;
  48 }
  49
  50 my %DEF = map { $_ => "<magic>" }
  51   "cls:array", "cls:class", "cls:error", "cls:float", "cls:function",
  52   "cls:list", "cls:string",
  53   "const:nil",
  54   "fun:*", "fun:char", "fun:setf/char", "fun:error", "fun:float",
  55   "fun:function", "fun:list", "fun:not", "fun:read",
  56   "fun:schar", "fun:setf/schar", "fun:string", "fun:set", "fun:union",
  57   "mac:and", "mac:or",
  58   "var:*";
  59 my %CAT = map { $_ => 1 }
  60   'sym', 'const', 'var', 'mac', 'fun', 'gf', 'cls', 'modvar', 'const',
  61   'meth', 'ar-meth', 'be-meth', 'af-meth',
  62   'msg', 'feat',
  63   'rst', 'ty', 'lmac', 'parse', 'parseform', 'opt', 'optmac', 'plug',
  64   'cty', 'cstg';
  65
  66 sub die_usage () { die "usage: $0 AUXFILE SYMFILE\n"; }
  67 die_usage unless @ARGV; my $auxfile = shift @ARGV;
  68 die_usage unless @ARGV; my $symfile = shift @ARGV;
  69 die_usage if @ARGV;
  70 (my $AUXDIR = $auxfile) =~ s![^/]*$!!;
  71 $auxfile =~ s!^.*/!!;
  72
  73 sub scanaux (\%$) {
  74   my ($def, $f) = @_;
  75   (my $s = $f) =~ s/\.aux$/.tex/;
  76   open my $fh, "<", "$AUXDIR$f";
  77   while (<$fh>) {
  78     chomp;
  79     if (/^\\\@input\{([^}]*\.aux)\}$/)
  80       { scanaux($def, $1); }
  81     elsif (/^\\newlabel\{([^:]+):([^}]+)\}/ && $CAT{$1}) {
  82       my ($cat, $sym) = ($1, $2);
  83       $def->{"$cat:$sym"} = $s;
  84       $def->{"sym:$sym"} //= $s unless $sym =~ m!^setf/|\(.*\)$!;
  85     }
  86   }
  87   close $fh;
  88 }
  89
  90 scansyms %LABEL, $symfile;
  91 scanaux %DEF, $auxfile;
  92
  93 ##use Data::Dumper;
  94 ##print "LABELS = " . Dumper(\%LABEL) . "\n";
  95 ##print "DEF = " . Dumper(\%DEF) . "\n";
  96
  97 my $BAD = 0;
  98
  99 sub bad ($) {
 100   my ($what) = @_;
 101   print STDERR "$0: $what\n";
 102   $BAD = 2;
 103 }
 104
 105 SYM: for my $sym (sort keys %LABEL) {
 106   if ($DEF{$sym}) { next SYM; }
 107   my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/;
 108   if ($name eq "nil" && $DEF{"$tag:()"}) { }
 109   elsif ($tag eq "cls" && $DEF{"ty:$name"}) { }
 110   elsif ($tag eq "gf" && $DEF{"fun:$name"}) { }
 111   elsif ($tag eq "var" && $DEF{"const:$name"}) { }
 112   elsif ($tag eq "sym" && $DEF{"plug:$name"}) { }
 113   elsif ($sym =~ /^(fun|sym):(main|augment-options)$/ &&
 114          $DEF{"$tag:sod-frontend:$name"}) { }
 115   elsif ($sym eq "gf:setf/generic-function-methods") { }
 116   else { bad "missing $tag:$name (defined in $LABEL{$sym})"; }
 117 }
 118
 119 SYM: for my $sym (sort keys %DEF) {
 120   if ($LABEL{$sym}) { next SYM; }
 121   my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/;
 122   if ($name eq "()" && $LABEL{"$tag:nil"}) { }
 123   elsif ($tag eq "ty" && $LABEL{"cls:$name"}) { }
 124   elsif ($tag eq "const" && $LABEL{"var:$name"}) { }
 125   elsif ($tag eq "fun" && $LABEL{"gf:$name"}) { }
 126   elsif ($tag eq "sym" && $name =~ /^:/) { }
 127   elsif ($DEF{$sym} eq "runtime.tex") { }
 128   elsif ($DEF{$sym} eq "structures.tex") { }
 129   elsif ($sym eq "lmac:parse") { }
 130   elsif ($sym eq "rst:noted") { }
 131   elsif ($tag eq "meth" || $tag eq "ar-meth" ||
 132          $tag eq "be-meth" || $tag eq "af-meth") { }
 133   elsif ($sym eq "parse::any" || $sym eq "parse::eof" ||
 134          $sym eq "parse::whitespace" || $sym eq "parse:atom" ||
 135          $sym eq "parse:char" || $sym eq "parse:string" ||
 136          $sym eq "parse:t" || $sym eq "parseform:t" ||
 137          $sym eq "parseform:when") { }
 138   elsif ($sym eq "plug:class-item" || $sym eq "plug:module") { }
 139   elsif ($sym eq "sym:int" || $sym eq "sym:atom" || $sym eq "sym:t" ||
 140          $sym eq "sym:when") { }
 141   elsif ($name =~ /^sod-frontend:(.*)$/ && $LABEL{"$tag:$1"}) { }
 142   else { bad "unexpected $tag:$name (described in $DEF{$sym})"; }
 143 }
 144
 145 exit $BAD;