#!/usr/local/perl5.002/bin/perl

# GraphColoring.pm - color the class graph %classes made by ClassParser.pm
# Copyright (C) 1996 Peter Orbaek <poe@daimi.aau.dk>
# This code is freely re-distributable under the GNU General Public License
# Version 1.0 11-May-96

package GraphColoring;

require 5.002;
use vars qw(@ISA @EXPORT);
use strict 'vars', 'subs';
use Carp;
use Exporter;
use ClassParser qw(%classes);

@ISA = qw(Exporter);
@EXPORT = qw(iterate cleanup);

my ($visited_bit, $changed);
$visited_bit = 1;
$changed     = 0;

# reset graph colorer to be ready for the next traversal spec
sub cleanup {
    my ($c);

    $visited_bit = 1;
    $changed     = 0;

    foreach $c (keys %classes) {
	$classes{$c}{visited} = 0;
	$classes{$c}{colored} = 0;
    }
}

# mark node referenced by $n as visited in current coloring
sub visited {
	my ($n) = @_;

	$$n{visited} == $visited_bit;
}

# return true iff the node referenced by is visited in current coloring
sub visit {
	my ($n) = @_;

	$$n{'visited'} = $visited_bit;
}

# return true iff the node referenced by $n is colored
sub iscolored {
	my ($n) = @_;
	$$n{colored};
}

# color the node referenced by $n and recursively all subclass node of $n
sub color {
    my ($n) = @_;
    my ($r);

    if (!($n->{colored})) {
	$changed      = 1;  # something happened!
	$n->{colored} = 1;

	# if this is a superclass then color all the subclasses
	# because they inherit all the fields of the superclass
	foreach $r (values %{$n->{subclasses}}) {
	    &color($r);
	}
    }
}

# color the graph interval between $s (source) and $t (target) using
# $forspec as a ref to a hash telling which instance edges NOT to follow
# return true is $s was colored. This is essentially a DFS coloring 
# bottom-up
sub colorInterval {
	my ($s, $t, $forspec) = @_;
	my ($r, %neighbors, $n, $c);

	if (!(visited $s)) {
		visit $s;

		if ($s eq $t) {
			color $s;
		}
		$r = 0;

		# follow all instance edges not mentioned in $forspec
		# also those inherited from all superclasses
		foreach $c ($s, Codegen::superrefs($s)) {
		    %neighbors = %{$c->{instancevars}};

		    foreach $n (keys %neighbors) {
			#print "FOO: $n ", $forspec->{$s}{$n}, "\n";
			# notice using $s not $c here
			next if ($forspec->{$s}{$n});
			# print "[instance $n, ";
			$r = $r | colorInterval($neighbors{$n}, $t);
			# print "]\n";
		    }
		}
		%neighbors = %{$$s{subclasses}};
		foreach $n (keys %neighbors) {
			# print "[subclass $n, ";
			$r = $r | colorInterval($neighbors{$n}, $t);
			# print "]\n";
		}

		color $s if ($r);
	}
	return iscolored($s);
}

# iterate the graph coloring of the interval from $s to $t until no more
# changes are made. Use $forspec generated in ProgParser to say which
# instance edges NOT to follow
sub iterate {
	my ($s, $t, $forspec) = @_;

	do {
		$changed = 0;
		colorInterval($s, $t, $forspec);
		$visited_bit = 1 - $visited_bit;
	} until ($changed == 0);
}

1;