cgal/Nef_2/noweb/specialize

#! /opt/gnu/bin/perl

$specialize = 0;
$spec_arg = "";

while (<>) {
  # specializing class templates 
  if ( /SPECIALIZE_CLASS\(.*\).*END/ ) {
    print specialize_members($spec_class,$nt_from);
    my @arglist = split(/ /,$class_to);
    foreach my $arg (@arglist) {
      my $copied_class = $spec_class;
      $copied_class =~ 
      s/template\s*\<class\s+$nt_from\>(\s*)class\s*(\w+)\s*/template \<\>$1class $2\<$arg\> /sg;
      $copied_class =~ 
      s/template\s*\<class\s+p$nt_from\>(\s*)class\s*(\w+)\s*/template \<\>$1class $2\<$arg\> /sg;
      $copied_class =~ 
      s/template\s*\<typename\s+$nt_from\>(\s*)class\s*(\w+)\s*/template \<\>$1class $2\<$arg\> /sg;
      $copied_class =~ s/template\s*\<class\s+$nt_from\>/template \<\>/sg;
      $copied_class =~ s/template\s*\<typename\s+$nt_from\>/template \<\>/sg;
      $copied_class =~ s/([\W]|^)$nt_from([\W]|$)/$1$arg$2/smg;
      $copied_class =~ s/([\W]|^)p$nt_from([\W]|$)/$1$arg$2/smg;
      $copied_class =~ s/typename//sg;
      $copied_class =~ s/typedef $arg $arg/typedef $arg $nt_from/sg;
      $copied_class =~ s/\/\*\{\\M/\/\*\{\\X/sg;
      print specialize_members($copied_class,$arg);
    }
    $nt_from = "";
    $class_to = "";
    $spec_class = "";
  }
  if ( $spec_class ) {
    $spec_class .= $_; $_="";
  }
  if ( /SPECIALIZE_CLASS\((\w+),([\w\ ]+)\).*START/ ) {
    $nt_from = $1;
    $class_to = $2;
    $spec_class = "// CLASS TEMPLATE $nt_from: \n"
  }

  # specializing function templates 
  if ( /SPECIALIZE\_FUNCTION\(.*\).*END/ ) {
    my @arglist = split(/ /,$args_to);
    foreach my $arg (@arglist) {
      my $copied_spec2 = $spec_func;
      my $header2 = "// SPECIALIZING inline to $nt_to:\n";
      $copied_spec2 =~ s/^.*?\n/$header2/;
      $copied_spec2 =~ s/$arg_from/$arg/sg;
      $copied_spec2 =~ s/template\s*\<class $arg\>/inline/sg;
      $copied_spec2 =~ s/template\s*\<typename $arg\>/inline/sg;
      print $copied_spec2;
      my $copied_spec1 = $spec_func;
      my $header1 = "// SPECIALIZING pure $arg params:\n";
      $copied_spec1 =~ s/^.*?\n/$header1/;
      $copied_spec1 =~ s/const\s*$arg_from\s*\&/const $arg\&/sg;
      print $copied_spec1;
    }
    print $spec_func;
    $spec_func = "";
    $args_to = "";
    $arg_from = "";
  }
  if ( $spec_func ) {
    $spec_func .= $_; $_ = "";
  }
  if ( /SPECIALIZE\_FUNCTION\((\w+),([\w\ ]+)\).*START/ ) {
    $arg_from = $1;
    $args_to = $2;
    $spec_func = "// SPECIALIZE_FUNCTION ORIGINAL\n"; 
  }

  # specializing implementation
  if ( /SPECIALIZE\_IMPLEMENTATION\(.*\).*END/ ) {
    my @arglist = split(/ /,$args_to);
    foreach my $arg (@arglist) {
      my $copied_spec2 = $spec_impl;
      my $header2 = "// SPECIALIZING to $nt_to:\n";
      $copied_spec2 =~ s/^.*?\n/$header2/;
      $copied_spec2 =~ s/$arg_from/$arg/sg;
      $copied_spec2 =~ s/template\s*\<class $arg\>//sg;
      $copied_spec2 =~ s/template\s*\<typename $arg\>//sg;
      print $copied_spec2;
    }
    print $spec_impl;
    $spec_impl = "";
    $args_to = "";
    $arg_from = "";
  }
  if ( $spec_impl ) {
    $spec_impl .= $_; $_ = "";
  }
  if ( /SPECIALIZE\_IMPLEMENTATION\((\w+),([\w\ ]+)\).*START/ ) {
    $arg_from = $1;
    $args_to = $2;
    $spec_impl = "// SPECIALIZE_FUNCTION ORIGINAL\n"; 
  }
  print;
}

sub specialize_members {
  local($spec,$nt) = @_; 
  local($result,$args_to,$spec_mem,$kill);
  $kill=0;
  $spec =~ s/\n\n/\n>>><<</sg;
  @LINES = split(/\n/,$spec); 
  foreach my $line (@LINES) {

    # general NT arg specializing for various types
    if ( $line =~ /SPECIALIZE\_MEMBERS\($args_to\).*END/ ) {
      my @arglist = split(/ /,$args_to);
      foreach my $arg (@arglist) {
        if ( $arg ne $nt ) {
          my $copied_spec = $spec_mem;
          my $header = "// SPECIALIZING_MEMBERS FOR const $arg\& \n";
          $copied_spec =~ s/.*\n/$header/;
          $copied_spec =~ s/const\s*$nt\s*\&/const $arg\&/sg;
          $result .= $copied_spec;
        }
      }
      $spec_mem = "";
      $args_to = "";
    }
    if ( $spec_mem ) {
      $spec_mem .= "$line\n"; 
    }
    if ( $line =~ /SPECIALIZE\_MEMBERS\(([\w\ ]+)\).*START/ ) {
      $args_to = $1;
      $spec_mem = "$line\n";
    }
    if ( $line =~ /KILL\s+$nt\s+START/ ) { $kill=1; }
    if ( $line =~ /KILL\s+$nt\s+END/ ) { $kill=0; $line = ""; }
    if ( $kill == 1 ) { $line = ""; }
    $result .= "$line\n";
  }
  $result =~ s/\n+/\n/sg;
  $result =~ s/\n>>><<</\n\n/sg;
  return $result;
}