X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fghc-iface.lprl;h=b9a72312714a6e4109aab051faaab90ecba01b06;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=6d3bde17779828266315da76363348c62bdf9e0e;hpb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;p=ghc-hetmet.git diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl index 6d3bde1..b9a7231 100644 --- a/ghc/driver/ghc-iface.lprl +++ b/ghc/driver/ghc-iface.lprl @@ -5,6 +5,15 @@ %************************************************************************ \begin{code} +%OldVersion = (); +%Decl = (); # details about individual definitions +%Stuff = (); # where we glom things together +%HiExists = ('old',-1, 'new',-1); # 1 <=> definitely exists; 0 <=> doesn't +%HiHasBeenRead = ('old', 0, 'new', 0); +%ModuleVersion = ('old', 0, 'new', 0); + +%HiSections = (); + sub postprocessHiFile { local($hsc_hi, # The iface info produced by hsc. $hifile_target, # The name both of the .hi file we @@ -13,13 +22,15 @@ sub postprocessHiFile { $going_interactive) = @_; local($new_hi) = "$Tmp_prefix.hi-new"; + local($show_hi_diffs) = $HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target; -# print STDERR `$Cat $hsc_hi`; + print STDERR "*** New hi file follows...\n" if $Verbose; + system("$Cat $hsc_hi 1>&2") if $Verbose; - &constructNewHiFile($hsc_hi, $hifile_target, $new_hi); + &constructNewHiFile($hsc_hi, *hifile_target, $new_hi, $show_hi_diffs); # run diff if they asked for it - if ($HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target) { + if ($show_hi_diffs) { if ( $HiDiff_flag eq 'usages' ) { # lots of near-useless info; but if you want it... &run_something("$Cmp -s $hifile_target $new_hi || $Diff $hifile_target $new_hi 1>&2 || exit 0", @@ -40,7 +51,7 @@ sub postprocessHiFile { # if we produced an interface file "no matter what", # print what we got on stderr (ToDo: honor -ohi flag) if ( $HiOnStdout ) { - print STDERR `$Cat $new_hi`; + 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"); @@ -53,23 +64,12 @@ sub deUsagifyHi { 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 + # 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"); @@ -79,75 +79,62 @@ sub deUsagifyHi { \begin{code} sub constructNewHiFile { local($hsc_hi, # The iface info produced by hsc. - $hifile_target, # Pre-existing .hi filename (if it exists) - $new_hi) = @_; # Filename for new one + *hifile_target, # Pre-existing .hi filename (if it exists) + $new_hi, # Filename for new one + $show_hi_diffs) = @_; + local($hiname,$hidir); - &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1; &readHiFile('new',$hsc_hi) unless $HiHasBeenRead{'new'} == 1; + if ($Specific_hi_file eq '') { # -ohi is used even if module name != stem of filename. + ($hiname = $hifile_target) =~ s/([^\/]*\/)*(.*)\.$HiSuffix/$2/; + if ($ModuleName{'new'} ne $hiname) { + ($hidir = $hifile_target) =~ s/([^\/]*\/)*.*\.$HiSuffix/$1/; + $hifile_target = $hidir . $ModuleName{'new'} . ".$HiSuffix"; + } + } + &readHiFile('old',$hifile_target) unless $HiHasBeenRead{'old'} == 1; open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n"); - local($new_module_version) = &calcNewModuleVersion(); - print NEWHI "interface ", $ModuleName{'new'}, " $new_module_version\n"; - - print NEWHI "__usages__\n", $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq ''; - - local(@version_keys) = sort (keys %Version); - local($num_ver_things) = 0; - foreach $v (@version_keys) { + local(@decl_names) = (); # Declarations in new module + foreach $v (sort (keys %Decl)) { next unless $v =~ /^new:(.*$)/; - last if $num_ver_things >= 1; - $num_ver_things++; + push(@decl_names,$1); } - print NEWHI "__versions__\n" unless $num_ver_things < 1; - foreach $v (@version_keys) { - next unless $v =~ /^new:(.*$)/; - $v = $1; - - &printNewItemVersion($v, $new_module_version), "\n"; - } + local($new_module_version) = &calcNewModuleVersion(@decl_names); + print NEWHI "__interface ", $ModuleName{'new'}, " $new_module_version $ProjectVersionInt where\n"; - print NEWHI "__exports__\n"; + print NEWHI $Stuff{'new:usages'} unless $Stuff{'new:usages'} eq ''; + print NEWHI $Stuff{'new:instance_modules'} unless $Stuff{'new:instance_modules'} eq ''; print NEWHI $Stuff{'new:exports'}; + print NEWHI $Stuff{'new:fixities'} unless $Stuff{'new:fixities'} eq ''; + print NEWHI $Stuff{'new:instances'} unless $Stuff{'new:instances'} eq ''; - if ( $Stuff{'new:instance_modules'} ) { - print NEWHI "__instance_modules__\n"; - print NEWHI $Stuff{'new:instance_modules'}; + 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 } - if ( $Stuff{'new:fixities'} ) { - print NEWHI "__fixities__\n"; - print NEWHI $Stuff{'new:fixities'}; - } + close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n"); +} +\end{code} - if ( $Stuff{'new:declarations'} ) { - print NEWHI "__declarations__\n"; - print NEWHI $Stuff{'new:declarations'}; - } +Read the .hi file made by the compiler, or the old one. +All the declarations in the file are stored in - if ( $Stuff{'new:instances'} ) { - print NEWHI "__instances__\n"; - print NEWHI $Stuff{'new:instances'}; - } + $Decl{"$mod:$v"} - if ( $Stuff{'new:pragmas'} ) { - print NEWHI "__pragmas__\n"; - print NEWHI $Stuff{'new:pragmas'}; - } +where $mod is "new" or "old", depending on whether it's the new or old + .hi file that's being read. - close(NEWHI) || &tidy_up_and_die(1,"Failed writing to $new_hi\n"); -} -\end{code} +and $v is + for values v "v" + for tycons T "type T" or "data T" + for classes C "class C" -\begin{code} -%Version = (); -%Decl = (); # details about individual definitions -%Stuff = (); # where we glom things together -%HiExists = ('old',-1, 'new',-1); # 1 <=> definitely exists; 0 <=> doesn't -%HiHasBeenRead = ('old', 0, 'new', 0); -%ModuleVersion = ('old', 0, 'new', 0); +\begin{code} sub readHiFile { local($mod, # module to read; can be special tag 'old' # (old .hi file for module being compiled) or @@ -158,13 +145,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:instance_modules"} = ''; - $Stuff{"$mod:instances"} = ''; $Stuff{"$mod:fixities"} = ''; + $Stuff{"$mod:instances"} = ''; $Stuff{"$mod:declarations"} = ''; - $Stuff{"$mod:pragmas"} = ''; if (! -f $hifile) { # no pre-existing .hi file $HiExists{$mod} = 0; @@ -173,75 +159,81 @@ 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; - - } elsif ( /^__([a-z]+)__$/ ) { - $now_in = $1; + if ( /^__interface ([A-Z]\S*) (\d+)/ ) { + if ( $mod ne 'new' ) { + $ModuleVersion{$mod} = $2; + } + $ModuleName{$mod} = $1; # used to decide name of iface file. - } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) { + } elsif ( /^import / ) { $Stuff{"$mod:usages"} .= $_; # save the whole thing - } elsif ( $now_in eq 'versions' && /^(\S+) (\d+)/ ) { - local($item) = $1; - local($n) = $2; -#print STDERR "version read:item=$item, n=$n, line=$_"; - $Version{"$mod:$item"} = $n; - - } elsif ( $now_in eq 'versions' && /^(\S+)/ && $mod eq 'new') { # doesn't have versions - local($item) = $1; -#print STDERR "new version read:item=$item, line=$_"; - $Version{"$mod:$item"} = 'y'; # stub value... - - } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities|pragmas)$/ ) { - $Stuff{"$mod:$1"} .= $_; # just save it up - - } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed... - $Stuff{"$mod:declarations"} .= $_; # just save it up - - if ( /^[A-Z][A-Za-z0-9_']*\.(\S+)\s+::\s+/ ) { - $Decl{"$mod:$1"} = $_; - - } elsif ( /^type\s+[A-Z][A-Za-z0-9_']*\.(\S+)/ ) { - $Decl{"$mod:$1"} = $_; - - } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+/ ) { - $Decl{"$mod:$3"} = $_; - - } elsif ( /class\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+.*where\s+\{.*\};/ ) { - $Decl{"$mod:$2"} = $_; # must be wary of => bit matching after "where"... - } elsif ( /class\s+(.*\s+=>\s+)?[A-Z][A-Za-z0-9_']*\.(\S+)\s+/ ) { - $Decl{"$mod:$2"} = $_; - - } else { # oh, well... - print STDERR "$Pgm: decl line didn't match?\n$_"; + } elsif ( /^__instimport/ ) { + $Stuff{"$mod:instance_modules"} .= $_; + + } elsif ( /^__export/ ) { + $Stuff{"$mod:exports"} .= $_; + + } elsif ( /^infix(r|l)? / ) { + $Stuff{"$mod:fixities"} .= $_; + + } elsif ( /^instance / ) { + $Stuff{"$mod:instances"} .= $_; + + } elsif ( /^--.*/ ) { # silently ignore comment lines. + ; + } else { # We're in a declaration + + # Strip off the initial version number, if any + 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 ( /^type\s+(\S+)/ ) { + # Type declaration + $current_name = "type $1"; + $Decl{"$mod:$current_name"} = $_; + if ($mod eq "old") { $OldVersion{$current_name} = $version; } + + } elsif ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) { + # Data declaration + $current_name = "data $3"; + $Decl{"$mod:$current_name"} = $_; + if ($mod eq "old") { $OldVersion{$current_name} = $version; } + + } 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 ( /^(\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; } @@ -249,6 +241,7 @@ sub readHiFile { \begin{code} sub calcNewModuleVersion { + local (@decl_names) = @_; return(&mv_change(1,'no old .hi file')) if $HiExists{'old'} == 0; # could use "time()" as initial version; if a module existed, then was deleted, @@ -259,12 +252,16 @@ sub calcNewModuleVersion { local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two local($changed_version) = $unchanged_version + 1; - return(&mv_change($changed_version,'usages changed')) if $Stuff{'old:usages'} ne $Stuff{'new:usages'}; - - foreach $t ( 'exports', 'instance_modules', 'instances', 'fixities', 'declarations', 'pragmas' ) { + foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) { return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"}; } +# Decl need separate treatment; they aren't in $Stuff + foreach $v (@decl_names) { + return(&mv_change($changed_version,"$v changed")) if $Decl{"old:$v"} ne $Decl{"new:$v"}; + } + + print STDERR "$Pgm: module version unchanged at $unchanged_version\n"; return($unchanged_version); } @@ -276,39 +273,34 @@ sub mv_change { } sub printNewItemVersion { - local($item, $mod_version) = @_; - - if (! defined($Decl{"new:$item"}) ) { -# it's OK, because the thing is almost-certainly wired-in -# print STDERR "$item: no decl?! (nothing into __versions__)\n"; - return; - } - + local($hifile, $item, $mod_version, $show_hi_diffs) = @_; local($idecl) = $Decl{"new:$item"}; - - if (! defined($Decl{"old:$item"})) { - print STDERR "new: $item\n"; - print NEWHI "$item $mod_version\n"; - } elsif ($idecl ne $Decl{"old:$item"}) { - print STDERR "changed: $item\n"; - print NEWHI "$item $mod_version\n"; - } elsif (! defined($Version{"old:$item"}) ) { - print STDERR "$item: no old version?!\n" - } else { - print NEWHI "$item ", $Version{"old:$item"}, "\n"; + + + 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 (! 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";} + print $hifile $OldVersion{"$item"}, " "; } return; } \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}