while (@ARGV) {
$_= shift @ARGV;
die if m/^\-/;
- $x= new IO::File $_,'r';
+ $x= new IO::File $_,'r' or die "$_: $!\n";
parse($_,$x);
}
sub parse ($$) {
my ($wh,$f) = @_;
while (defined($_= $f->getline)) {
- chomp; s/^\s+//; s/\s+$//;
- next if m/^\#/;
+ chomp; s/\s+$//;
+ next if m/^\s*\#/;
next if !m/\S/;
s/\t/ ' 'x(8-(length $`) % 8) /eg;
- s/^\s+//;
+ s/^\s*//;
$this_indent= length $&;
- while (@i && $this_indent < $i[0]) { shift @i; }
+ while (@i && $this_indent < $i[0]) {
+ shift @i;
+ }
if ($this_indent && (!@i || $this_indent > $i[0])) {
unshift @i, $this_indent;
}
} elsif (@i==1 && m/^([a-z]\w*)$/ && defined $c_table) {
$c_entry= $1;
$tables{$c_table}{$c_entry}{A} = [ ];
- } elsif (@i==2 && m/^(?:\?)?([a-z]\w*)\s.*(\S.*)/
+ } elsif (@i==2 && m/^(\w+)\s+\.\.\.$/ && defined $c_entry) {
+ $tables{$c_table}{$c_entry}{V}= $1;
+ } elsif (@i==2 && m/^(\??)([a-z]\w*)\s*(\S.*)/
&& defined $c_entry) {
- push @{ $tables{$c_table}{$c_entry}{A} }, [ $2, $3, $1 eq '?' ];
- } elsif (@i==2 && m/^\=\>\s.*(\S.*)/ && defined $c_entry) {
+ ($opt, $var, $type) = ($1,$2,$3);
+ if ($type =~ m/^\w+$/) {
+ $xtypeargs='';
+ } elsif ($type =~ m/^(\w+)\((.+)\)$/) {
+ $type= $1;
+ $xtypeargs= $2;
+ }
+ push @{ $tables{$c_table}{$c_entry}{A} },
+ { N => $var, T => $type, A => $xtypeargs, O => ($opt eq '?') };
+ } elsif (@i==2 && m/^\=\>\s*(\S.*)$/ && defined $c_entry) {
$tables{$c_table}{$c_entry}{R}= $1;
- } elsif (@i==2 && m/^\.\.\.$/ && defined $c_entry) {
- $tables{$c_table}{$c_entry}{V}= 1;
- } elsif (@i==0 && s/^Type\s+$//) {
-
- ($typename,$_)= ($1,$2);
- $_ .= '@' unless m/\@/;
- $types{$typename}= $_;
+ } elsif (@i==0 && m/^Type\s+([^\:]+)\:\s+(\S.*)$/) {
+ ($typename,$ctype)= ($1,$2);
+ $ctype .= ' @' unless $ctype =~ m/\@/;
+ if ($typename =~ m/^\w+$/) {
+ $xtypeargs='';
+ } elsif ($typename =~ m/^(\w+)\((.+)\)$/) {
+ $typename=$1;
+ $xtypeargs=$2;
+ } else {
+ badsyntax($wh,$.,"bad type name/args");
+ }
+ $types{$typename}= { C => $ctype, X => $xtypeargs };
} else {
+ printf STDERR ">%d<\n",
+ scalar m/^Type\s+([^\:]+)\:\s+(\S.*)$/;
badsyntax($wh,$., sprintf
"bad directive (indent level %d)", scalar @i);
}
$f->close;
}
-print Dumper(\%tables),"\n";
-print Dumper(\%types),"\n";
+#print Dumper(\%tables),"\n";
+#print Dumper(\%types),"\n";
+
+foreach $c_table (sort keys %tables) {
+ $r_table= $tables{$c_table};
+ foreach $c_entry (keys %$r_table) {
+ $r_entry= $r_table->{$c_entry};
+ $pa_decl= "int fn_${c_table}_${c_entry}(";
+ @pa_al= ();
+ foreach $arg (@{ $r_entry->{A} }) {
+ push @pa_al, make_decl($arg->{N}, $arg->{T}, $arg->{A});
+ }
+ if (exists $r_entry->{V}) {
+ $va= $r_entry->{V};
+ push @pa_al, make_decl_c("${va}c", 'int @');
+ push @pa_al, make_decl_c("${va}v", 'Tcl_Obj *const *@');
+ }
+ if (exists $r_entry->{R}) {
+ $t= $r_entry->{R};
+ push @pa_al, make_decl("*result", $t);
+ }
+ $pa_decl .= join ', ', @pa_al;
+ $pa_decl .= ");\n";
+ print $pa_decl or die $!;
+ }
+}
+
+sub make_decl ($$$) {
+ my ($n, $t, $ta) = @_;
+ my ($type);
+ if ($t eq 'enum') {
+ $ta =~ m/\,/ or die "enum with bad args \`$ta'\n";
+ $c= "const $` *@";
+ } else {
+ defined $types{$t} or die "unknown type $t\n";
+ $c= $types{$t}{C};
+ }
+ return make_decl_c($n,$c);
+}
+
+sub make_decl_c ($$) {
+ my ($n, $c) = @_;
+ $c =~ m/\@/ or die "$c for $n?";
+ return "$`$n$'";
+}
sub badsyntax ($$$) {
die "$_[0]:$_[1]: $_[2]\n";
}
__DATA__
-Type int
- int
-Type obj
- Tcl_Obj *
-Type charfrom
- (const char*)
+Type int: int
+Type obj: Tcl_Obj *@
+Type charfrom(const char*): int