X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fghc-iface.lprl;h=0fd3fb13f110a2ecb404ce65c1c0a9edcf0f6a4a;hb=3d7f51b9c6b157f31f46623bfbd2408aafe137ab;hp=533d52908950471bac7a12cd40b53606d9784eae;hpb=b12d8238d71d6058817b0c78839788e4fda40690;p=ghc-hetmet.git diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl index 533d529..0fd3fb1 100644 --- a/ghc/driver/ghc-iface.lprl +++ b/ghc/driver/ghc-iface.lprl @@ -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) { @@ -51,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 ) { - system("$Cat $new_hi 1>&2") if $Verbose; + system("$Cat $new_hi 1>&2"); # if $Verbose; } else { &run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )", "Replace .$HiSuffix file, if changed"); @@ -90,12 +90,20 @@ 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); - &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"); @@ -140,6 +148,20 @@ sub constructNewHiFile { } \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' @@ -171,14 +193,14 @@ sub readHiFile { next if /\{-# GHC_PRAGMA INTERFACE VERSION 20 #-\}/; # avoid pre-1.3 interfaces -#print STDERR "now_in:$now_in:$_"; + #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... + $ModuleName{$mod} = $1; # used to decide name of interface file. $ModuleVersion{$mod} = $2; } elsif ( /^_interface_ ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version @@ -187,13 +209,15 @@ sub readHiFile { } elsif ( /^_([a-z_]+)_$/ ) { $now_in = $1; - } elsif ( $now_in eq 'usages' && /^(\S+)\s+(\d+)\s+:: (.*)/ ) { + } elsif ( $now_in eq 'usages' && /^(\S+)\s+(!\s+)?(\d+)\s+::(.*)/ ) { $Stuff{"$mod:usages"} .= $_; # save the whole thing } elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities)$/ ) { $Stuff{"$mod:$1"} .= $_; # just save it up + } elsif ( /^--.*/ ) { # silently ignore comment lines. + ; } elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed... # We're in a declaration @@ -208,29 +232,30 @@ sub readHiFile { $_ = $2; } - if ( /^(\S+)\s+::\s+/ ) { + if ( /^(\S+)\s+_:_\s+/ ) { + # Value declaration $current_name = $1; $Decl{"$mod:$current_name"} = $_; if ($mod eq "old") { $OldVersion{$current_name} = $version; } } elsif ( /^type\s+(\S+)/ ) { - $current_name = $1; + # 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+/ ) { - $current_name = $3; + # 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+.*where\s+\{.*\};/ ) { + } elsif ( /^class\s+(\{[^{}]*\}\s+=>\s+)?(\S+)\s+/ ) { + # Class declaration # must be wary of => bit matching after "where"... - $current_name = $2; - $Decl{"$mod:$current_name"} = $_; - if ($mod eq "old") { $OldVersion{$current_name} = $version; } - - } elsif ( /class\s+(.*\s+=>\s+)?(\S+)\s+/ ) { - $current_name = $2; + # ..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; } @@ -277,7 +302,7 @@ 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"; return($unchanged_version); } @@ -291,22 +316,25 @@ sub mv_change { 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;