#  Copyright (c) 1997-2009
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.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: basic_types 9555 2010-03-09 22:00:06Z herr $

use re 'eval';

declare property_type Text {

   sub equal { $_[0] eq $_[1] }

   sub toXML {
      my ($text, $writer)=@_;
      $writer->cdata($text);
   }
}

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

declare property_type Int : c++ (builtin => 'int') {

   method parse {
      first(extract_integer(), /\G (??{$_[1]})/xgc || &parse_error);
   }

   sub isa { is_integer(@_) }

   function construct($) {
      use integer;
      0+$_[0]
   }
}

declare property_type Bool : c++ (builtin => 'bool') {

   method parse {
      if (m{\G\s* (?i: (\d+) | (true) | false) (??{$_[1]})}xgc) {
	 (defined($1) ? $1!=0 : defined($2))+0
      } else {
	 &parse_error;
      }
   }

   sub isa { is_boolean(@_) }

   function construct($) { $_[0] ? 1 : 0 }

   sub toString { $_[0] ? "true" : "false" }
}

declare property_type Float : c++ (builtin => 'double') {

   method parse {
      first(extract_float(), /\G (??{$_[1]})/xgc || &parse_error);
   }

   sub equal {
      my ($a, $b)=@_;
      my $max=max(abs($a),abs($b));
      $max<=1e-7 || abs($a-$b)<=1e-7*$max;
   }

   sub isa { is_float(@_) }

   function construct($) { 0.0+$_[0] }

   function inf() : c++ (name => 'std::numeric_limits<double>::infinity');

   function minus_inf() { -inf() }
}

declare property_type LocalFloatEpsilon : c++ (special => 'pm::local_epsilon_keeper');

function local_epsilon($) : c++ (include => ["converters.h"]);

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

declare property_type Integer : c++ (operators => '++ -- bool @arith_nofloat % %= << <<= >> >>= \
                                                   **(Integer::pow) abs(abs(*)) @compare <=>(compare(*)) ') {

   function inf() : c++ (name => 'std::numeric_limits<Integer>::max', include => ["Integer.h"]);

   function minus_inf() : c++ (name => 'std::numeric_limits<Integer>::min', include => ["Integer.h"]);
}


# @category Combinatorics

user_function binomial(*,$) : c++ (name => 'Integer::binom', include => ["Integer.h"]);

declare property_type Rational : c++ (operators => '++ -- bool @arith_nofloat << <<= >> >>= abs(abs(*)) @compare <=>(compare(*)) ') {

   method construct(*,*) : c++ : subst_const_op( / );

   function inf() : c++ (name => 'std::numeric_limits<Rational>::max', include => ["Rational.h"]);

   function minus_inf() : c++ (name => 'std::numeric_limits<Rational>::min', include => ["Rational.h"]);
}


# @category Arithmetic

user_function numerator(lvalue_opt(Rational)) : c++;


# @category Arithmetic

user_function denominator(lvalue_opt(Rational)) : c++;


# @category Arithmetic

user_function isfinite(*) : c++ (include => ["Rational.h"]);


# @category Arithmetic

user_function isinf(*) : c++ (include => ["Rational.h"]);


# @category Arithmetic

user_function div_exact(*,*) : c++ (include => ["operations.h"]);


# @category Arithmetic

user_function gcd(*,*) : c++ (include => ["operations.h"]);


# @category Arithmetic

user_function lcm(*,*) : c++ (include => ["operations.h"]);


# @category Arithmetic

user_function fac(*) : c++ (name => 'Integer::fac', include => ["Integer.h"]);

typecheck is_ordered_field_with_unlimited_precision($) {
   my $type=shift;
   $type->abstract or croak( $type->full_name, " is not a suitable coordinate type" )
}

typecheck is_ordered_field_with_unlimited_precision(Rational) { }

typecheck is_ordered_field($) { &typechecks::is_ordered_field_with_unlimited_precision }

typecheck is_ordered_field(Float) { }

# convert to different scalar type if needed
user_function convert_to<Element>($) {
   my $target_type=typeof Element;
   if ($target_type->isa->($_[0])) {
      $_[0]
   } else {
      $target_type->construct->($_[0]);
   }
}

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

