#!/usr/bin/perl
#
# this is the C preprocessor (CPP)
# -Samy Kamkar [cp5@LucidX.com]
#
# currently supported macros:
# error, warning, define, undef,
# ifdef, ifndef, elif, else, endif,
# include, include_next

use strict;

die unless @ARGV;

# we want global definitions
my %defines;
my @levels;
my @paths = ("/usr/include", "/usr/local/include", ".");

my $iflvl = -1;


############################################################

# print
 join($ARGV[0], &cpp("<$ARGV[0]>", $0, 0, 0));

sub cpp
{
  my ($h, $origname, $linenum, $next) = @_;

  if ($h =~ /^"/)
  {
    $h =~ s/"//g;
    open(TYPES, "<$h") || &error($origname, $linenum, "$h: $!");
  }
  else
  {
    $h =~ s/[<>]//g;
    foreach (@paths)
    {
      if (-e "$_/$h")
      {
        if ($next && -e "$_/$h")
        {
          $next = 0;
          next;
        }
        else
        {
          open(TYPES, "<$_/$h") || &error($origname, $linenum, "$h: $!");
          last;
        }
      }
    }
  }
  my $file = my $orig = join("", <TYPES>);
  close(TYPES) || &error($origname, $linenum, "$h: No such file or directory");
 
  ######################
  # INITIAL PROCESSING #
  ######################

  # strip comments
  $file =~ s:/\*.*?\*/: :gs;
  $file =~ s/\/\/[^\n]+//gs;

  # single-linify multiple lines
  $file =~ s/\\ ?\n//gs;

  # convert hex to decimal since perl will treat
  # hex as a string if we read it like C would
  $file =~ s/0x([a-f0-9]+)/hex($1)/egi;

  # make the code look a little more pretty
  $file =~ s/\n{2,}/\n/g;

  # do some conversions for lame systems
  # that don't support some characters
  $file =~ s'\?\?\('['g;
  $file =~ s'\?\?\)']'g;
  $file =~ s'\?\?<'{'g;
  $file =~ s'\?\?>'}'g;
  $file =~ s'\?\?='#'g;
  $file =~ s'\?\?/'\\'g;
  $file =~ s'\?\?\''^'g;
  $file =~ s'\?\?!'|'g;
  $file =~ s'\?\?-'~'g;
  $file =~ s'<%'{'g;
  $file =~ s'%>'}'g;
  $file =~ s'<%'{'g;
  $file =~ s'<:'['g;   
  $file =~ s':>']'g;
  $file =~ s'%:'#'g;
  $file =~ s'%:%:'##'g;
  $file =~ s/(^|\n)\s*/$1/gs;
  $file =~ s/(^|\n)#\s*/$1#/gs;

  my @lines = split(/[\n\r]+/, $file);

  # process all macros here
  for (my $i = 0; $i < @lines; $i++)
  {

    my $line = $lines[$i];
    $line =~ s/\s*$//;

    if ($line =~ /^\s*#\s*(\S+)\s*(.*)$/)
    {
      my ($macro, $allargs) = ($1, $2);
      my ($identifier, $args) = ($allargs =~ /^(\w+(?:\([^)]*\))?|\S+)\s*(.*)\s*$/);

      if ($macro eq "else")
      {
        $levels[$iflvl]{true} = !grep { $levels[$iflvl]{$_} == 1 } 0 .. $levels[$iflvl]{scopes};
        $levels[$iflvl]{scopes}++;
        $levels[$iflvl]{$levels[$iflvl]{scopes}} = $levels[$iflvl]{true};
      }

      elsif ($macro eq "elif")
      {
        if (defined $defines{$identifier})
        {
          $levels[$iflvl]{true} = !grep { $levels[$iflvl]{$_} == 1 } 0 .. $levels[$iflvl]{scopes};
        }            
        $levels[$iflvl]{scopes}++;
        $levels[$iflvl]{$levels[$iflvl]{scopes}} = $levels[$iflvl]{true};
      }

      elsif ($macro eq "endif")
      {
        delete $levels[$iflvl];
        $iflvl--;
      }

      elsif ($macro eq "ifdef")
      {
        $iflvl++;
        $levels[$iflvl]{scopes} = 0;
        $levels[$iflvl]{0} = $levels[$iflvl]{true} = (defined $defines{$identifier} ? 1 : 0);
      }

      elsif ($macro eq "ifndef")
      {
        $iflvl++;
        $levels[$iflvl]{scopes} = 0;
        $levels[$iflvl]{0} = $levels[$iflvl]{true} = (defined $defines{$identifier} ? 0 : 1);
      }

      elsif ($macro eq "if")
      {
        $iflvl++;
        $levels[$iflvl]{scopes} = 0;
        $levels[$iflvl]{0} = $levels[$iflvl]{true} = (eval $allargs ? 1 : 0);
      }

      # we will not process anything if we're inside an untrue #ifdef
      elsif (grep { $levels[$_]{true} == 0 } 0 .. $#levels)
      {
        next;
      }

      elsif ($macro eq "include")
      {
        my $incl;
        if ($identifier =~ /^([<"][^>"]+[>"])$/)
        {
          $incl = $1;
        }
        elsif ($defines{$identifier} =~ /^([<"][^>"]+[>"])$/)
        {
          $incl = $1;
        }
        else
        {
          &error($h, $i, "`#include' expects \"FILENAME\" or <FILENAME>", $line);
        }

        &cpp($incl, $h, $i, 0);
      }

      elsif ($macro eq "include_next")
      {
        my $incl;
        if ($identifier =~ /^([<"][^>"]+[>"])$/)
        {
          $incl = $1;
        }
        elsif ($defines{$identifier} =~ /^([<"][^>"]+[>"])$/)
        {
          $incl = $1;
        }
        else
        {
          &error($h, $i, "`#include' expects \"FILENAME\" or <FILENAME>", $line);
        }

        &cpp($incl, $h, $i, 1);
      }

      elsif ($macro eq "define")
      {

        # object-like macros
        if ($identifier =~ /^\w+$/)
        {
          print "sub $identifier { $args }\n";
          eval "sub $identifier { $args }";
          $defines{$identifier} = $args;
        }

        # function-like macros
        elsif ($identifier =~ /^(\w+)\(\s*(.*)\s*\)$/)
        {
          my $j = 0;
          my ($name, %accept) = ($1, map { $_ => $j++ } split(/\s*,\s*/, $2));

          my ($newargs, %strings, $previous, $current);
          while (length $args)
          {
            $args =~ s/^(['"\\]|\w+|[^'"\\\w]+)//;
            $current = $1;
            if (($current eq "'" || $current eq '"') && !grep { $_ } values %strings)
            {
              $strings{$current} ^= 1;
              $newargs .= $current;
            }

            elsif ($previous ne '\\' && (($current eq '"' && $strings{'"'}) || ($current eq "'" && $strings{"'"})))
            {
              $strings{$current} ^= 1;
              $newargs .= $current;
            }

            elsif (defined $accept{$current} && !grep { $_ } values %strings)
            {
              $newargs .= " \$_[$accept{$current}] ";
            }

            else
            {
              $previous = $current;
              $newargs .= $current;
            }
          }

$newargs =~ s/\*//;
if ($newargs =~ /^\w*\(|^$/ && $newargs !~ /->/)
{
          print "sub $name(" . ('$' x keys %accept) . ") { $newargs }\n";
          eval "sub $name(" . ('$' x keys %accept) . ") { $newargs }";
}
else
{
$newargs =~ s/"/\\"/g;
#h4w
          print "sub $name(" . ('$' x keys %accept) . ") { eval \"$newargs\" }\n";
          eval "sub $name(" . ('$' x keys %accept) . ") { eval \"$newargs\" }";
}
          $defines{$1} = [$2, $newargs];
        }

      }

      elsif ($macro eq "undef")
      {
        delete $defines{$identifier};
        print "undef &$identifier;\n";
        eval "undef &$identifier;";
      }

      elsif ($macro eq "error")
      {
        die "$h:$i: #error $allargs\n";
      }

      elsif ($macro eq "warning")
      {
        warn "$h:$i: #warning $allargs\n";
      }

      else
      {
        &error($h, $i, "undefined or invalid # directive", $line);
      }
    }

    elsif (!grep { $levels[$_]{true} == 0 } 0 .. $iflvl)
    {
      print "$line\n";
    }
  }

#  my $lines = '"' . join("\n", @lines, "\n") . '"';
#  while ($lines =~ /"([^"]*)"/gs) {
#    foreach my $line (grep { !/^\s*#/ } split(/\n/, $1)) {
#      $line =~ s/\s//g;
#      while ($line =~ /(\w+)\(([^)]*)\)/g) {
#        my $temp = '"' . $line . '"';
#        my $ntemp = $temp;
#        if ($definef{$1}) {
#          my ($name, @args) = ($1, split(/,/, $2));
#          my ($drep, @dargs) = @{$definef{$name}};
#          $drep = '"' . $drep . '"';
#          while ($drep =~ s/"([^"]*)"//) {
#            my $tmp = '"' . $1 . '"';
#            my $ntmp = $tmp;
#            for (my $i = 0; $i < @args; $i++) {
#              $ntmp =~ s/$dargs[$i]/$args[$i]/g;
#            }
#print "$ntmp -> $ntmp\n";
#            $drep =~ s/$tmp/$ntmp/;
#          }
#          $ntemp = $drep;
#          $line =~ s/$temp/$ntemp/;
#          print "$line\n";
#        }
#      }
#      print "h4w $line\n";
#    }
#  }

    
#for(keys(%defines)){print "$_ -> $defines{$_}\n"}
  return map { "$_\n" } @lines;
}

sub error
{
  print STDERR (shift() . ":" . (shift() + 1) . ": " . shift() . "\n");
  die shift();
}




__DATA__

bad code

 while ($file =~ s/^#\s*define\s+(\w+(?:\(\))?)(?:\s+([^\n]+))?\n//m)
 {
  $defines{$1} = $2;
 }

 while ($file =~ s/^#\s*define\s+(\w+)\(([^)]+)\)\s+([^\n]*)\n//m)
 {
  my ($a, $b, $c) = ($1, $2, $3);
  $b =~ s/\s//g;
  my @f = split(/,/, $b);
  while ($files{$h} =~ /$a\(([^)]+)\)/g)
  {
   my $d = $1;
   $d =~ s/\s//g;
   my @d = split(/,/, $d);
   my $e = $c;
   for (my $i = 0; $i < @f; $i++)
   {
    $e =~ s/$f[$i]/$d[$i]/g;
   }
   $file =~ s/$a\([^)]+\)/$e/;
  }
 }
 
 foreach (keys(%defines))
 {
  if ($defines{$defines{$_}})
  {
   $defines{$_} = $defines{$defines{$_}};
  }
  $file =~ s/$_/$defines{$_}/gs;
 }
  
 return $files{$h};
}