ghc/utils/hscpp/hscpp.prl

   1 #
   2 # reads CPP output and turns #line things into appropriate Haskell
   3 # pragmas
   4 #
   5 # considered to be GHC-project specific
   6 #
   7 #
   8 # NOTE: this script needs RAWCPP set in order to do something
   9 # useful:
  10 #
  11
  12 $Verbose = 0;
  13
  14 while ( $#ARGV >= 0 &&  $ARGV[0] eq '-v' ) {
  15     if ($ARGV[0] eq '-v') {
  16         $Verbose = 1;
  17     } else {
  18         die "hscpp: unrecognised argument: $$ARGV[0]\n";
  19     }
  20     shift(@ARGV);
  21 }
  22 #ToDo: print a version number ?
  23
  24 $OrigCpp = ${RAWCPP};
  25
  26 if ( $OrigCpp =~ /(\S+)\s+(.*)/ ) {
  27     $cmd  = $1;
  28     $rest = $2;
  29     if ( -x $cmd ) { # cool
  30         $Cpp = $OrigCpp;
  31     } else { # oops; try to guess
  32         $GccV = `gcc -v 2>&1`;
  33         if ( $GccV =~ /Reading specs from (.*)\/specs/ ) {
  34             $Cpp = "$1/cpp $rest";
  35         } else {
  36             die "hscpp: don't know how to run cpp: $OrigCpp\n";
  37         }
  38     }
  39 } else {
  40     $Cpp = $OrigCpp;
  41 }
  42
  43 print STDERR "hscpp:CPP invoked: $Cpp @ARGV\n" if $Verbose;
  44
  45 open(INPIPE, "$Cpp @ARGV |") || die "Can't open C pre-processor pipe\n";
  46
  47 while (<INPIPE>) {
  48
  49 # line directives come in flavo[u]rs:
  50 #   s/^#\s*line\s+\d+$/\{\-# LINE \-\}/;   IGNORE THIS ONE FOR NOW
  51     s/^#\s*line\s+(\d+)\s+(\".+\")$/\{\-# LINE \1 \2 \-\}/;
  52     s/^#\s*(\d+)\s+(\".*\").*/\{\-# LINE \1 \2 \-\}/;
  53
  54     print $_;
  55 }
  56
  57 close(INPIPE) || exit(1); # exit is so we reflect any errors.
  58
  59 exit(0);