ghc/utils/hstags/hstags.prl

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