%HiHasBeenRead = ('old', 0, 'new', 0);
%ModuleVersion = ('old', 0, 'new', 0);
-
+%HiSections = ();
sub postprocessHiFile {
local($hsc_hi, # The iface info produced by hsc.
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) {
# 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;
+ 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");
close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
}
+
+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 ( /^_(.*)_/ && $HiSection{$1} ) {
+ do { print NEWHIF $_;
+ $_ = <OLDHIF>;} until ($_ eq '' || /^_/ );
+ } 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)
+ *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");
}
local($new_module_version) = &calcNewModuleVersion(@decl_names);
- print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version\n";
+ print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version $GhcVersionInfo\n";
if ( $Stuff{'new:instance_modules'} ) {
print NEWHI "_instance_modules_\n";
}
\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'
last hi_line;
}
- if ( /^_interface_ ([A-Z]\S*) (\d+)/ ) {
- $ModuleName{$mod} = $1; # not sure this is used much...
+ if ( /^_interface_ ([A-Z]\S*) (\d+)/ && $mod ne 'new' ) {
+ $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
+ } elsif ( /^_interface_ ([A-Z]\S*) (\d+)/ && $mod eq 'new' ) { # special case: no version
$ModuleName{'new'} = $1;
} elsif ( /^_([a-z_]+)_$/ ) {
}
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; }
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);
}
} 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;
\end{code}
\begin{code}
-sub findHiChanges {
- local($hsc_hi, # The iface info produced by hsc.
- $hifile_target) = @_; # Pre-existing .hi filename (if it exists)
-}
-\end{code}
-
-\begin{code}
# make "require"r happy...
1;
\end{code}
projects / ghc-hetmet.git / blobdiff