[project @ 1998-02-05 12:23:33 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 7f4cb66..0fd3fb1 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) {
@@ -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");
 
@@ -140,6 +148,20 @@ sub constructNewHiFile {
 }
 \end{code}
 
+Read the .hi file made by the compiler, or the old one.
+All the declarations in the file are stored in
+
+       $Decl{"$mod:$v"}
+
+where $mod is "new" or "old", depending on whether it's the new or old
+       .hi file that's being read.
+
+and $v is
+       for values v    "v"
+       for tycons T    "type T" or "data T"
+       for classes C   "class C"
+
+
 \begin{code}
 sub readHiFile {
     local($mod,                    # module to read; can be special tag 'old'
@@ -178,7 +200,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
@@ -211,25 +233,29 @@ sub readHiFile {
           }
        
            if ( /^(\S+)\s+_:_\s+/ ) {
+                       # Value declaration
                $current_name = $1;
                $Decl{"$mod:$current_name"} = $_;
                if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 
            } elsif ( /^type\s+(\S+)/ ) {
-               $current_name = $1;
+                       # Type declaration      
+               $current_name = "type $1";
                $Decl{"$mod:$current_name"} = $_;
                if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 
            } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
-               $current_name = $3;
+                       # Data declaration      
+               $current_name = "data $3";
                $Decl{"$mod:$current_name"} = $_;
                if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 
            } elsif ( /^class\s+(\{[^{}]*\}\s+=>\s+)?(\S+)\s+/ ) {
+                       # Class declaration     
                # must be wary of => bit matching after "where"...
                # ..hence the [^{}] part
                # NB: a class decl may not have a where part at all
-               $current_name = $2;
+               $current_name = "class $2";
                $Decl{"$mod:$current_name"} = $_;
                if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 
@@ -276,7 +302,7 @@ sub calcNewModuleVersion {
        return(&mv_change($changed_version,"$v changed")) if $Decl{"old:$v"} ne $Decl{"new:$v"};
     }
     
-    print STDERR "Module version unchanged at $unchanged_version\n";
+    print STDERR "$Pgm: module version unchanged at $unchanged_version\n";
     return($unchanged_version);
 }
 
@@ -302,13 +328,13 @@ sub printNewItemVersion {
 
     } 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: $odeclNew: $idecl";}
+       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;