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";
25 local($show_hi_diffs) = $HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target;
27 print STDERR "*** New hi file follows...\n" if $Verbose;
28 system("$Cat $hsc_hi 1>&2") if $Verbose;
30 &constructNewHiFile($hsc_hi, *hifile_target, $new_hi, $show_hi_diffs);
32 # run diff if they asked for it
34 if ( $HiDiff_flag eq 'usages' ) {
35 # lots of near-useless info; but if you want it...
36 &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0",
37 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
39 # strip out usages, *then* run diff
40 local($hi_before) = "$Tmp_prefix.hi-before";
41 local($hi_after) = "$Tmp_prefix.hi-now";
43 &deUsagifyHi($hifile_target, $hi_before);
44 &deUsagifyHi($new_hi, $hi_after);
46 &run_something("$Cmp -s $hi_before $hi_after || $Diff $hi_before $hi_after 1>&2 || exit 0",
47 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
51 # if we produced an interface file "no matter what",
52 # print what we got on stderr.
54 if ( $HiWith ne '' ) {
55 # output some of the sections
56 local($hi_after) = "$Tmp_prefix.hi-now";
58 foreach $hi ( split(' ',$HiWith) ) {
61 &hiSectionsOnly($new_hi, $hi_after);
63 system("$Cat $hi_after 1>&2 ; $Rm $hi_after; ");
65 system("$Cat $new_hi 1>&2");
68 &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
69 "Replace .$HiSuffix file, if changed");
74 local($ifile,$ofile) = @_;
76 open(OLDHIF, "< $ifile") || &tidy_up_and_die(1,"Can't open $ifile (read)\n");
77 open(NEWHIF, "> $ofile") || &tidy_up_and_die(1,"Can't open $ofile (write)\n");
79 # read up to _usages_ line
82 print NEWHIF $_ unless /^(__interface|import)/;
86 close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
87 close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
93 local($ifile,$ofile) = @_;
95 open(OLDHIF, "< $ifile") || &tidy_up_and_die(1,"Can't open $ifile (read)\n");
96 open(NEWHIF, "> $ofile") || &tidy_up_and_die(1,"Can't open $ofile (write)\n");
98 # read up to _usages_ line
101 if ( /^__export/ && $HiSection {'exports'} ||
102 /^import / && $HiSection {'imports'} ||
103 /^\d+ ([^ ]+ :: |type |data |class |newtype )/ && $HiSection {'declarations'} ||
104 /^instance / && $HiSection {'instances'} ) {
112 close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
113 close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
118 sub constructNewHiFile {
119 local($hsc_hi, # The iface info produced by hsc.
120 *hifile_target, # Pre-existing .hi filename (if it exists)
121 $new_hi, # Filename for new one
122 $show_hi_diffs) = @_;
123 local($hiname,$hidir);
125 &readHiFile('new',$hsc_hi) unless $HiHasBeenRead{'new'} == 1;
126 if ($Specific_hi_file eq '') { # -ohi is used even if module name != stem of filename.
127 ($hiname = $hifile_target) = $1 if $hifile_target =~ /\/?([^\/\.]+)\.$HiSuffix/;
128 if ($ModuleName{'new'} ne $hiname) {
129 ($hidir = $hifile_target) =~ s/(.*)$hiname\.$HiSuffix/$1/;
130 $hifile_target = $hidir . $ModuleName{'new'} . ".$HiSuffix";
133 &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
135 open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");
137 local(@decl_names) = (); # Declarations in new module
138 foreach $v (sort (keys %Decl)) {
139 next unless $v =~ /^new:(.*$)/;
140 push(@decl_names,$1);
143 local($new_module_version) = &calcNewModuleVersion(@decl_names);
144 print NEWHI "__interface ", $ModuleName{'new'}, " $new_module_version $ProjectVersionInt where\n";
146 print NEWHI $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
147 print NEWHI $Stuff{'new:instance_modules'} unless $Stuff{'new:instance_modules'} eq '';
148 print NEWHI $Stuff{'new:exports'};
149 print NEWHI $Stuff{'new:instances'} unless $Stuff{'new:instances'} eq '';
151 foreach $v (@decl_names) {
152 &printNewItemVersion(NEWHI, $v, $new_module_version, $show_hi_diffs); # Print new version number
153 print NEWHI $Decl{"new:$v"}; # Print the new decl itself
156 close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n");
160 Read the .hi file made by the compiler, or the old one.
161 All the declarations in the file are stored in
165 where $mod is "new" or "old", depending on whether it's the new or old
166 .hi file that's being read.
170 for tycons T "type T" or "data T"
171 for classes C "class C"
176 local($mod, # module to read; can be special tag 'old'
177 # (old .hi file for module being compiled) or
178 # 'new' (new proto-.hi file for...)
179 $hifile) = @_; # actual file to read
181 # info about the old version of this module's interface
182 $HiExists{$mod} = -1; # 1 <=> definitely exists; 0 <=> doesn't
183 $HiHasBeenRead{$mod} = 0;
184 $ModuleVersion{$mod} = 0;
185 $Stuff{"$mod:instance_modules"} = '';
186 $Stuff{"$mod:usages"} = ''; # stuff glommed together
187 $Stuff{"$mod:exports"} = '';
188 $Stuff{"$mod:instances"} = '';
189 $Stuff{"$mod:declarations"} = '';
191 if (! -f $hifile) { # no pre-existing .hi file
196 open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n");
198 hi_line: while (<HIFILE>) {
199 next if /^ *$/; # blank line
201 if ( /^__interface ([A-Z]\S*) (\d+)/ ) {
202 if ( $mod ne 'new' ) {
203 $ModuleVersion{$mod} = $2;
205 $ModuleName{$mod} = $1; # used to decide name of iface file.
207 } elsif ( /^import / ) {
208 $Stuff{"$mod:usages"} .= $_; # save the whole thing
210 } elsif ( /^__instimport/ ) {
211 $Stuff{"$mod:instance_modules"} .= $_;
213 } elsif ( /^__export/ ) {
214 $Stuff{"$mod:exports"} .= $_;
216 } elsif ( /^instance / ) {
217 $Stuff{"$mod:instances"} .= $_;
219 } elsif ( /^-[-]+ .*/ ) { # silently ignore comment lines.
221 } else { # We're in a declaration
223 # Strip off the initial version number, if any
224 if ( /^([0-9]+)\s+(.*\n)/ ) {
226 # The "\n" is because we need to keep the newline at
227 # the end, so that it looks the same as if there's no version
228 # number and this if statement doesn't fire.
230 # So there's an initial version number
235 if ( /^type\s+(\S+)/ ) {
237 $current_name = "type $1";
238 $Decl{"$mod:$current_name"} = $_;
239 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
241 } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
243 $current_name = "data $3";
244 $Decl{"$mod:$current_name"} = $_;
245 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
247 } elsif ( /^class\s+(\{[^{}]*\}\s+=>\s+)?(\S+)\s+/ ) {
249 # must be wary of => bit matching after "where"...
250 # ..hence the [^{}] part
251 # NB: a class decl may not have a where part at all
252 $current_name = "class $2";
253 $Decl{"$mod:$current_name"} = $_;
254 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
256 } elsif ( /^infix(r|l)?\s+[0-9]\s+(\S+)/ ) {
258 $current_name = "fixity $2";
259 $Decl{"$mod:$current_name"} = $_;
260 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
262 } elsif ( /^(\S+)\s+::\s+/ ) {
265 $Decl{"$mod:$current_name"} = $_;
266 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
268 } else { # Continuation line
269 print STDERR "$Pgm:junk old iface line?:$_";
270 # $Decl{"$mod:$current_name"} .= $_
276 close(HIFILE) || &tidy_up_and_die(1,"Failed reading from $hifile\n");
277 $HiHasBeenRead{$mod} = 1;
282 sub calcNewModuleVersion {
283 local (@decl_names) = @_;
285 return(&mv_change(1,'no old .hi file')) if $HiExists{'old'} == 0;
286 # could use "time()" as initial version; if a module existed, then was deleted,
287 # then comes back, we don't want the resurrected one to have an
288 # lower version number than the original (in case there are any
289 # lingering references to the original in other .hi files).
291 local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
292 local($changed_version) = $unchanged_version + 1;
294 foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) {
295 return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
298 # Decl need separate treatment; they aren't in $Stuff
299 foreach $v (@decl_names) {
300 return(&mv_change($changed_version,"$v changed")) if $Decl{"old:$v"} ne $Decl{"new:$v"};
303 print STDERR "$Pgm: module version unchanged at $unchanged_version\n";
304 return($unchanged_version);
308 local($mv, $str) = @_;
310 print STDERR "$Pgm: module version changed to $mv; reason: $str\n";
314 sub printNewItemVersion {
315 local($hifile, $item, $mod_version, $show_hi_diffs) = @_;
316 local($idecl) = $Decl{"new:$item"};
319 if (! defined($Decl{"old:$item"})) { # Old decl doesn't exist
320 if ($show_hi_diffs) {print STDERR "new: $item\n";}
321 print $hifile "$mod_version "; # Use module version
323 } elsif (! defined($OldVersion{"$item"}) ) {
324 if ($show_hi_diffs) {print STDERR "$item: no old version?!\n";}
325 print $hifile "$mod_version "; # Use module version
327 } elsif ($idecl ne $Decl{"old:$item"}) { # Old decl differs from new decl
328 local($odecl) = $Decl{"old:$item"};
329 if ($show_hi_diffs) {print STDERR "changed: $item\nOld: $odecl", "New: $idecl";}
330 print $hifile "--old: ", $OldVersion{"$item"}, " $odecl"
331 if $Keep_HiDiffs; # show old in interface file
332 print $hifile "$mod_version "; # Use module version
334 } else { # Identical decls, so use old version number
335 #if ($show_hi_diffs) {print STDERR "$item: unchanged\n";}
336 print $hifile $OldVersion{"$item"}, " ";
343 # make "require"r happy...