#  Copyright (c) 1997-2005
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#----------------------------------------------------------------------------
#  $Project: polymake $$Id: Scheduler_debug.pm 6646 2005-12-21 18:56:09Z gawrilow $

use strict;
use namespaces;

package Poly::RuleChain;

my $dump_full=$Switches::d>2;

sub dump($) {
   my ($var)=@_;
   if (!instanceof RuleChain($var)) {
      dbg_print( "not a RuleChain ref: $var" );
      return;
   }

   local $Poly::dbg_prefix="";

   dbg_print( "weight=", $var->weight );

   if (!is_ARRAY($var->rules)) {
      dbg_print( "invalid field 'rules': ", $var->rules );
      return;
   }
   dbg_print( map { $_->header, "\n" } @{$var->rules} );

   return unless $dump_full;

   if (!is_hash($var->supplier)) {
      dbg_print( "invalid field 'supplier': ", $var->supplier );
      return;
   }
   if (!is_hash($var->consumer)) {
      dbg_print( "invalid field 'consumer': ", $var->consumer );
      return;
   }

   while (my ($rule, $supp_list)=each %{$var->supplier}) {
      if (!is_ARRAY($supp_list)) {
         if ($supp_list ne 'incl' and $supp_list ne 'run') {
	    dbg_print( "invalid supplier list of ", $rule->header, ": $supp_list" );
	 }
         next;
      }
      dbg_print( "supplier of ", $rule->header, ":\n" );
      foreach my $supp_group (@$supp_list) {
	 if (!is_hash($supp_group)) {
	    dbg_print( "invalid element in supplier list: $supp_group\n" );
	    next;
	 }
         dbg_print( (map { ("   ", $_->header, "\n") } keys %$supp_group),
		    "---" );
      }
   }

   while (my ($rule, $cons)=each %{$var->consumer}) {
      if (!is_hash($cons)) {
	 dbg_print( "invalid consumer list of ", $rule->header, ": $cons" );
	 next;
      }
      dbg_print( "consumer of ", $rule->header, ":\n",
		 (map { ("   ", $_->header, "\n") } keys %$cons), "---" );
   }

   while (my ($rule, $dict)=each %{$var->sensitive_supplier}) {
      if (!is_hash($dict)) {
	 dbg_print( "invalid sensitive_supplier of ", $rule->header, ": $dict" );
	 next;
      }
      dbg_print( "sensitive_supplier of ", $rule->header, ":\n" );
      while (my ($generator, $supp_list)=each %$dict) {
	 if (!is_hash($supp_list)) {
	    dbg_print( "invalid list for diff(", $generator->name, "): $supp_list" );
	    next;
	 }
	 dbg_print( "  diff(", $generator->name, "):\n",
		    map { "    ".$_->header."\n" } keys %$supp_list );
      }
   }

   while (my ($rule, $dict)=each %{$var->sensitive_consumer}) {
      if (!is_hash($dict)) {
	 dbg_print( "invalid sensitive_consumer of ", $rule->header, ": $dict" );
	 next;
      }
      dbg_print( "sensitive_consumer of ", $rule->header, ":\n" );
      while (my ($generator, $list)=each %$dict) {
	 if (!is_ARRAY($list)) {
	    dbg_print( "invalid list for diff(", $generator->name, "): $list" );
	    next;
	 }
	 dbg_print( "  diff(", $generator->name, "):\n",
		    map { "    ".$_->header."\n" } @$list );
      }
   }

   return unless instanceof InitRuleChain($var);

   if (!is_hash($var->run)) {
      dbg_print( "invalid field 'run': ", $var->run );
   } else {
      dbg_print( "exec codes:\n" );
      while (my ($rule, $code)=each %{$var->run}) {
	 dbg_print( $rule->header, " -> ",
		    is_object($code) ? $code : $code==$exec_OK ? "OK" : $code==$exec_failed ? "FAIL" : $code );
      }
   }
}

sub dump_list($) {
   my ($varlist)=@_;
   foreach my $var (@$varlist) {
      dbg_print( $var->id );
      $var->dump;
      dbg_print( "\n" );
   }
}

sub check_rule_graph($) {
   my ($self)=@_;

   while (my ($rule, $cons)=each %{$self->consumer}) {
      my @errormsg;
      foreach my $cons_rule (keys %$cons) {
	 my $supp=$self->supplier->{$cons_rule};
	 if (!defined $supp) {
	    push @errormsg, "undefined supplier of ", $cons_rule->header, "\n";
	    next;
	 }
         next if !is_ARRAY($supp);	# will report this later
         my $found;
         foreach my $supp_group (@$supp) {
	    next if !is_hash($supp_group);		# and this too
            if (exists $supp_group->{$rule}) {
               $found=1; last;
            }
         }
         if (!$found) {
            push @errormsg, "not found in supplier of ", $cons_rule->header, "\n";
         }
      }
      if (@errormsg) {
         dbg_print( "from consumer of ", $rule->header, ":\n", @errormsg );
      }
   }

   while (my ($rule, $supp_list)=each %{$self->supplier}) {
      if (is_ARRAY($supp_list)) {
         my @errormsg;
         foreach my $supp_group (@$supp_list) {
	    if (!is_hash($supp_group)) {
	       push @errormsg, "invalid element in supplier list: $supp_group\n";
	       next;
	    }
            foreach my $supp_rule (keys %$supp_group) {
	       if (!defined $self->consumer->{$supp_rule}) {
		  push @errormsg, "undefined consumer of ", $supp_rule->header, "\n";
		  next;
	       }
	       if (!exists $self->consumer->{$supp_rule}->{$rule}) {
		  push @errormsg, "not found in consumer of ", $supp_rule->header, "\n";
	       }
	    }
	 }
         if (@errormsg) {
            dbg_print( "from supplier of ", $rule->header, ":\n", @errormsg );
         }
      } else {
         dbg_print( "invalid supplier of ", $rule->header, ": $supp_list" );
      }
   }
}

sub announce_pop($) {
   my ($self)=@_;
   dbg_print( "======= pop ", $self->id, " =======" );
}
sub announce_push($) {
   my ($self)=@_;
   dbg_print( "======= push ", $self->id, " ======" );
   $self->dump;
}

####################################################################################

package Poly::Scheduler::Heap;
sub find($$) {
   my ($self, $id)=@_;
   foreach my $var (@$self) {
      return $var if $var->id eq $id;
   }
}

####################################################################################

1;