ghc/driver/ghc-iface.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-iface-thing]{Interface-file handling}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 \begin{code}
   8 %OldVersion = ();
   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);
  14
  15
  16
  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*
  21                                 # replace.
  22           $going_interactive) = @_;
  23
  24     local($new_hi) = "$Tmp_prefix.hi-new";
  25
  26 #    print STDERR `$Cat $hsc_hi`;
  27
  28     &constructNewHiFile($hsc_hi, $hifile_target, $new_hi);
  29
  30     # run diff if they asked for it
  31     if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) {
  32         if ( $HiDiff_flag eq 'usages' ) {
  33             # lots of near-useless info; but if you want it...
  34             &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0",
  35                 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
  36         } else {
  37             # strip out usages, *then* run diff
  38             local($hi_before) = "$Tmp_prefix.hi-before";
  39             local($hi_after)  = "$Tmp_prefix.hi-now";
  40
  41             &deUsagifyHi($hifile_target, $hi_before);
  42             &deUsagifyHi($new_hi,        $hi_after);
  43
  44             &run_something("$Cmp -s $hi_before $hi_after || $Diff $hi_before $hi_after 1>&2 || exit 0",
  45                 "Diff'ing old and new .$HiSuffix files"); # NB: to stderr
  46         }
  47     }
  48
  49     # if we produced an interface file "no matter what",
  50     # print what we got on stderr (ToDo: honor -ohi flag)
  51     if ( $HiOnStdout ) {
  52         print STDERR `$Cat $new_hi`;
  53     } else {
  54         &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
  55            "Replace .$HiSuffix file, if changed");
  56     }
  57 }
  58
  59 sub deUsagifyHi {
  60     local($ifile,$ofile) = @_;
  61
  62     open(OLDHIF, "< $ifile") || &tidy_up_and_die(1,"Can't open $ifile (read)\n");
  63     open(NEWHIF, "> $ofile") || &tidy_up_and_die(1,"Can't open $ofile (write)\n");
  64
  65     # read up to _usages_ line
  66     $_ = <OLDHIF>;
  67     while ($_ ne '' && ! /^_usages_/) {
  68         print NEWHIF $_ unless /^(_interface_ |\{-# GHC_PRAGMA)/;
  69         $_ = <OLDHIF>;
  70     }
  71     if ( $_ ne '' ) {
  72         # skip to next _<anything> line
  73         $_ = <OLDHIF>;
  74         while ($_ ne '' && ! /^_/) { $_ = <OLDHIF>; }
  75
  76         # print the rest
  77         while ($_ ne '') {
  78             print NEWHIF $_;
  79             $_ = <OLDHIF>;
  80         }
  81     }
  82
  83     close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
  84     close(NEWHIF) || &tidy_up_and_die(1,"Failed writing to $ofile\n");
  85 }
  86 \end{code}
  87
  88 \begin{code}
  89 sub constructNewHiFile {
  90     local($hsc_hi,          # The iface info produced by hsc.
  91           $hifile_target,   # Pre-existing .hi filename (if it exists)
  92           $new_hi) = @_;    # Filename for new one
  93
  94     &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1;
  95     &readHiFile('new',$hsc_hi)        unless $HiHasBeenRead{'new'} == 1;
  96
  97     open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");
  98
  99     local(@decl_names) = ();    # Entities in _declarations_ section of new module
 100     foreach $v (sort (keys %Decl)) {
 101         next unless $v =~ /^new:(.*$)/;
 102         push(@decl_names,$1);
 103     }
 104
 105     local($new_module_version) = &calcNewModuleVersion(@decl_names);
 106     print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version\n";
 107
 108     if ( $Stuff{'new:instance_modules'} ) {
 109         print NEWHI "_instance_modules_\n";
 110         print NEWHI $Stuff{'new:instance_modules'};
 111     }
 112
 113     print NEWHI "_usages_\n", $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq '';
 114
 115     print NEWHI "_exports_\n";
 116     print NEWHI $Stuff{'new:exports'};
 117
 118     if ( $Stuff{'new:fixities'} ) {
 119         print NEWHI "_fixities_\n";
 120         print NEWHI $Stuff{'new:fixities'};
 121     }
 122
 123     if ( $Stuff{'new:instances'} ) {
 124         print NEWHI "_instances_\n";
 125         print NEWHI $Stuff{'new:instances'};
 126     }
 127
 128     print NEWHI "_declarations_\n";
 129     foreach $v (@decl_names) {
 130         &printNewItemVersion(NEWHI, $v, $new_module_version);           # Print new version number
 131         print NEWHI $Decl{"new:$v"};            # Print the new decl itself
 132     }
 133
 134
 135
 136     close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n");
 137 }
 138 \end{code}
 139
 140 \begin{code}
 141 sub readHiFile {
 142     local($mod,             # module to read; can be special tag 'old'
 143                             # (old .hi file for module being compiled) or
 144                             # 'new' (new proto-.hi file for...)
 145           $hifile) = @_;    # actual file to read
 146
 147     # info about the old version of this module's interface
 148     $HiExists{$mod}      = -1; # 1 <=> definitely exists; 0 <=> doesn't
 149     $HiHasBeenRead{$mod} = 0;
 150     $ModuleVersion{$mod} = 0;
 151     $Stuff{"$mod:instance_modules"} = '';
 152     $Stuff{"$mod:usages"}           = ''; # stuff glommed together
 153     $Stuff{"$mod:exports"}          = '';
 154     $Stuff{"$mod:fixities"}         = '';
 155     $Stuff{"$mod:instances"}        = '';
 156     $Stuff{"$mod:declarations"}     = '';
 157
 158     if (! -f $hifile) { # no pre-existing .hi file
 159         $HiExists{$mod} = 0;
 160         return();
 161     }
 162
 163     open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n");
 164     $HiExists{$mod} = 1;
 165     local($now_in) = '';
 166     hi_line: while (<HIFILE>) {
 167         next if /^ *$/; # blank line
 168         next if /\{-# GHC_PRAGMA INTERFACE VERSION 20 #-\}/;
 169
 170         # avoid pre-1.3 interfaces
 171 #print STDERR "now_in:$now_in:$_";
 172         if ( /\{-# GHC_PRAGMA INTERFACE VERSION . #-\}/ ) {
 173             $HiExists{$mod} = 0;
 174             last hi_line;
 175         }
 176
 177         if ( /^_interface_ ([A-Z]\S*) (\d+)/ ) {
 178             $ModuleName{$mod}    = $1; # not sure this is used much...
 179             $ModuleVersion{$mod} = $2;
 180
 181         } elsif ( /^_interface_ ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
 182             $ModuleName{'new'} = $1;
 183
 184         } elsif ( /^_([a-z_]+)_$/ ) {
 185             $now_in = $1;
 186
 187         } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) {
 188             $Stuff{"$mod:usages"} .= $_; # save the whole thing
 189
 190
 191         } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities)$/ ) {
 192             $Stuff{"$mod:$1"} .= $_; # just save it up
 193
 194         } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
 195         # We're in a declaration
 196
 197         # Strip off the initial version number, if any
 198            if ( /^([0-9]+) (.*\n)/ ) {
 199                 # The "\n" is because we need to keep the newline at the end, so that
 200                 # it looks the same as if there's no version number and this if statement
 201                 # doesn't fire.
 202
 203                 # So there's an initial version number
 204                 $version = $1;
 205                 $_ = $2;
 206            }
 207
 208             if ( /^(\S+)\s+::\s+/ ) {
 209                 $current_name = $1;
 210                 $Decl{"$mod:$current_name"} = $_;
 211                 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 212
 213             } elsif ( /^type\s+(\S+)/ ) {
 214                 $current_name = $1;
 215                 $Decl{"$mod:$current_name"} = $_;
 216                 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 217
 218             } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
 219                 $current_name = $3;
 220                 $Decl{"$mod:$current_name"} = $_;
 221                 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 222
 223             } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+.*where\s+\{.*\};/ ) {
 224                 # must be wary of => bit matching after "where"...
 225                 $current_name = $2;
 226                 $Decl{"$mod:$current_name"} = $_;
 227                 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 228
 229             } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
 230                 $current_name = $2;
 231                 $Decl{"$mod:$current_name"} = $_;
 232                 if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 233
 234             } else { # Continuation line
 235                 $Decl{"$mod:$current_name"} .= $_
 236             }
 237
 238         } else {
 239             print STDERR "$Pgm:junk old iface line?:section:$now_in:$_";
 240         }
 241     }
 242
 243 #   foreach $i ( sort (keys %Decl)) {
 244 #       print STDERR "$i: ",$Decl{$i}, "\n";
 245 #   }
 246
 247     close(HIFILE) || &tidy_up_and_die(1,"Failed reading from $hifile\n");
 248     $HiHasBeenRead{$mod} = 1;
 249 }
 250 \end{code}
 251
 252 \begin{code}
 253 sub calcNewModuleVersion {
 254     local (@decl_names) = @_;
 255
 256     return(&mv_change(1,'no old .hi file')) if $HiExists{'old'} == 0;
 257         # could use "time()" as initial version; if a module existed, then was deleted,
 258         # then comes back, we don't want the resurrected one to have an
 259         # lower version number than the original (in case there are any
 260         # lingering references to the original in other .hi files).
 261
 262     local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
 263     local($changed_version)   = $unchanged_version + 1;
 264
 265 # This statement is curious; it is subsumed by the foreach!
 266 #    return(&mv_change($changed_version,'usages changed')) if $Stuff{'old:usages'} ne $Stuff{'new:usages'};
 267
 268     foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) {
 269         return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
 270     }
 271
 272 # Decl need separate treatment; they aren't in $Stuff
 273     foreach $v (@decl_names) {
 274         return(&mv_change($changed_version,"$v changed")) if $Decl{"old:$v"} ne $Decl{"new:$v"};
 275     }
 276
 277     print STDERR "Module version unchanged at $unchanged_version\n";
 278     return($unchanged_version);
 279 }
 280
 281 sub mv_change {
 282     local($mv, $str) = @_;
 283
 284     print STDERR "$Pgm: module version changed to $mv; reason: $str\n";
 285     return($mv);
 286 }
 287
 288 sub printNewItemVersion {
 289     local($hifile, $item, $mod_version) = @_;
 290     local($idecl) = $Decl{"new:$item"};
 291
 292     if (! defined($Decl{"old:$item"})) {        # Old decl doesn't exist
 293         print STDERR "new: $item\n";
 294         print $hifile  "$mod_version ";         # Use module version
 295
 296     } elsif ($idecl ne $Decl{"old:$item"})  {   # Old decl differs from new decl
 297         local($odecl) = $Decl{"old:$item"};
 298 #       print STDERR "changed: $item\nOld: $odecl\nNew: $idecl\n";
 299         print $hifile  "$mod_version ";         # Use module version
 300
 301     } elsif (! defined($OldVersion{"$item"}) ) {
 302         print STDERR "$item: no old version?!\n";
 303         print $hifile  "$mod_version ";                 # Use module version
 304
 305     } else {                                    # Identical decls, so use old version number
 306         print STDERR "$item: unchanged\n";
 307         print $hifile  $OldVersion{"$item"}, " ";
 308     }
 309     return;
 310 }
 311 \end{code}
 312
 313 \begin{code}
 314 sub findHiChanges {
 315     local($hsc_hi,              # The iface info produced by hsc.
 316           $hifile_target) = @_; # Pre-existing .hi filename (if it exists)
 317 }
 318 \end{code}
 319
 320 \begin{code}
 321 # make "require"r happy...
 322 1;
 323 \end{code}