Add '.ext/cfd/' from commit 'e370d22add00480a67fd028c0e7d3148737fe484'

[sod] / doc / check-docs

#! /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"} = $file;
      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 'c-storage-spec') { $labels->{"cstg:$sym"} = $file; }
	elsif ($t eq 'c-storage-form') { $labels->{"cstg:$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 { $_ => "<magic>" }
  "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',
  'cty', 'cstg';

sub die_usage () { die "usage: $0 AUXFILE SYMFILE\n"; }
die_usage unless @ARGV; my $auxfile = shift @ARGV;
die_usage unless @ARGV; my $symfile = shift @ARGV;
die_usage if @ARGV;
(my $AUXDIR = $auxfile) =~ s![^/]*$!!;
$auxfile =~ s!^.*/!!;

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}) {
      my ($cat, $sym) = ($1, $2);
      $def->{"$cat:$sym"} = $s;
      $def->{"sym:$sym"} //= $s unless $sym =~ m!^setf/|\(.*\)$!;
    }
  }
  close $fh;
}

scansyms %LABEL, $symfile;
scanaux %DEF, $auxfile;

##use Data::Dumper;
##print "LABELS = " . Dumper(\%LABEL) . "\n";
##print "DEF = " . Dumper(\%DEF) . "\n";

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 ($name eq "nil" && $DEF{"$tag:()"}) { }
  elsif ($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 ($sym =~ /^(fun|sym):(main|augment-options)$/ &&
	 $DEF{"$tag:sod-frontend:$name"}) { }
  elsif ($sym eq "gf:setf/generic-function-methods") { }
  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 ($name eq "()" && $LABEL{"$tag:nil"}) { }
  elsif ($tag eq "ty" && $LABEL{"cls:$name"}) { }
  elsif ($tag eq "const" && $LABEL{"var:$name"}) { }
  elsif ($tag eq "fun" && $LABEL{"gf:$name"}) { }
  elsif ($tag eq "sym" && $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" || $sym eq "sym:atom" || $sym eq "sym:t" ||
	 $sym eq "sym:when") { }
  elsif ($name =~ /^sod-frontend:(.*)$/ && $LABEL{"$tag:$1"}) { }
  else { bad "unexpected $tag:$name (described in $DEF{$sym})"; }
}

exit $BAD;