[project @ 1999-02-18 17:55:40 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 7bcd3c6..e9f2df0 100644 (file)
--- a/ghc/driver/ghc-iface.lprl
+++ b/ghc/driver/ghc-iface.lprl
@@ -49,9 +49,21 @@ sub postprocessHiFile {
     }
 
     # if we produced an interface file "no matter what",
-    # print what we got on stderr (ToDo: honor -ohi flag)
+    # print what we got on stderr.
     if ( $HiOnStdout ) {
-       system("$Cat $new_hi 1>&2");
+        if ( $HiWith ne '' ) {
+           # output some of the sections
+           local($hi_after)  = "$Tmp_prefix.hi-now";
+
+           foreach $hi ( split(' ',$HiWith) ) { 
+               $HiSection{$hi} = 1; 
+           }
+           &hiSectionsOnly($new_hi, $hi_after);
+
+           system("$Cat $hi_after 1>&2 ; $Rm $hi_after; ");
+       } else {
+            system("$Cat $new_hi 1>&2");
+       }
     } else {
        &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
           "Replace .$HiSuffix file, if changed");
@@ -77,19 +89,57 @@ sub deUsagifyHi {
 \end{code}
 
 \begin{code}
+sub hiSectionsOnly {
+    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 '' ) {
+       if ( /^__export/ && $HiSection {'exports'}           ||
+            /^import /  && $HiSection {'imports'}           ||
+            /^\d+ ([^ ]+ :: |type |data |class |newtype )/  && $HiSection {'declarations'} ||
+            /^instance / && $HiSection {'instances'} ) {
+                    print NEWHIF $_;
+                    $_ = <OLDHIF>;
+        } else {
+          $_ = <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}
 sub constructNewHiFile {
     local($hsc_hi,         # The iface info produced by hsc.
          *hifile_target,   # Pre-existing .hi filename (if it exists)
          $new_hi,          # Filename for new one
          $show_hi_diffs) = @_;
     local($hiname,$hidir);
-
+    local($mod_name_dec);
+    
     &readHiFile('new',$hsc_hi)       unless $HiHasBeenRead{'new'} == 1;
+
+    # Sigh, we need decode the module name found in the interface file
+    # since that's the (base)name we want to use when outputting the
+    # interface file.
+    $mod_name_dec = $ModuleName{'new'};
+    $mod_name_dec =~ s/zz/z/g;
+    $mod_name_dec =~ s/ZZ/Z/g;
+
     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";
+        ($hiname = $hifile_target) = $1 if  $hifile_target =~ /\/?([^\/]+)\.$HiSuffix$/;
+        if ( $mod_name_dec ne $hiname ) {
+         $hidir = '';
+         # strip off basename only if we've got a dirname.
+          ($hidir  = $hifile_target) =~ s/(.*\/)[^\/]*$/$1/
+                     if ( $hifile_target =~ /\/$hiname\.$HiSuffix/ ); 
+         $hifile_target = $hidir . $mod_name_dec . ".$HiSuffix";
         }
     }
     &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
@@ -178,7 +228,7 @@ sub readHiFile {
        } elsif ( /^instance / ) {
            $Stuff{"$mod:instances"} .= $_;
 
-       } elsif ( /^--.*/ ) { # silently ignore comment lines.
+       } elsif ( /^-[-]+ .*/ ) { # silently ignore comment lines.
            ;
        } else {  # We're in a declaration