%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)
+ # print what we got on stderr.
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");
# 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");
+}
+\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>;
}
}
\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);
+ 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) = $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;
- &readHiFile('new',$hsc_hi) unless $HiHasBeenRead{'new'} == 1;
open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");
- local(@decl_names) = (); # Entities in _declarations_ section of new module
+ local(@decl_names) = (); # Declarations in new module
foreach $v (sort (keys %Decl)) {
next unless $v =~ /^new:(.*$)/;
push(@decl_names,$1);
}
local($new_module_version) = &calcNewModuleVersion(@decl_names);
- print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version\n";
-
- if ( $Stuff{'new:instance_modules'} ) {
- print NEWHI "_instance_modules_\n";
- print NEWHI $Stuff{'new:instance_modules'};
- }
-
- print NEWHI "_usages_\n", $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
-
- print NEWHI "_exports_\n";
+ print NEWHI "__interface ", $ModuleName{'new'}, " $new_module_version $Orphan{'new'} $ProjectVersionInt where\n";
print NEWHI $Stuff{'new:exports'};
+ print NEWHI $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
+ print NEWHI $Stuff{'new:instances'} unless $Stuff{'new:instances'} eq '';
- if ( $Stuff{'new:fixities'} ) {
- print NEWHI "_fixities_\n";
- print NEWHI $Stuff{'new:fixities'};
- }
-
- if ( $Stuff{'new:instances'} ) {
- print NEWHI "_instances_\n";
- print NEWHI $Stuff{'new:instances'};
- }
-
- print NEWHI "_declarations_\n";
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
}
-
-
+ print NEWHI $Stuff{'new:rules'} unless $Stuff{'new:rules'} eq '';
+ print NEWHI $Stuff{'new:deprecations'} unless $Stuff{'new:deprecations'} eq '';
close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\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'
$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:fixities"} = '';
$Stuff{"$mod:instances"} = '';
$Stuff{"$mod:declarations"} = '';
+ $Stuff{"$mod:rules"} = '';
+ $Stuff{"$mod:deprecations"} = '';
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;
+ if ( /^__interface ([A-Z]\S*) (\d+)( \!)?/ ) {
+ if ( $mod ne 'new' ) {
+ # Reading old .hi file
+ $ModuleVersion{$mod} = $2;
+ }
- } elsif ( /^_([a-z_]+)_$/ ) {
- $now_in = $1;
+ $ModuleName{$mod} = $1; # used to decide name of iface file.
+ $Orphan{$mod} = $3;
+ # optional "!" indicates that the
+ # module contains orphan rules or instance decls
- } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) {
+ } elsif ( /^import / ) {
$Stuff{"$mod:usages"} .= $_; # save the whole thing
+ } elsif ( /^__export/ ) {
+ $Stuff{"$mod:exports"} .= $_;
- } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities)$/ ) {
- $Stuff{"$mod:$1"} .= $_; # just save it up
+ } elsif ( /^instance / ) {
+ $Stuff{"$mod:instances"} .= $_;
- } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
- # We're in a declaration
+ } elsif ( /^{-## __R / ) {
+ $Stuff{"$mod:rules"} .= $_;
+
+ } elsif ( /^{-## __D / ) {
+ $Stuff{"$mod:deprecations"} .= $_;
+
+ } elsif ( /^-[-]+ .*/ ) { # silently ignore comment lines.
+ ;
+ } else { # We're in a declaration
# Strip off the initial version number, if any
- if ( /^([0-9]+) (.*\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.
+ 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 ( /^(\S+)\s+_:_\s+/ ) {
- $current_name = $1;
- $Decl{"$mod:$current_name"} = $_;
- if ($mod eq "old") { $OldVersion{$current_name} = $version; }
- } elsif ( /^type\s+(\S+)/ ) {
- $current_name = $1;
+ 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+/ ) {
- $current_name = $3;
+ } elsif ( /^(newtype|data)\s+({.*}\s+=>\s+)?(\S+)\s+/ ) {
+ # Data declaration
+ # The (...)? parts skips over the context of a data decl
+ # to find the name of the type constructor. The curly
+ # brackets are part of the iface file syntax for contexts
+ $current_name = "data $3";
$Decl{"$mod:$current_name"} = $_;
if ($mod eq "old") { $OldVersion{$current_name} = $version; }
- } elsif ( /^class\s+(\{[^{}]*\}\s+=>\s+)?(\S+)\s+/ ) {
+ } 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; }
+
+ } elsif ( /^infix(r|l)?\s+[0-9]\s+(\S+)/ ) {
+ # fixity declaration
+ $current_name = "fixity $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"} .= $_
}
- } elsif ( /^--.*/ ) { # silently ignore comment lines.
- ;
- } 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;
}
local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
local($changed_version) = $unchanged_version + 1;
-# This statement is curious; it is subsumed by the foreach!
-# return(&mv_change($changed_version,'usages changed')) if $Stuff{'old:usages'} ne $Stuff{'new:usages'};
+ if ($Orphan{'old'} ne $Orphan{'new'}) {
+ return(&mv_change($changed_version, "orphan-hood changed"));
+ }
- foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) {
+ foreach $t ( 'usages' , 'exports', 'instances', 'fixities', 'rules', 'deprecations' ) {
return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
}
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"
+ if $Verbose;
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"
+ if $Verbose;
return($mv);
}
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: $odeclNew: $idecl";}
- 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;
\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