auto/MkSrc/CcHelper.pm

   1 # This file is part of The New Aspell
   2 # Copyright (C) 2001-2002 by Kevin Atkinson under the GNU LGPL
   3 # license version 2.0 or 2.1.  You should have received a copy of the
   4 # LGPL license along with this library if you did not you can find it
   5 # at http://www.gnu.org/.
   6
   7 package MkSrc::CcHelper;
   8
   9 BEGIN {
  10   use Exporter;
  11   our @ISA = qw(Exporter);
  12   our @EXPORT = qw(to_c_return_type c_error_cond
  13                    to_type_name make_desc make_func call_func
  14                    make_c_method call_c_method form_c_method
  15                    make_cxx_method);
  16 }
  17
  18 use strict;
  19 use warnings;
  20 no warnings qw(uninitialized);
  21 no locale;
  22
  23 use MkSrc::Util;
  24 use MkSrc::Type;
  25
  26 sub to_type_name ( $ $ ; \% );
  27
  28 =head1 Code Generation Modes
  29
  30 The code generation modes are currently one of the following:
  31
  32   cc: Mode used to create types suitable for C interface
  33   cc_cxx: Like cc but typenames don't have a leading Aspell prefix
  34   cxx: Mode used to create types suitable for CXX interface
  35   native: Mode in which types are suitable for the internal implementation
  36   native_no_err: Like Native but with out PosibErr return types
  37
  38 =head1 MkSrc::CcHelper
  39
  40 Helper functions used by interface generation code:
  41
  42 =over
  43
  44 =item to_c_return_type ITEM
  45
  46 .
  47
  48 =cut
  49
  50 sub to_c_return_type ( $ ) {
  51   my ($d) = @_;
  52   return $d->{type} unless exists $d->{'posib err'};
  53   return 'int' if one_of $d->{type}, ('void', 'bool', 'unsigned int');
  54   return $d->{type};
  55 }
  56
  57 =item c_error_cond ITEM
  58
  59 .
  60
  61 =cut
  62
  63 sub c_error_cond ( $ ) {
  64   my ($d) = @_;
  65   die unless exists $d->{'posib err'};
  66   return '-1' if one_of $d->{type}, ('bool', 'unsigned int', 'int');
  67   return '0';
  68 }
  69
  70 =item make_func NAME @TYPES PARMS ; %ACCUM
  71
  72 Creates a function prototype
  73
  74 Parms can be any of:
  75
  76   mode: code generation mode
  77
  78 =cut
  79
  80 sub make_func ( $ \@ $ ; \% ) {
  81   my ($name, $d, $p, $accum) = @_;
  82   $accum = {} unless defined $accum;
  83   my @d = @$d;
  84   return (join '',
  85           (to_type_name(shift @d, {%$p,pos=>'return'}, %$accum),
  86            ' ',
  87            to_lower $name,
  88            '(',
  89            (join ', ', map {to_type_name $_, {%$p,pos=>'parm'}, %$accum} @d),
  90            ')'));
  91 }
  92
  93 =item call_func NAME @TYPES PARMS ; %ACCUM
  94
  95 Return a string to call a func.  Will prefix the function with return
  96 if the functions returns a non-void type;
  97
  98 Parms can be any of:
  99
 100   mode: code generation mode
 101
 102 =cut
 103
 104 sub call_func ( $ \@ $ ; \% ) {
 105   my ($name, $d, $p, $accum) = @_;
 106   $accum = {} unless defined $accum;
 107   my @d = @$d;
 108   my $func_ret = to_type_name(shift @d, {%$p,pos=>'return'}, %$accum);
 109   return (join '',
 110           (($func_ret eq 'void' ? '' : 'return '),
 111            to_lower $name,
 112            '(',
 113            (join ', ', map {to_type_name $_,
 114                             {%$p,pos=>'parm',use_type=>false}, %$accum} @d),
 115            ')'));
 116 }
 117
 118 =item to_type_name ITEM PARMS ; %ACCUM
 119
 120 Converts item into a type name.
 121
 122 Parms can be any of:
 123
 124   mode: code generation mode
 125   use_type: include the actual type
 126   use_name: include the name on the type
 127   pos: either "return" or "other"
 128
 129 =cut
 130
 131 sub to_type_name ( $ $ ; \% ) {
 132   my ($d, $p, $accum) = @_;
 133   $accum = {} unless defined $accum;
 134
 135   my $mode = $p->{mode};
 136   die unless one_of $mode, qw(cc cc_cxx cxx native native_no_err);
 137   my $is_cc = one_of $mode, qw(cc cc_cxx cxx);
 138   my $is_native = one_of $mode, qw(native native_no_err);
 139
 140   my $pos  = $p->{pos};
 141   my $t = finalized_type($pos eq 'return' && $is_cc
 142                          ? to_c_return_type $d
 143                          : $d->{type});
 144   $p->{use_type} = true    unless exists $p->{use_type};
 145   $p->{use_name} = true    unless exists $p->{use_name};
 146   $p->{pos}      = 'other' unless exists $p->{pos};
 147
 148   my $name = $t->{name};
 149   my $type = $t->{type};
 150
 151   return ( (to_type_name {%$d, type=>'string'}, $p, %$accum) ,
 152            (to_type_name {%$d, type=>'int', name=>"$d->{name}_size"}, $p, %$accum) )
 153       if $name eq 'encoded string' && $is_cc && $pos eq 'parm';
 154
 155   my $str;
 156
 157   if ($p->{use_type})
 158   {
 159     $str .= "const " if $t->{const};
 160
 161     if ($name eq 'string') {
 162       if ($is_native && $pos eq 'parm') {
 163         $accum->{headers}{'parm string'} = true;
 164         $str .= "ParmString";
 165       } else {
 166         $str .= "const char *";
 167       }
 168     } elsif ($name eq 'string obj') {
 169       die unless $pos eq 'return';
 170       if ($is_cc) {
 171         $str .= "const char *";
 172       } else {
 173         $accum->{headers}{'string'} = true;
 174         $str .= "String";
 175       }
 176     } elsif ($name eq 'encoded string') {
 177       $str .= "const char *";
 178     } elsif ($name eq '') {
 179       $str .= "void";
 180     } elsif ($name eq 'bool' && $is_cc) {
 181       $str .= "int";
 182     } elsif ($type eq 'basic') {
 183       $str .= $name;
 184     } elsif (one_of $type, qw(enum class struct union)) {
 185       my $c_type = $type eq 'class' ? 'struct' : $type;
 186       if ($t->{pointer}) {
 187         $accum->{types}->{$name} = $t;
 188       } else {
 189         $accum->{headers}->{$t->{created_in}} = true;
 190       }
 191       $str .= "$c_type Aspell" if $mode eq 'cc';
 192       $str .= to_mixed($name);
 193     } else {
 194       print STDERR "Warning: Unknown Type: $name\n";
 195       $str .= "{unknown type: $name}";
 196     }
 197
 198     if ($t->{pointer} && $type eq 'class' && $mode eq 'cxx') {
 199       $str .= "Ptr";
 200     } elsif ($t->{pointer}) {
 201       $str .= " *";
 202     }
 203
 204   }
 205
 206   if (defined $d->{name} && $p->{use_name})
 207   {
 208     $str .= " " unless $str eq '';
 209     $str .= to_lower($d->{name});
 210   }
 211
 212   $str .= "[$t->{array}]" if $t->{array} && $p->{use_type};
 213
 214   return $str;
 215 }
 216
 217 =item make_desc DESC ; LEVEL
 218
 219 Make a C comment out of DESC optionally indenting it LEVEL spaces.
 220
 221 =cut
 222
 223 sub make_desc ( $ ; $ ) {
 224   my ($desc, $indent) = @_;
 225   return '' unless defined $desc;
 226   my @desc = split /\n/, $desc;
 227   $indent = 0 unless defined $indent;
 228   $indent = ' 'x$indent;
 229   return ("$indent/* ".
 230           join("\n$indent * ", @desc).
 231           " */\n");
 232 }
 233
 234 =item make_c_method CLASS ITEM PARMS ; %ACCUM
 235
 236 Create the phototype for a C method which is really a function.
 237
 238 Parms is any of:
 239
 240   mode: code generation mode
 241   no_aspell: if true do not include aspell in the name
 242   this_name: name for the parameter representing the current object
 243
 244 =item call_c_method CLASS ITEM PARMS ; %ACCUM
 245
 246 Like make_c_method but instead returns the appropriate string to call
 247 the function.  If the function returns a non-void type the string will
 248 be prefixed with a return statement.
 249
 250 =item form_c_method CLASS ITEM PARMS ; %ACCUM
 251
 252 Like make_c_method except that it returns the array:
 253
 254   ($func, $data, $parms, $accum)
 255
 256 which is suitable for passing into make_func.  It will return an
 257 empty array if it can not make a method from ITEM.
 258
 259 =cut
 260
 261 sub form_c_method ($ $ $ ; \% )
 262 {
 263   my ($class, $d, $p, $accum) = @_;
 264   $accum = {} unless defined $accum;
 265   my $mode = $p->{mode};
 266   my $this_name = defined $p->{this_name} ? $p->{this_name} : 'ths';
 267   my $name = $d->{name};
 268   my $func = '';
 269   my @data = ();
 270   @data = @{$d->{data}} if defined $d->{data};
 271   if ($d->{type} eq 'constructor') {
 272     if (defined $name) {
 273       $func = $name;
 274     } else {
 275       $func = "new aspell $class";
 276     }
 277     splice @data, 0, 0, {type => $class} unless exists $d->{'returns alt type'};
 278   } elsif ($d->{type} eq 'destructor') {
 279     $func = "delete aspell $class";
 280     splice @data, 0, 0, ({type => 'void'}, {type=>$class, name=>$this_name});
 281   } elsif ($d->{type} eq 'method') {
 282     if (exists $d->{'c func'}) {
 283       $func = $d->{'c func'};
 284     } elsif (exists $d->{'prefix'}) {
 285       $func = "$d->{prefix} $name";
 286     } else {
 287       $func = "aspell $class $name";
 288     }
 289     if (exists $d->{'const'}) {
 290       splice @data, 1, 0, {type => "const $class", name=> $this_name};
 291     } else {
 292       splice @data, 1, 0, {type => "$class", name=> $this_name};
 293     }
 294   } else {
 295     return ();
 296   }
 297   $func = "aspell $func" unless $func =~ /aspell/;
 298   $func =~ s/aspell\ ?// if exists $p->{no_aspell};
 299   return ($func, \@data, $p, $accum);
 300 }
 301
 302 sub make_c_method ($ $ $ ; \%)
 303 {
 304   my @ret = &form_c_method(@_);
 305   return undef unless @ret > 0;
 306   return &make_func(@ret);
 307 }
 308
 309 sub call_c_method ($ $ $ ; \%)
 310 {
 311   my @ret = &form_c_method(@_);
 312   return undef unless @ret > 0;
 313   return &call_func(@ret);
 314 }
 315
 316 =item make_cxx_method ITEM PARMS ; %ACCUM
 317
 318 Create the phototype for a C++ method.
 319
 320 Parms is one of:
 321
 322   mode: code generation mode
 323
 324 =cut
 325
 326 sub make_cxx_method ( $ $ ; \% ) {
 327   my ($d, $p, $accum) = @_;
 328   my $ret;
 329   $ret .= make_func $d->{name}, @{$d->{data}}, $p, %$accum;
 330   $ret .= " const" if exists $d->{const};
 331   return $ret;
 332 }
 333
 334 =back
 335
 336 =cut
 337
 338
 339 1;