diff options
Diffstat (limited to 'ghc/driver/ghc-recomp.lprl')
| -rw-r--r-- | ghc/driver/ghc-recomp.lprl | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/ghc/driver/ghc-recomp.lprl b/ghc/driver/ghc-recomp.lprl new file mode 100644 index 0000000000..3414605e8d --- /dev/null +++ b/ghc/driver/ghc-recomp.lprl @@ -0,0 +1,135 @@ +%************************************************************************ +%* * +\section[Driver-recomp-chking]{Recompilation checker} +%* * +%************************************************************************ + +\begin{code} +sub runRecompChkr { + local($ifile, # originating input file + $ifile_hs, # post-unlit, post-cpp, etc., input file + $ifile_root, # input filename minus suffix + $ofile_target,# the output file that we ultimately hope to produce + $hifile_target# the .hi file ... (ditto) + ) = @_; + + ($i_dev,$i_ino,$i_mode,$i_nlink,$i_uid,$i_gid,$i_rdev,$i_size, + $i_atime,$i_mtime,$i_ctime,$i_blksize,$i_blocks) = stat($ifile); + + if ( ! -f $ofile_target ) { + print STDERR "$Pgm:compile:Output file $ofile_target doesn't exist\n"; + return(1); + } + + ($o_dev,$o_ino,$o_mode,$o_nlink,$o_uid,$o_gid,$o_rdev,$o_size, + $o_atime,$o_mtime,$o_ctime,$o_blksize,$o_blocks) = stat(_); # stat info from -f test + + if ( ! -f $hifile_target ) { + print STDERR "$Pgm:compile:Interface file $hifile_target doesn't exist\n"; + return(1); + } + + ($hi_dev,$hi_ino,$hi_mode,$hi_nlink,$hi_uid,$hi_gid,$hi_rdev,$hi_size, + $hi_atime,$hi_mtime,$hi_ctime,$hi_blksize,$hi_blocks) = stat(_); # stat info from -f test + + if ($i_mtime > $o_mtime) { + print STDERR "$Pgm:recompile:Input file $ifile newer than $ofile_target ($i_mtime > $o_mtime)\n"; + return(1); + } + + # OK, let's see what we used last time; if none of it has + # changed, then we don't need to continue with this compilation. + require('ghc-iface.prl') + || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-iface.prl (recomp)!\n"); + &tidy_up_and_die(1,"$Pgm:recomp:why has $hifile_target already been read?\n") + if $HiHasBeenRead{'old'} == 1; + + &readHiFile('old',$hifile_target); + %ModUsed = (); + %Used = (); + + foreach $ul ( split(/;\n/, $Stuff{'old:usages'}) ) { + + $ul =~ /^(\S+)\s+(\d+)\s+:: (.*)/ || die "$Pgm: bad old usages line!\n"; + local($mod) = $1; + local($modver) = $2; + local(@thing) = split(/\s+/, $3); + + $ModUsed{$mod} = $modver; + + local($key, $n); + while ( $#thing >= 0 ) { + $key = "$mod:" . $thing[0]; + $n = $thing[1]; + $Used{$key} = $n; + shift @thing; shift @thing; # toss two + } + } + + # see if we can avoid recompilation just by peering at the + # module-version numbers: + + &makeHiMap() unless $HiMapDone; + + local($used_modules_have_changed) = 0; + used_mod: foreach $um ( keys %ModUsed ) { + if ( ! defined($HiMap{$um}) ) { + print STDERR "$Pgm:recompile:interface for used module $um no longer exists\n"; + foreach $hm ( keys %HiMap ) { + print STDERR "$hm ==> ", $HiMap{$hm}, "\n"; + } + return 1; + } else { + if ( $HiHasBeenRead{$um} ) { + print STDERR "$Pgm:very strange that $um.hi has already been read?!?\n" + } else { + &readHiFile($um, $HiMap{$um}); + } + } + if ( $ModUsed{$um} != $ModuleVersion{$um} ) { + print STDERR "used module version: $um: was: ",$ModUsed{$um}, "; is ", $ModuleVersion{$um}, "\n"; + $used_modules_have_changed = 1; + last used_mod; # no point continuing... + } + } + return 0 if ! $used_modules_have_changed; + + # well, some module version has changed, but maybe no + # entity of interest has... +print STDERR "considering used entities...\n"; + local($used_entities_have_changed) = 0; + + used_entity: foreach $ue ( keys %Used ) { + $ue =~ /([A-Z][A-Za-z0-9_']*):(.+)/; + local($ue_m) = $1; + local($ue_n) = $2; + + die "$Pgm:interface for used-entity module $ue_m doesn't exist\n" + if ! defined($HiMap{$ue_m}); + + &readHiFile($ue_m, $HiMap{$ue_m}) unless $HiHasBeenRead{$ue_m}; + # we might not have read it before... + + if ( !defined($Version{$ue}) ) { + print STDERR "No version info for $ue?!\n"; + + } elsif ( $Used{$ue} != $Version{$ue} ) { + print STDERR "$Pgm:recompile: used entity changed: $ue: was version ",$Used{$ue},"; is ", $Version{$ue}, "\n"; + $used_entities_have_changed = 1; + last used_entity; # no point continuing... + } + } + return 0 if ! $used_entities_have_changed; + + print STDERR "ifile $ifile:\t$i_mtime\n"; + print STDERR "ofile $ofile_target:\t$o_mtime\n"; + print STDERR "hifile $hifile_target:\t$hi_mtime\n"; + + return(1); # OK, *recompile* +} +\end{code} + +\begin{code} +# make "require"r happy... +1; +\end{code} |