#!/usr/bin/perl

###############################################################################
#                                                                             #
#  Name   : template                                                          #
#  Author : Chris Koeritz                                                     #
#  Rights : Copyright (C) 1996-$now by Author                                 #
#                                                                             #
#  Purpose:                                                                   #
#                                                                             #
#    Attempts to pre-instantiate C++ templates to work-around C++ compilers   #
#  that don't support templates (a rare breed, these days).                   #
#                                                                             #
###############################################################################
#  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.  See: "http://www.gruntose.com/Info/GNU/GPL.html" for a #
#  version of the License.  Please send any updates to "fred@gruntose.com".   #
###############################################################################

# this was a majestic abortive attempt to create a template instantiator for
# compilers that do not possess templates, but which do support some subset
# of C++.  This was necessary at the time, due to our firmware compiler's
# limitations.  This processor never totally worked, although it did produce
# some interesting compilable code.  Might be useful as a demo or maybe just
# as a warning to avoid brain-damaged C++ compilers.

# to do:
#   maintain statistics about placement in file for error resolution.

# limitations so far:
#
# the word "template" must be the first word on the line.
#
# the type to instantiate must be one word (like charstar, not char *).
#
# templates must follow the form templateName<templateType> without
#   any spaces between the angle brackets.

# flag to enable debugging print outs.
$DEBUG_TEMPLATIZER = 1;
#$DEBUG_TEMPLATIZER = 0;

# array to store instance types to convert to
@instance_type_buffer = ();
# flag for checking read from file option
$f_option = 0;
$d_option = 0;

