#!/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; } }