1 %************************************************************************
3 \section[Driver-iface-thing]{Interface-file handling}
5 %************************************************************************
9 %Decl = (); # details about individual definitions
10 %Stuff = (); # where we glom things together
11 %HiExists = ('old',-1, 'new',-1); # 1 <=> definitely exists; 0 <=> doesn't
12 %HiHasBeenRead = ('old', 0, 'new', 0);
13 %ModuleVersion = ('old', 0, 'new', 0);
17 sub postprocessHiFile {
18 local($hsc_hi, # The iface info produced by hsc.
19 $hifile_target, # The name both of the .hi file we
20 # already have and which we *might*
22 $going_interactive) = @_;
24 local($new_hi) = "$Tmp_prefix.hi-new";
26 print STDERR "*** New hi file follows...\n"
27 print STDERR `$Cat $hsc_hi`;
29 &constructNewHiFile($hsc_hi, $hifile_target, $new_hi);
31 # run diff if they asked for it
32 if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) {
33 if ( $HiDiff_flag eq 'usages' ) {
34 # lots of near-useless info; but if you want it...
35 &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0",
36 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
38 # strip out usages, *then* run diff
39 local($hi_before) = "$Tmp_prefix.hi-before";
40 local($hi_after) = "$Tmp_prefix.hi-now";
42 &deUsagifyHi($hifile_target, $hi_before);
43 &deUsagifyHi($new_hi, $hi_after);
45 &run_something("$Cmp -s $hi_before $hi_after || $Diff $hi_before $hi_after 1>&2 || exit 0",
46 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
50 # if we produced an interface file "no matter what",
51 # print what we got on stderr (ToDo: honor -ohi flag)
53 print STDERR `$Cat $new_hi`;
55 &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
56 "Replace .$HiSuffix file, if changed");
61 local($ifile,$ofile) = @_;
63 open(OLDHIF, "< $ifile") || &tidy_up_and_die(1,"Can't open $ifile (read)\n");
64 open(NEWHIF, "> $ofile") || &tidy_up_and_die(1,"Can't open $ofile (write)\n");
66 # read up to _usages_ line
68 while ($_ ne '' && ! /^_usages_/) {
69 print NEWHIF $_ unless /^(_interface_ |\{-# GHC_PRAGMA)/;
73 # skip to next _<anything> line
75 while ($_ ne '' && ! /^_/) { $_ = <OLDHIF>; }
84 close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
85 close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
90 sub constructNewHiFile {
91 local($hsc_hi, # The iface info produced by hsc.
92 $hifile_target, # Pre-existing .hi filename (if it exists)
93 $new_hi) = @_; # Filename for new one
95 &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
96 &readHiFile('new',$hsc_hi) unless $HiHasBeenRead{'new'} == 1;
98 open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");
100 local(@decl_names) = (); # Entities in _declarations_ section of new module
101 foreach $v (sort (keys %Decl)) {
102 next unless $v =~ /^new:(.*$)/;
103 push(@decl_names,$1);
106 local($new_module_version) = &calcNewModuleVersion(@decl_names);
107 print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version\n";
109 if ( $Stuff{'new:instance_modules'} ) {
110 print NEWHI "_instance_modules_\n";
111 print NEWHI $Stuff{'new:instance_modules'};
114 print NEWHI "_usages_\n", $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
116 print NEWHI "_exports_\n";
117 print NEWHI $Stuff{'new:exports'};
119 if ( $Stuff{'new:fixities'} ) {
120 print NEWHI "_fixities_\n";
121 print NEWHI $Stuff{'new:fixities'};
124 if ( $Stuff{'new:instances'} ) {
125 print NEWHI "_instances_\n";
126 print NEWHI $Stuff{'new:instances'};
129 print NEWHI "_declarations_\n";
130 foreach $v (@decl_names) {
131 &printNewItemVersion(NEWHI, $v, $new_module_version); # Print new version number
132 print NEWHI $Decl{"new:$v"}; # Print the new decl itself
137 close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n");
143 local($mod, # module to read; can be special tag 'old'
144 # (old .hi file for module being compiled) or
145 # 'new' (new proto-.hi file for...)
146 $hifile) = @_; # actual file to read
148 # info about the old version of this module's interface
149 $HiExists{$mod} = -1; # 1 <=> definitely exists; 0 <=> doesn't
150 $HiHasBeenRead{$mod} = 0;
151 $ModuleVersion{$mod} = 0;
152 $Stuff{"$mod:instance_modules"} = '';
153 $Stuff{"$mod:usages"} = ''; # stuff glommed together
154 $Stuff{"$mod:exports"} = '';
155 $Stuff{"$mod:fixities"} = '';
156 $Stuff{"$mod:instances"} = '';
157 $Stuff{"$mod:declarations"} = '';
159 if (! -f $hifile) { # no pre-existing .hi file
164 open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n");
167 hi_line: while (<HIFILE>) {
168 next if /^ *$/; # blank line
169 next if /\{-# GHC_PRAGMA INTERFACE VERSION 20 #-\}/;
171 # avoid pre-1.3 interfaces
172 #print STDERR "now_in:$now_in:$_";
173 if ( /\{-# GHC_PRAGMA INTERFACE VERSION . #-\}/ ) {
178 if ( /^_interface_ ([A-Z]\S*) (\d+)/ ) {
179 $ModuleName{$mod} = $1; # not sure this is used much...
180 $ModuleVersion{$mod} = $2;
182 } elsif ( /^_interface_ ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
183 $ModuleName{'new'} = $1;
185 } elsif ( /^_([a-z_]+)_$/ ) {
188 } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) {
189 $Stuff{"$mod:usages"} .= $_; # save the whole thing
192 } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities)$/ ) {
193 $Stuff{"$mod:$1"} .= $_; # just save it up
195 } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
196 # We're in a declaration
198 # Strip off the initial version number, if any
199 if ( /^([0-9]+) (.*\n)/ ) {
200 # The "\n" is because we need to keep the newline at the end, so that
201 # it looks the same as if there's no version number and this if statement
204 # So there's an initial version number
209 if ( /^(\S+)\s+::\s+/ ) {
211 $Decl{"$mod:$current_name"} = $_;
212 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
214 } elsif ( /^type\s+(\S+)/ ) {
216 $Decl{"$mod:$current_name"} = $_;
217 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
219 } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
221 $Decl{"$mod:$current_name"} = $_;
222 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
224 } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+.*where\s+\{.*\};/ ) {
225 # must be wary of => bit matching after "where"...
227 $Decl{"$mod:$current_name"} = $_;
228 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
230 } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
232 $Decl{"$mod:$current_name"} = $_;
233 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
235 } else { # Continuation line
236 $Decl{"$mod:$current_name"} .= $_
240 print STDERR "$Pgm:junk old iface line?:section:$now_in:$_";
244 # foreach $i ( sort (keys %Decl)) {
245 # print STDERR "$i: ",$Decl{$i}, "\n";
248 close(HIFILE) || &tidy_up_and_die(1,"Failed reading from $hifile\n");
249 $HiHasBeenRead{$mod} = 1;
254 sub calcNewModuleVersion {
255 local (@decl_names) = @_;
257 return(&mv_change(1,'no old .hi file')) if $HiExists{'old'} == 0;
258 # could use "time()" as initial version; if a module existed, then was deleted,
259 # then comes back, we don't want the resurrected one to have an
260 # lower version number than the original (in case there are any
261 # lingering references to the original in other .hi files).
263 local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
264 local($changed_version) = $unchanged_version + 1;
266 # This statement is curious; it is subsumed by the foreach!
267 # return(&mv_change($changed_version,'usages changed')) if $Stuff{'old:usages'} ne $Stuff{'new:usages'};
269 foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) {
270 return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
273 # Decl need separate treatment; they aren't in $Stuff
274 foreach $v (@decl_names) {
275 return(&mv_change($changed_version,"$v changed")) if $Decl{"old:$v"} ne $Decl{"new:$v"};
278 print STDERR "Module version unchanged at $unchanged_version\n";
279 return($unchanged_version);
283 local($mv, $str) = @_;
285 print STDERR "$Pgm: module version changed to $mv; reason: $str\n";
289 sub printNewItemVersion {
290 local($hifile, $item, $mod_version) = @_;
291 local($idecl) = $Decl{"new:$item"};
293 if (! defined($Decl{"old:$item"})) { # Old decl doesn't exist
294 print STDERR "new: $item\n";
295 print $hifile "$mod_version "; # Use module version
297 } elsif ($idecl ne $Decl{"old:$item"}) { # Old decl differs from new decl
298 local($odecl) = $Decl{"old:$item"};
299 # print STDERR "changed: $item\nOld: $odecl\nNew: $idecl\n";
300 print $hifile "$mod_version "; # Use module version
302 } elsif (! defined($OldVersion{"$item"}) ) {
303 print STDERR "$item: no old version?!\n";
304 print $hifile "$mod_version "; # Use module version
306 } else { # Identical decls, so use old version number
307 print STDERR "$item: unchanged\n";
308 print $hifile $OldVersion{"$item"}, " ";
316 local($hsc_hi, # The iface info produced by hsc.
317 $hifile_target) = @_; # Pre-existing .hi filename (if it exists)
322 # make "require"r happy...