ghc/driver/ghc-recomp.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-recomp-chking]{Recompilation checker}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 \begin{code}
   8 sub runRecompChkr {
   9     local($ifile,       # originating input file
  10           $ifile_hs,    # post-unlit, post-cpp, etc., input file
  11           $ifile_root,  # input filename minus suffix
  12           $ofile_target,# the output file that we ultimately hope to produce
  13           $hifile_target# the .hi file ... (ditto)
  14          ) = @_;
  15
  16     ($i_dev,$i_ino,$i_mode,$i_nlink,$i_uid,$i_gid,$i_rdev,$i_size,
  17      $i_atime,$i_mtime,$i_ctime,$i_blksize,$i_blocks) = stat($ifile);
  18
  19     if ( ! -f $ofile_target ) {
  20         print STDERR "$Pgm:compile:Output file $ofile_target doesn't exist\n";
  21         return(1);
  22     }
  23
  24     ($o_dev,$o_ino,$o_mode,$o_nlink,$o_uid,$o_gid,$o_rdev,$o_size,
  25      $o_atime,$o_mtime,$o_ctime,$o_blksize,$o_blocks) = stat(_); # stat info from -f test
  26
  27     if ( ! -f $hifile_target ) {
  28         print STDERR "$Pgm:compile:Interface file $hifile_target doesn't exist\n";
  29         return(1);
  30     }
  31
  32     ($hi_dev,$hi_ino,$hi_mode,$hi_nlink,$hi_uid,$hi_gid,$hi_rdev,$hi_size,
  33      $hi_atime,$hi_mtime,$hi_ctime,$hi_blksize,$hi_blocks) = stat(_); # stat info from -f test
  34
  35     if ($i_mtime > $o_mtime) {
  36         print STDERR "$Pgm:recompile:Input file $ifile newer than $ofile_target\n";
  37         return(1);
  38     }
  39
  40     # OK, let's see what we used last time; if none of it has
  41     # changed, then we don't need to continue with this compilation.
  42     require('ghc-iface.prl')
  43         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-iface.prl (recomp)!\n");
  44     &tidy_up_and_die(1,"$Pgm:recomp:why has $hifile_target already been read?\n")
  45         if $HiHasBeenRead{'old'} == 1;
  46
  47     &readHiFile('old',$hifile_target);
  48     %ModUsed = ();
  49     %Used    = ();
  50
  51     foreach $ul ( split(/;\n/, $Stuff{'old:usages'}) ) {
  52
  53         $ul =~ /^(\S+)\s+(\d+)\s+:: (.*)/ || die "$Pgm: bad old usages line!\n";
  54         local($mod)    = $1;
  55         local($modver) = $2;
  56         local(@thing)  = split(/\s+/, $3);
  57
  58         $ModUsed{$mod} = $modver;
  59
  60         local($key, $n);
  61         while ( $#thing >= 0 ) {
  62             $key = "$mod:" . $thing[0];
  63             $n   = $thing[1];
  64             $Used{$key} = $n;
  65             shift @thing; shift @thing; # toss two
  66         }
  67     }
  68
  69     # see if we can avoid recompilation just by peering at the
  70     # module-version numbers:
  71
  72     &makeHiMap() unless $HiMapDone;
  73
  74     local($used_modules_have_changed) = 0;
  75     used_mod: foreach $um ( keys %ModUsed ) {
  76         if ( ! defined($HiMap{$um}) ) {
  77             print STDERR "$Pgm:recompile:interface for used module $um no longer exists\n";
  78             foreach $hm ( keys %HiMap ) {
  79                 print STDERR "$hm ==> ", $HiMap{$hm}, "\n";
  80             }
  81             return 1;
  82         } else {
  83             if ( $HiHasBeenRead{$um} ) {
  84                 print STDERR "$Pgm:very strange that $um.hi has already been read?!?\n"
  85             } else {
  86                 &readHiFile($um, $HiMap{$um});
  87             }
  88         }
  89         if ( $ModUsed{$um} != $ModuleVersion{$um} ) {
  90             print STDERR "used module version: $um: was: ",$ModUsed{$um}, "; is ", $ModuleVersion{$um}, "\n";
  91             $used_modules_have_changed = 1;
  92             last used_mod; # no point continuing...
  93         }
  94     }
  95     return 0 if ! $used_modules_have_changed;
  96
  97     # well, some module version has changed, but maybe no
  98     # entity of interest has...
  99 print STDERR "considering used entities...\n";
 100     local($used_entities_have_changed) = 0;
 101
 102     used_entity: foreach $ue ( keys %Used ) {
 103         $ue =~ /([A-Z][A-Za-z0-9_']*):(.+)/;
 104         local($ue_m) = $1;
 105         local($ue_n) = $2;
 106
 107         die "$Pgm:interface for used-entity module $ue_m doesn't exist\n"
 108             if ! defined($HiMap{$ue_m});
 109
 110         &readHiFile($ue_m, $HiMap{$ue_m}) unless $HiHasBeenRead{$ue_m};
 111         # we might not have read it before...
 112
 113         if ( !defined($Version{$ue}) ) {
 114             print STDERR "No version info for $ue?!\n";
 115
 116         } elsif ( $Used{$ue} != $Version{$ue} ) {
 117             print STDERR "$Pgm:recompile: used entity changed: $ue: was version ",$Used{$ue},"; is ", $Version{$ue}, "\n";
 118             $used_entities_have_changed = 1;
 119             last used_entity; # no point continuing...
 120         }
 121     }
 122     return 0 if ! $used_entities_have_changed;
 123
 124     return(1); # OK, *recompile*
 125 }
 126 \end{code}
 127
 128 \begin{code}
 129 # make "require"r happy...
 130 1;
 131 \end{code}