ghc/utils/hstags/hstags.prl

   1 $tmp     = (( $ENV{'TMPDIR'} ) # to make tmp file names
   2            ? ($ENV{'TMPDIR'} . "/$$.eht")
   3            : "$(TMPDIR)/$$.eht" );
   4
   5 #------------------------------------------------------------------------
   6 # If you are adjusting paths by hand for a binary GHC distribution,
   7 # de-commenting the line to set GLASGOW_HASKELL_ROOT should do.
   8 # Or you can leave it as is, and set the environment variable externally.
   9 #------------------------------------------------------------------------
  10 # $ENV{'GLASGOW_HASKELL_ROOT'} = '/some/absolute/path/name';
  11
  12 if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables
  13     $TopPwd         = '$(TOP_PWD)';
  14     $InstLibDirGhc  = '$(INSTLIBDIR_GHC)';
  15     $InstDataDirGhc = '$(INSTDATADIR_GHC)';
  16 } else {
  17     $TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'};
  18
  19     if ( '$(INSTLIBDIR_GHC)' =~ /\/local\/fp(\/.*)/ ) {
  20         $InstLibDirGhc  = $ENV{'GLASGOW_HASKELL_ROOT'} . $1;
  21     } else {
  22         print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTLIBDIR_GHC).\n(Installation error)\n";
  23         exit(1);
  24     }
  25
  26     if ( '$(INSTDATADIR_GHC)' =~ /\/local\/fp(\/.*)/ ) {
  27         $InstDataDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $1;
  28     } else {
  29         print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTDATADIR_GHC).\n(Installation error)\n";
  30         exit(1);
  31     }
  32 }
  33
  34 $Unlit = ( $(INSTALLING) ) ? "$InstLibDirGhc/unlit"
  35                            : "$TopPwd/$(CURRENT_DIR)/$(GHC_UNLIT)";
  36 $HsCpp = # but this is re-set to "cat" (after options) if -cpp not seen
  37          ( $(INSTALLING) ) ? "$InstLibDirGhc/hscpp"
  38                            : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSCPP)";
  39 $HsP   = ( $(INSTALLING) ) ? "$InstLibDirGhc/hsp"
  40                            : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSP)";
  41 $HsTagsHelp
  42        = ( $(INSTALLING) ) ? "$InstLibDirGhc/hstags-help"
  43                            : "$TopPwd/$(CURRENT_DIR)/$(HSTAGSSRC)/hstags-help";
  44
  45 $Verbose = 0;
  46 $Append = '>';
  47 $DoCpp = 0;
  48 $Cpp_opts = '';
  49 $HsP_opts = '';
  50 @Files = ();
  51
  52 while ($ARGV[0] =~ /^-./) {
  53     $_ = shift(@ARGV);
  54     /^--/               && last;
  55     /^-v/               && ($Verbose  =  1, next);
  56     /^-a$/              && ($Append   = '>>', next);
  57     /^-fglasgow-ext/    && ($HsP_opts .= ' -N', next);
  58     /^-optP(.*)/        && ($Cpp_opts .= " $1", next);
  59     /^-[UDI]/           && ($Cpp_opts .= " $_", next);
  60     /^-cpp/             && ($DoCpp = 1, next);
  61     /^-/                && next; # ignore the rest
  62     push(@Files, $_);
  63 }
  64
  65 $ghc_version_info = $(PROJECTVERSION) * 100;
  66 $DoHsCpp = ( ! $DoCpp ) ? 'cat'
  67                         : "$HsCpp -D__HASKELL1__=2 -D__GLASGOW_HASKELL__=$ghc_version_info $Cpp_opts";
  68
  69 # to find Prelude.hi
  70 $HsP_opts .= ( ( $(INSTALLING) ) ? " -J$InstDataDirGhc/imports"
  71                                  : " -J$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/prelude" );
  72
  73 open(STDOUT, "$Append TAGS") || die "can't create TAGS";
  74
  75 foreach $f ( @ARGV ) {
  76     # if file is in a dir && we are CPPing, then we add its dir to the -I list.
  77     if ( $DoCpp && $f =~ /(.+)\/[^\/]+$/ ) {
  78         $Idir = "-I$1";
  79     } else {
  80         $Idir = '';
  81     }
  82
  83     if ( $f =~ /\.lhs$/ ) {
  84         $ToDo = "$Unlit $f - | $DoHsCpp $Idir | $HsP -E $HsP_opts | $HsTagsHelp $f > $tmp";
  85     } else {
  86         $ToDo = "$DoHsCpp $Idir < $f | $HsP -E  $HsP_opts | $HsTagsHelp $f > $tmp";
  87     }
  88     print STDERR "$ToDo\n" if $Verbose;
  89     system($ToDo);
  90     $return_val = $?;
  91     die "Fatal error $return_val\n" if $return_val != 0;
  92
  93     $stuff = `ls -l $tmp`;
  94     @size = split(/[ \t]+/,$stuff);
  95
  96     print STDOUT "\f\n$f,",$size[3],"\n";
  97     print STDOUT `cat $tmp`;
  98 }
  99
 100 unlink $tmp;