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"} = 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;