#  Copyright (c) 1997-2006
#  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: Poly.pm 7142 2006-03-02 09:37:17Z gawrilow $

package RefHash;
use Poly::Ext;

use strict;
use namespaces;

package Poly;
use Poly::Ext;
use Carp;

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

sub min($$) {  $_[0]<$_[1] ? $_[0] : $_[1]  }
sub max($$) {  $_[0]>$_[1] ? $_[0] : $_[1]  }
sub assign_min($$) { !defined($_[0]) || $_[0] > $_[1] and $_[0]=$_[1] }
sub assign_max($$) { !defined($_[0]) || $_[0] < $_[1] and $_[0]=$_[1] }
sub assign_min_max($$$) { !defined($_[0]) ? ($_[0]=$_[1]=$_[2]) : $_[0] > $_[2] ? ($_[0]=$_[2]) : $_[1] < $_[2] && ($_[1]=$_[2]) }
####################################################################################
sub contains($$) {		# \@list, scalar => bool
   my ($list, $item)=@_;
   foreach my $elem (@$list) {
      ref($elem) ? contains($elem,$item) : $elem==$item
      and return 1;
   }
   return 0;
}
####################################################################################
# "string1", "string2"
# => -1 (s1==prefix(s2)) / 0 (s1==s2) / 1 (prefix(s1)==s2) / 2 (otherwise)
sub prefix_cmp($$) {
   my ($s1, $s2)=@_;
   my $l=min(length($s1), length($s2));
   if (substr($s1,0,$l) eq substr($s2,0,$l)) {
      length($s1) <=> length($s2)
   } else {
      2
   }
}
####################################################################################
sub uniq {
   my %seen;
   grep { !($seen{$_}++) } @_;
}
####################################################################################
sub sorted_uniq {
   my $i=-1;
   grep { ++$i == 0 || $_[$i-1] ne $_ } @_;
}
####################################################################################
sub num_sorted_uniq {
   my $i=-1;
   grep { ++$i == 0 || $_[$i-1] != $_ } @_;
}
####################################################################################
# \@list, scalar, [order] => bool
# @list must be sorted in increasing order (or decreasing if $order==-1)
sub binsearch($$;$) {
   my ($list, $item, $order)=(@_, 1);
   my ($l, $h)=(0, scalar @$list);
   while ($l<$h) {
      my $m=($l+$h)/2;
      my $cmp=$item <=> $list->[$m];
      return 1 if !$cmp;
      $cmp!=$order ? ($h=$m) : ($l=$m+1);
   }
   return 0;
}
####################################################################################
sub deep_copy($) {
   my ($src)=@_;
   !ref($src) || is_object($src)
     ? $src
   : is_hash($src)
     ? { map { $_ => deep_copy($src->{$_}) } keys %$src }
   : is_ARRAY($src)
     ? [ map { deep_copy($_) } @$src ]
     : $src
}
####################################################################################
sub enforce_nl($) {
   $_[0].="\n" if substr($_[0],-1) ne "\n";
   $_[0]
}

# FIXME: must die
sub read_block($) {		# \FILEHANDLE => \@data, \@comments
   my ($in)=@_;
   my (@data, @comments);

   while (<$in>) {
      s/^\s+//;
      last if !length;
      enforce_nl($_);
      if (substr($_,0,1) eq '#') {
	 push @comments, $_;
      } else {
	 push @data, $_;
      }
   }
   if (@data) {
      # for the rare case of the last file line lacking \n
      enforce_nl($data[-1]);
   }
   wantarray ? (\@data, \@comments) : \@data;
}
####################################################################################
# FIXME: must die
sub read_block_chomp($) {		# \FILEHANDLE => \@data
   my $data=&read_block;
   foreach (@$data) { chomp };
   return $data;
}
####################################################################################
declare $dbg_prefix="polymake: ";
declare $err_prefix=$dbg_prefix;

{ my $sel=select; select STDERR; $|=1; select $sel; }

sub dbg_print {
   # FIXME: should be connected to the shell output facilities
   print STDERR $dbg_prefix, @_, substr($_[-1],-1) ne "\n" && "\n";
}
####################################################################################
sub err_print {
   # FIXME: should be connected to the shell output facilities
   print STDERR $err_prefix, "ERROR: ", @_, substr($_[-1],-1) ne "\n" && "\n";
}
####################################################################################
sub warn_print {
   # FIXME: should be connected to the shell output facilities
   print STDERR $err_prefix, "WARNING: ", @_, substr($_[-1],-1) ne "\n" && "\n";
}
####################################################################################
sub print_subs {
   my ($pkg)=@_;  $pkg ||= caller;
   print STDERR "package $pkg\n";
   my $symtab=get_pkg($pkg);
   while (my ($name, $glob)=each %$symtab) {
      if (exists &$glob) {
	 print STDERR "$name\n";
      }
   }
   no strict 'refs';
   foreach (@{"$pkg\::ISA"}) {
      print_subs($_);
   }
}
####################################################################################
declare_lvalue(\&retrieve);

*UNIVERSAL::can=\&can;

sub is_array {
   is_object($_[0]) && can($_[0],".constructor") ? defined(overload::Method($_[0],'@{}')) : is_ARRAY($_[0])
}

1