1 %************************************************************************
3 \section[Driver-iface-thing]{Interface-file handling}
5 %************************************************************************
8 sub postprocessHiFile {
9 local($hsc_hi, # The iface info produced by hsc.
10 $hifile_target, # The name both of the .hi file we
11 # already have and which we *might*
13 $going_interactive) = @_;
15 local($new_hi) = "$Tmp_prefix.hi-new";
17 # print STDERR `$Cat $hsc_hi`;
19 &constructNewHiFile($hsc_hi, $hifile_target, $new_hi);
21 # run diff if they asked for it
22 if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) {
23 if ( $HiDiff_flag eq 'usages' ) {
24 # lots of near-useless info; but if you want it...
25 &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0",
26 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
28 # strip out usages, *then* run diff
29 local($hi_before) = "$Tmp_prefix.hi-before";
30 local($hi_after) = "$Tmp_prefix.hi-now";
32 &deUsagifyHi($hifile_target, $hi_before);
33 &deUsagifyHi($new_hi, $hi_after);
35 &run_something("$Cmp -s $hi_before $hi_after || $Diff $hi_before $hi_after 1>&2 || exit 0",
36 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
40 # if we produced an interface file "no matter what",
41 # print what we got on stderr (ToDo: honor -ohi flag)
43 print STDERR `$Cat $new_hi`;
45 &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
46 "Replace .$HiSuffix file, if changed");
51 local($ifile,$ofile) = @_;
53 open(OLDHIF, "< $ifile") || &tidy_up_and_die(1,"Can't open $ifile (read)\n");
54 open(NEWHIF, "> $ofile") || &tidy_up_and_die(1,"Can't open $ofile (write)\n");
56 # read up to __usages__ line
58 while ($_ ne '' && ! /^__usages__/) {
59 print NEWHIF $_ unless /^(interface |\{-# GHC_PRAGMA)/;
63 # skip to next __<anything> line
65 while ($_ ne '' && ! /^__/) { $_ = <OLDHIF>; }
74 close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
75 close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
80 sub constructNewHiFile {
81 local($hsc_hi, # The iface info produced by hsc.
82 $hifile_target, # Pre-existing .hi filename (if it exists)
83 $new_hi) = @_; # Filename for new one
85 &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
86 &readHiFile('new',$hsc_hi) unless $HiHasBeenRead{'new'} == 1;
88 open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");
90 local($new_module_version) = &calcNewModuleVersion();
91 print NEWHI "interface ", $ModuleName{'new'}, " $new_module_version\n";
93 print NEWHI "__usages__\n", $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
95 local(@version_keys) = sort (keys %Version);
96 local($num_ver_things) = 0;
97 foreach $v (@version_keys) {
98 next unless $v =~ /^new:(.*$)/;
99 last if $num_ver_things >= 1;
103 print NEWHI "__versions__\n" unless $num_ver_things < 1;
104 foreach $v (@version_keys) {
105 next unless $v =~ /^new:(.*$)/;
108 &printNewItemVersion($v, $new_module_version), "\n";
111 print NEWHI "__exports__\n";
112 print NEWHI $Stuff{'new:exports'};
114 if ( $Stuff{'new:instance_modules'} ) {
115 print NEWHI "__instance_modules__\n";
116 print NEWHI $Stuff{'new:instance_modules'};
119 if ( $Stuff{'new:fixities'} ) {
120 print NEWHI "__fixities__\n";
121 print NEWHI $Stuff{'new:fixities'};
124 if ( $Stuff{'new:declarations'} ) {
125 print NEWHI "__declarations__\n";
126 print NEWHI $Stuff{'new:declarations'};
129 if ( $Stuff{'new:instances'} ) {
130 print NEWHI "__instances__\n";
131 print NEWHI $Stuff{'new:instances'};
134 if ( $Stuff{'new:pragmas'} ) {
135 print NEWHI "__pragmas__\n";
136 print NEWHI $Stuff{'new:pragmas'};
139 close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n");
145 %Decl = (); # details about individual definitions
146 %Stuff = (); # where we glom things together
147 %HiExists = ('old',-1, 'new',-1); # 1 <=> definitely exists; 0 <=> doesn't
148 %HiHasBeenRead = ('old', 0, 'new', 0);
149 %ModuleVersion = ('old', 0, 'new', 0);
152 local($mod, # module to read; can be special tag 'old'
153 # (old .hi file for module being compiled) or
154 # 'new' (new proto-.hi file for...)
155 $hifile) = @_; # actual file to read
157 # info about the old version of this module's interface
158 $HiExists{$mod} = -1; # 1 <=> definitely exists; 0 <=> doesn't
159 $HiHasBeenRead{$mod} = 0;
160 $ModuleVersion{$mod} = 0;
161 $Stuff{"$mod:usages"} = ''; # stuff glommed together
162 $Stuff{"$mod:exports"} = '';
163 $Stuff{"$mod:instance_modules"} = '';
164 $Stuff{"$mod:instances"} = '';
165 $Stuff{"$mod:fixities"} = '';
166 $Stuff{"$mod:declarations"} = '';
167 $Stuff{"$mod:pragmas"} = '';
169 if (! -f $hifile) { # no pre-existing .hi file
174 open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n");
177 hi_line: while (<HIFILE>) {
178 next if /^ *$/; # blank line
179 next if /\{-# GHC_PRAGMA INTERFACE VERSION 20 #-\}/;
181 # avoid pre-1.3 interfaces
182 #print STDERR "now_in:$now_in:$_";
183 if ( /\{-# GHC_PRAGMA INTERFACE VERSION . #-\}/ ) {
188 if ( /^interface ([A-Z]\S*) (\d+)/ ) {
189 $ModuleName{$mod} = $1; # not sure this is used much...
190 $ModuleVersion{$mod} = $2;
192 } elsif ( /^interface ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
193 $ModuleName{'new'} = $1;
195 } elsif ( /^__([a-z]+)__$/ ) {
198 } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) {
199 $Stuff{"$mod:usages"} .= $_; # save the whole thing
201 } elsif ( $now_in eq 'versions' && /^(\S+) (\d+)/ ) {
204 #print STDERR "version read:item=$item, n=$n, line=$_";
205 $Version{"$mod:$item"} = $n;
207 } elsif ( $now_in eq 'versions' && /^(\S+)/ && $mod eq 'new') { # doesn't have versions
209 #print STDERR "new version read:item=$item, line=$_";
210 $Version{"$mod:$item"} = 'y'; # stub value...
212 } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities|pragmas)$/ ) {
213 $Stuff{"$mod:$1"} .= $_; # just save it up
215 } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
216 $Stuff{"$mod:declarations"} .= $_; # just save it up
218 if ( /^[A-Z][A-Za-z0-9_']*\.(\S+)\s+::\s+/ ) {
219 $Decl{"$mod:$1"} = $_;
221 } elsif ( /^type\s+[A-Z][A-Za-z0-9_']*\.(\S+)/ ) {
222 $Decl{"$mod:$1"} = $_;
224 } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+/ ) {
225 $Decl{"$mod:$3"} = $_;
227 } elsif ( /class\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+.*where\s+\{.*\};/ ) {
228 $Decl{"$mod:$2"} = $_; # must be wary of => bit matching after "where"...
229 } elsif ( /class\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+/ ) {
230 $Decl{"$mod:$2"} = $_;
232 } else { # oh, well...
233 print STDERR "$Pgm: decl line didn't match?\n$_";
237 print STDERR "$Pgm:junk old iface line?:section:$now_in:$_";
241 # foreach $i ( sort (keys %Decl)) {
242 # print STDERR "$i: ",$Decl{$i}, "\n";
245 close(HIFILE) || &tidy_up_and_die(1,"Failed reading from $hifile\n");
246 $HiHasBeenRead{$mod} = 1;
251 sub calcNewModuleVersion {
253 return(&mv_change(1,'no old .hi file')) if $HiExists{'old'} == 0;
254 # could use "time()" as initial version; if a module existed, then was deleted,
255 # then comes back, we don't want the resurrected one to have an
256 # lower version number than the original (in case there are any
257 # lingering references to the original in other .hi files).
259 local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
260 local($changed_version) = $unchanged_version + 1;
262 return(&mv_change($changed_version,'usages changed')) if $Stuff{'old:usages'} ne $Stuff{'new:usages'};
264 foreach $t ( 'exports', 'instance_modules', 'instances', 'fixities', 'declarations', 'pragmas' ) {
265 return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
268 return($unchanged_version);
272 local($mv, $str) = @_;
274 #print STDERR "$Pgm: module version changed to $mv; reason: $str\n";
278 sub printNewItemVersion {
279 local($item, $mod_version) = @_;
281 if (! defined($Decl{"new:$item"}) ) {
282 # it's OK, because the thing is almost-certainly wired-in
283 # print STDERR "$item: no decl?! (nothing into __versions__)\n";
287 local($idecl) = $Decl{"new:$item"};
289 if (! defined($Decl{"old:$item"})) {
290 #print STDERR "new: $item\n";
291 print NEWHI "$item $mod_version\n";
292 } elsif ($idecl ne $Decl{"old:$item"}) {
293 #print STDERR "changed: $item\n";
294 print NEWHI "$item $mod_version\n";
295 } elsif (! defined($Version{"old:$item"}) ) {
296 #print STDERR "$item: no old version?!\n"
298 print NEWHI "$item ", $Version{"old:$item"}, "\n";
306 local($hsc_hi, # The iface info produced by hsc.
307 $hifile_target) = @_; # Pre-existing .hi filename (if it exists)
312 # make "require"r happy...