X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fghc-iface.lprl;h=b9a72312714a6e4109aab051faaab90ecba01b06;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=ebd47784221df75b3c4f19918d70e76015bbb694;hpb=b4d4a80e8b47237dbdbb5bbd5ceaab00306ebb77;p=ghc-hetmet.git

diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl
index ebd4778..b9a7231 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) {
@@ -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");
     } else {
 	&run_something("$Cmp -s $hifile_target $new_hi || ( $Rm $hifile_target && $Cp $new_hi $hifile_target )",
 	   "Replace .$HiSuffix file, if changed");
@@ -66,20 +66,9 @@ sub deUsagifyHi {
 
     # read up to _usages_ line
     $_ = <OLDHIF>;
-    while ($_ ne '' && ! /^_usages_/) {
-	print NEWHIF $_ unless /^(_interface_ |\{-# GHC_PRAGMA)/;
-	$_ = <OLDHIF>;
-    }
-    if ( $_ ne '' ) {
-	# skip to next _<anything> line
+    while ($_ ne '') {
+	print NEWHIF $_ unless /^(__interface|import)/;
 	$_ = <OLDHIF>;
-	while ($_ ne '' && ! /^_/) { $_ = <OLDHIF>; }
-
-	# print the rest
-	while ($_ ne '') {
-	    print NEWHIF $_;
-	    $_ = <OLDHIF>;
-	}
     }
 
     close(OLDHIF) || &tidy_up_and_die(1,"Failed reading from $ifile\n");
@@ -90,56 +79,61 @@ 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");
 
-    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 "__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: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
     }
 
-    
-
     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'
@@ -165,87 +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 (<HIFILE>) {
 	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;
+	if ( /^__interface ([A-Z]\S*) (\d+)/ ) {
+	    if ( $mod ne 'new' ) {
+		$ModuleVersion{$mod} = $2;
+	    }
+	    $ModuleName{$mod}    = $1; # used to decide name of iface file.
 
-	} elsif ( /^_interface_ ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
-	    $ModuleName{'new'} = $1;
+	} elsif ( /^import / ) {
+	    $Stuff{"$mod:usages"} .= $_; # save the whole thing
 
-	} elsif ( /^_([a-z_]+)_$/ ) {
-	    $now_in = $1;
+	} elsif ( /^__instimport/ ) {
+	    $Stuff{"$mod:instance_modules"} .= $_;
 
-	} elsif ( $now_in eq 'usages' && /^(\S+)\s+(!\s+)?(\d+)\s+::(.*)/ ) {
-	    $Stuff{"$mod:usages"} .= $_; # save the whole thing
+	} elsif ( /^__export/ ) {
+	    $Stuff{"$mod:exports"} .= $_;
 
+	} elsif ( /^infix(r|l)? / ) {
+	    $Stuff{"$mod:fixities"} .= $_;
 
-	} elsif ( $now_in =~ /^(exports|instance_modules|instances|fixities)$/ ) {
-	    $Stuff{"$mod:$1"} .= $_; # just save it up
+	} elsif ( /^instance / ) {
+	    $Stuff{"$mod:instances"} .= $_;
 
 	} elsif ( /^--.*/ ) { # silently ignore comment lines.
 	    ;
-	} elsif ( $now_in eq 'declarations' ) { # relatively special treatment needed...
-	# We're in a declaration
+	} 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;
-		$Decl{"$mod:$current_name"} = $_;
-	        if ($mod eq "old") { $OldVersion{$current_name} = $version; }
 
-	    } elsif ( /^type\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 ( /^(newtype|data)\s+(.*\s+=>\s+)?(\S+)\s+/ ) {
-		$current_name = $3;
+	   } 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+/ ) {
+	   } 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 = $2;
+		$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
-		$Decl{"$mod:$current_name"} .= $_
+		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;
 }
@@ -264,9 +252,6 @@ 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'};
-
     foreach $t ( 'usages' , 'exports', 'instance_modules', 'instances', 'fixities' ) {
 	return(&mv_change($changed_version,"$t changed")) if $Stuff{"old:$t"} ne $Stuff{"new:$t"};
     }
@@ -276,7 +261,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);
 }
 
@@ -316,13 +301,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}