examples/legacy/template.pl

   1 #!/usr/bin/perl
   2
   3 ###############################################################################
   4 #                                                                             #
   5 #  Name   : template                                                          #
   6 #  Author : Chris Koeritz                                                     #
   7 #  Rights : Copyright (C) 1996-$now by Author                                 #
   8 #                                                                             #
   9 #  Purpose:                                                                   #
  10 #                                                                             #
  11 #    Attempts to pre-instantiate C++ templates to work-around C++ compilers   #
  12 #  that don't support templates (a rare breed, these days).                   #
  13 #                                                                             #
  14 ###############################################################################
  15 #  This program is free software; you can redistribute it and/or modify it    #
  16 #  under the terms of the GNU General Public License as published by the Free #
  17 #  Software Foundation; either version 2 of the License or (at your option)   #
  18 #  any later version.  See: "http://www.gruntose.com/Info/GNU/GPL.html" for a #
  19 #  version of the License.  Please send any updates to "fred@gruntose.com".   #
  20 ###############################################################################
  21
  22 # this was a majestic abortive attempt to create a template instantiator for
  23 # compilers that do not possess templates, but which do support some subset
  24 # of C++.  This was necessary at the time, due to our firmware compiler's
  25 # limitations.  This processor never totally worked, although it did produce
  26 # some interesting compilable code.  Might be useful as a demo or maybe just
  27 # as a warning to avoid brain-damaged C++ compilers.
  28
  29 # to do:
  30 #   maintain statistics about placement in file for error resolution.
  31
  32 # limitations so far:
  33 #
  34 # the word "template" must be the first word on the line.
  35 #
  36 # the type to instantiate must be one word (like charstar, not char *).
  37 #
  38 # templates must follow the form templateName<templateType> without
  39 #   any spaces between the angle brackets.
  40
  41 # flag to enable debugging print outs.
  42 $DEBUG_TEMPLATIZER = 1;
  43 #$DEBUG_TEMPLATIZER = 0;
  44
  45 # array to store instance types to convert to
  46 @instance_type_buffer = ();
  47 # flag for checking read from file option
  48 $f_option = 0;
  49 $d_option = 0;
  50
  51 if ($#ARGV < 1) {
  52   die("
  53     The template instantiater supports an optional directory path as the first
  54     parameter (preceded by a -d with no spaces in between the d and the
  55     directory name) in which to store the generated templates, and then
  56     requires the instantiation type as the next argument (or a file
  57     specification preceded by -f), and a list of files as the last
  58     arguments.
  59     The files will be scanned for templates and those templates will be
  60     instantiated in the type(s) specified.
  61     Examples:
  62        perl template.pl char istring.h torpedo.h
  63        perl template.pl -f instance.txt matrix.h
  64        perl template.pl -d. -f instance.txt function.h data_src.h
  65        perl template.pl -dfirm_src\library\basis -f instance.txt amorph.h\n");
  66 }
  67
  68 # Check directory option
  69 if (grep(/^\s*-d/, @ARGV)) {
  70    $d_option = 1;
  71    $d_dir = @ARGV[0];
  72 #   print $d_dir, "\n";
  73    shift;
  74 }
  75
  76
  77 # Check to see if user used a file to specify instantiation types
  78 if (grep(/^\s*-f/, @ARGV)) {
  79    $f_option = 1;
  80    shift;
  81    $types_file = @ARGV[0];
  82
  83 # Open instantiation type file to read from
  84    open(TYPES_FILE, "<$types_file")
  85      || die("couldn't open file $types_file for reading");
  86
  87 # Read in all the different types to instantiate
  88 # Create instance_type list
  89    @tp = <TYPES_FILE>;
  90    while (@tp) {
  91       local($line) = @tp;
  92       chop $line;
  93       push(@instance_type_buffer, $line);
  94       shift @tp;
  95    }
  96    shift @ARGV;
  97    &instantiate_templates(@ARGV);
  98    exit;
  99 }
 100
 101 &instantiate_templates(@ARGV);
 102 exit;
 103
 104 #
 105 # driver of the instantiation process.
 106 #
 107 sub instantiate_templates {
 108   if (!$f_option) {
 109   # grab the user's desired instance type.
 110   $instance_type = @_[0];
 111   push(@instance_type_buffer, $instance_type);
 112   print "Instantiation type is \"$instance_type\".\n";
 113   # jump over the instance type to look at the filenames.
 114   shift;
 115   }
 116
 117   local($i) = 0;
 118   foreach $filename (@_) {
 119     open(INPUT_FILE, "<$filename")
 120       || die("couldn't open file $filename for reading");
 121     # create an output name for the instance.
 122     $out_filename = &make_output_name($filename);
 123     if ($DEBUG_TEMPLATIZER) {
 124 #      print "out file is ", $out_filename, "\n";
 125     }
 126     local($index) = $i + 1;
 127     print "Instantiating file[$index] as $out_filename.\n";
 128     # now try opening our output file.
 129     open(OUTPUT_FILE, ">$out_filename")
 130       || die("couldn't open file $filename for writing");
 131     # grab the current file into an array.
 132
 133     @file_array = <INPUT_FILE>;
 134     @start_template = @file_array;
 135     @stop_template = @file_array;
 136     # process the file's contents as a manipulable array.
 137     while (@file_array) {
 138       local($line) = shift @file_array;
 139       if (grep(/^\s*template/, $line)) {
 140         @start_template = @file_array;
 141
 142         # iterate through all the instance types for each template
 143         foreach $instance_type (@instance_type_buffer) {
 144            @file_array = @start_template;
 145            &snag_place_holder($line);
 146            &snag_object_name;
 147            &absorb_until_matched_block;
 148            &replace_place_holder;
 149            &dump_the_buffer;
 150            print OUTPUT_FILE "\n";
 151         }
 152       } elsif (grep(/\w+<\w+>/, $line)) {
 153         local(@pieces) = split(/\s/, $line);
 154         foreach $piece (@pieces) {
 155           local($prefix) = "";
 156           # special case for separating function name from templated first
 157           # parameter to it.
 158           if (grep(/\(\w+</, $piece)) {
 159             local(@chop_paren) = split(/\(/, $piece, 2);
 160             $prefix = $chop_paren[0].'(';
 161             $piece = $chop_paren[1];
 162           }
 163           if (grep(/\w+<\w+>/, $piece)) { $piece = &special_mangle($piece); }
 164           print OUTPUT_FILE "$prefix$piece ";
 165         }
 166         print OUTPUT_FILE "\n";
 167       } else {
 168           print OUTPUT_FILE $line;
 169       }
 170     }
 171     $i++;
 172   }
 173 }
 174
 175 #
 176 # generates an output name from the filename to be translated.
 177 #
 178 sub make_output_name {
 179   local($out_filename) = @_[0];
 180   local($d_dir_temp) = $d_dir;
 181 #  print "OUTFILE NAME: ",$out_filename,"\n";
 182   # break down the filename at the slashes.
 183   local(@split_filename) = split(/[\\\/]/, $out_filename);
 184   # take the basename of the list of names.
 185   $out_filename = $split_filename[$#split_filename];
 186   local($hold_filename) = $out_filename;
 187   if (grep(!/\.cpp$/i, $out_filename) && grep(!/\.h$/i, $out_filename)
 188       && grep(!/\.c$/i, $out_filename) && grep(!/\.h$/i, $out_filename) ) {
 189     die("filename @_[0] not recognized as a C++ code file.");
 190   }
 191   # makes an instance of the file in a directory named after the instance type
 192   # that is located under the current directory.
 193
 194   $d_dir_temp = join('/',$d_dir, $hold_filename);
 195   if ($d_option) {
 196      $d_dir_temp =~ s/-d//i;
 197      @split_filename = split(/[\\\/]/, $d_dir_temp);
 198 #     exit;
 199   }
 200
 201 # try to create dir using the deepest dir given in filename input
 202
 203     local($y) = 0;
 204     foreach (@split_filename) { $y++; }
 205
 206     local($x) = 0;
 207     local($ret) = 0;
 208     local($dirs) = 0;
 209
 210     if ($y >= 2) {
 211       foreach (@split_filename) {
 212        if ((($x > 0) && ($x < $y-1)) || (($d_option) && ($x < $y-1))) {
 213          if (!$dirs) { $dirs = @split_filename[$x]; }
 214          else { $dirs = $dirs."/".@split_filename[$x]; }
 215 #         print "Creating... ",$dirs,"\n";
 216          $ret = mkdir($dirs, 0777);
 217          if (!ret) { die("a directory named $instance_dir could not be made."); }
 218        }
 219        $x++;
 220       }
 221       $out_filename = $dirs."/".$hold_filename;
 222     }
 223     else { $out_filename = "template/".$hold_filename;
 224          local($instance_dir) = "template";
 225          $ret = mkdir($instance_dir, 0777);
 226          if (!ret) { die("a directory named $instance_dir could not be made."); }
 227     }
 228 #   print $out_filename, "\n";
 229
 230 #  local($instance_dir) = @split_filename[$x-2];
 231 #  creates the directory.
 232 #  local($ret) = mkdir($instance_dir, 0777);
 233 #  if (!ret) { die("a directory named $instance_dir could not be made."); }
 234
 235   $out_filename;  # return the new name.
 236 }
 237
 238 #
 239 # grabs the name of the placeholder type that will be replaced by
 240 # the template instantiation type.
 241 #
 242 sub snag_place_holder {
 243   $place_holder = @_[0];
 244   chop $place_holder;
 245
 246   local(@pieces) = split(/>\s*/, $place_holder, 2);
 247
 248   # send back the parts not involved in the template statement.
 249   if (length($pieces[1])) {
 250      unshift(@file_array, $pieces[1]."\n");
 251   }
 252   $place_holder = $pieces[0];
 253   $place_holder =~ s/\s*template\s+<class\s+(\w+)$/\1/;
 254   if ($DEBUG_TEMPLATIZER) {
 255 #    print "Replacing place holder \"$place_holder\" with \"$instance_type\".\n";
 256   }
 257 }
 258
 259 #
 260 # grabs the name of the object itself that will become an instantiated
 261 # object in the type specified.  the global variable "object_name" is
 262 # set by the subfunctions used here.
 263 #
 264 sub snag_object_name {
 265   local($next_line) = shift(@file_array);
 266   chop $next_line;
 267   &match_class_declaration($next_line)
 268     || &match_class_member_definition($next_line)
 269       || &match_function_definition($next_line);
 270 }
 271
 272 #
 273 # creates a mangled form of the name that includes the instantiation
 274 # type.  the global variable "mangled_name" is set by this function.
 275 #
 276 sub mangle_name {
 277   local($to_grind) = @_[0];
 278   local($mangled_name) = "template__".$to_grind."__".$instance_type;
 279   if ($DEBUG_TEMPLATIZER) {
 280 #    print "Replacing name \"$to_grind\" with \"$mangled_name\".\n";
 281   }
 282   $mangled_name;
 283 }
 284
 285 #
 286 # processes "#include" preprocessor directives to make sure if the filename
 287 # is in there to include a C++ file (for the template code), then it gets
 288 # converted to the new file name.
 289 #
 290
 291 # this is a pretty bogus thing; it should not be used.
 292
 293 sub convert_inclusion {
 294   local($line) = @_[0];
 295   chop $line;
 296   local($temp) = $line;
 297   # extract out the name parts of the include declaration.
 298   $temp =~ s/\s*#include\s*([<"])([\w.]+)([>"])/\1 \2 \3/;
 299   local(@broken_up) = split(/ /, $temp);
 300   # strip off the punctuation from the name.
 301   local($incl_prefix) = @broken_up[1];
 302   $incl_prefix =~ s/["<](.*)[">]/\1/;
 303   $incl_prefix =~ s/\s//g;
 304   # return if it's not a code file being included.
 305   if (!grep(/.cpp/i, $incl_prefix)) { print OUTPUT_FILE $line, "\n"; return; }
 306   # strip to just the name without the ending.
 307   $incl_prefix =~ s/\.cpp$//i;
 308   # now get the name of the file we're processing.
 309   local($file_prefix) = $filename;
 310   # return if it's not a header file being examined.
 311   if (!grep(/.h/i, $file_prefix)) { print OUTPUT_FILE $line, "\n"; return; }
 312   # strip off the extension.
 313   $file_prefix =~ s/\.h$//i;
 314   # return if the names aren't equivalent--this means the include doesn't
 315   # refer to our new templated form of the code file.
 316   if ($incl_prefix ne $file_prefix) { print OUTPUT_FILE $line, "\n"; return FALSE; }
 317   # dump out a message about the removal.
 318   $line =~ s/^\s*//;
 319   print OUTPUT_FILE "/* removed unneeded template inclusion: $line */\n";
 320 }
 321
 322 #
 323 # extracts lines from the file until the curly brackets are matched up
 324 # at level 0.
 325 #
 326 sub absorb_until_matched_block {
 327   $bracket_level = 0;
 328   $end_absorb = 0;
 329   @template_buffer = ();
 330   $hit_one=0;
 331   while (@file_array) {
 332     local($line) = shift @file_array;
 333     &look_for_curlies($line);
 334     if (($hit_one && ($bracket_level == 0)) || $end_absorb) { return; }
 335   }
 336 }
 337
 338 #
 339 # examines the parameters passed in for curly brackets and changes the
 340 # counter if they are found.
 341 #
 342 sub look_for_curlies {
 343 #  $hit_one = 0;  # records whether a bracket was found or not.
 344   local($line) = @_[0];
 345   @word = ();
 346   foreach $char (split(//, $line)) {
 347     if ($char eq '{') {
 348       $hit_one = 1;
 349       $bracket_level++;
 350     } elsif ($char eq '}') {
 351       $hit_one = 1;
 352       $bracket_level--;
 353     } elsif (($char eq ';') && ($hit_one==0)) {
 354       $end_absorb = 1;
 355     }
 356
 357
 358     if ($DEBUG_TEMPLATIZER) {
 359 #      print "~$char~ ";
 360     }
 361     push(@word, $char);
 362     if (grep(!/\w/, $char)) {
 363       # don't split yet if it's a possible template char.
 364       if (grep(!/[<>]/, $char)) {
 365         local($real_word) = join("", @word);
 366         if ($DEBUG_TEMPLATIZER) {
 367 #          print "adding a word $real_word\n";
 368         }
 369         push(@template_buffer, "$real_word");
 370         @word = ();
 371       }
 372     }
 373   }
 374 }
 375
 376 #
 377 # this goes through the buffer and replaces all occurrences of the name to
 378 # replace with the instance name.
 379 #
 380 sub replace_place_holder {
 381   @new_template_buffer = @template_buffer;
 382   @template_buffer = ();
 383
 384   foreach $i (0 .. $#new_template_buffer) {
 385     $word = $new_template_buffer[$i];
 386 #    if ($DEBUG_TEMPLATIZER) {
 387 #      print "<$i $word> ";
 388 #      $old = $word;
 389 #    }
 390
 391     # replace a templated combination with the mangled version.
 392     $word =~ s/^${object_name}<${instance_type}>/${mangled_name}/;
 393
 394 #    if ($DEBUG_TEMPLATIZER) {
 395 #      if ($old ne $word) {print "1 ... changed to $word.\n"; $old = $word; }
 396 #    }
 397
 398     if (grep(/^\w+<\w+>/, $word)) {
 399       # replace some other template with our stuff if we can.
 400       $word = &special_mangle($word);
 401     }
 402
 403 #    if ($DEBUG_TEMPLATIZER) {
 404 #      if ($old ne $word) {print "2 ... changed to $word.\n"; $old = $word; }
 405 #    }
 406
 407     # replace the object's name with its mangled form.
 408     $word =~ s/^${object_name}/${mangled_name}/;
 409
 410 #    if ($DEBUG_TEMPLATIZER) {
 411 #      if ($old ne $word) {print "3... changed to $word.\n"; $old = $word; }
 412 #    }
 413
 414     # replace the place holder with the instantiation type.
 415     $word =~ s/^${place_holder}/${instance_type}/;
 416
 417 #    if ($DEBUG_TEMPLATIZER) {
 418 #      if ($old ne $word) {print "4... changed to $word.\n"; $old = $word; }
 419 #    }
 420
 421     push(@template_buffer, $word);
 422   }
 423 }
 424
 425 #
 426 # processes a general template usage, in the form X<Y>, where either
 427 # X or Y are not ones that we think we need to replace.  it is assumed
 428 # that it's safe to use the mangled form of the template.
 429 #
 430 sub special_mangle {
 431   local($word) = @_[0];
 432   # split the template form into pieces.
 433   local(@pieces) = split(/[<>]/, $word, 2);
 434
 435   $pieces[1] =~ s/${place_holder}/${instance_type}/;
 436   $pieces[1] =~ s/>//;
 437   # hold onto the real instance type.
 438   local($hold_instance) = $instance_type;
 439   $instance_type = $pieces[1];
 440   # mangle the name in the template usage line.
 441   local($hold_mangled) = &mangle_name($pieces[0]);
 442   # restore the original instance type.
 443   $instance_type = $hold_instance;
 444   # returns the new mangled form.
 445   $hold_mangled;
 446 }
 447
 448 #
 449 # prints out the buffer we've accumulated to the output file.
 450 #
 451 sub dump_the_buffer {
 452   print OUTPUT_FILE @template_buffer;
 453 }
 454
 455 #
 456 # processes a class declaration and sets the object name for future use.
 457 #
 458 sub match_class_declaration {
 459   local($next_line) = @_[0];
 460 # too strict!
 461 #  if (grep(!/class\s.*\w+$/, $next_line)
 462 #      && grep(!/class\s.*\w+\s*\{/, $next_line)
 463 #      && grep(!/struct\s.*\w+$/, $next_line)
 464 #      && grep(!/struct\s.*\w+\s*\{/, $next_line)) {
 465 #    return 0;
 466 #  }
 467
 468   if (grep(!/class\s+\w+/, $next_line) && grep(!/struct\s+\w+/, $next_line) ) {
 469     return 0;
 470   }
 471
 472   if ($DEBUG_TEMPLATIZER) {
 473 #    print "matched class decl in $next_line\n";
 474   }
 475
 476   if (grep(/class\s+\w+.*:/, $next_line)
 477       || grep(/struct\s+\w+.*:/, $next_line)) {
 478     # parses an inheriting class decl.
 479     if ($DEBUG_TEMPLATIZER) {
 480 #      print "in inheritance case on $next_line\n";
 481     }
 482     local(@pieces) = split(/:/, $next_line, 2);
 483     # push the rest of the line back into the input array.
 484     if ($DEBUG_TEMPLATIZER) {
 485 #      print "going to unshift $pieces[1]...\n";
 486     }
 487     unshift(@file_array, ": ".$pieces[1]." ");
 488     $next_line = $pieces[0];
 489   } elsif (grep(/class\s.*\w+\s*\{/, $next_line)
 490       || grep(/struct\s.*\w+\s*\{/, $next_line)) {
 491     # parses a non-inheriting declaration with bracket on same line.
 492     if ($DEBUG_TEMPLATIZER) {
 493 #      print "in special case on $next_line\n";
 494     }
 495     # special case for continued stuff on same line.
 496     local(@pieces) = split(/{/, $next_line, 2);
 497     # push the rest of the line back into the input array.
 498     unshift(@file_array, " { ".$pieces[1]." ");
 499     $next_line = $pieces[0];
 500   }
 501   if ($DEBUG_TEMPLATIZER) {
 502 #    print "matched class declaration... $next_line\n";
 503   }
 504   local(@pieces) = split(/\s/, $next_line);
 505   $object_name = $pieces[$#pieces];
 506   $mangled_name = &mangle_name($object_name);
 507   foreach $posn (0 .. $#pieces - 1) { print OUTPUT_FILE "$pieces[$posn] "; }
 508   print OUTPUT_FILE "$mangled_name\n";
 509   1;
 510 }
 511
 512 #
 513 # processes the implementation of a class member and sets the object
 514 # name for future use.
 515 #
 516 sub match_class_member_definition {
 517   local($next_line) = @_[0];
 518   local($junk);
 519   if (grep(!/\w+<\w+>::/, $next_line)) {
 520     return 0;
 521   }
 522   if ($DEBUG_TEMPLATIZER) {
 523 #    print "matched class member definition... $next_line\n";
 524   }
 525   local(@pieces) = split(/>::/, $next_line, 2);
 526   # checks for spaces in the first part of the split.  if there is one,
 527   # it means we don't have a simple object thing.
 528   if (grep(/\s/, $pieces[0])) {
 529     if ($DEBUG_TEMPLATIZER) {
 530 #      print "matched a space in the first part of supposed object name... $pieces[0]\n";
 531     }
 532     if (grep(/^\w+<\w+>/, $pieces[0])) {
 533       if ($DEBUG_TEMPLATIZER) {
 534 #        print "matched a template usage in first part of name...";
 535       }
 536       # replace some other template with our stuff if we can.
 537       $pieces[0] = &special_mangle($pieces[0]);
 538     }
 539     if ($DEBUG_TEMPLATIZER) {
 540 #      print "now our first bit is: $pieces[0]\n";
 541     }
 542     local(@new_pieces) = split(/ /, $pieces[0]);
 543     $pieces[0] = $new_pieces[$#new_pieces];
 544     foreach $posn (0 .. $#new_pieces - 1) {
 545       $new_pieces[$posn] =~ s/${place_holder}/${instance_type}/g;
 546       print OUTPUT_FILE "$new_pieces[$posn] ";
 547     }
 548   }
 549   unshift(@file_array, "::\n".$pieces[1]."\n");
 550   $object_name = $pieces[0];
 551   $object_name =~ s/(\W*)(\w+)<(\w+)/\2/;
 552   if (length($1)) { print OUTPUT_FILE "$1"; }
 553   if ($3 ne $place_holder) {
 554     die("The placeholder does not match on this line: $next_line");
 555   }
 556   $mangled_name = &mangle_name($object_name);
 557   print OUTPUT_FILE "$mangled_name\n";
 558   1;  # return success.
 559 }
 560
 561 #
 562 # processes a function template by making sure it fits the format and
 563 # then setting up the variables for the replacement.  since function templates
 564 # are so simple, the object name is not changed; only the place_holder is
 565 # changed to the instance type.
 566 #
 567 sub match_function_definition {
 568   local($next_line) = @_[0];
 569
 570   if (grep(!/^\s*\w+\s+.*/, $next_line) ) {
 571     if ($DEBUG_TEMPLATIZER) {
 572       print "failed on funcdef for ", $next_line, "!\n";
 573     }
 574     return 0;
 575   }
 576
 577 # old broken code:...
 578 #  if (grep(!/^\s*\w+\s+.*\(.*\)\s*/, $next_line) ) {
 579 #print "failed on funcdef for ", $next_line, "!\n";
 580 #    return 0;
 581 #  }
 582
 583 #  if ($DEBUG_TEMPLATIZER) {
 584 #    print "matched function definition on $next_line\n";
 585 #  }
 586
 587 #  if ($DEBUG_TEMPLATIZER) {
 588 #   print "stuffing back into the file array $next_line.\n";
 589 #  }
 590   # put the line back because it's nearly right for being instantiated.
 591   unshift(@file_array, "inline ".$next_line."\n");
 592   # come up with a very rare name that will not be matched in the text.
 593   $object_name = "hogga_wogga_nunky_budget_weeny_teeny_kahini_beany";
 594   $mangled_name = &mangle_name($object_name);
 595   1;  # return a success.
 596 }