base/tcmdifgen

   1 #!/usr/bin/perl
   2
   3 use IO;
   4 use Data::Dumper;
   5
   6 parse('builtins','DATA');
   7
   8 while (@ARGV) {
   9     $_= shift @ARGV;
  10     die if m/^\-/;
  11     $x= new IO::File $_,'r';
  12     parse($_,$x);
  13 }
  14
  15 sub parse ($$) {
  16     my ($wh,$f) = @_;
  17     while (defined($_= $f->getline)) {
  18         chomp; s/^\s+//; s/\s+$//;
  19         next if m/^\#/;
  20         next if !m/\S/;
  21         s/\t/ ' 'x(8-(length $`) % 8) /eg;
  22
  23         s/^\s+//;
  24         $this_indent= length $&;
  25         while (@i && $this_indent < $i[0]) { shift @i; }
  26         if ($this_indent && (!@i || $this_indent > $i[0])) {
  27             unshift @i, $this_indent;
  28         }
  29
  30         if (@i==0 && m/^Table\s+(\w+)$/) {
  31             $c_table= $1;
  32             undef $c_entry;
  33         } elsif (@i==1 && m/^([a-z]\w*)$/ && defined $c_table) {
  34             $c_entry= $1;
  35             $tables{$c_table}{$c_entry}{A} = [ ];
  36         } elsif (@i==2 && m/^(?:\?)?([a-z]\w*)\s.*(\S.*)/
  37                  && defined $c_entry) {
  38             push @{ $tables{$c_table}{$c_entry}{A} }, [ $2, $3, $1 eq '?' ];
  39         } elsif (@i==2 && m/^\=\>\s.*(\S.*)/ && defined $c_entry) {
  40             $tables{$c_table}{$c_entry}{R}= $1;
  41         } elsif (@i==2 && m/^\.\.\.$/ && defined $c_entry) {
  42             $tables{$c_table}{$c_entry}{V}= 1;
  43         } elsif (@i==0 && s/^Type\s+$//) {
  44
  45             ($typename,$_)= ($1,$2);
  46             $_ .= '@' unless m/\@/;
  47             $types{$typename}= $_;
  48         } else {
  49             badsyntax($wh,$., sprintf
  50                       "bad directive (indent level %d)", scalar @i);
  51         }
  52     }
  53     $f->error and die $!;
  54     $f->close;
  55 }
  56
  57 print Dumper(\%tables),"\n";
  58 print Dumper(\%types),"\n";
  59
  60 sub badsyntax ($$$) {
  61     die "$_[0]:$_[1]: $_[2]\n";
  62 }
  63
  64 __DATA__
  65 Type int
  66         int
  67 Type obj
  68         Tcl_Obj *
  69 Type charfrom
  70         (const char*)