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 $file = '';
  14 @args = ();
  15
  16 $Cpp = ${RAWCPP};
  17
  18 while (@ARGV) {
  19     $_ = $ARGV[0];
  20     /^-v$/  && do { $Verbose = 1; shift(@ARGV); next; };
  21     /^[^-]/ && $#ARGV == 0 && do { $file = $_; shift(@ARGV); next; };
  22     push @args, $_;
  23     shift(@ARGV);
  24 }
  25
  26 die "usage: hscpp [arg...] file" if ($file eq '');
  27
  28 print STDERR "hscpp:CPP invoked: $Cpp @args - <$file\n" if $Verbose;
  29 open(INPIPE, "$Cpp @args - <$file |")
  30         || die "Can't open C pre-processor pipe\n";
  31
  32 while (<INPIPE>) {
  33
  34     s/^#\s*line\s+(\d+)\s+\"\"$/\{\-# LINE \1 \"$file\" \-\}/;
  35     s/^#\s*(\d+)\s+\"\".*/\{\-# LINE \1 \"$file\" \-\}/;
  36
  37 # line directives come in flavo[u]rs:
  38
  39 #   s/^#\s*line\s+\d+$/\{\-# LINE \-\}/;   IGNORE THIS ONE FOR NOW
  40     s/^#\s*line\s+(\d+)\s+(\".+\")$/\{\-# LINE \1 \2 \-\}/;
  41     s/^#\s*(\d+)\s+(\".*\").*/\{\-# LINE \1 \2 \-\}/;
  42
  43     print $_;
  44 }
  45
  46 close(INPIPE) || exit(1); # exit is so we reflect any errors.
  47
  48 exit(0);