%************************************************************************
\begin{code}
+%OldVersion = ();
+%Decl = (); # details about individual definitions
+%Stuff = (); # where we glom things together
+%HiExists = ('old',-1, 'new',-1); # 1 <=> definitely exists; 0 <=> doesn't
+%HiHasBeenRead = ('old', 0, 'new', 0);
+%ModuleVersion = ('old', 0, 'new', 0);
+
+%HiSections = ();
+
sub postprocessHiFile {
local($hsc_hi, # The iface info produced by hsc.
$hifile_target, # The name both of the .hi file we
$going_interactive) = @_;
local($new_hi) = "$Tmp_prefix.hi-new";
+ local($show_hi_diffs) = $HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target;
-# print STDERR `$Cat $hsc_hi`;
+ print STDERR "*** New hi file follows...\n" if $Verbose;
+ system("$Cat $hsc_hi 1>&2") if $Verbose;
- &constructNewHiFile($hsc_hi, $hifile_target, $new_hi);
+ &constructNewHiFile($hsc_hi, *hifile_target, $new_hi, $show_hi_diffs);
# run diff if they asked for it
- if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) {
+ if ($show_hi_diffs) {
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",
# if we produced an interface file "no matter what",
# print what we got on stderr (ToDo: honor -ohi flag)
if ( $HiOnStdout ) {
- print STDERR `$Cat $new_hi`;
+ 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");
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
+ # read up to _usages_ line
$_ = <OLDHIF>;
- while ($_ ne '' && ! /^__usages__/) {
- print NEWHIF $_ unless /^(interface |\{-# GHC_PRAGMA)/;
+ while ($_ ne '') {
+ print NEWHIF $_ unless /^(__interface|import)/;
$_ = <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");
\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
+ *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();
- print NEWHI "interface ", $ModuleName{'new'}, " $new_module_version\n";
-
- print NEWHI "__usages__\n", $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
-
- local(@version_keys) = sort (keys %Version);
- local($num_ver_things) = 0;
- foreach $v (@version_keys) {
+ local(@decl_names) = (); # Declarations in new module
+ foreach $v (sort (keys %Decl)) {
next unless $v =~ /^new:(.*$)/;
- last if $num_ver_things >= 1;
- $num_ver_things++;
+ push(@decl_names,$1);
}
- print NEWHI "__versions__\n" unless $num_ver_things < 1;
- foreach $v (@version_keys) {
- next unless $v =~ /^new:(.*$)/;
- $v = $1;
-
- &printNewItemVersion($v, $new_module_version), "\n";
- }
+ local($new_module_version) = &calcNewModuleVersion(@decl_names);
+ print NEWHI "__interface ", $ModuleName{'new'}, " $new_module_version $ProjectVersionInt where\n";
- print NEWHI "__exports__\n";
+ print NEWHI $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
+ print NEWHI $Stuff{'new:instance_modules'} unless $Stuff{'new:instance_modules'} eq '';
print NEWHI $Stuff{'new:exports'};
+ print NEWHI $Stuff{'new:fixities'} unless $Stuff{'new:fixities'} eq '';
+ print NEWHI $Stuff{'new:instances'} unless $Stuff{'new:instances'} eq '';
- if ( $Stuff{'new:instance_modules'} ) {
- print NEWHI "__instance_modules__\n";
- print NEWHI $Stuff{'new:instance_modules'};
+ foreach $v (@decl_names) {
+ &printNewItemVersion(NEWHI, $v, $new_module_version, $show_hi_diffs); # Print new version number
+ print NEWHI $Decl{"new:$v"}; # Print the new decl itself
}
- if ( $Stuff{'new:fixities'} ) {
- print NEWHI "__fixities__\n";
- print NEWHI $Stuff{'new:fixities'};
- }
+ close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n");
+}
+\end{code}
- if ( $Stuff{'new:declarations'} ) {
- print NEWHI "__declarations__\n";
- print NEWHI $Stuff{'new:declarations'};
- }
+Read the .hi file made by the compiler, or the old one.
+All the declarations in the file are stored in
- if ( $Stuff{'new:instances'} ) {
- print NEWHI "__instances__\n";
- print NEWHI $Stuff{'new:instances'};
- }
+ $Decl{"$mod:$v"}
- if ( $Stuff{'new:pragmas'} ) {
- print NEWHI "__pragmas__\n";
- print NEWHI $Stuff{'new:pragmas'};
- }
+where $mod is "new" or "old", depending on whether it's the new or old
+ .hi file that's being read.
- close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n");
-}
-\end{code}
+and $v is
+ for values v "v"
+ for tycons T "type T" or "data T"
+ for classes C "class C"
-\begin{code}
-%Version = ();
-%Decl = (); # details about individual definitions
-%Stuff = (); # where we glom things together
-%HiExists = ('old',-1, 'new',-1); # 1 <=> definitely exists; 0 <=> doesn't
-%HiHasBeenRead = ('old', 0, 'new', 0);
-%ModuleVersion = ('old', 0, 'new', 0);
+\begin{code}
sub readHiFile {
local($mod, # module to read; can be special tag 'old'
# (old .hi file for module being compiled) or
$HiExists{$mod} = -1; # 1 <=> definitely exists; 0 <=> doesn't
$HiHasBeenRead{$mod} = 0;
$ModuleVersion{$mod} = 0;
+ $Stuff{"$mod:instance_modules"} = '';
$Stuff{"$mod:usages"} = ''; # stuff glommed together
$Stuff{"$mod:exports"} = '';
- $Stuff{"$mod:instance_modules"} = '';
- $Stuff{"$mod:instances"} = '';
$Stuff{"$mod:fixities"} = '';
+ $Stuff{"$mod:instances"} = '';
$Stuff{"$mod:declarations"} = '';
- $Stuff{"$mod:pragmas"} = '';
if (! -f $hifile) { # no pre-existing .hi file
$HiExists{$mod} = 0;
open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n");
$HiExists{$mod} = 1;
- 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:$_";
- if ( /\{-# GHC_PRAGMA INTERFACE VERSION . #-\}/ ) {
- $HiExists{$mod} = 0;
- last hi_line;
- }
-
- if ( /^interface ([A-Z]\S*) (\d+)/ ) {
- $ModuleName{$mod} = $1; # not sure this is used much...
- $ModuleVersion{$mod} = $2;
- } elsif ( /^interface ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
- $ModuleName{'new'} = $1;
-
- } elsif ( /^__([a-z]+)__$/ ) {
- $now_in = $1;
+ if ( /^__interface ([A-Z]\S*) (\d+)/ ) {
+ if ( $mod ne 'new' ) {
+ $ModuleVersion{$mod} = $2;
+ }
+ $ModuleName{$mod} = $1; # used to decide name of iface file.
- } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) {
+ } elsif ( /^import / ) {
$Stuff{"$mod:usages"} .= $_; # save the whole thing
- } elsif ( $now_in eq 'versions' && /^(\S+) (\d+)/ ) {
- local($item) = $1;
- local($n) = $2;
-#print STDERR "version read:item=$item, n=$n, line=$_";
- $Version{"$mod:$item"} = $n;
-
- } elsif ( $now_in eq 'versions' && /^(\S+)/ && $mod eq 'new') { # doesn't have versions
- local($item) = $1;
-#print STDERR "new version read:item=$item, line=$_";
- $Version{"$mod:$item"} = 'y'; # stub value...
-
- } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities|pragmas)$/ ) {
- $Stuff{"$mod:$1"} .= $_; # just save it up
-
- } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
- $Stuff{"$mod:declarations"} .= $_; # just save it up
-
- if ( /^[A-Z][A-Za-z0-9_']*\.(\S+)\s+::\s+/ ) {
- $Decl{"$mod:$1"} = $_;
-
- } elsif ( /^type\s+[A-Z][A-Za-z0-9_']*\.(\S+)/ ) {
- $Decl{"$mod:$1"} = $_;
-
- } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+/ ) {
- $Decl{"$mod:$3"} = $_;
-
- } elsif ( /class\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+.*where\s+\{.*\};/ ) {
- $Decl{"$mod:$2"} = $_; # must be wary of => bit matching after "where"...
- } elsif ( /class\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+/ ) {
- $Decl{"$mod:$2"} = $_;
-
- } else { # oh, well...
- print STDERR "$Pgm: decl line didn't match?\n$_";
+ } elsif ( /^__instimport/ ) {
+ $Stuff{"$mod:instance_modules"} .= $_;
+
+ } elsif ( /^__export/ ) {
+ $Stuff{"$mod:exports"} .= $_;
+
+ } elsif ( /^infix(r|l)? / ) {
+ $Stuff{"$mod:fixities"} .= $_;
+
+ } elsif ( /^instance / ) {
+ $Stuff{"$mod:instances"} .= $_;
+
+ } elsif ( /^--.*/ ) { # silently ignore comment lines.
+ ;
+ } else { # We're in a declaration
+
+ # Strip off the initial version number, if any
+ if ( /^([0-9]+)\s+(.*\n)/ ) {
+
+ # The "\n" is because we need to keep the newline at
+ # the end, so that it looks the same as if there's no version
+ # number and this if statement doesn't fire.
+
+ # So there's an initial version number
+ $version = $1;
+ $_ = $2;
+ }
+
+ if ( /^type\s+(\S+)/ ) {
+ # 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+/ ) {
+ # 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 = "class $2";
+ $Decl{"$mod:$current_name"} = $_;
+ if ($mod eq "old") { $OldVersion{$current_name} = $version; }
+
+ } elsif ( /^(\S+)\s+::\s+/ ) {
+ # Value declaration
+ $current_name = $1;
+ $Decl{"$mod:$current_name"} = $_;
+ if ($mod eq "old") { $OldVersion{$current_name} = $version; }
+
+ } else { # Continuation line
+ print STDERR "$Pgm:junk old iface line?:$_";
+ # $Decl{"$mod:$current_name"} .= $_
}
- } else {
- print STDERR "$Pgm:junk old iface line?:section:$now_in:$_";
- }
+ }
}
-# foreach $i ( sort (keys %Decl)) {
-# print STDERR "$i: ",$Decl{$i}, "\n";
-# }
-
close(HIFILE) || &tidy_up_and_die(1,"Failed reading from $hifile\n");
$HiHasBeenRead{$mod} = 1;
}
\begin{code}
sub calcNewModuleVersion {
+ local (@decl_names) = @_;
return(&mv_change(1,'no old .hi file')) if $HiExists{'old'} == 0;
# could use "time()" as initial version; if a module existed, then was deleted,
local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
local($changed_version) = $unchanged_version + 1;
- return(&mv_change($changed_version,'usages changed')) if $Stuff{'old:usages'} ne $Stuff{'new:usages'};
-
- foreach $t ( 'exports', 'instance_modules', 'instances', 'fixities', 'declarations', 'pragmas' ) {
+ foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) {
return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
}
+# Decl need separate treatment; they aren't in $Stuff
+ foreach $v (@decl_names) {
+ return(&mv_change($changed_version,"$v changed")) if $Decl{"old:$v"} ne $Decl{"new:$v"};
+ }
+
+ print STDERR "$Pgm: module version unchanged at $unchanged_version\n";
return($unchanged_version);
}
sub mv_change {
local($mv, $str) = @_;
-#print STDERR "$Pgm: module version changed to $mv; reason: $str\n";
+ print STDERR "$Pgm: module version changed to $mv; reason: $str\n";
return($mv);
}
sub printNewItemVersion {
- local($item, $mod_version) = @_;
-
- if (! defined($Decl{"new:$item"}) ) {
-# it's OK, because the thing is almost-certainly wired-in
-# print STDERR "$item: no decl?! (nothing into __versions__)\n";
- return;
- }
-
+ local($hifile, $item, $mod_version, $show_hi_diffs) = @_;
local($idecl) = $Decl{"new:$item"};
-
- if (! defined($Decl{"old:$item"})) {
-#print STDERR "new: $item\n";
- print NEWHI "$item $mod_version\n";
- } elsif ($idecl ne $Decl{"old:$item"}) {
-#print STDERR "changed: $item\n";
- print NEWHI "$item $mod_version\n";
- } elsif (! defined($Version{"old:$item"}) ) {
-#print STDERR "$item: no old version?!\n"
- } else {
- print NEWHI "$item ", $Version{"old:$item"}, "\n";
+
+
+ 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 (! 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";}
+ 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