declare property_type String : c++ (builtin => 'std::string') {

   method parse {
      if (m{\G\s* (['"])? (?(1) (.*?) (?<! \\) \1 | (.*?) ) (??{$_[1]}) }xgc) {
         $1 ? "$2" : "$3";
      } else {
	 &parse_error;
      }
   }

   sub toString {
      !length($_[0]) || $_[0] =~ /\s/ ? "'$_[0]'" : $_[0]
   }

   sub equal { $_[0] eq $_[1] }
}

declare property_type SCALAR : c++ (special => 'perl::Scalar');

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

sub equal_arrays { is_ARRAY($_[1]) && &equal_lists }

declare property_type List<Element> : c++ (name => 'std::list', builtin => \&as_builtin) {

   method as_builtin {
      my ($self)=@_;
      my $opts=$self->param->cppoptions;
      !$opts || defined($opts->special) || $opts->builtin;
   }

   my $list_elem_end=qr{ \s*\} (??{ pop @delimiters }) | \s }x;

   method parse {
      my ($self, $delim)=@_;
      push @delimiters, $delim;
      my $end=$#delimiters;
      /\G\s* \{ (?: $list_elem_end )? /xogc or parse_error(original_object());

      my @list;
      local_incr($nesting_level);
      while ($#delimiters>=$end) {
	 push @list, $self->param->parse->($list_elem_end);
      }
      bless \@list, original_object()->pkg;
   }

   method canonical {
      my ($self, $value)=@_;
      $self->param->canonical->($_) for @$value;
   }

   method equal {
      my ($self, $a, $b)=@_;
      my $l=$#$a;
      return 0 if $l != $#$b;
      for (my $i=0; $i<=$l; ++$i) {
	 return 0 unless $self->param->equal->($a->[$i],$b->[$i]);
      }
      1
   }

   method toString {
      my ($self, $value)=@_;
      local_incr($nesting_level);
      "{" . join(" ", map { $self->param->toString->($_) } @$value) . "}"
   }

   method trivial_constructor {
      my $self=shift;
      my ($obj, $arg0);
      if (@_!=1 || !is_ARRAY($arg0=$_[0])) {
	 $obj=[ @_ ];
      } elsif (is_object($arg0)) {
	 $obj=[ @$arg0 ];
      } else {
	 $obj=$arg0;
      }
      bless $obj, $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
         $self->canonical->($obj);
      }
      $obj
   }

   method nontrivial_constructor {
      my $self=shift;
      my $obj=bless [ map { new_object($self->param,$_) } @_==1 && is_ARRAY($_[0]) ? @{$_[0]} : @_ ], $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
         $self->canonical->($obj);
      }
      $obj
   }

   method param_is_derived {
      my ($self, $other)=@_;
      $self->name eq $other->name &&
      $self->application == $other->application &&
      UNIVERSAL::isa($other->param->pkg, $self->param->pkg)
   }

   method init {
      my ($self)=@_;
      $self->dimension=1;
      $self->construct=
         $self->param->dimension || defined($self->param->construct)
	 ? \&nontrivial_constructor
	 : \&trivial_constructor;
      unless (defined($self->param->canonical)) {
         undef $self->canonical;
      }
      unless (defined($self->param->equal)) {
         $self->equal=\&equal_arrays;
      }
      unless (defined($self->param->toString)) {
         $self->toString=sub { "{@{$_[0]}}" };
      }
      if (defined($self->param->construct)) {
         $self->isa=sub : method {
            is_object($_[1]) and &PropertyType::isa_fallback || param_is_derived($_[0],$_[1]->type)
         };
      }
      $self->toXML=
         defined($self->param->toXML)
         ? sub : method { nontrivialArray_toXML((shift)->param, @_) }
         : sub : method { trivialArray_toXML((shift)->param, @_) };

      $self->define_basic_operators;
   }
}
##################################################################################

declare property_type Array<Element> : List<Element> : c++ (builtin => \&as_builtin) {

   my $array_elem_end =qr{ \s*> (??{ pop @delimiters }) | \s }x;
   my $array1_elem_end=qr{ (?m:\s*\Z) (??{ pop @delimiters }) | (?<=\n) | [ \t]*\n }x;
   my $array0_elem_end=qr{ (?m:[ \t]*$) (??{ pop @delimiters }) | [ \t] }x;

   method parse {
      my ($self, $delim)=@_;
      push @delimiters, $delim;
      my $end=$#delimiters;
      my $nested=$nesting_level;
      local $nesting_level= $self->dimension==2 ? 0 : $nested+1;
      my @array;
      my $elem_end=
	 $nested
	 ? (/\G\s*< (?: $array_elem_end )? /xogc || parse_error(original_object()), $array_elem_end) :
         $self->dimension>1
	 ? (/\G $array1_elem_end /xogc, $array1_elem_end)
	 : (/\G $array0_elem_end /xogc, $array0_elem_end);
      while ($#delimiters >= $end) {
	 push @array, $self->param->parse->($elem_end);
      }
      bless \@array, original_object()->pkg;
   }

   method init {
      my ($self)=@_;
      &List::init;
      $self->dimension= $self->param->dimension==1 && $self->param->pkg !~ /^Polymake::common::Array_/ ? 1 : $self->param->dimension+1;
      $self->toString=
         defined($self->param->toString)
	 ? ($self->dimension>2
	    ? sub : method {
		 my ($self, $value)=@_;
		 local_incr($nesting_level);
		 ($nesting_level>1 && "<") .
		 join("", map { $self->param->toString->($_) } @$value) .
		 ($nesting_level>1 && ">\n")
	      } :
            $self->dimension==2
	    ? sub : method {
		 my ($self, $value)=@_;
                 my $nested=$nesting_level;
		 local $nesting_level=0;
		 ($nested>0 && "<") .
		 join("", map { enforce_nl($self->param->toString->($_)) } @$value) .
		 ($nested>0 && ">\n")
	      }
	    : sub : method {
	         my ($self, $value)=@_;
	         local_incr($nesting_level);
	         ($nesting_level>1 && "<") .
	         join(" ", map { $self->param->toString->($_) } @$value) .
	         ($nesting_level>1 && ">")
	      })
         : sub {
	      ($nesting_level>0 && "<") . "@{$_[0]}" . ($nesting_level>0 && ">")
	   };
   }
}

function permuted_cxx(*,*) : c++ (name => 'permuted', include => ["permutations.h"]);

function permuted_inv_cxx(*,*) : c++ (name => 'permuted_inv', include => ["permutations.h"]);

function permuted(Array, $) {
   my ($array, $perm)=@_;
   my $proto=$array->type;
   if ($proto->cppoptions->builtin) {
      local $Core::PropertyType::trusted_value=1;
      $proto->construct->(@$array[ @$perm ]);
   } else {
      permuted_cxx(@_);
   }
}

function permuted_inv(Array, $) {
   my ($array, $perm)=@_;
   my $proto=$array->type;
   if ($proto->cppoptions->builtin) {
      my @inv; $#inv=$#$array;
      $inv[$perm->[$_]]=$array->[$_] for 0..$#inv;
      local $Core::PropertyType::trusted_value=1;
      $proto->construct->(\@inv);
   } else {
      permuted_inv_cxx(@_);
   }
}

function permuted_elements(Array, $) {
   my ($array, $perm)=@_;
   local $Core::PropertyType::trusted_value=1;
   $array->type->construct->(map { permuted($_,$perm) } @$array);
}


# @category Combinatorics

user_function find_permutation(*,*) : c++ (include => ["permutations.h"]);


# @category Combinatorics

user_function permutation_cycles(*) : c++ (include => ["permutations.h"]) : returns(Array<List<Int>>);

declare property_type ARRAY : Array<SCALAR> : c++ (special => 'perl::Array');

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

declare property_type Iterator<*> : c++ {

   # inherit the overloaded ++, bool, and deref
   @ISA=qw( Polymake::Core::CPlusPlus::Iterator );
}

function entire(*) : c++ : returns(Iterator<*>);

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

declare property_type Tuple<...> {

   my $tuple_elem_end=qr{ \s*\) (??{ pop @delimiters }) | \s }x;
   my $tuple0_elem_end=qr{ (?m:\s*\Z) (??{ pop @delimiters }) | \s }x;

   method parse {
      my ($self, $delim)=@_;
      push @delimiters, $delim;
      my $end=$#delimiters;
      my @tuple;
      local_incr($nesting_level);
      my $elem_end=
         $nesting_level>1
	 ? (/\G\s*\( (?: $tuple_elem_end )?/xogc || parse_error(original_object()), $tuple_elem_end)
	 : (/\G $tuple0_elem_end /xogc, $tuple0_elem_end);
      my $l=$#{$self->param};
      foreach my $elem (@{$self->param}) {
	 if ($#delimiters < $end) {
	    $#tuple=$#{$self->param};	# fill the rest with undef
	    last;
	 }
	 push @tuple, $elem->parse->($elem_end);
      }
      parse_error(original_object()) if $#delimiters>=$end;
      bless \@tuple, original_object()->pkg;
   }

   method canonical {
      my ($self, $value)=@_;
      die "too many elements\n" if $#$value > $#{$self->param};
      for (my $i=0; $i<=$#$value; ++$i) {
	 if (defined($value->[$i])) {
	    $self->param->[$i]->canonical->($value->[$i]);
	 }
      }
   }

   method toString {
      my ($self, $value)=@_;
      local_incr($nesting_level);
      my $text=$nesting_level>1 && "(";
      for (my $i=0; $i<=$#$value; ++$i) {
	 $text .= ($i>0 && substr($text,-1,1) !~ /\s/ && " ") . $self->param->[$i]->toString->($value->[$i]);
      }
      $text.($nesting_level>1 && ")");
   }

   method trivial_constructor {
      my $self=shift;
      my ($obj, $arg0);
      if (@_ != 1 || !is_ARRAY($arg0=$_[0])) {
	 $obj=\@_;
      } elsif (is_object($arg0)) {
	 $obj=[ @$arg0 ];
      } else {
	 $obj=$arg0;
      }
      if ($#$obj != $#{$self->param}) {
	 croak( "wrong number of arguments given to constructor of ", $self->full_name );
      }
      bless $obj, $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
	 $self->canonical->($obj);
      }
      $obj
   }

   method nontrivial_constructor {
      my $self=shift;
      my $single_arg= @_ == 1 && is_ARRAY(my $arg0=$_[0]);
      if (($single_arg ? $#$arg0 : $#_) != $#{$self->param}) {
	 croak( "wrong number of arguments given to constructor of ", $self->full_name );
      }
      my $i=0;
      my $obj=bless [ map { new_object($self->param->[$i++],$_) } $single_arg ? @$arg0 : @_ ], $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
	 $self->canonical->($obj);
      }
      $obj
   }

   method equal {
      my ($self, $a, $b)=@_;
      my $l=$#$a;
      return 0 if $l != $#$b;
      for (my $i=0; $i<=$l; ++$i) {
	 return 0 unless $self->param->[$i]->equal->($a->[$i],$b->[$i]);
      }
      1
   }

   method params_are_derived {
      my ($self, $other)=@_;
      $self->name eq $other->name &&
      $self->application == $other->application &&
      do {
	 for (my ($i,$l)=(0,$#{$self->param}); $i<=$l; ++$i) {
	    return 0 unless UNIVERSAL::isa($other->param->[$i]->pkg, $self->param->[$i]->pkg);
	 }
	 1
      }
   }

   method init {
      my ($self)=@_;
      $self->dimension=1;
      my ($need_canonical, $need_toString, $need_toXML, $need_special_constructor, $need_equal);
      foreach my $elem (@{$self->param}) {
	 $need_canonical ||= defined($elem->canonical);
	 $need_toString ||= defined($elem->toString);
	 $need_toXML ||= defined($elem->toXML);
	 $need_special_constructor ||= defined($elem->construct);
	 $need_equal ||= defined($elem->equal);
	 assign_max($self->dimension, $elem->dimension);
      }
      unless ($need_canonical) {
	 undef $self->canonical;
      }
      unless ($need_toString) {
	 $self->toString=sub { $nesting_level ? "(@{$_[0]})" : "@{$_[0]}" };
      }
      $self->toXML=$need_toXML
         ? sub : method { nontrivialComposite_toXML((shift)->param, @_) }
	 : \&trivialComposite_toXML;
      $self->construct= $need_special_constructor ? \&nontrivial_constructor : \&trivial_constructor;
      if ($need_special_constructor) {
	 $self->isa=sub : method {
            is_object($_[1]) and &PropertyType::isa_fallback || params_are_derived($_[0],$_[1]->type)
         };
      }
      unless ($need_equal) {
	 $self->equal=\&equal_arrays;
      }
      $self->define_basic_operators;
   }
}

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

declare property_type Pair<First,Second> : Tuple<First,Second> : \
        c++ (name => 'std::pair', builtin => \&as_builtin, include => ["polymake.h"], fields => [qw(first second)]) {

   method as_builtin {
      my ($self)=@_;
      foreach (@{$self->param}) {
	 my $opts=$_->cppoptions;
	 return 0 if $opts && !$opts->builtin;
      }
      1
   }
}

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

declare property_type Serialized<X> : c++ (name => 'pm::Serialized', include => ["polymake.h"]);

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

INCLUDE
  set_types
  algebraic_types
  graph_types


# Local Variables:
# mode: perl
# c-basic-offset:3
# End:
