X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fghc-iface.lprl;h=80ce281144e85a24c66d5995032efa438172f44e;hb=5ffba4e2eac0a76ffbe8d98b672fcc39201a591f;hp=533d52908950471bac7a12cd40b53606d9784eae;hpb=b12d8238d71d6058817b0c78839788e4fda40690;p=ghc-hetmet.git diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl index 533d529..80ce281 100644 --- a/ghc/driver/ghc-iface.lprl +++ b/ghc/driver/ghc-iface.lprl @@ -12,7 +12,7 @@ %HiHasBeenRead = ('old', 0, 'new', 0); %ModuleVersion = ('old', 0, 'new', 0); - +%HiSections = (); sub postprocessHiFile { local($hsc_hi, # The iface info produced by hsc. @@ -27,7 +27,7 @@ sub postprocessHiFile { 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) { @@ -49,9 +49,21 @@ sub postprocessHiFile { } # 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"); @@ -66,19 +78,34 @@ sub deUsagifyHi { # read up to _usages_ line $_ = ; - while ($_ ne '' && ! /^_usages_/) { - print NEWHIF $_ unless /^(_interface_ |\{-# GHC_PRAGMA)/; + while ($_ ne '') { + print NEWHIF $_ unless /^(__interface|import)/; $_ = ; } - if ( $_ ne '' ) { - # skip to next _ line - $_ = ; - while ($_ ne '' && ! /^_/) { $_ = ; } - # print the rest - while ($_ ne '') { - print NEWHIF $_; - $_ = ; + 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 + $_ = ; + while ($_ ne '' ) { + if ( /^__export/ && $HiSection {'exports'} || + /^import / && $HiSection {'imports'} || + /^\d+ ([^ ]+ :: |type |data |class |newtype )/ && $HiSection {'declarations'} || + /^instance / && $HiSection {'instances'} ) { + print NEWHIF $_; + $_ = ; + } else { + $_ = ; } } @@ -90,56 +117,72 @@ sub deUsagifyHi { \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' @@ -151,12 +194,12 @@ sub readHiFile { $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; @@ -165,88 +208,95 @@ sub readHiFile { open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n"); $HiExists{$mod} = 1; - local($now_in) = ''; hi_line: while () { 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; + + if ( /^type\s+(\S+)/ ) { + # Type declaration + $current_name = "type $1"; $Decl{"$mod:$current_name"} = $_; if ($mod eq "old") { $OldVersion{$current_name} = $version; } - } elsif ( /^type\s+(\S+)/ ) { - $current_name = $1; + } 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 ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) { - $current_name = $3; + } 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 = "class $2"; $Decl{"$mod:$current_name"} = $_; if ($mod eq "old") { $OldVersion{$current_name} = $version; } - } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+.*where\s+\{.*\};/ ) { - # must be wary of => bit matching after "where"... - $current_name = $2; + } 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 ( /class\s+(.*\s+=>\s+)?(\S+)\s+/ ) { - $current_name = $2; + } 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"} .= $_ } - } 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; } @@ -265,10 +315,11 @@ sub calcNewModuleVersion { 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"}; } @@ -277,36 +328,41 @@ sub calcNewModuleVersion { 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: $odecl\nNew: $idecl\n";} - 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; @@ -314,13 +370,6 @@ sub printNewItemVersion { \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}