[project @ 1996-07-25 20:43:49 by partain]

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

diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl
index 5f0fe31..6d3bde1 100644 (file)
--- a/ghc/driver/ghc-iface.lprl
+++ b/ghc/driver/ghc-iface.lprl
@@ -20,8 +20,21 @@ sub postprocessHiFile {
 
     # run diff if they asked for it
     if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) {
 
     # run diff if they asked for it
     if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) {

-       &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0",
-           "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
+       if ( $HiDiff_flag eq 'usages' ) {
+           # lots of near-useless info; but if you want it...
+           &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0",
+               "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
+       } else {
+           # strip out usages, *then* run diff
+           local($hi_before) = "$Tmp_prefix.hi-before";
+           local($hi_after)  = "$Tmp_prefix.hi-now";
+
+           &deUsagifyHi($hifile_target, $hi_before);
+           &deUsagifyHi($new_hi,        $hi_after);
+
+           &run_something("$Cmp -s $hi_before $hi_after || $Diff $hi_before $hi_after 1>&2 || exit 0",
+               "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
+       }

     }
 
     # if we produced an interface file "no matter what",
     }
 
     # if we produced an interface file "no matter what",

@@ -33,6 +46,34 @@ sub postprocessHiFile {
           "Replace .$HiSuffix file, if changed");
     }
 }
           "Replace .$HiSuffix file, if changed");
     }
 }

+
+sub deUsagifyHi {
+    local($ifile,$ofile) = @_;
+
+    open(OLDHIF, "< $ifile") || &tidy_up_and_die(1,"Can't open $ifile (read)\n");
+    open(NEWHIF, "> $ofile") || &tidy_up_and_die(1,"Can't open $ofile (write)\n");
+
+    # read up to __usages__ line
+    $_ = <OLDHIF>;
+    while ($_ ne '' && ! /^__usages__/) {
+       print NEWHIF $_ unless /^(interface |\{-# GHC_PRAGMA)/;
+       $_ = <OLDHIF>;
+    }
+    if ( $_ ne '' ) {
+       # skip to next __<anything> line
+       $_ = <OLDHIF>;
+       while ($_ ne '' && ! /^__/) { $_ = <OLDHIF>; }
+
+       # print the rest
+       while ($_ ne '') {
+           print NEWHIF $_;
+           $_ = <OLDHIF>;
+       }
+    }
+
+    close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
+    close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
+}

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -135,6 +176,7 @@ sub readHiFile {
     local($now_in) = '';
     hi_line: while (<HIFILE>) {
        next if /^ *$/; # blank line
     local($now_in) = '';
     hi_line: while (<HIFILE>) {
        next if /^ *$/; # blank line

+       next if /\{-# GHC_PRAGMA INTERFACE VERSION 20 #-\}/;

 
        # avoid pre-1.3 interfaces
 #print STDERR "now_in:$now_in:$_";
 
        # avoid pre-1.3 interfaces
 #print STDERR "now_in:$now_in:$_";

@@ -237,7 +279,8 @@ sub printNewItemVersion {
     local($item, $mod_version) = @_;
 
     if (! defined($Decl{"new:$item"}) ) {
     local($item, $mod_version) = @_;
 
     if (! defined($Decl{"new:$item"}) ) {

-       print STDERR "$item: no decl?! (nothing into __versions__)\n";
+# it's OK, because the thing is almost-certainly wired-in
+#      print STDERR "$item: no decl?! (nothing into __versions__)\n";

        return;
     }
 
        return;
     }