ghc/utils/mkdependHS/mkdependHS.prl

   1 # *** MSUB does some substitutions here ***
   2 # *** grep for $( ***
   3 #
   4 # tries to work like mkdependC
   5 #
   6 # ToDo: strip out all the .h junk
   7 #
   8 ($Pgm = $0) =~ s/.*\/([^\/]+)$/\1/;
   9 $Usage  = <<EOUSAGE;
  10 Usage: $Pgm [mkdependHS options] [-- GHC options --] srcfile1 [srcfile2 ...]
  11
  12 Options recognised wherever they occur (mkdependHS or GHC):
  13
  14     -D<blah>    A cpp #define; usual meaning
  15     -i<dirs>    Add <dirs> (colon-separated) to list of directories
  16                 to search for "import"ed modules
  17     -I<dir>     Add <dir> to list of directories to search for
  18                 .h files (i.e., usual meaning)
  19     -syslib <blah> This program uses this GHC system library; take
  20                 appropriate action (e.g., recognise when they are
  21                 "import"ing a module from that library).
  22     -fhaskell1.[2-9] Deal with the oddities associated with a
  23                 particular version of Haskell 1.
  24     -ignore <mod>
  25
  26 mkdependHS-specific options (not between --'s):
  27
  28     -v          Be verbose.
  29     -v -v       Be very verbose.
  30     -f blah     Use "blah" as the makefile, rather than "makefile"
  31                 or "Makefile".
  32     -o <osuf>   Use <osuf> as the "object file" suffix ( default: .o)
  33     -s <suf>    Make extra dependencies for files with
  34                 suffix <suf><osuf>; thus, "-o .hc -s _a" will
  35                 make dependencies both for .hc files and for _a.hc
  36                 files.  (Useful in conjunction with NoFib "ways".)
  37     -x <file>   Regard <file> as "stable"; i.e., eXclude it from having
  38                 dependencies on it.
  39 EOUSAGE
  40
  41 $Status  = 0; # just used for exit() status
  42 $Verbose = 0; # 1 => verbose, 2 => very verbose
  43 $Dashdashes_seen = 0;
  44
  45 # Try to guess how to run gcc's CPP directly -------------
  46
  47 $OrigCpp = '$(RAWCPP)';
  48 if ( $OrigCpp !~ /(\S+)\s+(.*)/ ) {
  49     $Cpp = $OrigCpp;
  50 } else {
  51     $cmd  = $1;
  52     $rest = $2;
  53     if ( -x $cmd ) { # cool
  54         $Cpp = $OrigCpp;
  55     } else { # oops; try to guess
  56         $GccV = `gcc -v 2>&1`;
  57         if ( $GccV =~ /Reading specs from (.*)\/specs/ ) {
  58             $Cpp = "$1/cpp $rest";
  59         } else {
  60             die "hscpp: don't know how to run cpp: $OrigCpp\n";
  61         }
  62     }
  63 }
  64
  65 if ( $ENV{'TMPDIR'} ) { # where to make tmp file names
  66     $Tmp_prefix = $ENV{'TMPDIR'} . "/mkdependHS$$";
  67 } else {
  68     $Tmp_prefix ="$(TMPDIR)/mkdependHS$$";
  69     $ENV{'TMPDIR'} = '$(TMPDIR)'; # set the env var as well
  70 }
  71
  72 #------------------------------------------------------------------------
  73 # If you are adjusting paths by hand for a binary GHC distribution,
  74 # de-commenting the line to set GLASGOW_HASKELL_ROOT should do.
  75 # Or you can leave it as is, and set the environment variable externally.
  76 #------------------------------------------------------------------------
  77 # $ENV{'GLASGOW_HASKELL_ROOT'} = '/some/absolute/path/name';
  78
  79 if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables
  80     $TopPwd         = '$(TOP_PWD)';
  81     $InstLibDirGhc  = '$(INSTLIBDIR_GHC)';
  82     $InstDataDirGhc = '$(INSTDATADIR_GHC)';
  83 } else {
  84     $TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'};
  85
  86     if ( '$(INSTLIBDIR_GHC)' =~ /\/local\/fp(\/.*)/ ) {
  87         $InstLibDirGhc  = $ENV{'GLASGOW_HASKELL_ROOT'} . $1;
  88     } else {
  89         print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTLIBDIR_GHC).\n(Installation error)\n";
  90         exit(1);
  91     }
  92
  93     if ( '$(INSTDATADIR_GHC)' =~ /\/local\/fp(\/.*)/ ) {
  94         $InstDataDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $1;
  95     } else {
  96         print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTDATADIR_GHC).\n(Installation error)\n";
  97         exit(1);
  98     }
  99 }
 100
 101 $Unlit = ( $(INSTALLING) ) ? "$InstLibDirGhc/unlit"
 102                              : "$TopPwd/$(CURRENT_DIR)/$(GHC_UNLIT)";
 103
 104 $Begin_magic_str = "# DO NOT DELETE: Beginning of Haskell dependencies\n";
 105 $End_magic_str = "# DO NOT DELETE: End of Haskell dependencies\n";
 106 $Obj_suffix = '.o';
 107 $ghc_version_info = $(PROJECTVERSION) * 100;
 108
 109 $Import_dirs = '.';
 110 %Syslibs = ();
 111 %IgnoreMe = ();
 112 %PreludeIfaces = ( 'Prelude',       '1',
 113                  , 'Array',         '1'
 114                  , 'Char',          '1'
 115                  , 'Complex',       '1'
 116                  , 'Directory',     '1'
 117                  , 'IO',            '1'
 118                  , 'Ix',            '1'
 119                  , 'List',          '1'
 120                  , 'Maybe',         '1'
 121                  , 'Monad',         '1'
 122                  , 'Ratio',         '1'
 123                  , 'System',        '1'
 124                  , 'PreludeGlaST',  '1'
 125                  , 'PreludeGlaMisc','1'
 126                  , 'Concurrent',    '1'
 127                  , 'Parallel',      '1');
 128 %GhcLibIfaces = (  'Bag', '1',
 129                    'BitSet', '1',
 130                    # CharSeq not supposed to be used by user (I think. WDP)
 131                    'FiniteMap', '1',
 132                    'ListSetOps', '1',
 133                    'Maybes', '1',
 134                    'PackedString', '1',
 135                    'Regex', '1',
 136                    'MatchPS', '1',
 137                    'Readline', '1',
 138                    'Socket', '1',
 139                    'SocketPrim', '1',
 140                    'BSD', '1',
 141                    'Pretty', '1',
 142                    'Set', '1',
 143                    'Util', '1' );
 144 %HbcLibIfaces = (  'Algebra', '1',
 145                    'Hash', '1',
 146                    'ListUtil', '1',
 147                    'Miranda', '1',
 148                    'NameSupply', '1',
 149                    'Native', '1',
 150                    'Number', '1',
 151                    'Parse', '1',
 152                    'Pretty', '1',
 153                    'Printf', '1',
 154                    'QSort', '1',
 155                    'Random', '1',
 156                    'SimpleLex', '1',
 157                    'Time', '1',
 158                    'Trace', '1',
 159                    'Word', '1' );
 160 %IO13Ifaces = (    'LibSystem', '1',
 161                    'LibCPUTime', '1',
 162                    'LibDirectory', '1',
 163                    'LibPosix', '1',
 164                    'LibTime', '1' );
 165
 166 $Haskell_1 = 2; # assume Haskell 1.2, still. Changed by -fhaskell-1.3
 167 $Include_dirs = '-I.';
 168 $Makefile = '';
 169 @Src_files = ();
 170
 171 &mangle_command_line_args();
 172
 173 if ( $Status ) {
 174     print stderr $Usage;
 175     exit(1);
 176 }
 177
 178 push(@Defines,
 179      ("-D__HASKELL1__=$Haskell_1",
 180       "-D__GLASGOW_HASKELL__=$ghc_version_info"));
 181
 182 @Import_dirs  = split(/:/,$Import_dirs);
 183 @Include_dirs = split(/\s+/,$Include_dirs); # still has -I's in it
 184 # NB: We keep the scalar-variable equivalents to use in error messages
 185
 186 if ( ! $Makefile && -f 'makefile' ) {
 187     $Makefile = 'makefile';
 188 } elsif ( ! $Makefile && -f 'Makefile') {
 189     $Makefile = 'Makefile';
 190 } elsif ( ! $Makefile) {
 191     die "$Pgm: no makefile or Makefile found\n";
 192 }
 193
 194 print STDERR "CPP defines=@Defines\n" if $Verbose;
 195 print STDERR "Import_dirs=@Import_dirs\n" if $Verbose;
 196 print STDERR "Include_dirs=@Include_dirs\n" if $Verbose;
 197
 198 &preprocess_import_dirs();
 199
 200 @Depend_lines = ();
 201
 202 foreach $sf (@Src_files) {
 203     # just like lit-inputter
 204     # except it puts each file through CPP and
 205     # a de-commenter (not implemented);
 206     # builds up @Depend_lines
 207     print STDERR "Here we go for source file: $sf\n" if $Verbose;
 208     ($bf = $sf) =~ s/\.l?hs$//;
 209     push(@Depend_lines, "$bf$Obj_suffix : $sf\n");
 210     foreach $suff (@File_suffix) {
 211         push(@Depend_lines, "$bf$suff$Obj_suffix : $sf\n");
 212     }
 213
 214     # if it's a literate file, .lhs, then we de-literatize it:
 215     if ( $sf !~ /\.lhs$/ ) {
 216         $file_to_read = $sf;
 217     } else {
 218         $file_to_read = "$Tmp_prefix.hs";
 219         local($to_do) = "$Unlit $sf $file_to_read";
 220         &run_something($to_do, 'unlit');
 221     }
 222     &slurp_file_for_imports($file_to_read, $sf);
 223
 224     if ( $sf =~ /\.lhs$/ ) {
 225         unlink "$Tmp_prefix.hs";
 226     }
 227 }
 228
 229 # OK, mangle the Makefile
 230 unlink("$Makefile.bak");
 231 rename($Makefile,"$Makefile.bak");
 232 # now copy Makefile.bak into Makefile, rm'ing old dependencies
 233 # and adding the new
 234 open(OMKF,"< $Makefile.bak") || die "$Pgm: can't open $Makefile.bak: $!\n";
 235 open(NMKF,"> $Makefile") || die "$Pgm: can't open $Makefile: $!\n";
 236 select(NMKF);
 237 $_ = <OMKF>;
 238 while ($_ && $_ ne $Begin_magic_str) { # copy through, 'til Begin_magic_str
 239     print $_;
 240     $_ = <OMKF>;
 241 }
 242 while ($_ && $_ ne $End_magic_str) { # delete 'til End_magic_str
 243     $_ = <OMKF>;
 244 }
 245 # insert dependencies
 246 print $Begin_magic_str;
 247 print @Depend_lines;
 248 print $End_magic_str;
 249 while (<OMKF>) { # copy the rest through
 250     print $_;
 251 }
 252 close(NMKF) || exit(1);
 253 close(OMKF) || exit(1);
 254 exit 0;
 255
 256 sub mangle_command_line_args {
 257     while($_ = $ARGV[0]) {
 258         shift(@ARGV);
 259
 260         if ( /^--$/ ) {
 261             $Dashdashes_seen++;
 262
 263         } elsif ( /^-D(.*)/ ) { # recognized wherever they occur
 264             push(@Defines, $_);
 265         } elsif ( /^-i(.*)/ ) {
 266             $Import_dirs .= ":$1";
 267         } elsif ( /^-I/ ) {
 268             $Include_dirs .= " $_";
 269         } elsif ( /^-syslib$/ ) {
 270             push(@Syslibs, &grab_arg_arg($_,''));
 271         } elsif ( /^-fhaskell-1\.([2-9])/ ) {
 272             $Haskell_1 = $1;
 273         } elsif ($Dashdashes_seen != 1) { # not between -- ... --
 274             if ( /^-v$/ ) {
 275                 $Verbose++;
 276             } elsif ( /^-f(.*)/ ) {
 277                 $Makefile       = &grab_arg_arg('-f',$1);
 278             } elsif ( /^-o(.*)/ ) {
 279                 $Obj_suffix     = &grab_arg_arg('-o',$1);
 280             } elsif ( /^-x(.*)/ ) {
 281                 local($thing) = &grab_arg_arg($_,$1);
 282                 $IgnoreMe{$thing} = 'y';
 283             } elsif ( /^-s(.*)/ ) {
 284                 local($suff)    =  &grab_arg_arg('-s',$1);
 285                 push(@File_suffix, $suff);
 286             } elsif ( /^-/ ) {
 287                 print STDERR "$Pgm: unknown option ignored: $_\n";
 288                 $Status++;
 289             } else {
 290                 push(@Src_files, $_);
 291             }
 292
 293         } elsif ($Dashdashes_seen == 1) { # where we ignore unknown options
 294             push(@Src_files, $_) if ! /^-/;
 295         }
 296     }
 297     @File_suffix = sort (@File_suffix);
 298 }
 299
 300 sub grab_arg_arg {
 301     local($option, $rest_of_arg) = @_;
 302
 303     if ($rest_of_arg) {
 304         return($rest_of_arg);
 305     } elsif ($#ARGV >= 0) {
 306         local($temp) = $ARGV[0]; shift(@ARGV);
 307         return($temp);
 308     } else {
 309         print STDERR "$Pgm: no argument following $option option\n";
 310         $Status++;
 311     }
 312 }
 313
 314 sub preprocess_import_dirs {
 315     # it's probably cheaper to find out what's in all
 316     # the @Import_dirs before we start processing.
 317     local($d, $thing);
 318     local($_);
 319     %ModuleIn = ();
 320
 321     foreach $d ( @Import_dirs ) {
 322         opendir(DIR, $d) || die "$Pgm: can't open directory $d\n";
 323
 324         for ($_ = readdir(DIR); $_; $_ = readdir(DIR)) {
 325             next unless /(.*)\.hi$/;
 326             $thing = $1;
 327             if ($ModuleIn{$thing} && $ModuleIn{$thing} ne $d) {
 328                 print STDERR "$Pgm: warning: $thing.hi appears in both $ModuleIn{$thing} and $d!\n";
 329             } else {
 330                 $ModuleIn{$thing} = $d;
 331             }
 332         }
 333         closedir(DIR); # No, don't check the error code
 334     }
 335 }
 336
 337 sub slurp_file_for_imports {
 338     local($file_to_read, $orig_src_file) = @_;
 339     local($follow_file);
 340
 341     local($last_seen_dir) = $orig_src_file;
 342     $last_seen_dir =~ s/\/[^\/]+$//; # strip to dir name
 343     $last_seen_dir = '.' if ($last_seen_dir eq $orig_src_file);
 344
 345     # we mangle #include's so they will also leave something
 346     # behind to indicate the dependency on _them_
 347
 348     print STDERR "/usr/bin/sed -e '/^# *include/{p;s/^# *include/!include/;};s/'\\''//g;s/\"//g' $file_to_read | $Cpp $Include_dirs -I$last_seen_dir @Defines |\n" if $Verbose;
 349
 350     open(SRCFILE, "/usr/bin/sed -e '/^# *include/{p;s/^# *include/!include/;};s/'\\''//g;s/\"//g' $file_to_read | $Cpp $Include_dirs -I$last_seen_dir @Defines |")
 351         || die "$Pgm: Can't open $file_to_read: $!\n";
 352
 353     while (<SRCFILE>) {
 354         next unless (/^>?\s*(import)\s+([A-Z][A-Za-z0-9_']*)/ || /^!(include)\s+"(\S+)"/);
 355         $todo    = $1;
 356         $modname = $2;
 357
 358         if ($todo eq 'import') {
 359             if ( $IgnoreMe{$modname} eq 'y' ) {
 360                 $follow_file = '__ignore__';
 361             } elsif ( $ModuleIn{$modname} ) {
 362                 $follow_file = "$ModuleIn{$modname}/$modname.hi";
 363             } else { # hard way
 364                 $follow_file
 365                   = &find_in_Import_dirs($orig_src_file, $modname, $last_seen_dir);
 366             }
 367         } else {
 368             if ( $IgnoreMe{$modname} eq 'y' ) {
 369                 $follow_file = '__ignore__';
 370             } else {
 371                 $follow_file
 372                   = &find_in_Include_dirs($orig_src_file, $modname, $last_seen_dir);
 373             }
 374         }
 375
 376         if (! $follow_file) { # it didnae find anything
 377             die "$orig_src_file: Couldn't handle: $_\n";
 378
 379         } else { # it found something
 380             if ($follow_file ne '__ignore__') {
 381                 local($int_file);
 382                 $int_file = $follow_file;
 383
 384                 if ( $int_file !~ /\.(l?hs|hi)$/ ) {
 385                     push(@Depend_lines, "$bf$Obj_suffix : $int_file\n");
 386                     foreach $suff (@File_suffix) {
 387                         push(@Depend_lines, "$bf$suff$Obj_suffix : $int_file\n");
 388                     }
 389
 390                 } else {
 391                     $int_file =~ s/\.l?hs$//;
 392                     $int_file =~ s/\.hi$//;
 393
 394                     push(@Depend_lines, "$bf$Obj_suffix : $int_file.hi\n");
 395                     foreach $suff (@File_suffix) {
 396                         push(@Depend_lines, "$bf$suff$Obj_suffix : $int_file$suff.hi\n");
 397                     }
 398                 }
 399             }
 400         }
 401     }
 402     close(SRCFILE) || exit(1);
 403 }
 404
 405 # when we see something, we cache that fact ('y').
 406 # also, when we get a miss, we cache that (so we don't try later); ('n')
 407 %FileExists = ();
 408
 409 sub find_in_Import_dirs {
 410     local($orig_src_file, $modname, $last_seen_dir) = @_;
 411     local($import_dir);
 412     local($do_magical_check) = 0;
 413     local($name_to_check);
 414
 415     # do it the old hard way: hop along Import_dir list
 416     foreach $import_dir (@Import_dirs) {
 417         # handle . magically
 418         if ($import_dir eq '.') {
 419             # record that we should do a SPECIAL try for a file in last_seen_dir (LAST)
 420             $do_magical_check = 1;
 421         }
 422
 423         $name_to_check = "$import_dir/$modname.hi";
 424         if ( $FileExists{$name_to_check} ne 'n' ) { # either 'y' or nothing
 425             print STDERR "trying $name_to_check...\n" if $Verbose >= 2; # very verbose
 426             return($name_to_check) if $FileExists{$name_to_check} eq 'y';
 427             if (-f $name_to_check) {
 428                 $FileExists{$name_to_check} = 'y';
 429                 return($name_to_check) ;
 430             } else {
 431                 $FileExists{$name_to_check} = 'n';
 432             }
 433         }
 434
 435         $name_to_check = "$import_dir/$modname.hs";
 436         print STDERR "trying... $name_to_check\n" if $Verbose >= 2; # very verbose
 437         return($name_to_check) if -f $name_to_check;
 438
 439         $name_to_check = "$import_dir/$modname.lhs";
 440         print STDERR "trying... $name_to_check\n" if $Verbose >= 2; # very verbose
 441         return($name_to_check) if -f $name_to_check;
 442     }
 443     if ($do_magical_check == 1) {
 444         $name_to_check = "$last_seen_dir/$modname.hi";
 445
 446         if ( $FileExists{$name_to_check} ne 'n' ) { # either 'y' or nothing
 447             print STDERR "trying $name_to_check...\n" if $Verbose >= 2; # very verbose
 448             return($name_to_check) if $FileExists{$name_to_check} eq 'y';
 449             if (-f $name_to_check) {
 450                 $FileExists{$name_to_check} = 'y';
 451                 return($name_to_check) ;
 452             } else {
 453                 $FileExists{$name_to_check} = 'n';
 454             }
 455         }
 456
 457         $name_to_check = "$last_seen_dir/$modname.lhs";
 458         print STDERR "trying... $name_to_check\n" if $Verbose >= 2; # very verbose
 459         return($name_to_check) if -f $name_to_check;
 460
 461         $name_to_check = "$last_seen_dir/$modname.hs";
 462         print STDERR "trying... $name_to_check\n" if $Verbose >= 2; # very verbose
 463         return($name_to_check) if -f $name_to_check;
 464     }
 465     # OK, maybe it's referring to something in a system library
 466     foreach $lib ( @Syslibs ) {
 467         if ( $lib eq 'ghc' ) {
 468             return('__ignore__') if $GhcLibIfaces{$modname};
 469         } elsif ( $lib eq 'hbc' ) {
 470             return('__ignore__') if $HbcLibIfaces{$modname};
 471         } else {
 472             die "Unrecognised syslib: $lib\n";
 473         }
 474     }
 475
 476     # Might be a Haskell 1.3 Module (but only if we've said -fhaskell-1.3)
 477     if ( $Haskell_1 >= 3 ) {
 478         return('__ignore__') if $IO13Ifaces{$modname};
 479     }
 480
 481     # Last hope: referring to a Prelude interface
 482     return('__ignore__') if $PreludeIfaces{$modname};
 483
 484     die "No file `$modname.hi', `$modname.lhs' or `$modname.hs' (reqd from file `$orig_src_file')\namong import directories:\n\t$Import_dirs\n";
 485 }
 486
 487 sub find_in_Include_dirs {
 488     local($orig_src_file, $name, $last_seen_dir) = @_;
 489     local($include_dir);
 490     local($do_magical_check) = 0;
 491
 492     # no funny name guessing here
 493
 494     # hop along Include_dir list
 495     foreach $include_dir (@Include_dirs) {
 496         $include_dir =~ s/^-I//;
 497
 498         # handle . magically
 499         if ($include_dir eq '.') {
 500             # record that we should do a SPECIAL try for a file in last_seen_dir (LAST)
 501             $do_magical_check = 1;
 502         }
 503         print STDERR "trying $include_dir/$name...\n" if $Verbose >= 2; # very verbose
 504         if (-f "$include_dir/$name") {
 505             return("$include_dir/$name");
 506         }
 507     }
 508     if ($do_magical_check == 1) {
 509         print STDERR "trying $last_seen_dir/$name...\n" if $Verbose >= 2; # very verbose
 510         if (-f "$last_seen_dir/$name") {
 511             return("$last_seen_dir/$name");
 512         }
 513     }
 514     die "No file `$name' (reqd from file `$orig_src_file') among include directories: $Include_dirs\n";
 515 }
 516
 517 # out of the driver, actually
 518 sub run_something {
 519     local($str_to_do, $tidy_name) = @_;
 520
 521     print STDERR "\n$tidy_name:\n\t" if $Verbose;
 522     print STDERR "$str_to_do\n" if $Verbose;
 523
 524     local($return_val) = system($str_to_do) >> 8;
 525
 526     if ($return_val != 0) {
 527         local($die_msg) = "$Pgm: execution of the $tidy_name had trouble";
 528         $die_msg .= " (program not found)" if $return_val == 255;
 529         $die_msg .= " ($!)" if $Verbose && $! != 0;
 530         $die_msg .= "\n";
 531         print STDERR $die_msg;
 532         exit $return_val;
 533     }
 534 }