[project @ 1997-12-17 13:14:21 by simonm]

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

diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl
index 5f606fb..67657b5 100644 (file)
--- a/ghc/driver/ghc-iface.lprl
+++ b/ghc/driver/ghc-iface.lprl
@@ -27,7 +27,7 @@ sub postprocessHiFile {
     print STDERR "*** New hi file follows...\n" if $Verbose;
     system("$Cat $hsc_hi 1>&2") if $Verbose;
 
-    &constructNewHiFile($hsc_hi, $hifile_target, $new_hi, $show_hi_diffs);
+    &constructNewHiFile($hsc_hi, *hifile_target, $new_hi, $show_hi_diffs);
 
     # run diff if they asked for it
     if ($show_hi_diffs) {
@@ -51,7 +51,7 @@ sub postprocessHiFile {
     # if we produced an interface file "no matter what",
     # print what we got on stderr (ToDo: honor -ohi flag)
     if ( $HiOnStdout ) {
-        system("$Cat $new_hi 1>&2") if $Verbose;
+        system("$Cat $new_hi 1>&2"); # if $Verbose;
     } else {
        &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
           "Replace .$HiSuffix file, if changed");
@@ -90,12 +90,20 @@ sub deUsagifyHi {
 \begin{code}
 sub constructNewHiFile {
     local($hsc_hi,         # The iface info produced by hsc.
-         $hifile_target,   # Pre-existing .hi filename (if it exists)
+         *hifile_target,   # Pre-existing .hi filename (if it exists)
          $new_hi,          # Filename for new one
          $show_hi_diffs) = @_;
+    local($hiname,$hidir);
 
-    &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
     &readHiFile('new',$hsc_hi)       unless $HiHasBeenRead{'new'} == 1;
+    if ($Specific_hi_file eq '') {  # -ohi is used even if  module name != stem of filename.
+        ($hiname = $hifile_target) =~ s/([^\/]*\/)*(.*)\.$HiSuffix/$2/;
+        if ($ModuleName{'new'} ne $hiname) {
+          ($hidir  = $hifile_target) =~ s/([^\/]*\/)*.*\.$HiSuffix/$1/;
+         $hifile_target = $hidir . $ModuleName{'new'} . ".$HiSuffix";
+        }
+    }
+    &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
 
     open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");
 
@@ -178,7 +186,7 @@ sub readHiFile {
        }
 
        if ( /^_interface_ ([A-Z]\S*) (\d+)/ ) {
-           $ModuleName{$mod}    = $1; # not sure this is used much...
+           $ModuleName{$mod}    = $1; # used to decide name of interface file.
            $ModuleVersion{$mod} = $2;
 
        } elsif ( /^_interface_ ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
@@ -187,13 +195,15 @@ sub readHiFile {
        } elsif ( /^_([a-z_]+)_$/ ) {
            $now_in = $1;
 
-       } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) {
+       } elsif ( $now_in eq 'usages' && /^(\S+)\s+(!\s+)?(\d+)\s+::(.*)/ ) {
            $Stuff{"$mod:usages"} .= $_; # save the whole thing
 
 
        } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities)$/ ) {
            $Stuff{"$mod:$1"} .= $_; # just save it up
 
+       } elsif ( /^--.*/ ) { # silently ignore comment lines.
+           ;
        } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
        # We're in a declaration
 
@@ -223,13 +233,10 @@ sub readHiFile {
                $Decl{"$mod:$current_name"} = $_;
                if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 
-           } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+.*where\s+\{.*\};/ ) {
+           } elsif ( /^class\s+(\{[^{}]*\}\s+=>\s+)?(\S+)\s+/ ) {
                # must be wary of => bit matching after "where"...
-               $current_name = $2;
-               $Decl{"$mod:$current_name"} = $_;
-               if ($mod eq "old") { $OldVersion{$current_name} = $version; }
-
-           } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
+               # ..hence the [^{}] part
+               # NB: a class decl may not have a where part at all
                $current_name = $2;
                $Decl{"$mod:$current_name"} = $_;
                if ($mod eq "old") { $OldVersion{$current_name} = $version; }
@@ -238,8 +245,6 @@ sub readHiFile {
                $Decl{"$mod:$current_name"} .= $_
            }
 
-       } elsif ( /^--.*/ ) { # silently ignore comment lines.
-           ;
        } else {
            print STDERR "$Pgm:junk old iface line?:section:$now_in:$_";
        }
@@ -293,22 +298,25 @@ sub mv_change {
 sub printNewItemVersion {
     local($hifile, $item, $mod_version, $show_hi_diffs) = @_;
     local($idecl) = $Decl{"new:$item"};
+    
 
     if (! defined($Decl{"old:$item"})) {       # Old decl doesn't exist
        if ($show_hi_diffs) {print STDERR "new: $item\n";}
        print $hifile  "$mod_version ";         # Use module version
 
-    } elsif ($idecl ne $Decl{"old:$item"})  {  # Old decl differs from new decl
-       local($odecl) = $Decl{"old:$item"};
-       if ($show_hi_diffs) {print STDERR "changed: $item\nOld: $odecl\nNew: $idecl\n";}
-       print $hifile  "$mod_version ";         # Use module version
-
     } elsif (! defined($OldVersion{"$item"}) ) {
        if ($show_hi_diffs) {print STDERR "$item: no old version?!\n";}
        print $hifile  "$mod_version ";                 # Use module version
 
+    } elsif ($idecl ne $Decl{"old:$item"})  {  # Old decl differs from new decl
+       local($odecl) = $Decl{"old:$item"};
+       if ($show_hi_diffs) {print STDERR "changed: $item\nOld: $odecl", "New: $idecl";}
+       print $hifile  "--old: ", $OldVersion{"$item"}, " $odecl" 
+                       if $Keep_HiDiffs;         # show old in interface file
+       print $hifile  "$mod_version ";           # Use module version
+
     } else {                                   # Identical decls, so use old version number
-       if ($show_hi_diffs) {print STDERR "$item: unchanged\n";}
+       #if ($show_hi_diffs) {print STDERR "$item: unchanged\n";}
        print $hifile  $OldVersion{"$item"}, " ";
     }
     return;