[project @ 1996-06-27 15:55:53 by partain]

[ghc-hetmet.git] / ghc / driver / ghc-recomp.lprl

diff --git a/ghc/driver/ghc-recomp.lprl b/ghc/driver/ghc-recomp.lprl
new file mode 100644 (file)
index 0000000..3414605
--- /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}