1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
#!/usr/bin/perl
while (<>) {
if (/^\.SH SYNOPSIS/) {
$spec = '';
for ($_ = <>; $_ && !/^\.SH/; $_ = <>) {
s/^\.[IRB][IRB]\s*//;
s/^\.[IRB]\s+//;
next if /^\./;
s/\\f\w//g;
s/\\&//g;
s/^\s+//;
next if /^$/;
next if /^#/;
$spec .= $_;
}
$_ = $spec;
0 while s/\(([^),;]*)\s*,\s*([^);]*)\)/($1|$2)/g;
s/\(\*([^,;]*)\)\(\)/(*)()$1/g;
s/(\w+)\[\]/*$1/g;
s/\n/ /g;
s/\s+/ /g;
s/(\w+) \(([^*])/$1($2/g;
s/^ //;
s/ ?; ?/\n/g;
s/\) /)\n/g;
s/ \* / \*/g;
s/\* / \*/g;
$* = 1;
0 while s/^((struct )?\w+ )([^\n,]*), ?(.*)/$1$3\n$1$4/g;
$* = 0;
s/\|/,/g;
@cases = ();
for (reverse split(/\n/,$_)) {
if (/\)$/) {
($type,$name,$args) = split(/(\w+)\(/);
$type =~ s/ $//;
if ($type =~ /^(\w+) =/) {
$type = $type{$1} if $type{$1};
}
$type = 'int' if $type eq '';
@args = grep(/./, split(/[,)]/,$args));
$case = "CASE $type $name\n";
foreach $arg (@args) {
$type = $type{$arg} || "int";
$type =~ s/ //g;
$type .= "\t" if length($type) < 8;
if ($type =~ /\*/) {
$case .= "IO $type $arg\n";
}
else {
$case .= "I $type $arg\n";
}
}
$case .= "END\n\n";
unshift(@cases, $case);
}
else {
$type{$name} = $type if ($type,$name) = /(.*\W)(\w+)$/;
}
}
print @cases;
}
}
|
