%************************************************************************
%*									*
\section[Driver-iface-thing]{Interface-file handling}
%*									*
%************************************************************************

\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
				# already have and which we *might*
				# replace.
	  $going_interactive) = @_;

    local($new_hi) = "$Tmp_prefix.hi-new";
    local($show_hi_diffs) = $HiDiff_flag && ! $HiOnStdout && ! $going_interactive && -f $hifile_target;

    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);

    # run diff if they asked for it
    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",
		"Diff'ing old and new .$HiSuffix files"); # NB: to stderr
	} else {
	    # strip out usages, *then* run diff
	    local($hi_before) = "$Tmp_prefix.hi-before";
	    local($hi_after)  = "$Tmp_prefix.hi-now";

	    &deUsagifyHi($hifile_target, $hi_before);
	    &deUsagifyHi($new_hi,	 $hi_after);

	    &run_something("$Cmp -s $hi_before $hi_after || $Diff $hi_before $hi_after 1>&2 || exit 0",
		"Diff'ing old and new .$HiSuffix files"); # NB: to stderr
	}
    }

    # if we produced an interface file "no matter what",
    # print what we got on stderr.
    if ( $HiOnStdout ) {
        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");
    }
}

sub deUsagifyHi {
    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
    $_ = <OLDHIF>;
    while ($_ ne '') {
	print NEWHIF $_ unless /^(__interface|import)/;
	$_ = <OLDHIF>;
    }

    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
    $_ = <OLDHIF>;
    while ($_ ne '' ) {
	if ( /^__export/ && $HiSection {'exports'} 	     ||
	     /^import /  && $HiSection {'imports'} 	     ||
	     /^\d+ ([^ ]+ :: |type |data |class |newtype )/  && $HiSection {'declarations'} ||
	     /^instance / && $HiSection {'instances'} ) {
       	     print NEWHIF $_;
       	     $_ = <OLDHIF>;
        } else {
          $_ = <OLDHIF>;
	}
    }

    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 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
	  $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;

    open(NEWHI, "> $new_hi") || &tidy_up_and_die(1,"Can't open $new_hi (write)\n");

    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 $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 '';

    print STDERR @decl_names ;

    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 '';

    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'
			    # (old .hi file for module being compiled) or
			    # 'new' (new proto-.hi file for...)
	  $hifile) = @_;    # actual file to read

    # info about the old version of this module's interface
    $HiExists{$mod}      = -1; # 1 <=> definitely exists; 0 <=> doesn't
    $HiHasBeenRead{$mod} = 0;
    $ModuleVersion{$mod} = 0;
    $Stuff{"$mod:usages"}	    = ''; # stuff glommed together
    $Stuff{"$mod:exports"}	    = '';
    $Stuff{"$mod:instances"}	    = '';
    $Stuff{"$mod:declarations"}	    = '';
    $Stuff{"$mod:rules"}	    = '';

    if (! -f $hifile) { # no pre-existing .hi file
	$HiExists{$mod} = 0;
	return();
    }

    open(HIFILE, "< $hifile") || &tidy_up_and_die(1,"Can't open $hifile (read)\n");
    $HiExists{$mod} = 1;
    hi_line: while (<HIFILE>) {
	next if /^ *$/; # blank line

	if ( /^__interface ([A-Z]\S*) (\d+)( \!)?/ ) {
	    if ( $mod ne 'new' ) {
		# Reading old .hi file
		$ModuleVersion{$mod} = $2;
	    }

	    $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 ( /^import / ) {
	    $Stuff{"$mod:usages"} .= $_; # save the whole thing

	} elsif ( /^__export/ ) {
	    $Stuff{"$mod:exports"} .= $_;

	} elsif ( /^instance / ) {
	    $Stuff{"$mod:instances"} .= $_;

	} elsif ( /^{-## __R / ) {
	    $Stuff{"$mod:rules"} .= $_;
	
	} 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	
			# 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 ( /^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 ( /^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 ( /^(\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"} .= $_
	    }

       }
    }

    close(HIFILE) || &tidy_up_and_die(1,"Failed reading from $hifile\n");
    $HiHasBeenRead{$mod} = 1;
}
\end{code}

\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,
	# then comes back, we don't want the resurrected one to have an
	# lower version number than the original (in case there are any
	# lingering references to the original in other .hi files).

    local($unchanged_version) = $ModuleVersion{'old'}; # will return one of these two
    local($changed_version)   = $unchanged_version + 1;

    if ($Orphan{'old'} ne $Orphan{'new'}) {
	return(&mv_change($changed_version, "orphan-hood changed"));
    }

    foreach $t ( 'usages' , 'exports', 'instances', 'fixities', 'rules' ) {
	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" 
	if $Verbose;
    return($unchanged_version);
}

sub mv_change {
    local($mv, $str) = @_;

    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 (! 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}
# make "require"r happy...
1;
\end{code}