if ($#ARGV < 1) {
  die("
    The template instantiater supports an optional directory path as the first
    parameter (preceded by a -d with no spaces in between the d and the
    directory name) in which to store the generated templates, and then 
    requires the instantiation type as the next argument (or a file
    specification preceded by -f), and a list of files as the last
    arguments.
    The files will be scanned for templates and those templates will be
    instantiated in the type(s) specified.
    Examples:
       perl template.pl char istring.h torpedo.h
       perl template.pl -f instance.txt matrix.h
       perl template.pl -d. -f instance.txt function.h data_src.h
       perl template.pl -dfirm_src\library\basis -f instance.txt amorph.h\n");
}

# Check directory option
if (grep(/^\s*-d/, @ARGV)) {
   $d_option = 1;
   $d_dir = @ARGV[0];
#   print $d_dir, "\n";
   shift;
}


# Check to see if user used a file to specify instantiation types
if (grep(/^\s*-f/, @ARGV)) {
   $f_option = 1;
   shift;
   $types_file = @ARGV[0];

# Open instantiation type file to read from
   open(TYPES_FILE, "<$types_file")
     || die("couldn't open file $types_file for reading");

# Read in all the different types to instantiate
# Create instance_type list
   @tp = <TYPES_FILE>;
   while (@tp) {
      local($line) = @tp;
      chop $line;
      push(@instance_type_buffer, $line);
      shift @tp;
   }
   shift @ARGV;
   &instantiate_templates(@ARGV);
   exit;
}

&instantiate_templates(@ARGV);
exit;

#
# driver of the instantiation process.
#
sub instantiate_templates {
  if (!$f_option) {
  # grab the user's desired instance type.
  $instance_type = @_[0];
  push(@instance_type_buffer, $instance_type);
  print "Instantiation type is \"$instance_type\".\n";
  # jump over the instance type to look at the filenames.
  shift;
  }

  local($i) = 0;
  foreach $filename (@_) {
    open(INPUT_FILE, "<$filename")
      || die("couldn't open file $filename for reading");
    # create an output name for the instance.
    $out_filename = &make_output_name($filename);
    if ($DEBUG_TEMPLATIZER) {
#      print "out file is ", $out_filename, "\n";      
    }
    local($index) = $i + 1;
    print "Instantiating file[$index] as $out_filename.\n";
    # now try opening our output file.
    open(OUTPUT_FILE, ">$out_filename")
      || die("couldn't open file $filename for writing");
    # grab the current file into an array.

    @file_array = <INPUT_FILE>;
    @start_template = @file_array;
    @stop_template = @file_array;
    # process the file's contents as a manipulable array.
    while (@file_array) {
      local($line) = shift @file_array;
      if (grep(/^\s*template/, $line)) {
        @start_template = @file_array;

        # iterate through all the instance types for each template
        foreach $instance_type (@instance_type_buffer) {
           @file_array = @start_template;
           &snag_place_holder($line);
           &snag_object_name;
           &absorb_until_matched_block;
           &replace_place_holder;
           &dump_the_buffer;
           print OUTPUT_FILE "\n";
        }
      } elsif (grep(/\w+<\w+>/, $line)) {
        local(@pieces) = split(/\s/, $line);
        foreach $piece (@pieces) {
          local($prefix) = "";
          # special case for separating function name from templated first
          # parameter to it.
          if (grep(/\(\w+</, $piece)) {
            local(@chop_paren) = split(/\(/, $piece, 2);
            $prefix = $chop_paren[0].'(';
            $piece = $chop_paren[1];
          }
          if (grep(/\w+<\w+>/, $piece)) { $piece = &special_mangle($piece); }
          print OUTPUT_FILE "$prefix$piece ";
        }
        print OUTPUT_FILE "\n";
      } else {
          print OUTPUT_FILE $line;
      }
    }
    $i++;
  }
}

#
# generates an output name from the filename to be translated.
#
sub make_output_name {
  local($out_filename) = @_[0];
  local($d_dir_temp) = $d_dir;
#  print "OUTFILE NAME: ",$out_filename,"\n";
  # break down the filename at the slashes.
  local(@split_filename) = split(/[\\\/]/, $out_filename);
  # take the basename of the list of names.
  $out_filename = $split_filename[$#split_filename];
  local($hold_filename) = $out_filename;
  if (grep(!/\.cpp$/i, $out_filename) && grep(!/\.h$/i, $out_filename)
      && grep(!/\.c$/i, $out_filename) && grep(!/\.h$/i, $out_filename) ) {
    die("filename @_[0] not recognized as a C++ code file.");
  }
  # makes an instance of the file in a directory named after the instance type
  # that is located under the current directory.

  $d_dir_temp = join('/',$d_dir, $hold_filename);
  if ($d_option) {
     $d_dir_temp =~ s/-d//i;
     @split_filename = split(/[\\\/]/, $d_dir_temp);
#     exit;
  }

# try to create dir using the deepest dir given in filename input

    local($y) = 0;
    foreach (@split_filename) { $y++; }

    local($x) = 0;
    local($ret) = 0;
    local($dirs) = 0;

    if ($y >= 2) {
      foreach (@split_filename) {
       if ((($x > 0) && ($x < $y-1)) || (($d_option) && ($x < $y-1))) {
         if (!$dirs) { $dirs = @split_filename[$x]; }
         else { $dirs = $dirs."/".@split_filename[$x]; }
#         print "Creating... ",$dirs,"\n";
         $ret = mkdir($dirs, 0777);
         if (!ret) { die("a directory named $instance_dir could not be made."); }
       }
       $x++;
      }
      $out_filename = $dirs."/".$hold_filename;
    }
    else { $out_filename = "template/".$hold_filename;
         local($instance_dir) = "template";
         $ret = mkdir($instance_dir, 0777);
         if (!ret) { die("a directory named $instance_dir could not be made."); }
    }
#   print $out_filename, "\n";

#  local($instance_dir) = @split_filename[$x-2];
#  creates the directory.
#  local($ret) = mkdir($instance_dir, 0777);
#  if (!ret) { die("a directory named $instance_dir could not be made."); }

  $out_filename;  # return the new name.
}

#
# grabs the name of the placeholder type that will be replaced by
# the template instantiation type.
#
sub snag_place_holder {
  $place_holder = @_[0];
  chop $place_holder;

  local(@pieces) = split(/>\s*/, $place_holder, 2);

  # send back the parts not involved in the template statement.
  if (length($pieces[1])) {
     unshift(@file_array, $pieces[1]."\n");
  }
  $place_holder = $pieces[0];
  $place_holder =~ s/\s*template\s+<class\s+(\w+)$/\1/;
  if ($DEBUG_TEMPLATIZER) {
#    print "Replacing place holder \"$place_holder\" with \"$instance_type\".\n";
  }
}

#
# grabs the name of the object itself that will become an instantiated
# object in the type specified.  the global variable "object_name" is
# set by the subfunctions used here.
#
sub snag_object_name {
  local($next_line) = shift(@file_array);
  chop $next_line;
  &match_class_declaration($next_line)
    || &match_class_member_definition($next_line)
      || &match_function_definition($next_line);
}

#
# creates a mangled form of the name that includes the instantiation
# type.  the global variable "mangled_name" is set by this function.
#
sub mangle_name {
  local($to_grind) = @_[0];
  local($mangled_name) = "template__".$to_grind."__".$instance_type;
  if ($DEBUG_TEMPLATIZER) {
#    print "Replacing name \"$to_grind\" with \"$mangled_name\".\n";
  }
  $mangled_name;
}

#
# processes "#include" preprocessor directives to make sure if the filename
# is in there to include a C++ file (for the template code), then it gets
# converted to the new file name.
#

# this is a pretty bogus thing; it should not be used.

sub convert_inclusion {
  local($line) = @_[0];
  chop $line;
  local($temp) = $line;
  # extract out the name parts of the include declaration.
  $temp =~ s/\s*#include\s*([<"])([\w.]+)([>"])/\1 \2 \3/;
  local(@broken_up) = split(/ /, $temp);
  # strip off the punctuation from the name.
  local($incl_prefix) = @broken_up[1];
  $incl_prefix =~ s/["<](.*)[">]/\1/;
  $incl_prefix =~ s/\s//g;
  # return if it's not a code file being included.
  if (!grep(/.cpp/i, $incl_prefix)) { print OUTPUT_FILE $line, "\n"; return; }
  # strip to just the name without the ending.
  $incl_prefix =~ s/\.cpp$//i;
  # now get the name of the file we're processing.
  local($file_prefix) = $filename;
  # return if it's not a header file being examined.
  if (!grep(/.h/i, $file_prefix)) { print OUTPUT_FILE $line, "\n"; return; }
  # strip off the extension.
  $file_prefix =~ s/\.h$//i;
  # return if the names aren't equivalent--this means the include doesn't
  # refer to our new templated form of the code file.
  if ($incl_prefix ne $file_prefix) { print OUTPUT_FILE $line, "\n"; return FALSE; }
  # dump out a message about the removal.
  $line =~ s/^\s*//;
  print OUTPUT_FILE "/* removed unneeded template inclusion: $line */\n";
}

#
# extracts lines from the file until the curly brackets are matched up
# at level 0.
#
sub absorb_until_matched_block {
  $bracket_level = 0;
  $end_absorb = 0;
  @template_buffer = ();
  $hit_one=0;
  while (@file_array) {
    local($line) = shift @file_array;
    &look_for_curlies($line);
    if (($hit_one && ($bracket_level == 0)) || $end_absorb) { return; }
  }
}

#
# examines the parameters passed in for curly brackets and changes the
# counter if they are found.
#
sub look_for_curlies {
#  $hit_one = 0;  # records whether a bracket was found or not.
  local($line) = @_[0];
  @word = ();
  foreach $char (split(//, $line)) {
    if ($char eq '{') {
      $hit_one = 1;
      $bracket_level++;
    } elsif ($char eq '}') {
      $hit_one = 1;
      $bracket_level--;
    } elsif (($char eq ';') && ($hit_one==0)) {
      $end_absorb = 1;
    }


    if ($DEBUG_TEMPLATIZER) {
#      print "~$char~ ";
    }
    push(@word, $char);
    if (grep(!/\w/, $char)) {
      # don't split yet if it's a possible template char.
      if (grep(!/[<>]/, $char)) {
        local($real_word) = join("", @word);
        if ($DEBUG_TEMPLATIZER) {
#          print "adding a word $real_word\n";
        }
        push(@template_buffer, "$real_word");
        @word = ();
      }
    }
  }
}

#
# this goes through the buffer and replaces all occurrences of the name to
# replace with the instance name.
#
sub replace_place_holder {
  @new_template_buffer = @template_buffer;
  @template_buffer = ();

  foreach $i (0 .. $#new_template_buffer) {
    $word = $new_template_buffer[$i];
#    if ($DEBUG_TEMPLATIZER) {
#      print "<$i $word> ";
#      $old = $word;
#    }

    # replace a templated combination with the mangled version.
    $word =~ s/^${object_name}<${instance_type}>/${mangled_name}/;

#    if ($DEBUG_TEMPLATIZER) {
#      if ($old ne $word) {print "1 ... changed to $word.\n"; $old = $word; }
#    }

    if (grep(/^\w+<\w+>/, $word)) {
      # replace some other template with our stuff if we can.
      $word = &special_mangle($word);
    }

#    if ($DEBUG_TEMPLATIZER) {
#      if ($old ne $word) {print "2 ... changed to $word.\n"; $old = $word; }
#    }

    # replace the object's name with its mangled form.
    $word =~ s/^${object_name}/${mangled_name}/;

#    if ($DEBUG_TEMPLATIZER) {
#      if ($old ne $word) {print "3... changed to $word.\n"; $old = $word; }
#    }

    # replace the place holder with the instantiation type.
    $word =~ s/^${place_holder}/${instance_type}/;

#    if ($DEBUG_TEMPLATIZER) {
#      if ($old ne $word) {print "4... changed to $word.\n"; $old = $word; }
#    }

    push(@template_buffer, $word);
  }
}

#
# processes a general template usage, in the form X<Y>, where either
# X or Y are not ones that we think we need to replace.  it is assumed
# that it's safe to use the mangled form of the template.
#
sub special_mangle {
  local($word) = @_[0];
  # split the template form into pieces.
  local(@pieces) = split(/[<>]/, $word, 2);

  $pieces[1] =~ s/${place_holder}/${instance_type}/;
  $pieces[1] =~ s/>//;
  # hold onto the real instance type.
  local($hold_instance) = $instance_type;
  $instance_type = $pieces[1];
  # mangle the name in the template usage line.
  local($hold_mangled) = &mangle_name($pieces[0]);
  # restore the original instance type.
  $instance_type = $hold_instance;
  # returns the new mangled form.
  $hold_mangled;
}

#
# prints out the buffer we've accumulated to the output file.
#
sub dump_the_buffer {
  print OUTPUT_FILE @template_buffer;
}

#
# processes a class declaration and sets the object name for future use.
#
sub match_class_declaration {
  local($next_line) = @_[0];
# too strict!
#  if (grep(!/class\s.*\w+$/, $next_line)
#      && grep(!/class\s.*\w+\s*\{/, $next_line)
#      && grep(!/struct\s.*\w+$/, $next_line)
#      && grep(!/struct\s.*\w+\s*\{/, $next_line)) {
#    return 0;
#  }

  if (grep(!/class\s+\w+/, $next_line) && grep(!/struct\s+\w+/, $next_line) ) {
    return 0;
  }

  if ($DEBUG_TEMPLATIZER) {
#    print "matched class decl in $next_line\n";
  }

  if (grep(/class\s+\w+.*:/, $next_line)
      || grep(/struct\s+\w+.*:/, $next_line)) {
    # parses an inheriting class decl.
    if ($DEBUG_TEMPLATIZER) {
#      print "in inheritance case on $next_line\n";
    }
    local(@pieces) = split(/:/, $next_line, 2);
    # push the rest of the line back into the input array.
    if ($DEBUG_TEMPLATIZER) {
#      print "going to unshift $pieces[1]...\n";
    }
    unshift(@file_array, ": ".$pieces[1]." ");
    $next_line = $pieces[0];
  } elsif (grep(/class\s.*\w+\s*\{/, $next_line)
      || grep(/struct\s.*\w+\s*\{/, $next_line)) {
    # parses a non-inheriting declaration with bracket on same line.
    if ($DEBUG_TEMPLATIZER) {
#      print "in special case on $next_line\n";
    }
    # special case for continued stuff on same line.
    local(@pieces) = split(/{/, $next_line, 2);
    # push the rest of the line back into the input array.
    unshift(@file_array, " { ".$pieces[1]." ");
    $next_line = $pieces[0];
  }
  if ($DEBUG_TEMPLATIZER) {
#    print "matched class declaration... $next_line\n";
  }
  local(@pieces) = split(/\s/, $next_line);
  $object_name = $pieces[$#pieces];
  $mangled_name = &mangle_name($object_name);
  foreach $posn (0 .. $#pieces - 1) { print OUTPUT_FILE "$pieces[$posn] "; }
  print OUTPUT_FILE "$mangled_name\n";
  1;
}

#
# processes the implementation of a class member and sets the object
# name for future use.
#
sub match_class_member_definition {
  local($next_line) = @_[0];
  local($junk);
  if (grep(!/\w+<\w+>::/, $next_line)) {
    return 0;
  }
  if ($DEBUG_TEMPLATIZER) {
#    print "matched class member definition... $next_line\n";
  }
  local(@pieces) = split(/>::/, $next_line, 2);
  # checks for spaces in the first part of the split.  if there is one,
  # it means we don't have a simple object thing.
  if (grep(/\s/, $pieces[0])) {
    if ($DEBUG_TEMPLATIZER) {
#      print "matched a space in the first part of supposed object name... $pieces[0]\n";
    }
    if (grep(/^\w+<\w+>/, $pieces[0])) {
      if ($DEBUG_TEMPLATIZER) {
#        print "matched a template usage in first part of name...";
      }
      # replace some other template with our stuff if we can.
      $pieces[0] = &special_mangle($pieces[0]);
    }
    if ($DEBUG_TEMPLATIZER) {
#      print "now our first bit is: $pieces[0]\n";
    }
    local(@new_pieces) = split(/ /, $pieces[0]);
    $pieces[0] = $new_pieces[$#new_pieces];
    foreach $posn (0 .. $#new_pieces - 1) {
      $new_pieces[$posn] =~ s/${place_holder}/${instance_type}/g;
      print OUTPUT_FILE "$new_pieces[$posn] ";
    }
  }
  unshift(@file_array, "::\n".$pieces[1]."\n");
  $object_name = $pieces[0];
  $object_name =~ s/(\W*)(\w+)<(\w+)/\2/;
  if (length($1)) { print OUTPUT_FILE "$1"; }
  if ($3 ne $place_holder) {
    die("The placeholder does not match on this line: $next_line");
  }
  $mangled_name = &mangle_name($object_name);
  print OUTPUT_FILE "$mangled_name\n";
  1;  # return success.
}

#
# processes a function template by making sure it fits the format and
# then setting up the variables for the replacement.  since function templates
# are so simple, the object name is not changed; only the place_holder is
# changed to the instance type.
#
sub match_function_definition {
  local($next_line) = @_[0];

  if (grep(!/^\s*\w+\s+.*/, $next_line) ) {
    if ($DEBUG_TEMPLATIZER) {
      print "failed on funcdef for ", $next_line, "!\n";
    }
    return 0;
  }

# old broken code:...
#  if (grep(!/^\s*\w+\s+.*\(.*\)\s*/, $next_line) ) {
#print "failed on funcdef for ", $next_line, "!\n";
#    return 0;
#  }

#  if ($DEBUG_TEMPLATIZER) {
#    print "matched function definition on $next_line\n";
#  }

#  if ($DEBUG_TEMPLATIZER) {
#   print "stuffing back into the file array $next_line.\n";
#  }
  # put the line back because it's nearly right for being instantiated.
  unshift(@file_array, "inline ".$next_line."\n");
  # come up with a very rare name that will not be matched in the text.
  $object_name = "hogga_wogga_nunky_budget_weeny_teeny_kahini_beany";
  $mangled_name = &mangle_name($object_name);
  1;  # return a success.
}