#!/usr/bin/perl # # ada2idl.pl - A little helper for translating Ada types to CORBA IDL # # Usage: # perl ada2idl.pl AdaPkgSpec # (AdaPkgSpec is your Ada package spec source file) # Output is written to stdout. # # Copyright (C) 2008, Oliver Kellogg # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # $Log: ada2idl.pl,v $ # Revision 0.6 2010/06/14 06:55:12 kellogg # Fix conversion of Ada comments. # # Revision 0.5 2010/06/13 21:47:03 kellogg # Improve clarity of code. Map variant record to IDL 'union'. # # Revision 0.4 2009/04/02 01:48:48 kellogg # Fix conversion of record components and unsigned types. # # Revision 0.3 2008/08/16 19:08:25 kellogg # Generate #pragma subtype and #pragma range as proposed in # http://www.omg.org/archives/ada-rtf/msg00175.html # ########################################################################### # Option -c switches on non-standard comments for Ada ranges and subtypes; # the default is to use #pragma range and #pragma subtype for these. $use_range_comment = 0; if ($ARGV[0] eq '-c') { $use_range_comment = 1; $inputfile=$ARGV[1]; } else { $inputfile=$ARGV[0]; } open(IN, "<$inputfile") or die "cannot open file $inputfile\n"; $linenum = 0; $skip_to_end_of_use_clause = 0; while () { chop; $linenum++; next if (/^\s*use /); # Skip "use" clauses if (/^( *)end record/) { if ($skip_to_end_of_use_clause) { $skip_to_end_of_use_clause = 0; } else { print "${1}\};\n"; } next; } if (/\) *;/ and $skip_to_end_of_use_clause) { $skip_to_end_of_use_clause = 0; next; } next if ($skip_to_end_of_use_clause); s/\s*--\W*$//; # Remove non-text comments s/[ \t]+$//; # Remove whitespace at end of line unless ($_) { print "\n"; next; } # Convert Ada comment to IDL if (/^(\s*)--(.*)/) { my $space = $1; my $comment = $2; print("${space}//$comment\n"); next; } s@--@//@; if (/^( *)package\s+([\w\.]+)\s+is(.*)/) { print "${1}module \L$2\E {$3\n"; next; } next if (/^ *for .* use .*;/); if (/^ *for .* use/) { $skip_to_end_of_use_clause = 1; next; } s/p_portable\.//; s/int16/short/; s/int32/long/; s/float32/float/; s/float64/double/; s/(unsigned_byte|uint8)/octet/; s/uint8/octet/; s/(unsigned_word|uint16)/unsigned short/; s/(unsigned_longword|uint32)/unsigned long/; if (/(\w+) *: *constant +([\w\.]+) :=/) { s/([a-z])\.([a-z])/${1}::${2}/gi; # dot notation s/(\w+) *: *constant +([\w:]+) :=/const \L$2\E \L$1\E =/; print "$_\n"; next; } s/([a-z])\.([a-z])/${1}::${2}/gi; # dot notation if (/^(\s+)(\w+)\s*:\s*([\w\:]+)(.*)$/) { print($1 . lc("$3 $2") . "$4\n"); # record components next; } if (/^\s*with\s+(\w+)/) { print("#include \"" . lc($1) . ".idl\"\n"); next; } next if (/^\s*(end )?case/); if (/^(\s*)(end\s+\w+).*/) { print("$1\}; // $1\n"); next; } my $l = $_; if ($l =~ /^\s*\w+ *,/) { # enum literals $l =~ s/(\w+) *,/\L$1\E,/g; print("$l\n"); next; } if ($l =~ /^\s*\w+ *\)/) { # last enum literal $l =~ s/(\w+) *\)/\L$1\E }/; print("$l\n"); next; } if ($l =~ /^(\s+)(sub)?type\s+(\w+)/) { my $space = $1; my $is_subtype = $2; my $type = lc($3); $l =~ s/^\s+(sub)?type\s+\w+\s*//; $l =~ s/\/\/.*$//; while ($l !~ /\bis\s+[\w\(]/) { my $nxt = ; chop $nxt; $nxt =~ s/\s*--.*$//; $l .= $nxt; $linenum++; } $l = lc($l); if ($l =~ /\(\s*(\w+)\s*:\s*([\w\:]+)/) { my $switchname = $1; my $switchtype = $2; print("${space}// #switchname $type $switchname\n"); print("${space}union $type switch ($switchtype) {\n"); next; } $l =~ s/^\s*is\s+//; if ($l =~ /^\((.*)/) { my $rest = $1; print("${space}enum $type {\n"); if ($rest) { $rest =~ s/\)/}/; print "$space $rest\n"; } next; } if ($l =~ /^record/) { print "${space}struct $type {\n"; next; } if ($l =~ /^array *\( *(.*)\) +of +([\w\.:]+)/) { my $index_expr = $1; my $elem_type = $2; my $intro = "${space}typedef $elem_type $type"; if ($index_expr =~ /^([\w\.:]+) *\.\. *([\w\.:]+)/) { my $low = $1; my $high = $2; if ($low =~ /^\d+$/) { if ($high =~ /^\d+$/) { my $dim = $high - $low + 1; print "$intro\[$dim\];\n"; next; } elsif ($low == 0) { print "$intro\[$high - 1\];\n"; next; } elsif ($low == 1) { print "$intro\[$high\];\n"; next; } } print "${space}const short ${type}_dim = $high - $low + 1;\n"; print "$intro\[${type}_dim\];\n"; } else { print "${space}// #array_index $type $index_expr\n"; print "$intro\[ __FILL_IN_THE_LENGTH_HERE__ \];\n"; } next; } if ($l =~ /^new\s/) { $l =~ s/^new\s+//; } if ($l =~ /^([\w\:]+)/) { my $origtype = $1; if ($l =~ / range ([^ ]+) *\.\. *([^ ]+) *;/) { my $lowerbound = $1; my $upperbound = $2; if ($use_range_comment) { print "${space}// #range $type \[ $lowerbound : $upperbound \]\n"; } else { my $spc = $space; $spc =~ s/ //; print "#${spc}pragma range $type $lowerbound .. $upperbound\n"; if ($is_subtype) { print "#${spc}pragma subtype $type\n"; } } } print "${space}typedef $origtype $type;\n"; } else { warn "line $linenum: cannot convert\n"; print "${space}$l // FIXME: ada2idl.pl could not convert this\n"; } } elsif ($l =~ /^(\s*)when\s+others/) { my $space = $1; print "${space}default:\n"; } elsif ($l =~ /^(\s*)when\s+(.+)/) { my $space = $1; my $rest = lc($2); $rest =~ s/\s*=>.*$//; print "${space}case $rest :\n"; } else { print "$l // ada2idl.pl could not convert this\n"; } } close IN;