#  Copyright (c) 1997-2010
#  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: CPlusPlus.pm 10011 2011-01-12 22:08:59Z gawrilow $

use namespaces;

package Polymake::Core::CPlusPlus;

my ($debug, $dl_suffix, $Object_pseudo_proto, $Object_pseudo_options, $custom_handler);

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

package Polymake::Core::CPlusPlus::FuncDescr;
use Polymake::Struct (
   '$wrapper',
   '$func_ptr',
   '$name | func_ptr_type',
   '$source_file',
   '$arg_types',
   '$auto_func',
);

sub source_line { (shift)->source_file+0 }

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

package Polymake::Core::CPlusPlus::AutoFunction;

use Polymake::Struct (
   [ new => '$$$%' ],
   '$name',
   [ '$perl_name' => '#1' ],
   [ '$wrapper_name' => '#1' ],
   [ '$flags' => '#2' ],
   [ '$application' => '#3' ],
   [ '$extension' => '$Application::extension' ],
   '@include',
   [ '$embedded' => 'undef' ],
   [ '$macro_call' => '$this->flags & $func_is_void ? "Void( " : "( "' ],
   '@all_params',
   '@template_params',
   '@extra_template_params',
   '@lvalue_params',
   '@wary_params',
   [ '$via_object' => 'undef' ],
   [ '$opt_hashes' => '0' ],
   '@args_for_deduction',
   '%inst_cache',
   '&builtin_code',
   '%seen_in',                  # "sourcefile" => number of instantiations
);

sub prepare {
   my ($self, $signature, $pkg, $app)=@_;
   my $internal=@_<4  and  $pkg="Polymake";
   my ($tpcount, $arg_off, $type_eval_pkg)=(defined($self->via_object)+0, 0, $pkg);
   my $tpcount_before_explicit=$tpcount;
   my $type_eval_symtab;
   my $type_args_may_be_omitted=0;
   my (@arg_list, $min, $defaults, @repeated);  # as in Overload::parse_signature
   my $fixed=1;
   my ($repeated_seen, $arg_for_lvalue_opt);

   if (is_string($self->extra_template_params)) {
      $type_eval_pkg="Polymake::Core::CPlusPlus::AutoFunction::_type_eval";
      $type_eval_symtab=get_pkg($type_eval_pkg,1);
      namespaces::using($type_eval_pkg,$pkg);
      push @arg_list, 'namespaces::TemplateExpression';
      push @repeated, undef;
      $arg_off=1;
      $type_args_may_be_omitted=1;
      (my $extra=$self->extra_template_params) =~ s/^\s+//;
      $self->extra_template_params=[ ];
      while ($extra =~ /\G($id_re) (?: \s*=\s* ($extd_type_re))? \s*(?:,\s*|$)/oxgc) {
         my ($id, $default)=($1,$2);
         my $placeholder=new PropertyTypePlaceholder($id,$pkg,undef);
         $placeholder->cppoptions=new TemplateParam("T$tpcount",$tpcount++,$default);
         $placeholder->abstract=sub { 1 };
         define_function($type_eval_symtab, $id, sub { $placeholder->cppoptions->deduced ||= defined($min)+1; $placeholder });
         push @{$self->extra_template_params}, $placeholder;
         $type_args_may_be_omitted &&= defined($default);
      }
   } elsif (@{$self->extra_template_params} or $self->flags & $func_has_prescribed_ret_type) {
      $tpcount+=@{$self->extra_template_params};
      $arg_off=1;
   }

   if ($self->perl_name ne "operator" && $self->perl_name ne "construct") {
      $self->name ||= $self->perl_name;
      if ($tpcount > $tpcount_before_explicit) {
         $self->name .= "<" . join(",", map { "T$_" } $tpcount_before_explicit..$tpcount-1) . ">";
      }
   }

   if ($self->flags & $func_is_method) {
      unless ($internal) {
         my $opts=UNIVERSAL::can($pkg,"c++options");
         if ($opts) {
            if ($opts==\&ObjectType::cppoptions) {
               $self->flags |= $func_is_top_object_method;
               if ($self->via_object) {
                  push @{$self->all_params}, "self.";
                  $self->wrapper_name.="_O";
               }
               goto NOMETHOD;
            } else {
               $opts=$opts->();
            }
         } else {
            my $proto=(UNIVERSAL::can($pkg,"prototype") || croak( "perl package $pkg has no C++ binding" ))->();
            unless ($opts=$proto->cppoptions) {
               croak( "class ", $proto->full_name, " has no C++ binding" );
            }
         }
         if ($opts->builtin && !is_code($opts->builtin)) {
            croak( "can't declare methods for C++ primitive type ", $opts->builtin );
         }
      }
      push @{$self->all_params}, "arg0.get<T$tpcount>()".($self->perl_name ne 'operator' && ".");
      push @{$self->template_params}, [ $arg_off, $self->flags & $func_is_non_const ? $func_is_lvalue : $self->flags & ($func_is_lvalue|$func_is_lvalue_opt) ];
      $self->wary_params->[$arg_off]=$self->flags & $func_is_wary;
      $arg_for_lvalue_opt=$tpcount if $self->flags & ($func_is_lvalue | $func_is_lvalue_opt);
      ++$tpcount;
    NOMETHOD: ;
   }
   if ($self->flags & $func_has_prescribed_ret_type) { $self->wrapper_name.="_R"; }
      
   $signature =~ s/^\s+//;
   while (pos($signature) < length($signature)) {
      if ($signature =~ /\G; \s*/gxc) {
         if (defined $min) {
            croak( "invalid signature: multiple ';'" );
         }
         $min=@arg_list;
         next;
      }

      my ($as_template_arg, $wrapper_suffix);
      my $lval_flag=0;
      my $wary_flag=0;
      my $cpp_arg_no=@{$self->all_params};
      my $perl_arg_no=$cpp_arg_no+$arg_off;
      my $cpp_arg="arg$cpp_arg_no";

      if ($signature =~ /\G \@ \s*$/gxc) {
         if ($repeated_seen) {
            croak( "several repeating trailing lists not allowed" );
         }
         $wrapper_suffix="e";
         $self->flags |= $func_is_ellipsis;
         undef $fixed;

      } elsif ($signature =~ /\G % \s*$/gxc) {
         $wrapper_suffix="o";
         if (defined $min) {
            # provide undef's as default values for the optional parameters
            $#{$defaults ||= [ ]}=$#arg_list;
         }
         undef $fixed;

      } elsif ($signature =~ /\G (?: \$ | (?: (\*) | ($type_re (?: \s*\|\s* $type_re)*)) ((?: \s*:\s* $id_re)+)?)
                                 (?(1) | (?(3) | (?: \s*=\s* ($expression_re) | (?(2) \s*(\+))? ))) \s*(?:,\s*)?/gxco) {

         if ($repeated_seen) {
            croak( "repeating argument must be the last one in the signature" );
         }
         my ($star, $type, $attrs, $default_value, $repeated)=($1, $2, $3, $4, $5);
         while ($attrs =~ /$id_re/go) {
            if ($& eq "wary") {
               $wary_flag=1;
            } elsif ($& eq "lvalue") {
               $lval_flag=$func_is_lvalue;
            } elsif ($& eq "lvalue_opt") {
               $lval_flag=$func_is_lvalue_opt;
               unless ($self->flags & ($func_is_lvalue | $func_is_lvalue_opt | $func_is_void)) {
                  $arg_for_lvalue_opt=$tpcount;
                  $self->flags |= $func_is_lvalue_opt;
               }
            } else {
               croak( "unknown argument attribute '$&'" );
            }
         }
         if ($lval_flag == ($func_is_lvalue | $func_is_lvalue_opt)) {
            croak( "multiple conflicting argument attributes: $attrs" );
         }
         if ($lval_flag && defined($min)) {
            croak( "an lvalue argument can't be optional" );
         }

         if (defined($min) != defined($default_value)) {
            croak( defined($min) ? "optional argument without default value not allowed in a C++ function"
                                 : "only optional arguments may have default values" );
         }

         $repeated_seen=$repeated;
         push @repeated, $repeated;

         if (defined $default_value) {
            Overload::parse_default_value($defaults, $#arg_list, $pkg, $app, $default_value);
         }
         if (defined $type) {
            my $proto;
            if ($type =~ /^$qual_id_re$/o) {
               if ($type_eval_symtab && exists $type_eval_symtab->{$type}) {
                  my $placeholder=$type_eval_symtab->{$type}->();
                  push @{$self->args_for_deduction}, [ $placeholder, $perl_arg_no ];
                  push @arg_list, '$';
                  $as_template_arg=1;
               } else {
                  $type=namespaces::lookup_class($pkg, $type, $app ? ($app->pkg) : ())
                        || croak( "Unknown type '$type'" );
                  push @arg_list, $type;
                  if (defined (my $opts=UNIVERSAL::can($type,"c++options"))) {
                     $as_template_arg= $opts != \&ObjectType::cppoptions;
                  } else {
                     $proto=(UNIVERSAL::can($type,"prototype") || croak( "pure perl package '$type' can't be passed to C++ subroutine" ))->();
                  }
               }
            } elsif ($type =~ /\|/) {
               my @alt_list;
               foreach (split /\s*\|\s*/, $type) {
                  if (/^$qual_id_re$/o) {
                     $type=namespaces::lookup_class($pkg, $_, $app ? ($app->pkg) : ())
                           || croak( $type_eval_symtab && exists $type_eval_symtab->{$_}
                                     ? "Can't use template type argument $_ in an alternative"
                                     : "Unknown type '$_'" );
                     if (defined (my $opts=UNIVERSAL::can($type,"c++options"))) {
                        if (defined $as_template_arg) {
                           if ($as_template_arg != ($opts != \&ObjectType::cppoptions)) {
                              croak( "can't mix C++ types and polymake Objects in an alternative list" );
                           }
                        } else {
                           $as_template_arg= $opts != \&ObjectType::cppoptions;
                        }
                     } else {
                        croak( "pure perl package '$type' can't be passed to C++ subroutine" );
                     }
                     push @alt_list, $type;

                  } else {
                     translate_type(my $tt=$_);
                     $tt="package $type_eval_pkg; $tt";
                     $proto=$app ? $app->eval_expr->($tt) : eval($tt)  or report_type_error($type);
                     if ($proto->abstract) {
                        croak( "Can't use the type $_ depending on a template argument in an alternative" );
                     }
                     if (defined $as_template_arg) {
                        if ($as_template_arg != !instanceof ObjectType($proto)) {
                           croak( "can't mix C++ types and polymake Objects in an alternative list" );
                        }
                     } else {
                        $as_template_arg= !instanceof ObjectType($proto);
                     }
                     push @alt_list, $proto->pkg;
                  }
               }
               push @arg_list, \@alt_list;
               undef $proto;

            } else {
               translate_type(my $tt=$type);
               $tt="package $type_eval_pkg; $tt";
               $proto=$app ? $app->eval_expr->($tt) : eval($tt)  or report_type_error($type);
               push @arg_list, $proto->pkg;
               if ($proto->abstract) {
                  if (defined($proto->context_pkg) && !($self->flags & $func_is_method) && $self->perl_name ne "construct") {
                     croak( "template parameters in abstract type ", $proto->full_name, " does not match the function declaration" );
                  }
                  push @{$self->args_for_deduction}, [ $proto, $perl_arg_no ];
                  $as_template_arg= $proto->cppoptions != $Object_pseudo_options;
                  undef $proto;
               }
            }

            if (defined($proto)) {
               if (my $opts=$proto->cppoptions) {
                  if ($opts == $Object_pseudo_options) {
                     if ($lval_flag) {
                        croak( "superfluous 'lvalue' attribute: objects of type ", $proto->name, " are always passed by reference" );
                     }
                  } else {
                     if ($proto->cppoptions->builtin) {
                        if ($lval_flag) {
                           croak( $proto->full_name, " is declared as perl built-in type and can't be passed to C++ code by reference" );
                        }
                        $wrapper_suffix=$proto->cppoptions->builtin;
                        $cpp_arg.=".get<$wrapper_suffix>()";
                        $arg_list[-1]= $wrapper_suffix eq "int" ? "Polymake::Overload::integer" :
                                       $wrapper_suffix eq "double" ? "Polymake::Overload::float" : '$';
                     } else {
                        $as_template_arg=1;
                     }
                  }
               } else {
                  croak( "class ", $proto->full_name, " has no C++ binding" );
               }
            }
         } else {
            $as_template_arg=defined($star);
            push @arg_list, '$';
         }
      } else {
         croak( "Invalid signature for a C++ function" );
      }

      if ($as_template_arg || $lval_flag==$func_is_lvalue_opt) {
         push @{$self->all_params}, "$cpp_arg.get<T$tpcount>()";
         push @{$self->template_params}, [ $perl_arg_no, $lval_flag ];
         ++$tpcount;
      } else {
         push @{$self->all_params}, $cpp_arg;
         push @{$self->lvalue_params}, $perl_arg_no if $lval_flag;
      }
      $self->wary_params->[$perl_arg_no]=$wary_flag;
      $self->wrapper_name.="_".($wrapper_suffix || ($as_template_arg ? "X" : "x"));
      $self->wrapper_name.=$lval_flag if $lval_flag;
   }

   if ($type_eval_symtab) {
      Overload::finalize_extra_template_params($self->extra_template_params, $pkg, $type_eval_pkg, $app);
   } elsif (!$tpcount) {
      $self->inst_cache=undef;
   }

   if ($self->flags & ($func_is_lvalue|$func_is_lvalue_opt)) {
      $self->macro_call="Lvalue".$self->macro_call."T$arg_for_lvalue_opt, ";
   }
   if (my $fl=($self->flags & ($func_is_method|$func_is_lvalue|$func_is_lvalue_opt|$func_is_void))) {
      $self->wrapper_name .= "_f$fl";
   }
   if ($repeated_seen) {
      $self->flags |= $func_is_ellipsis;
      undef $fixed;
   }
   $self->wrapper_name =~ tr/:/_/;

   defined(wantarray) and do {
      $min=@arg_list unless defined $min;
      ([ $min, $fixed && scalar(@arg_list), $defaults, \@repeated, @arg_list ],
       $type_args_may_be_omitted)
   }
}

sub prepare_wrapper_code {
   my ($self, $code)=@_;
   my $n_args=@{$self->all_params};
   ++$n_args if @{$self->extra_template_params} || ($self->flags & $func_has_prescribed_ret_type);
   set_number_of_args($code, $n_args, $self->opt_hashes, $self->flags & $func_is_ellipsis, undef);
   declare_lvalue($code, 1) if $self->flags & ($func_is_lvalue|$func_is_lvalue_opt);
}

sub deduce_extra_params {
   my ($self, $args)=@_;
   Overload::deduce_extra_template_params($self->extra_template_params, $self->args_for_deduction,
                                          $args, 0, $args->[0], \&guess_builtin_type);
}

sub gen_source_code {
   my ($self, $debug_code)=@_;

   my $t_args=$self->template_params ? $#{$self->extra_template_params}+1+$#{$self->template_params} : -1;
   ++$t_args if $self->via_object;
   my $typelist=join(",", map { "T$_" } 0..$t_args);
   my $change_guard_name=$self->name;
   my $call_name= $change_guard_name eq "stack" ? $self->application->name."::stack" : $change_guard_name;
   my $call_as_method= ($self->flags & $func_is_method) && (defined($self->via_object) || !($self->flags & $func_is_top_object_method));

   my @args=@{$self->all_params};
   my $arg_off=@{$self->extra_template_params} || ($self->flags & $func_has_prescribed_ret_type) ? 1 : 0;

   ( "   template <" . join(", ", $t_args>=0 ? (map { "typename T$_" } 0..$t_args) : "typename T0=void") . ">\n",
     "   FunctionInterface4perl( " . $self->wrapper_name . ($t_args>=0 && ", $typelist") . " ) {\n",
     @args>0 &&
     "      perl::Value " . join(", ", map { "arg$_(stack[".($_+$arg_off)."])" } 0..$#args) . ";\n",
     $self->via_object &&
     "      perl::Object arg0o;  arg0 >> arg0o;  const T0 self(arg0o);\n",
     "      WrapperReturn" . $self->macro_call . ($call_as_method ? shift(@args) : "") . "$call_name(" . join(", ", @args) . ") );\n",
     "   };\n",
     defined($self->embedded) && !$call_as_method && @args &&
     "  " . ( $change_guard_name =~ s/<.*>$// &&
              " template <" . join(",", map { "typename X$_" } 0..$#{$self->extra_template_params}) . ">" ) .
     " int $change_guard_name(" . join(",", ("perl::Anything") x @args) . ");\n",
     "\n",
   )
}

sub find_instance {
   my ($self, $args)=@_;
   my $instance=$self->inst_cache;
   if (defined($self->via_object)) {
      $instance=$instance->{$self->via_object} or return;
   }
   my $builtin_code=$self->builtin_code;
   if (@{$self->extra_template_params}) {
      foreach my $proto ($self->deduce_extra_params($args)) {
         if (!defined $proto) {
            croak( "an explicit template parameter omitted in the call" );
         }
         $instance &&= $instance->{$proto->cpp_type_descr->typeid};
      }
   }
   foreach (@{$self->template_params}) {
      my ($arg, $lval_flag)=($args->[$_->[0]], $_->[1]);
      my $typeid=get_magic_typeid($arg, $lval_flag);
      if (defined $typeid) {
         undef $builtin_code;
         $instance &&= $instance->{$typeid};
         if ($lval_flag) {
            if ($lval_flag == $func_is_lvalue_opt) {
               $instance &&= $instance->[$typeid];
            } elsif ($typeid==1) {
               $self->complain_ro_violation($_->[0]);
            }
         }
      } else {
         my $proto=guess_builtin_type($arg);
         if ($lval_flag) {
            croak( "Can't pass a primitive type ", $proto->full_name, " by reference to a C++ function" );
         }
         my $descr=provide_cpp_type_descr($proto, 1);
         if (is_code($descr)) {
            $descr=$descr->();
         }
         $instance &&= $instance->{$descr->typeid};
      }
   }
   $self->check_lvalue_args($args);
   defined($builtin_code || $instance);
}

sub disable_after_error { 0 }

sub name_for_disabled { &wrapper_name }
sub instance_macro { defined($_[0]->via_object) ? "MethodInstance4perl" : "FunctionInstance4perl" }

sub source_file { "auto-".$_[0]->perl_name.".cc" }

sub complain_ro_violation {
   my ($self, $arg_no)=@_;
   croak( "Attempt to modify a read-only C++ object passed as argument $arg_no to function ", $self->perl_name );
}

sub check_lvalue_args {
   my ($self, $args)=@_;
   foreach my $arg_no (@{$self->lvalue_params}) {
      if (defined (my $typeid=get_magic_typeid($args->[$arg_no], $func_is_lvalue))) {
         if ($typeid==1) {
            complain_ro_violation($self,$arg_no);
         }
      } else {
         croak( "Argument $arg_no in the call to ", $self->perl_name, " can't be passed by reference\n",
                "as it is not an object with C++ binding." );
      }
   }
}

#######################################################################################
package Polymake::Core::CPlusPlus::DuplicateInstance;

use Polymake::Struct (
   [ new => '$$' ],
   [ '$descr' => '#1' ],
   [ '$application' => '#2' ],
   [ '$extension' => '$Application::extension' ],
);

sub embedded { (shift)->descr->auto_func->embedded }
sub is_instance_of { (shift)->descr->auto_func }

#######################################################################################
package Polymake::Core::CPlusPlus::LackingInstance;

use Polymake::Struct (
   [ new => '$$;$' ],
   [ '$is_instance_of' => '#1' ],
   '@args',     # 'C++ type expression', ...
   '@headers',  # [ 'header', ... ], ...
   [ '$embedded' => '#1 ->embedded' ],
   [ '$application' => '#1 ->application' ],
   [ '$extension' => '#1 ->extension' ],
   '$source_file',
   '$private',
);

sub new {
   my $self=&_new;
   my ($auto_func, $args, $wary_params)=@_;
   $wary_params ||= $auto_func->wary_params;

   if ($auto_func->via_object) {
      push @{$self->args}, $auto_func->via_object;
   }

   if (@{$auto_func->extra_template_params}) {
      my @extra=$auto_func->deduce_extra_params($args);
      foreach (@extra) {
         my ($arg_type, $includes, $embedded, $app, $extension)=$_->get_cpp_representation;
         push @{$self->args}, $arg_type;
         push @{$self->headers}, @$includes;
         set_embedded($self,$embedded) if defined($embedded);
         set_extension($self->extension,$extension) if defined($extension);
         set_application($self,$app);
      }
   }

   foreach (@{$auto_func->template_params}) {
      my ($arg_no, $lval_flag)=@$_;
      my ($arg_type, $includes, $embedded, $app, $extension);
      if (defined (my $typeid=get_magic_typeid($args->[$arg_no], $lval_flag))) {
         my $const= $lval_flag && $typeid==0 ? "" : "const ";
         ($arg_type, $includes, $embedded, $app, $extension)=($root->typeids->{$typeid} || die "unregistered C++ typeid $typeid\n")->get_cpp_representation;
         $arg_type="Wary< $arg_type >" if $wary_params->[$arg_no];
         $arg_type="perl::Canned< $const$arg_type >";
      } else {
         my $proto=guess_builtin_type($args->[$arg_no]);
         my $opts=$proto->cppoptions->finalize;
         if (ref($opts->builtin) eq "Polymake::Enum") {
            $arg_type="perl::Enum<" . $opts->name . ">";
         } elsif ($opts->template_params) {
            $arg_type=$opts->name;
            $arg_type="Wary< $arg_type >" if $wary_params->[$arg_no];
            $arg_type="perl::TryCanned< const $arg_type >";
         } else {
            $arg_type=$opts->name;
         }
         $includes=$opts->include;
         $app=$proto->application;
      }
      push @{$self->args}, $arg_type;
      push @{$self->headers}, @$includes;
      set_embedded($self,$embedded) if defined($embedded);
      set_extension($self->extension,$extension) if defined($extension);
      set_application($self,$app);
   }

   analyze_provenience($self);
   unless (defined($self->embedded)) {
      $self->source_file=source_top($self->application, $self->extension) . "/src/perl/" . $auto_func->source_file($args);
   }
   $self;
}

sub complain_source_conflict {
   "Don't know where to place the instance of ", $_[0]->is_instance_of->perl_name
}

sub gen_source_code {
   my $self=shift;
   my $func=$self->is_instance_of;
   "   " . $func->instance_macro . "(" . join(", ", $func->wrapper_name, @{$self->args}) . ");\n"
}

sub gen_temp_code {
   my $self=shift;
   ( $self->is_instance_of->gen_source_code($debug), $self->gen_source_code );
}

sub include {
   my $self=shift;
   (@{$self->is_instance_of->include}, @{$self->headers})
}

sub temp_include {
   my $self=shift;
   if (defined (my $src_file=$self->is_instance_of->embedded || $self->embedded)) {
      (withInclude => $src_file, @{$self->headers})
   } else {
      (@{$self->is_instance_of->include}, @{$self->headers})
   }
}

sub retry_on_error {
   my $self=shift;
   $self->private=1;
   $self->is_instance_of->disable_after_error($self) and
   bless $self, "Polymake::Core::CPlusPlus::DisabledInstance";
}

my $skip_core_functions_re=qr{^\(eval\s+\d+\)|^$InstallTop/(?:perllib/Polymake|scripts)/|/XML/}o;
my $called_from_app_tree=qr{^(.*?)/apps/$id_re/(rules|perllib|scripts|src|testsuite)}o;

sub analyze_provenience {
   my $self=shift;
   my $file;
   my $depth=1;
   my $is_saving;
   while (defined ($file=(caller(++$depth))[1])) {
      if ($file =~ m{Core/XMLfile\.pm$}) {
         $is_saving=1 if (caller($depth))[3] =~ /::save(?:_data)?$/;
      }
      if ($file !~ $skip_core_functions_re) {
         if ($file =~ $called_from_app_tree) {
            return if $1 eq $InstallTop;
            if (defined (my $ext=lookup Extension($1))) {
               set_extension($self->extension, $ext);
               return;
            }
         }
         last;
      }
   }
   $self->private=!$is_saving;
}
#######################################################################################

package Polymake::Core::CPlusPlus::DisabledInstance;
use Polymake::Struct ([ '@ISA' => 'LackingInstance' ]);

sub gen_source_code {
   my $self=shift;
   "   DisabledFunction4perl(" . join(", ", $self->is_instance_of->name_for_disabled, @{$self->args}) . ");\n"
}

sub retry_on_error { 0 }

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

package Polymake::Core::CPlusPlus::LackingRegular;
use Polymake::Struct (
   [ new => '$$' ],
   [ '$is_instance_of' => '#1' ],
   '$func_ptr_type',
);

sub new {
   my $self=&_new;
   my $func_descr=pop;
   my $func=$self->is_instance_of;
   ($self->func_ptr_type=demangle($func_descr->func_ptr_type)) =~ s/pm::type2type<\s* ($balanced_re) \(\) \s* ($balanced_re) >/$1$2/xo;
   $self->func_ptr_type =~ s/(?<![\w:])pm::(perl::(?:Object(?:Type)?|OptionSet|Scalar|Array|Hash))(?![\w:])/$1/g;
   my $i=0;
   @{$func->all_params}=map {
      my $arg="arg$i";
      if (defined (my $type_descr=$root->typeids->{$_})) {
         my $proto=&{$type_descr->pkg->{prototype}}();
         if (!$proto->cppoptions->builtin) {
            my $const= !contains($self->is_instance_of->lvalue_params,$i) && "const ";
            $arg.=".get< perl::TryCanned< $const".$type_descr->get_cpp_representation($proto)." > >()";
         }
      }
      ++$i; $arg
   } @{$func_descr->arg_types};

   if ($func->flags & $func_is_void) {
      $func->macro_call="Void( ";
   }
   $func->seen_in=1;
   $self;
}

sub gen_source_code {
   my ($self, $debug_code)=@_;
   my $func=$self->is_instance_of;
   my $args=$func->all_params;
   ( "   FunctionWrapper4perl( ".$self->func_ptr_type." ) {\n",
     @$args>0 &&
     "      perl::Value " . join(", ", map { "arg$_(stack[$_])" } 0..$#$args) . ";\n",
     "      IndirectWrapperReturn" . $func->macro_call . join(", ", @$args) . " );\n",
     "   }\n",
     "   FunctionWrapperInstance4perl( ".$self->func_ptr_type." );\n\n",
   )
}

sub gen_temp_code { gen_source_code(shift,$debug) }
sub temp_include { (withInclude => (shift)->is_instance_of->embedded) }

sub include { () }
sub embedded { (shift)->is_instance_of->embedded }
sub extension { (shift)->is_instance_of->extension }
sub private { 0 }
sub retry_on_error { 0 }

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

package Polymake::Core::CPlusPlus::Constructor;
use Polymake::Struct (
   [ '@ISA' => 'AutoFunction' ],
   [ new => '' ],
   [ '$perl_name' => '"construct"' ],
   [ '$wrapper_name' => '"new"' ],
   [ '$macro_call' => '"New(T0, "' ],
   [ '@extra_template_params' => '(0)' ],
);

sub disable_after_error {
   my ($self, $failed)=@_;
   @{$failed->args}<=2;
}

sub create_fallback {
   $#{$_[0]->all_params} ? sub { croak( "Class ", $_[0]->full_name, " has no default constructor" ) } : \&construct_any
}

sub deduce_extra_params {
   # the only template type argument is the type to be constructed,
   # already represented by a PropertyType object sitting at the front of the argument list
   $_[1]->[0]
}

sub source_file { $_[1]->[0]->name.".cc" }

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

package Polymake::Core::CPlusPlus::SpecialOperator;
use Polymake::Struct (
   [ '@ISA' => 'AutoFunction' ],
   [ new => '$' ],
   [ '$perl_name' => '"operator"' ],
   [ '$wrapper_name' => '#1' ],
   [ '$seen_in' => '1' ],
   [ '@all_params' => '(undef)' ],
   [ '@template_params' => '([1,0])' ],
   [ '@extra_template_params' => '(0)' ],
);

*deduce_extra_params=\&Constructor::deduce_extra_params;
*source_file=\&Constructor::source_file;

sub gen_source_code { "" }

sub create_fallback {
   my $is_assign=$_[0]->wrapper_name eq "assign";
   sub {
      croak( $is_assign ? "Assignment " : "Conversion ",
             $_[0]->full_name,
             $is_assign ? " = " : " ( ",
             is_object($_[1]) ? $_[1]->type->full_name : ref($_[1]) || "'$_[1]'",
             $is_assign ? "" : " ) ", " not defined" );
   }
}
sub instance_macro { "OperatorInstance4perl" }

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

package Polymake::Core::CPlusPlus::IndirectWrapper;
use Polymake::Struct (
   [ '$wrapper_name' => '".wrp"' ],
   '%inst_cache',
   [ '$seen_in' => '1' ],
   [ '$template_params' => '0' ],
   [ '$via_object' => 'undef' ],
);

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

package Polymake::Core::CPlusPlus::Operator;

# the following must match the declarations in perl/wrappers.h

my @op_wrapper_class=qw( Unary_ Binary_ UnaryAssign_ BinaryAssign_ - Binary_ );

use Polymake::Struct (
   [ '@ISA' => 'AutoFunction' ],
   [ new => '$$$' ],
   [ '$seen_in' => '1' ],
   [ '$application' => 'undef' ],
   [ '$sign' => '#3' ],
   '%subs',
);

sub new {
   my $self=&_new;
   substr($self->wrapper_name,0,1)=$op_wrapper_class[$self->flags];
   if ($self->flags & 1) {
      # binary operation
      @{$self->template_params}=([0, $self->flags & ($func_is_lvalue|$func_is_lvalue_opt)], [1,0]);
      $#{$self->all_params}=1;
   } else {
      # unary operation
      @{$self->template_params}=([0, $self->flags & ($func_is_lvalue|$func_is_lvalue_opt)]);
      $#{$self->all_params}=0;
   }
   $self;
}

sub code {
   my ($self, $special_flag, $wary)=@_;
   $self->subs->{"$special_flag:$wary"} ||= do {
      $wary &&= [1,0];
      my $code;
      if ($self->flags & 1) {
         if ($self->flags & $func_is_lvalue) {

            # binary operation with assignment, operands swapping can't occur
            if ($special_flag eq "F") {
               $code=sub {
                  pop;
                  if (is_object($_[1]) || is_integer($_[1])) {
                     &{ resolve_auto_function($self,\@_,$wary) }
                  } else {
                     my @args=($_[0], defined(try_to_integer($_[1]) || CPlusPlus::std_parsing_constructor($_[0]->type,$_[1])));
                     resolve_auto_function($self,\@args,$wary)->(@args)
                  }
               };
            } elsif ($special_flag eq "") {
               $code=sub { pop; &{ resolve_auto_function($self,\@_,$wary) } };
            } else {
               croak( "Invalid flag $special_flag for operator ", $self->sign );
            }
            declare_lvalue($code, 1);

         } elsif ($self->flags & $func_is_lvalue_opt) {

            # internal function mapped to an operator, no additional arguments
            $code=sub { &{ resolve_auto_function($self,\@_,$wary) } };
            declare_lvalue($code, 1);

         } else {

            # binary operation, operands may be swapped
            my $wary_swapped=$wary && [0,1];
            if ($special_flag eq "F") {
               $code=sub {
                  if (pop) {
                     if (is_object($_[1]) || is_integer($_[1])) {
                        my @args=@_[1,0];
                        local_scalar($self->flags, $func_is_void);
                        resolve_auto_function($self,\@args,$wary_swapped)->(@args);
                     } else {
                        my @args=(defined(try_to_integer($_[1]) || CPlusPlus::std_parsing_constructor($_[0]->type,$_[1])), $_[0]);
                        resolve_auto_function($self,\@args,$wary_swapped)->(@args)
                     }
                  } else {
                     if (is_object($_[1]) || is_integer($_[1])) {
                        &{ resolve_auto_function($self,\@_,$wary) }
                     } else {
                        my @args=($_[0], defined(try_to_integer($_[1]) || CPlusPlus::std_parsing_constructor($_[0]->type,$_[1])));
                        resolve_auto_function($self,\@args,$wary)->(@args)
                     }
                  }
               };
            } elsif ($special_flag eq "") {
               $code=sub {
                  if (pop) {
                     my @args=@_[1,0];
                     local_scalar($self->flags, $func_is_void);
                     resolve_auto_function($self,\@args,$wary_swapped)->(@args);
                  } else {
                     &{ resolve_auto_function($self,\@_,$wary) }
                  }
               };
            } else {
               croak( "Invalid flag $special_flag for operator ", $self->sign );
            }
         }
      } else {

         # unary operation
         if ($special_flag eq "") {
            $code=sub { splice @_,-2; &{ resolve_auto_function($self,\@_,$wary) } };
            if ($self->flags & ($func_is_lvalue|$func_is_lvalue_opt)) {
               declare_lvalue($code, 1);
            }
            
         } else {
            croak( "Invalid flag $special_flag for operator ", $self->sign );
         }
      }
      $code;
   };
}

sub gen_source_code { "" }

sub source_file {
   my ($self, $args)=@_;
   $args->[ ($self->flags & $func_is_void) ? 1 : 0 ]->type->name . ".cc";
}

sub complain_ro_violation {
   my ($self)=@_;
   croak("Attempt to modify a read-only C++ object passed to operator ", $self->sign);
}

sub disable_after_error { 1 }
sub create_fallback { my $sign=$_[0]->sign; sub { missing_op(@_,0,$sign) } }
sub name_for_disabled { (shift)->perl_name }
sub instance_macro { "OperatorInstance4perl" }

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

package Polymake::Core::CPlusPlus::TypeDescr;
use Polymake::Struct (
   '$pkg',
   '$vtbl | source_file',          # source_file is filled by duplicates only
   '$typeid',
   '$kind',                        # Enum class_is_*
   [ '$generated_by' => 'undef' ], # FuncDescr of a function created such an object if it does not correspond to any declared property type
                                   #     or typeid of a container/composite which this class belongs as element to
   '$source_name',
   '$include',
   '$embedded',
   '$application',
   '$extension',
);

sub source_line { (shift)->source_file+0 }

sub get_cpp_representation {
   my ($self, $proto)=@_;
   $self->source_name ||= do {
      if (defined($self->generated_by)) {
         demangle($self->typeid);
      } else {
         ($proto ||= &{$self->pkg->{prototype}}())->cppoptions->finalize->name ||= demangle($self->typeid);
      }
   } || do {
      my $typeid=$self->typeid;
      die <<".";
Can't obtain the C++ representation for typeid $typeid.
Probably the mangling rules are not guessed correctly.
Please investigate and put suitable regular expressions
in the custom arrays \@Polymake::Core::CPlusPlus::to_mangled_typeinfo
or \@Polymake::Core::CPlusPlus::to_mangled_defconstr.
.
   };
   if (wantarray) {
      $self->include ||= do {
         if (defined (my $gen=$self->generated_by)) {
            my $parent;
            unless (ref($gen)) {
               do {
                  $parent=$root->typeids->{$gen} ||
                     croak( ($parent || $self)->source_name, " pretends to be a dependent type of an unregistered C++ class ", demangle($gen) );
                  $gen=$parent->generated_by;
               } while (defined($gen) && !ref($gen));
            }
            if (ref($gen)) {
               if (defined $gen->arg_types) {
                  # it is a descriptor of an auto-function
                  my $auto_func=$gen->auto_func;
                  my @includes=@{$auto_func->include};
                  $self->embedded=$auto_func->embedded;
                  $self->extension=$auto_func->extension;
                  $self->application=$auto_func->application;
                  foreach my $arg_type (@{$gen->arg_types}) {
                     if (defined (my $arg_type_descr=$root->typeids->{$arg_type})) {
                        (undef, my ($includes, $embedded, $app, $extension))=$arg_type_descr->get_cpp_representation;
                        push @includes, @$includes;
                        set_embedded($self,$embedded) if defined($embedded);
                        set_extension($self->extension,$extension) if defined($extension);
                        set_application($self,$app);
                     }
                  }
                  \@includes
               } else {
                  # it is an embedded property type
                  $self->embedded=$gen->source_file;
                  $self->extension=$proto->extension;
                  $self->application=$proto->application;
                  [ ]
               }
            } else {
               # it is a typeid of a container class
               (undef, my $includes, $self->embedded, $self->application, $self->extension)=$parent->get_cpp_representation;
               $includes
            }
         } else {
            $self->application=($proto ||= &{$self->pkg->{prototype}}())->application;
            my $includes=$proto->cppoptions->finalize->include;
            $self->embedded=$proto->cppoptions->embedded;
            $self->extension=$proto->cppoptions->extension;
            $includes
         }
      };
      ($self->source_name, $self->include, $self->embedded, $self->application, $self->extension);
   } else {
      $self->source_name;
   }
}

sub complain_source_conflict {
   "Don't know where to place the instantiation of ", $_[0]->source_name
}

# Sometimes a TypeDescr object is being passed instead of PropertyType 0-th argument to a converting constructor.
# The following methods make it compatible to PropertyType to the extent sufficient for
# resolve_auto_function and new LackingInstance.

sub cpp_type_descr { shift }
sub cpp_persistent_type_descr { shift }
sub name { &{(shift)->pkg->{type}}->name }

#######################################################################################
package Polymake::Core::CPlusPlus::Options;

use Polymake::Struct (
   [ new => '%' ],
   '$name',
   '@include',
   [ '$builtin' => 'undef' ],
   [ '$special' => 'undef' ],
   '$template_params',
   '$operators',
   [ '$fields' => 'undef' ],
   [ '$default_constructor' => '1' ],
   [ '$finalize_with' => 'undef' ],
   [ '$descr' => 'undef' ],     # cached for builtins and persistent types
   [ '$embedded' => 'undef' ],
   [ '$extension' => '$Application::extension' ],
   '$private',
);

sub finalize {
   my $self=shift;
   if (defined (my $proto=$self->finalize_with)) {
      undef $self->finalize_with;
      my @incs=@{$self->include};
      my @t_params;
      set_extension($self->extension,$proto->extension) if defined($proto->extension);

      foreach (is_object($proto->param) ? $proto->param : @{$proto->param}) {
         unless ($_->cppoptions) {
            die "Can't create C++ binding for ", $proto->full_name, ": non-C++ parameter ", $_->name, "\n";
         }
         my $p_opts=$_->cppoptions->finalize;
         push @t_params, $p_opts->name;
         push @incs, @{$p_opts->include};
         set_extension($self->extension,$p_opts->extension) if defined($p_opts->extension);
         set_embedded($self,$p_opts->embedded) if defined($p_opts->embedded);
      }

      if (is_code($self->name)) {
         $self->name= is_method($self->name) ? $self->name->($proto,@t_params) : $self->name->(@t_params);
      } elsif ($self->template_params eq "*") {
         $self->name="";
      } elsif ($self->name =~ /%\d/) {
         unshift @t_params, undef;      # shift the indexing
         $self->name =~ s/%(\d+)/ $t_params[$1] /g;
      } else {
         $self->name.="< " . join(", ", @t_params) . " >";
      }
      if (@incs>@{$self->include}) {
         $self->include=[ uniq(@incs) ];
      }
   }
   $self;
}

sub complain_source_conflict {
   "Can't create C++ binding for ", $_[0]->name;
}

sub temp_include {
   my $self=shift;
   if (defined (my $src_file=$self->embedded)) {
      (withInclude => $src_file, @{$self->include})
   } else {
      @{$self->include}
   }
}

sub recognizing_template {
   my ($self, $pkg)=@_;
   my $typenames=join(", ", map { "typename T$_" } 0..$self->template_params-1);
   my $Ts=join(",", map { "T$_" } 0..$self->template_params-1);
   my $declared=$self->name;
   if ($declared =~ /%\d/) {
      $declared =~ s/%(\d+)/"T".($1-1)/ge;
   } else {
      $declared .= "<$Ts>";
   }
   return <<".";
   template <typename T, $typenames>
   RecognizeType4perl("$pkg", ($Ts), $declared)

.
}

sub recognizing_class {
   my ($self, $pkg)=@_;
   my $declared=$self->name;
   return <<".";
   template <typename T>
   RecognizeType4perl("$pkg", (), $declared)

.
}

sub register_template {
   my ($self, $pkg)=@_;
   return <<".";
   ClassTemplate4perl("$pkg");
.
}

sub gen_source_code {
   my ($self, $proto)=@_;
   my $pkg=$proto->pkg;
   "   ".($self->builtin || $self->special ? "Builtin" : "Class")."4perl(\"$pkg\", ".$self->name.");\n"
}
*gen_temp_code=\&gen_source_code;

sub retry_on_error { 0 }

sub analyze_provenience {
   my $self=shift;
   my $depth=1;
   while ((my ($file, $sub)=(caller(++$depth))[1,3])) {
      if ($sub eq "(eval)") {
         # clients may trigger creation of new types too
         if ($file =~ m{/perllib/Polymake/Core/CPlusPlus\.pm}) {
            if (ref(my $descr=get_cur_func_descr())) {
               $file=$descr->source_file;
            } else {
               if (defined($descr) && defined ($descr=$root->typeids->{$descr})) {
                  set_extension($self->extension, $descr->extension) if $descr->extension;
               }
               next;
            }
         } else {
            next;
         }
      } elsif ($file =~ $skip_core_functions_re) {
         next;
      }
      if ($file =~ $called_from_app_tree) {
         next if $2 eq "rules" && $sub =~ /::add_template_instance$/;
         return if $1 eq $InstallTop;
         if (defined (my $ext=lookup Extension($1))) {
            set_extension($self->extension, $ext);
            return;
         }
      }
      last;
   }
   $self->private=1;
}

#######################################################################################
# bind all Object types involved in template arg deduction to the C++ Object class

package Polymake::Core::CPlusPlus::ObjectOptions;
use Polymake::Struct (
   [ '@ISA' => 'Options' ],
);

sub finalize { shift }
sub Polymake::Core::ObjectType::cppoptions { $Object_pseudo_options }
sub descr : lvalue {
   croak("attempt to pass a polymake Object to a C++ function expecting something different from of perl::Object");
   $Object_pseudo_proto;
}

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

package Polymake::Core::CPlusPlus::TemplateParam;
use Polymake::Struct (
   [ '@ISA' => 'Overload::TemplateParam' ],
);

sub finalize { shift }
sub include { [ ] }
sub template_params { undef }

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

package Polymake::Core::CPlusPlus::EmbeddedRules;
use Polymake::Struct (
   [ new => '@' ],
   '$lastfile',
   [ '$preproc' => '0' ],
   [ '@lines' => '@' ],
);

*TIEHANDLE=\&new;

sub READLINE {
   my $self=shift;
   if ($self->preproc) {
      --$self->preproc;
      shift @{$self->lines};

   } elsif (!@{$self->lines}) {
      undef;

   } elsif ($self->lines->[0] =~ /^(\#line\s+(\d+))\s+"(.*)"/) {
      shift @{$self->lines};
      $.=$2-1;

      # perl seems confused when it encounters the same source file in the consecutive lines
      if ($3 eq $self->lastfile) {
         "$1\n";
      } else {
         $self->lastfile=$3;
         unshift @{$self->lines}, "$1 \"$3\"\n";
         ++$self->preproc;
         "package application;\n";
      }

   } else {
      ++$.;
      $self->lines->[0] =~ s{^.*\n}{}m;
      if (!length($self->lines->[0])) { shift @{$self->lines}; }
      $&;
   }
}

sub CLOSE { !@{$_[0]->lines} }

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

package Polymake::Core::CPlusPlus::SharedModule;
use Polymake::Struct (
   [ new => '$;$$' ],
   [ '$build_dir' => 'undef' ],         # directory where to execute `make'
   '$so_name',
   [ '$so_timestamp' => 'undef' ],
   '$needs_private',
   [ '$private' => 'undef' ],           # => another SharedModule
);

sub new {
   my $self=&_new;
   my ($perApp, $extension, $enforce)=@_;
   my $app=$perApp->application;
   my $app_name=$app->name;
   my $build_top;
   if (defined($extension)) {
      if (($build_top=$extension->dir) =~ s|^$InstallTop/|$InstallArch/|o) {
         $self->needs_private=1;
      } else {
         $build_top.="/build.$Arch";
      }
   } elsif ($app->installTop eq $InstallTop) {
      $build_top=$InstallArch;
      $self->needs_private= $build_top !~ m{/build.$Arch}o;
   } else {
      if (($build_top=$app->installTop) =~ s|^$InstallTop/|$InstallArch/|o) {
         $self->needs_private=1;
      } else {
         $build_top=$app->installTop."/build.$Arch";
      }
   }
   $self->build_dir="$build_top/apps/$app_name";

   if (-e ($self->so_name="$build_top/lib/$app_name$dl_suffix")) {
      if (!($self->needs_private ||= !-w _) &&
          ($self->so_timestamp=(stat _)[9]) < $wrapper_updated{defined($extension) ? $extension->dir."/$app_name" : $app_name}) {
         compile($self, $app);
      }
      $perApp->load_proper($self);

      my $private_top=$private_wrappers{defined($extension) ? $extension->dir : $app->installTop};
      if (defined($private_top) && -d "$private_top/apps/$app_name/src/perl") {
         new_private($self, $private_top, $app_name);
         if (-e $self->private->so_name) {
            if (($self->private->so_timestamp=(stat _)[9]) < $wrapper_updated{defined($extension) ? $extension->dir."/$app_name" : $app_name} ||
                $self->private->so_timestamp < $self->so_timestamp) {
               compile($self->private, $app);
            }
         } else {
            create_extension_build_dir($app, $private_top, 1);
            compile($self->private, $app);
         }
         $perApp->load_private($self->private);
      }

   } elsif (has_source_files(source_top($app,$extension))) {
      if (defined($extension) && $wrapper_updated{$extension->dir."/$app_name"} < 0) {
         # self-configuration has failed: nothing to do yet
         return;
      }

      # this application/extension has not yet been built for the current architecture
      create_extension_build_dir($app, $extension && $extension->dir);
      compile($self, $app);
      $perApp->load_proper($self);

   } elsif (!$enforce) {
      return;

   } elsif (defined $extension) {
      create_extension_build_dir($app, $extension->dir);
      $self->needs_private ||= !-w $self->build_dir;

   } else {
      # although there are no own clients in the application, we've probably got to generate some bindings to third-party types
      create_extension_build_dir($app);
      $self->needs_private ||= !-w $self->build_dir;
   }

   $self
}

sub compile {
   my ($self, $app)=@_;
   unless ($MAKE) {
      require Polymake::Core::CPlusPlus_config;
      configure_make($custom_handler);
   }
   my $errfile=new Tempfile;
   my $debug_flag= $debug && "Debug=y";
   warn_print( "Recompiling shared module for application ", $app->name, ", please be patient..." );
   my $rc=system("$MAKE -C " . $self->build_dir . " all $debug_flag $MAKEFLAGS" . (!$Verbose::cpp && ">/dev/null") . " 2>$errfile.err");
   if ($rc) {
      die "shared module compilation failed; see the error log below\n\n", `cat $errfile.err`;
   }
   if (defined($self->so_timestamp) && (stat $self->so_name)[9]==$self->so_timestamp) {
      # touch the unchanged shared object to avoid further unnecessary make calls
      utime(undef, undef, $self->so_name);
   }
}

sub new_private {
   my ($self, $private_top, $app_name)=@_;
   $self=$self->private=_new($self, undef);
   my $build_top="$private_top/build.$Arch";
   $self->build_dir="$build_top/apps/$app_name";
   $self->so_name="$build_top/lib/$app_name$dl_suffix";
   $self
}

sub build_top {
   my $path=(shift)->so_name;
   $path =~ s{/lib/[^/]+$}{};
   $path
}
#######################################################################################

package Polymake::Core::CPlusPlus::perApplication;
use Polymake::Struct (
   [ 'new' => '$' ],
   [ '$application' => 'weak( #1 )' ],
   '$functions_begin',
   '$functions_end',
   '$embedded_rules_begin',
   [ '$embedded_rules_cnt' => '0' ],
   '%embedded_property_types',  # name => FuncDescr : generating TypeDescr
   '%lacking_types',            # PropertyType => 1 for types with declared C++ binding but lacking generated wrappers
   '%lacking_templates',
   '@lacking_auto_functions',
   '@obsolete_auto_functions',
   '@duplicate_function_instances',
   '$duplicate_class_instances_begin',
   '$duplicate_class_instances_end',
   '$will_update_sources',
   '%shared_modules',           # "top_dir" => SharedModule
);

sub load_proper {
   my ($self, $shared_mod)=@_;
   if (-e $shared_mod->so_name) {       # in an early development phase, there might be no clients at all, hence this test
      $self->functions_begin=@{$root->functions};
      $self->embedded_rules_begin=@{$root->embedded_rules};
      $self->duplicate_class_instances_begin=@{$root->duplicate_class_instances};
      $shared_mod->so_timestamp=(stat _)[9];
      load_shared_module($shared_mod->so_name);
      $self->functions_end=$#{$root->functions};
      $self->embedded_rules_cnt=@{$root->embedded_rules}-$self->embedded_rules_begin;
      $self->duplicate_class_instances_end=$#{$root->duplicate_class_instances};
      push %{$self->embedded_property_types}, %{$root->embedded_property_types};
      $root->embedded_property_types={ };
   }
}

sub load_private {
   my ($self, $shared_mod)=@_;
   $shared_mod->so_timestamp=(stat $shared_mod->so_name)[9];
   load_shared_module($shared_mod->so_name);
   $self->functions_end=$#{$root->functions};
   $self->duplicate_class_instances_end=$#{$root->duplicate_class_instances};
}

sub end_loading {
   my $self=shift;
   bind_functions($self, $self->functions_begin, $self->functions_end);
}
#######################################################################################
my $cut_comments=\&Application::RuleFilter::cut_comments;

sub cut_embedded_comments {
   map { split /(?<=\n)/ } map { s/(?<!^)(?<![\#\n])(?=\#)/\n/mg; $_ } &$cut_comments;
}

sub get_embedded_rules {
   my $self=shift;
   my $lines=$self->embedded_rules_cnt;
   $self->embedded_rules_cnt=0;
   my $handle=Symbol::gensym;
   select(select $handle);
   tie *$handle, "Polymake::Core::CPlusPlus::EmbeddedRules", (splice @{$root->embedded_rules}, $self->embedded_rules_begin, $lines);
   $self->application->compile_scope->begin_locals;
   local_incr($from_embedded_rules);
   local *Polymake::Core::Application::RuleFilter::cut_comments=\&cut_embedded_comments;
   $self->application->compile_scope->end_locals;
   $handle
}

#######################################################################################
sub needs_build {
   my ($self, $extension)=@_;
   my $shared_mod;
   not (defined($shared_mod=$self->shared_modules->{$extension->dir}) &&
        $shared_mod->needs_private);
}

sub store_in_conf_makefile {
   my ($self, $top_dir, %vars)=@_;
   if (keys %vars) {
      my $conf_file="$top_dir/build.$Arch/conf.make";
      open my $cf, $conf_file or die "can't read $conf_file: $!\n";
      my ($cf_new, $cf_k)=new OverwriteFile($conf_file);
      local $_;
      while (<$cf>) {
         if (/(?:^|(?<=\s))($id_re)=/o && exists $vars{$1}) {
            if (defined (my $value=delete $vars{$1})) {
               print $cf_new "$`$1=$value\n";
            }
         } elsif (/DESTDIR=/) {
            last;
         } else {
            print $cf_new $_;
         }
      }
      while (my ($var, $value)=each %vars) {
         print $cf_new "$var=$value\n";
      }
      if (length($_)) {
         print $cf_new $_;
         while (<$cf>) {
            print $cf_new $_;
         }
      }
      close $cf;
      close $cf_new;

      if ($top_dir ne $InstallTop) {
         # recompile the extension at the next start because the configuration has changed
         my $wrapper_tag="$top_dir/".$self->application->name;
         assign_max($wrapper_updated{$wrapper_tag}, time+1);
         $custom_handler->set('%wrapper_updated');
      }
      1
   } else {
      0
   }
}
#######################################################################################
my %builtin2proxy=( int => 'NumProxy', double => 'NumProxy', 'std::string' => 'StringProxy', bool => 'BoolProxy' );

sub add_type {
   my ($self, $proto)=splice @_,0,2;
   my $opts=$proto->cppoptions=new Options(@_);
   if ($opts->special) {
      $opts->name ||= $opts->special || $proto->name;
      provide_cpp_type_descr($proto);

   } elsif ($opts->builtin) {
      if (ref($opts->builtin)) {
         $opts->name ||= $proto->name;
         if (ref($opts->builtin) eq "Polymake::Enum") {
            while (my ($key, $val)=each %{$opts->builtin}) {
               my $ref=readonly_deep(bless \$val, $proto->pkg);
               namespaces::export_sub($proto->application->pkg, define_function($proto->application->pkg, $key, sub { $ref }));
            }
         }
      } else {
         $opts->name ||= $opts->builtin;
         $root->builtins->{$opts->builtin}=$proto;
         if (defined (my $proxy_class=$builtin2proxy{$opts->builtin})) {
            no strict 'refs';
            push @{$proto->pkg."::ISA"}, "Polymake::Core::CPlusPlus::$proxy_class";
         }
      }
      provide_cpp_type_descr($proto);

   } else {
      if (!is_code($opts->name)) {
         if ($opts->name =~ /^(?: [\w:]+:: )?$/x) {
            $opts->name .= $proto->name;
         }
         if ($opts->descr eq "embedded") {
            if (defined (my $func_descr=$self->embedded_property_types->{$opts->name})) {
               (my $super, $opts->fields)=@{ call_function_once($func_descr,$proto) };
               $proto->add_super($super) if defined $super;
               $opts->embedded=$func_descr->source_file;
            } else {
               croak( "no embedded description for property type ", $opts->name, " found" );
            }
         }
      }
      create_methods($self, $proto);
   }
}
#######################################################################################
sub add_type_template {
   my ($self, $super_pkg)=splice @_,0,2;
   my $opts=new Options(@_);
   if (!is_code($opts->name)) {
      if ($opts->name =~ /^(?: [\w:]+:: )?$/x) {
         $opts->name .= ($super_pkg =~ /([^:]+)$/)[0];
      }
   }
   if (!exists $root->templates->{$super_pkg} && $opts->template_params ne "*") {
      $self->lacking_templates->{$super_pkg}=$opts;
      ensure_update_sources($self);
   }
   if ($opts->builtin) {
      if (is_code($opts->builtin)) {
         if ($super_pkg =~ /::(array|map|pair)$/i) {
            $root->builtins->{lc($1)} ||= $super_pkg;
         }
      } else {
         croak( "template type can't be declared as a C++ built-in type" );
      }
   } else {
      define_operators($self,$opts,$super_pkg);
   }
   define_function($super_pkg, "c++options",
                   sub {
                      if ((my $proto)=@_) {
                         my $clone=inherit_class([ @$opts ], $opts);
                         weak($clone->finalize_with=$proto);
                         if (is_code($opts->builtin)) {
                            $clone->builtin=$opts->builtin->($proto);
                         }
                         $clone
                      } else {
                         $opts
                      }
                   });
}
#######################################################################################
sub add_template_instance {
   my ($self, $proto, $cpp_opts_sub, $defer)=@_;
   $proto->cppoptions=$cpp_opts_sub->($proto);
   if (!$proto->abstract && $proto->cppoptions->template_params ne "*") {
      if ($proto->cppoptions->builtin) {
         # this may be required when accessing to the C++ object via TryCanned
         $proto->cppoptions->descr=$root->classes->{$proto->pkg} || sub { $proto->cppoptions->descr=provide_cpp_type_descr($proto, 1) };
         define_operators($self,$proto->cppoptions,$proto->pkg,$proto);
      } elsif ($defer && !exists $root->classes->{$proto->pkg}) {
         $proto->cppoptions->descr=sub { create_methods($self, $proto, $cpp_opts_sub->()) };
         $proto->construct=sub : method {
            my $proto=shift;  $proto->cppoptions->descr->();
            $proto->construct->(@_);
         };
         $proto->parse_string=sub : method {
            my $proto=shift;  $proto->cppoptions->descr->();
            $proto->parse_string->(@_);
         };
         $proto->parse=sub : method {
            my $proto=shift;  $proto->cppoptions->descr->();
            $proto->parse->(@_);
         };
      } else {
         create_methods($self, $proto, $cpp_opts_sub->());
      }
   }
}
#######################################################################################
sub add_auto_function {
   my ($self, $name, $signature, $attrs, $options)=@_;
   my ($pkg, $srcfile)=caller;
   my $application=$self->application;
   my $returns;
   my $flags=0;
   $flags |= $func_is_method if delete $attrs->{method};
   $flags |= $func_is_void if delete $attrs->{void};

   if (delete $attrs->{lvalue}) {
      if ($flags & $func_is_void) {
         croak( "Attributes 'lvalue' and 'void' are mutually exclusive" );
      }
      $flags |= $func_is_lvalue;
   }
   if (delete $attrs->{lvalue_opt}) {
      if (!($flags & $func_is_method)) {
         croak("Attribute 'lvalue_opt' is only applicable to methods");
      }
      if ($flags & $func_is_void) {
         croak( "Attributes 'lvalue_opt' and 'void' are mutually exclusive" );
      }
      $flags |= $func_is_lvalue_opt;
   }
   if (delete $attrs->{non_const}) {
      if (!($flags & $func_is_method)) {
         croak("Attribute 'non_const' is only applicable to methods");
      }
      if ($flags & ($func_is_lvalue | $func_is_lvalue_opt)) {
         croak( "Attributes 'non_const', 'lvalue', and 'lvalue_opt' are mutually exclusive" );
      }
      $flags |= $func_is_non_const;
   }
   if (delete $attrs->{wary}) {
      if (!($flags & $func_is_method)) {
         croak("Attribute 'wary' is only applicable to methods");
      }
      $flags |= $func_is_wary;
   }
   if (defined ($returns=delete $attrs->{returns})) {
      if ($flags & $func_is_void) {
         croak( "Attributes 'returns' and 'void' are mutually exclusive" );
      }
      if ($returns eq '@' || $returns eq 'list') {
         $options->{macro_call}="List( ";
         undef $returns;
      } else {
         $options->{macro_call}="Pkg( ";
         $flags |= $func_has_prescribed_ret_type;
      }
   }
   my @kw;
   if (defined (my $kw=delete $attrs->{keywords})) {
      @kw=(keywords=>$kw);
   }
   my $subst_const_op=delete $attrs->{subst_const_op};
   my $ext_code=delete $attrs->{ext_code};
   if (delete $attrs->{builtin_sub}) {
      $options->{builtin_code}=$ext_code
         or croak("builtin_sub attribute without corresponding perl code");
      undef $ext_code;
   }
   if (keys %$attrs) {
      croak("Unknown attribute", keys(%$attrs)>1 && "s", " for a C++ function: ", join(", ", keys %$attrs));
   }

   my $auto_func= ($flags & $func_is_method and $name eq "construct")
                  ? new Constructor()
                  : new AutoFunction($name, $flags, $application, $options);
   my ($code, $type_args_may_be_omitted);
   if (defined($auto_func->embedded)) {
      $auto_func->name ||= $name;
      if (defined $signature) {
         $auto_func->flags |= $func_is_ellipsis if $signature =~ /\@\s*$/;
         $signature =~ s/($type_re)&/$1/go;
      }
      $auto_func->template_params=0;
      my $descr=$root->regular_functions->[$auto_func->embedded];
      $auto_func->embedded=$srcfile;
      $descr->auto_func=$auto_func;
      undef $auto_func->inst_cache;
      $code= defined($returns) ? sub { unshift @_, $returns; &{resolve_regular_function($auto_func, $descr, \@_)} }
                               : sub { &{resolve_regular_function($auto_func, $descr, \@_)} };
   } else {
      croak( "C++ function template without signature" ) unless defined $signature;
      if ($from_embedded_rules) {
         $auto_func->embedded=$srcfile;
         $signature =~ s/($type_re)&/$1:lvalue/go;
      }
      ($signature, $type_args_may_be_omitted)=$auto_func->prepare($signature, $pkg, $application);

      if (!($flags & $func_is_method) && $pkg ne $application->pkg) {
         my $app=$application->pkg;
         (my $pkg_prefix=$pkg)=~s/^$app\:://;
         $pkg_prefix=~tr/:/_/;
         substr($auto_func->wrapper_name,0,0)=$pkg_prefix."__";
      }
      check_twins($auto_func);

      if ($flags & $func_is_method and $name eq 'operator') {
         my $obj;
         my $closure=sub { unshift @_, $obj;  &{resolve_auto_function($auto_func, \@_)} };
         $code=sub { $obj=shift; $closure };
         declare_lvalue($closure, 1) if $flags & ($func_is_lvalue|$func_is_lvalue_opt);
      } else {
         $code= defined($returns) ? sub { unshift @_, $returns; &{resolve_auto_function($auto_func, \@_)} }
                                  : sub { &{resolve_auto_function($auto_func, \@_)} };
      }
      set_method($code) if $flags & $func_is_method;
      declare_lvalue($code, 1) if $auto_func->flags & ($func_is_lvalue|$func_is_lvalue_opt);
   }

   if (@kw) {
      $auto_func->opt_hashes=@{$kw[1]};
   }

   if (defined $signature) {
      if ($name eq "operator") {
         overload::OVERLOAD($pkg, '&{}' => $code);
         ()
      } else {
         if ($name eq "construct") {
            if (defined $subst_const_op) {
               no strict 'refs';
               namespaces::subst_const_op($application->pkg, $subst_const_op, sub { $pkg->new(@_) });
            }
         } else {
            if (defined $subst_const_op) {
               push @kw, subst_const_op => [ $pkg, $subst_const_op ];
            }
            if (@{$auto_func->extra_template_params}) {
               push @kw, extra_template_params => 1;
               if (defined $ext_code) {
                  my @returns= defined($returns) ? ($returns) : ();
                  my $with_explicit_template_args=
                     sub {
                        my $tp_args=$_[0];
                        local_refs(Overload::localize_template_params($auto_func->extra_template_params,
                                      Overload::deduce_extra_template_params($auto_func->extra_template_params,
                                                                             $auto_func->args_for_deduction,
                                                                             \@_, 1, shift, \&guess_builtin_type)));
                        $ext_code->(@_, sub { unshift @_, $tp_args, @returns; &{resolve_auto_function($auto_func, \@_)} });
                     };
                  push @kw, wrapper =>
                       @{$auto_func->args_for_deduction} || $type_args_may_be_omitted
                       ? [ $with_explicit_template_args,
                           sub {
                              local_refs(Overload::localize_template_params($auto_func->extra_template_params,
                                            Overload::deduce_extra_template_params($auto_func->extra_template_params,
                                                                                   $auto_func->args_for_deduction,
                                                                                   \@_, 1, undef, \&guess_builtin_type)));
                              $ext_code->(@_, sub { unshift @_, undef, @returns; &{resolve_auto_function($auto_func, \@_)} });
                           } ]
                       : $with_explicit_template_args;
                  declare_lvalue($ext_code, 1) if $flags & ($func_is_lvalue|$func_is_lvalue_opt);

               } elsif (@{$auto_func->args_for_deduction} || $type_args_may_be_omitted) {
                  push @kw, wrapper => [ undef, sub { unshift_undef_args(1); &$code; } ];
               }
            }
         }
         if (@{$auto_func->args_for_deduction} && !@{$auto_func->extra_template_params}) {
            push @kw, wrapper => sub { Overload::check_matching_template_params($auto_func->args_for_deduction,
                                                                                \@_, \&guess_builtin_type);
                                       &$code; };
         }
         ( $name, $signature, $code, @kw )
      }
   } else {
      define_function($pkg, $name, $code);
      ()
   }
}
#######################################################################################
sub bind_functions {
   my ($self, $begin, $end, $subst_for_temp_src)=@_;

   foreach my $descr (@{$root->functions}[$begin..$end]) {
      my $auto_func=$root->auto_functions->{$descr->name};
      my ($src_file, $bunch);
      if (defined $subst_for_temp_src) {
         $src_file=$subst_for_temp_src->{readwrite($descr->source_file)};
         undef $descr->source_file;
         $descr->source_file=$src_file;
      } else {
         ($src_file=$descr->source_file) =~ s|/src/perl/wrap-|/src/|;
      }
      if (ref($auto_func) eq "HASH") {
         $bunch=$auto_func;
         $auto_func= $bunch->{$src_file} || $bunch->{$self->application->name};
      }

      unless (defined $auto_func) {
         if (defined $subst_for_temp_src) {
            croak( "temporary file ", keys(%$subst_for_temp_src), " contains definition of an unknown function" );
         }
         my $delete_func=(defined($bunch) ? $bunch->{$src_file} : $root->auto_functions->{$descr->name})=
            new AutoFunction($descr->name,0,$self->application);
         $delete_func->template_params=-1;
         $delete_func->seen_in->{$descr->source_file}=1;
         push @{$self->obsolete_auto_functions}, $delete_func;
         ensure_update_sources($self);
         dbg_print( "C++ function ", $descr->name, " defined in ", $descr->source_file,
                    " has no binding declared in the rules, treating as obsolete" ) if $Verbose::cpp;
         next;
      }

      if (ref($auto_func->template_params)) {
         $descr->auto_func=$auto_func;                  # help guessing the right set of headers for non-persistent return types

         my $sub;
         if (defined $descr->wrapper) {
            $sub=create_function_wrapper($descr, $self->application->pkg);
            $auto_func->prepare_wrapper_code($sub);
         } else {
            $sub=$auto_func->create_fallback($descr);
         }

         my $last=$#{$descr->arg_types};
         my ($inst_cache, $extra);
         if ($last>=0) {
            $inst_cache=$auto_func->inst_cache;
            $extra=@{$auto_func->extra_template_params};
            for (my $tp=0; $tp<$last; ++$tp) {
               if ($tp>=$extra  &&  $auto_func->template_params->[$tp-$extra]->[1] & $func_is_lvalue_opt) {
                  $inst_cache=($inst_cache->{$descr->arg_types->[$tp]}->[$descr->arg_types->[$tp]] ||= { });
               } else {
                  $inst_cache=($inst_cache->{$descr->arg_types->[$tp]} ||= { });
               }
            }
         }
         (( $last>=0
            ? $last>=$extra  &&  $last-$extra <= $#{$auto_func->template_params}  &&
              $auto_func->template_params->[$last-$extra]->[1] & $func_is_lvalue_opt
              ? $inst_cache->{$descr->arg_types->[$last]}->[$descr->arg_types->[$last]]
              : $inst_cache->{$descr->arg_types->[$last]}
            : $auto_func->inst_cache )
          &&= do {
                 unless (defined $subst_for_temp_src) {
                    push @{$self->duplicate_function_instances}, new DuplicateInstance($descr,$self->application);
                    $auto_func->seen_in->{$descr->source_file}+=0;   # pull into existence
                    ensure_update_sources($self);
                 }
                 next;
              }
         ) =$sub;
         unless (defined $subst_for_temp_src) {
            $auto_func->seen_in->{$descr->source_file}++;
         }

      } elsif ($auto_func->template_params==0) {
         ($auto_func->inst_cache->{$descr->arg_types} &&= next) =$descr;        # repetition can occur when mixing several applications together
      } elsif (defined $subst_for_temp_src) {
         croak( "temporary file ", keys(%$subst_for_temp_src), " contains definition of an unknown function" );
      } elsif (!$auto_func->seen_in->{$descr->source_file}++) {
         dbg_print( "C++ function ", $descr->name, " defined in ", $descr->source_file,
                    " has no binding declared in the rules, treating as obsolete" ) if $Verbose::cpp;
      }
   }

   if (defined $subst_for_temp_src) {
      splice @{$root->duplicate_class_instances}, $self->duplicate_class_instances_begin;
      $self->duplicate_class_instances_end=$self->duplicate_class_instances_begin-1;

   } elsif ($self->duplicate_class_instances_end >= $self->duplicate_class_instances_begin) {
      foreach my $descr (@{$root->duplicate_class_instances}[$self->duplicate_class_instances_begin .. $self->duplicate_class_instances_end]) {
         $descr->application=$self->application;
         $descr->extension=$Application::extension;
      }
      ensure_update_sources($self);
   }
}
#######################################################################################
sub ensure_update_sources {
   my $self=shift;
   if ($PrivateDir) {
      $self->will_update_sources ||= do {
         add AtEnd($self->application->name.":C++", sub { generate_sources($self) },
                   before=>[ "Customize", "Background", map { "$_:C++" } keys(%{$self->application->used}) ], after => 'Object');
         1
      }
   }
}

sub generate_sources {
   my $self=shift;
   my %files;

   foreach my $proto (keys %{$self->lacking_types}) {
      my $opts=$proto->cppoptions;
      my $pkg= $proto->context_pkg || ($opts->builtin || $opts->special ? "builtins" : $proto->pkg);
      my $src_top=source_top($self->application, $opts->extension);
      my $source_file= defined($opts->embedded)
                       ? wrapper_filename($opts->embedded)
                       : do { $pkg =~ /($id_re)$/o; "$src_top/src/perl/$1.cc" };
      my $ccfile=prepare_source_file($self, \%files, $opts, 0, $source_file, "bindings.cc");
      push @{$ccfile->{includes}}, @{$opts->include};
      push @{$ccfile->{instances}}, $opts->gen_source_code($proto);

      if (!$opts->template_params && $pkg ne "builtins" && !defined($opts->embedded)) {
         push @{ prepare_h_file($self, \%files, $opts, $src_top)->{declarations} },
              $opts->recognizing_class($proto->pkg);
      }
   }

   while (my ($pkg, $generic_opts)=each %{$self->lacking_templates}) {
      my $src_top=source_top($self->application, $generic_opts->extension);
      push @{ prepare_h_file($self, \%files, $generic_opts, $src_top)->{declarations} },
           $generic_opts->recognizing_template($pkg);
      $pkg =~ /($id_re)$/o;
      my $ccfile=prepare_source_file($self, \%files, $generic_opts, 0, "$src_top/src/perl/$1.cc", "bindings.cc");
      push @{$ccfile->{includes}}, @{$generic_opts->include};
      push @{$ccfile->{instances}}, $generic_opts->register_template($pkg);
   }

   foreach my $inst (@{$root->duplicate_class_instances}[$self->duplicate_class_instances_begin .. $self->duplicate_class_instances_end]) {
      prepare_source_file($self, \%files, $inst, 1, $inst->source_file, "bindings.cc")->{dup_class}->{$inst->pkg}=$inst;
   }

   foreach my $inst (@{$self->lacking_auto_functions}) {
      my $ccfile=prepare_source_file($self, \%files, $inst, 0,
                                     defined($inst->embedded) ? wrapper_filename($inst->embedded) : $inst->source_file, "bindings.cc");
      push @{$ccfile->{includes}}, $inst->include;
      if (ref (my $seen_in=$inst->is_instance_of->seen_in)) {
         unless (exists $seen_in->{$ccfile->{filename}}) {
            push @{$ccfile->{declarations}}, $inst->is_instance_of->gen_source_code;
         }
         $seen_in->{$ccfile->{filename}}++;
      }
      push @{$ccfile->{instances}}, $inst->gen_source_code;
   }

   foreach my $auto_func (@{$self->obsolete_auto_functions}) {
      foreach (keys %{$auto_func->seen_in}) {
         prepare_source_file($self, \%files, $auto_func, 1, $_, "bindings.cc")->{obsolete}->{$auto_func->wrapper_name}=$auto_func;
      }
   }

   foreach my $inst (@{$self->duplicate_function_instances}) {
      my $ccfile=prepare_source_file($self, \%files, $inst, 1, $inst->descr->source_file, "bindings.cc");
      my $seen_in=$inst->is_instance_of->seen_in;
      if (ref($seen_in) && !$seen_in->{$ccfile->{filename}}) {
         $ccfile->{obsolete}->{$inst->is_instance_of->wrapper_name}=$inst->is_instance_of;
      } else {
         push @{$ccfile->{dup_func}->{$inst->is_instance_of->wrapper_name}}, $inst;
      }
   }

   %{$self->lacking_types}=();
   %{$self->lacking_templates}=();
   @{$self->lacking_auto_functions}=();
   @{$self->obsolete_auto_functions}=();
   @{$self->duplicate_function_instances}=();

   my $t=time+1;
   foreach (values %files) {
      modify_source_file($_);
      $wrapper_updated{$_->{wrapper_tag}}=$t;
   }
   $custom_handler->set('%wrapper_updated');
}
#######################################################################################
sub prepare_h_file {
   my ($self, $files, $opts, $src_top)=@_;
   my $main_header=$opts->include->[-1];
   my ($guard_name, $wrapper_dir)=
      $DeveloperMode && $main_header =~ m{polymake/[^/]+$}
      ? ("CORE_WRAPPERS_", "$InstallTop/include/core-wrappers")
      : ("APP_WRAPPERS_",  "$src_top/include/app-wrappers/polymake");
   (my $short_name=$main_header) =~ s/\.h$//;
   $short_name =~ s{^polymake/}{};
   $short_name =~ s{[./: ]}{_}g;
   prepare_source_file($self, $files, $opts, -1, "$wrapper_dir/$main_header", "bindings.h",
                       guard_name=>$guard_name.$short_name, include_file=>$main_header);
}
#######################################################################################
sub prepare_source_file {
   my ($self, $files, $lacking, $true_filename, $file, @template)=@_;
   my $orig_file=$file;

   my ($src_top, $private_app_top);
   if (defined (my $ext=$lacking->extension)) {
      $src_top=is_object($ext) ? $ext->dir : $ext->[0]->dir;
   } else {
      $src_top=$self->application->installTop;
   }

   my $shared_mod=$self->shared_modules->{$src_top}
      or return { };            # if the shared module has disappeared (e.g. after forget_extension),
                                # this source file won't be registered in %files and thus avoids modification.
   if ($true_filename) {
      if ($true_filename>0 && defined (my $private_top=$private_wrappers{$src_top})) {
         if (index($file, $private_top."/apps/".$lacking->application->name)==0) {
            $shared_mod=$shared_mod->private;
         }
      }
   } elsif ($lacking->private || $shared_mod->needs_private) {
      my $app_name=$self->application->name;
      my $private_top=$private_wrappers{$src_top} || create_private_wrapper_dir($src_top);
      $private_app_top="$private_top/apps/$app_name";
      if (defined $lacking->embedded) {
         $orig_file =~ s{^.*?(?=/apps/$app_name/)}{$src_top};
         $file=$private_top.$';
      } else {
         $file =~ s{^\Q$src_top\E(?=/)}{$private_top};
      }
      $shared_mod=$shared_mod->private;
   }

   $files->{$file} ||= do {
      my $wrapper_tag=($src_top ne $self->application->installTop && "$src_top/").$self->application->name;

      if (-r $file && -w _) {
         if (defined($shared_mod) && defined($shared_mod->so_timestamp) && (stat _)[9] > $shared_mod->so_timestamp) {
            $wrapper_updated{$wrapper_tag}=time+1;
            $custom_handler->set('%wrapper_updated');
            my $so_name=$shared_mod->so_name;
            die <<".";
Automatical update of the C++ source file $file refused:
The shared module $so_name is out-of-date!
It will be recompiled at the very beginning of the next polymake session.
Alternatively, you may run `make' manually right now.
.
         }
         $file =~ $directory_re;
         if (-d "$1/.svn") {
            my $svn_status=qx(svn status -u $file);
            if ($svn_status =~ /^C /) {
               die <<".";
The C++ source file $file is in conflicting state w.r.t. the checked-in version.
Please resolve the conflict and run `make' manually before you start polymake the next time.
.
            } elsif ($svn_status =~ /\* /) {
               die <<".";
The C++ source file $file is not up-to-date w.r.t. the repository.
Automatical update now would lead to future conflicts.
Please update your working copy and run `make' manually before you start polymake the next time.
.
            } elsif ($svn_status !~ /\S/) {
               warn_print( "Could not check the SVN status of file $file - probably no connection to the repository?\n",
                           "Automatical updates are made to your own risk." );
            }
         }

         dbg_print( "Updating C++ source file $file" ) if $Verbose::cpp;

      } elsif (-e _) {
         die <<"."
The C++ source file $file exists but can't be updated due to lacking permission.
Until this file is writable for you, you can't maintain persistent C++ bindings!
.
      } else {
         create_source_file($file, @template, app_name=>$self->application->name);
         if (defined($private_app_top) && $orig_file =~ s{/src/perl/wrap-}{/src/}) {
            my $link=$private_app_top.substr($orig_file,$-[0]);
            symlink $orig_file, $link
               or die "Could not create a link $link => $orig_file : $!\n";
         }
      }

      { filename => $file, wrapper_tag => $wrapper_tag }
   };
}
#######################################################################################
sub compile_load_temp_shared_module {
   my ($self, $lacking, $type_proto)=@_;
   local $_;
   my $extension;
   set_extension($extension, $lacking->extension) if defined($lacking->extension);
   my $owing_extension;
   my $src_top= defined($extension)
              ? ($owing_extension=is_object($extension) ? $extension : $extension->[0])->dir
              : $self->application->installTop;
   my $shared_mod=
   $self->shared_modules->{$src_top} ||= do {
      $self->application->found_extension($owing_extension);
      new SharedModule($self, $owing_extension, 1)
   };

   if ($shared_mod->needs_private or
       # compile in private wrappers if several extensions are mixtured
       defined($extension) && !is_object($extension) && do { shift @$extension; 1 }) {

      if (!defined($shared_mod->private)) {
         my $private_top=$private_wrappers{$src_top} || create_private_wrapper_dir($src_top);
         create_extension_build_dir($self->application, $private_top, 1);

         my $app_name=$self->application->name;
         if (-f (my $mf_inc="$src_top/apps/$app_name/src/Makefile.inc")) {
            my $link="$private_top/apps/$app_name/src/Makefile.inc";
            create_source_dir($link);
            symlink $mf_inc, $link
               or die "Could not create a link $link => $mf_inc : $!\n";
         }

         $shared_mod->new_private($private_top,$app_name);

         if (defined($extension) && -f (my $mf_conf=$shared_mod->build_top."/make.conf")) {
            my $priv_mf_conf=$shared_mod->private->build_top."/make.conf";
            symlink $mf_conf, $priv_mf_conf
               or die "Could not create a link $priv_mf_conf => $mf_conf : $!\n";
         }
      }
      $shared_mod=$shared_mod->private;

      if (defined $extension) {
         modify_ext_makefile($shared_mod->build_dir, is_object($extension) ? $extension : @$extension);
      }
   }

   unless ($MAKE) {
      require Polymake::Core::CPlusPlus_config;
      configure_make($custom_handler);
   }
   my $file=new Tempfile;
   my $so_name=$file->rename.$dl_suffix;
 RETRY: {
      open my $cc, ">$file.cc";
      print $cc <<".";
#include <unistd.h>
namespace { void delete_temp_file() __attribute__((destructor));
            void delete_temp_file() { unlink("$so_name"); } }
.
      my @includes=$lacking->temp_include;
      my $withInclude= $includes[0] eq "withInclude" && join("=", splice @includes, 0, 2)
        or unshift @includes, "polymake/client.h";
      print $cc map { "#include \"$_\"\n" } uniq(@includes);
      print $cc "namespace polymake { namespace ".$self->application->name." {\n",
                $lacking->gen_temp_code($type_proto),
                "} }\n";
      close $cc;

      warn_print( "Compiling temporary shared module, please be patient..." ) if $Verbose::cpp;
      my $debug_flag= $debug && "Debug=y";
      my $rc=system(($Verbose::cpp>1 && "cat $file.cc >&2; ") .
                    "$MAKE -C " . $shared_mod->build_dir . " $so_name $debug_flag SharedModules=$file OwnShared=$so_name $withInclude ProcessDep=none " .
                    ($Verbose::cpp ? ">&2 " : ">/dev/null") . " 2>$file.err");
      if ($rc) {
         if ($lacking->retry_on_error) {
            if ($Verbose::cpp) {
               dbg_print( "Compilation failed:\n\n" . `cat $file.err` . "\n\nRetrying with alternative source code." )
            }
            redo RETRY;
         }
         die "Shared module compilation failed; see the error log below\n\n" . `cat $file.err`;
      }
   }

   if (defined $type_proto) {
      load_shared_module($so_name);
   } else {
      my $functions_begin=@{$root->functions};
      load_shared_module($so_name);
      bind_functions($self, $functions_begin, $#{$root->functions},
                     { "$file.cc" => ($lacking->private ? "$file.cc" : $lacking->is_instance_of->embedded || $lacking->source_file) });
   }
}
#######################################################################################
sub loading_extension {
   my ($self, $extension)=@_;
   $self->application->cpp=new PendingExtension($self, $extension);
}
#######################################################################################
sub forget_extension {
   my ($self, $ext, $forget_me_too)=@_;
   if (defined (my $shared_mod=$self->shared_modules->{$ext->dir})) {
      if ($shared_mod->private) {
         delete_private_wrapper_dir($ext->dir);
      }
      delete $self->shared_modules->{$ext->dir};
      if (defined (delete $wrapper_updated{$ext->dir."/".$self->application->name})) {
         $custom_handler->set('%wrapper_updated');
      }
   }
   if ($forget_me_too) {
      if ($self->will_update_sources) {
         $self->will_update_sources=0;
         forget AtEnd($self->application->name.":C++");
      }
      if (defined (delete $wrapper_updated{$self->application->name})) {
         $custom_handler->set('%wrapper_updated');
      }
   }
}
#######################################################################################

package Polymake::Core::CPlusPlus::PendingAppHandler;

*new=\&perApplication::__new;

sub try_load {
   my ($self, $enforce)=@_;
   bless $self, "Polymake::Core::CPlusPlus::perApplication";
   if (defined (my $shared_mod=new SharedModule($self, undef, $enforce))) {
      $self->shared_modules->{$self->application->installTop}=$shared_mod;
   } else {
      bless $self;
      undef
   }
}

sub AUTOLOAD {
   my ($self)=@_;
   try_load($self, 1);
   no strict 'refs';
   $AUTOLOAD=~s/::PendingAppHandler(?=::)/::perApplication/;
   goto &$AUTOLOAD;
}

sub embedded_rules_cnt {
   my ($self)=@_;
   try_load($self) && $self->embedded_rules_cnt
}

sub end_loading {}
sub DESTROY {}

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

package Polymake::Core::CPlusPlus::PendingExtension;
use Polymake::Struct (
   [ new => '$$' ],
   [ '$handler' => '#1' ],
   [ '$extension' => '#2' ],
   [ '$configs' => 'undef' ],
);

sub try_load {
   my ($self, $enforce)=@_;
   my $extension=$self->extension;
   my $do_it=1;
   if (defined($self->configs) && $self->configs==0) {
      my $wrapper_tag=$self->extension->dir."/".$self->handler->application->name;
      if ($enforce) {
         # build auto-configuration in some rules failed, but there is still something to compile
         $wrapper_updated{$wrapper_tag}=time+1;
      } else {
         # build auto-configuration failed completely
         $wrapper_updated{$wrapper_tag}=-1;
         $do_it=0;
      }
      $custom_handler->set('%wrapper_updated');
   }
   $do_it && do {
      $self=$self->handler;
      if (defined (my $shared_mod=new SharedModule($self, $extension, $enforce))) {
         $_[0]=$self;
         $self->shared_modules->{$extension->dir}=$shared_mod;
      } else {
         undef
      }
   }
}

sub AUTOLOAD {
   try_load($_[0], 1);
   no strict 'refs';
   $AUTOLOAD=~s/::PendingExtension(?=::)/::perApplication/;
   goto &$AUTOLOAD;
}

sub embedded_rules_cnt {
   &try_load && $_[0]->embedded_rules_cnt
}

sub needs_build {
   my $self=shift;
   my $ext_dir=$self->extension->dir;
   $ext_dir !~ m{^$InstallTop/}o && (!-d "$ext_dir/build.$Arch" || -w _) && ($self->configs+=0, 1)
}

sub store_in_conf_makefile {
   my $self=shift;
   my $build_dir=$self->extension->dir."/build.$Arch";
   -f "$build_dir/conf.make"
     or create_extension_build_dir($self->handler->application, $self->extension->dir);
   $self->configs+=$self->handler->store_in_conf_makefile(@_);
}

sub end_loading {
   $_[0]=$_[0]->handler;
}

sub DESTROY {}

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

package Polymake::Core::CPlusPlus;

declare ($from_embedded_rules, $root);
declare $typeinfo_re=qr{^typeinfo for };
declare $wrapped_typeinfo_re=qr{^typeinfo for PolymakeTestWrap<(.*)>};
declare $constructor_re=qr{::$id_re (?:\[.*?\])? \(\)$}xo;
declare $wrapped_constructor_re=qr{^PolymakeTestWrap<(.*)>::PolymakeTestWrap (?:\[.*?\])? \(\)$}xo;

use Polymake::Struct (
   '@functions',
   '@regular_functions',
   '@embedded_rules',
   '%embedded_property_types',
   '@duplicate_class_instances',
   '%classes',
   '%builtins',
   '%templates',
   '%typeids',
   '%auto_functions',
   '$auto_default_constructor',
   '$auto_convert_constructor',
   '$auto_assignment',
   '$auto_conversion',
   '$indirect_wrapper',
   '@auto_assoc_methods',
   '@auto_set_methods',
);

# auto-function flags:
use Polymake::Enum qw( func: is_method=1 is_lvalue=2 is_lvalue_opt=4 is_non_const=8 is_void=0x10 is_wary=0x20
                             is_ellipsis=0x40 is_top_object_method=0x80 has_prescribed_ret_type=0x100 );

# class description kind:    (keep in sync with glue.h)
use Polymake::Enum qw( class_is: scalar container composite opaque kind_mask=0xf
                       assoc_container=0x100 sparse_container=0x200 set=0x400 serializable=0x800 );

use Polymake::Enum qw( assoc: helem find exists delete_void delete_ret );

use Polymake::Ext;

push @UserSettings::add_custom_vars,
sub {
   $custom_handler=$Custom->app_handler(__PACKAGE__);

   declare @to_mangled_typeinfo;
   $custom_handler->add('@to_mangled_typeinfo', <<'.', $Customize::state_config);
# Regular expressions deriving the typeinfo mangled name from the class typeinfo name
.
   declare @to_mangled_defconstr;
   $custom_handler->add('@to_mangled_defconstr', <<'.', $Customize::state_config);
# Regular expressions deriving the default constructor mangled name from the class typeinfo name
.
   declare $nm_util;
   $custom_handler->add('$nm_util', <<'.', $Customize::state_config);
# Path and optional flags to the nm utility
.
   declare $cppfilt_util;
   $custom_handler->add('$cppfilt_util', <<'.', $Customize::state_config);
# Path and optional flags to the c++filt utility
.
   declare $MAKE;
   $custom_handler->add('$MAKE', <<'.', $Customize::state_config);
# GNU make utility
.
   declare $MAKEFLAGS;
   $custom_handler->add('$MAKEFLAGS', <<'.', $Customize::state_config);
# Options for make utility (especially useful: -jN for parallel builds on multi-core machines)
.
   declare %private_wrappers;
   $custom_handler->add('%private_wrappers', <<'.', $Customize::state_hidden | $Customize::state_noexport);
# Locations of the automatically generated source code of C++/perl wrappers for private use.
.
   declare %wrapper_updated;
   $custom_handler->add('%wrapper_updated', <<'.', $Customize::state_hidden | $Customize::state_noexport);
# Timestamps of last changes made to the automatically generated source code of C++/perl wrappers
.

   $custom_handler->cleanup;
};

sub init {
   $root=&_new;
   my $standalone=shift;

   $Object_pseudo_proto=_new PropertyType("Object", "Polymake::Core::Object", undef);
   $Object_pseudo_options=$Object_pseudo_proto->cppoptions=new ObjectOptions(name=>"Object", builtin=>"perl::Object");
   define_function("Polymake::Core::Object", "c++options", \&ObjectType::cppoptions);

   $debug= $DebugLevel ? $ENV{POLYMAKE_DEBUG_CLIENTS} : "";
   $dl_suffix="$debug.$DynaLoader::dl_dlext";

   load_shared_module("$InstallArch/lib/core$dl_suffix") if $standalone;

   # create the standard constructors right now
   my $dc=new Constructor;
   $dc->prepare("");
   $dc->name="";
   $root->auto_default_constructor=$root->auto_functions->{$dc->wrapper_name}=$dc;

   my $cc=$root->auto_convert_constructor=new Constructor;
   $cc->prepare("*");
   $cc->name="";
   $root->auto_convert_constructor=$root->auto_functions->{$cc->wrapper_name}=$cc;

   $root->auto_assignment=$root->auto_functions->{"=ass"}=new SpecialOperator("assign");
   $root->auto_conversion=$root->auto_functions->{".cnv"}=new SpecialOperator("convert");
   $root->indirect_wrapper=$root->auto_functions->{".wrp"}=new IndirectWrapper;
   create_assoc_methods($root);
}

sub app_handler { new PendingAppHandler(@_) }

#################################################################################
sub provide_cpp_type_descr {
   my ($proto, $maybe_private)=@_;
   $root->classes->{$proto->pkg}
   or do {
      my $perApp=($proto->covering_app || croak( "don't know where to place the definition of C++ type ", $proto->full_name ))->cpp;
      $proto->cppoptions->finalize;
      $proto->cppoptions->analyze_provenience if $maybe_private;
      $perApp->compile_load_temp_shared_module($proto->cppoptions, $proto);
      if (defined (my $descr=$root->classes->{$proto->pkg})) {
         $perApp->lacking_types->{$proto}=1;
         $perApp->ensure_update_sources;
         $descr
      } else {
         die " C++ binding of type ", $proto->full_name, " was not created as expected\n";
      }
   }
}

sub Polymake::Core::PropertyType::cpp_type_descr {
   my ($self)=@_;
   $root->classes->{$self->pkg} || croak( "type ", $self->full_name, " has no C++ binding" );
}

sub Polymake::Core::PropertyType::cpp_persistent_type_descr {
   my ($self)=@_;
   defined($self->cppoptions) ? ($self->cppoptions->descr ||= &Polymake::Core::PropertyType::cpp_type_descr)
                              : &Polymake::Core::PropertyType::cpp_type_descr;  # let's it croak
}

sub Polymake::Core::PropertyType::get_cpp_representation {
   &Polymake::Core::PropertyType::cpp_type_descr->get_cpp_representation(@_);
}

sub get_magic_cpp_class {
   my $typeid=get_magic_typeid(shift, 1);
   $typeid && do {
      if (defined (my $descr=$root->typeids->{$typeid})) {
         scalar($descr->get_cpp_representation);
      } else {
         demangle($typeid);
      }
   }
}

sub Polymake::Core::PropertyType::get_element_type {
   my $proto=shift;
   if ($proto->dimension==1) {
      if ($proto->cppoptions && !$proto->cppoptions->builtin) {
         get_type_proto($proto->cpp_type_descr->vtbl, 1)
      } else {
         $proto->param;
      }
   } else {
      undef
   }
}

sub Polymake::Core::PropertyType::guess_element_type {
   my $data=shift;
   if (is_object($data) && UNIVERSAL::can($data, "type") &&
       defined (my $type=$data->type->get_element_type)) {
      return $type;
   }
   my $first=$data->[0];
   if (is_object($first) && UNIVERSAL::can($first, "type")) {
      $first->type;
   } else {
      match_builtin_type($first);
   }
}

# the indices correspond to the return values of classify_scalar
my @builtin_type_names=qw( std::string double int bool );

sub match_builtin_type {
   if (defined (my $type=&classify_scalar)) {
      $root->builtins->{$builtin_type_names[$type]}
   } else {
      undef
   }
}

sub guess_builtin_type {
   if (my $class=ref($_[0])) {
      if ($class eq "ARRAY") {
         # deliberately interpret an empty array as an empty set of indices
         if (defined (my $elem_proto= @{$_[0]} ? guess_builtin_type($_[0]->[0]) : $root->builtins->{int})) {
            return $root->builtins->{array}->generic_type($elem_proto);
         } else {
            croak( "don't know how to match [ '$_[0]->[0]' ] to a C++ type" );
         }
      }
      ### FIXME: mapping for HASH
      if (&is_object) {
         if (defined (my $proto=UNIVERSAL::can($_[0],"prototype"))) {
            $proto=$proto->();
            if ($proto->cppoptions && $proto->cppoptions->builtin) {
               return $proto;
            }
         }
      }
      croak( "don't know how to match $class to a C++ type" );
   } else {
      defined(&match_builtin_type || croak( "can't map ", defined($_[0]) ? "'$_[0]'" : "UNDEF", " to a C++ type" ))
   }
}

# private:
sub set_embedded {
   my ($self, $embedded)=@_;
   if (defined($self->embedded)) {
      if ($self->embedded ne $embedded) {
         croak( $self->complain_source_conflict, ": conflicting files $embedded and ", $self->embedded );
      }
   } else {
      $self->embedded=$embedded;
   }
}

*set_application=\&PropertyParamedType::set_application;
*set_extension=\&PropertyParamedType::set_extension;

sub source_top {
   my ($app, $ext)=@_;
   defined($ext) ? (is_object($ext) ? $ext : $ext->[0])->app_dir($app) : $app->top;
}

sub wrapper_filename {
   my $ccfile=shift;
   $ccfile =~ s{[^/]+\.(?:cc|C|cpp|tcc)$}{perl/wrap-$&};
   $ccfile;
}

#######################################################################################
sub resolve_auto_function {
   my ($auto_func, $args)=@_;
   $auto_func->find_instance($args) || do {
      my $lacking=new LackingInstance(@_);
      my $perApp=$lacking->application->cpp;
      $perApp->compile_load_temp_shared_module($lacking);
      if (defined (my $inst=$auto_func->find_instance($args))) {
         push @{$perApp->lacking_auto_functions}, $lacking;
         $perApp->ensure_update_sources;
         $inst
      } else {
         die "an instance of C++ ",
             instanceof Operator($auto_func) ? ("operator ", $auto_func->sign)
                                             : ("function ", $auto_func->perl_name),
             " was not created as expected\n";
      }
   }
}
#######################################################################################
sub resolve_regular_function {
   my ($auto_func, $descr, $args)=@_;
   my $indirect_wrapper=
   $auto_func->inst_cache ||= do {
      my $code=create_function_wrapper($descr, $auto_func->application->pkg);
      (my $void_ret, @{$auto_func->lvalue_params})=@{$code->()};
      $auto_func->flags |= $func_is_void if $void_ret;
      my $indirect_descr=$root->indirect_wrapper->inst_cache->{$descr->arg_types} || do {
         my $lacking=new LackingRegular($auto_func,$descr);
         my $perApp=$auto_func->application->cpp;
         $perApp->compile_load_temp_shared_module($lacking);
         if (defined (my $inst=$root->indirect_wrapper->inst_cache->{$descr->arg_types})) {
            push @{$perApp->lacking_auto_functions}, $lacking;
            $perApp->ensure_update_sources;
            $inst
         } else {
            die "the wrapper for C++ function ", $auto_func->perl_name, " was not created as expected\n";
         }
      };
      my $n_args=@{$descr->arg_types};
      ++$n_args if $auto_func->flags & $func_has_prescribed_ret_type;
      set_number_of_args($code, $n_args, $auto_func->opt_hashes, $auto_func->flags & $func_is_ellipsis, $indirect_descr->wrapper);
      $code
   };
   $auto_func->check_lvalue_args($args);
   $indirect_wrapper
}
#######################################################################################
sub try_merge_auto_functions {
   my ($f1, $f2)=@_;
   return 0 if $f1->embedded ne $f2->embedded;
   return 1 if $f1->application==$f2->application;
   if ($f1->name ne "construct" && defined (my $common_app=$f1->application->common($f2->application))) {
      $f2->application=$common_app;
      return 1;
   }
   0
}
#######################################################################################
sub check_twins {
   my ($auto_func)=@_;
   if (defined (my $twin=$root->auto_functions->{$auto_func->wrapper_name})) {
      if (ref($twin) eq "HASH") {
         foreach my $other (values %$twin) {
            if (try_merge_auto_functions($auto_func,$other)) {
               push @{$other->include}, @{$auto_func->include};
               $_[0]=$other;
               return;
            }
         }
         $twin->{$auto_func->embedded || $auto_func->application->name}=$auto_func;
      } elsif (try_merge_auto_functions($auto_func,$twin)) {
         push @{$twin->include}, @{$auto_func->include};
         $_[0]=$twin;
      } else {
         $root->auto_functions->{$auto_func->wrapper_name}=
            { map { ($_->embedded || $_->application->name, $_) } $auto_func, $twin };
      }
   } else {
      $root->auto_functions->{$auto_func->wrapper_name}=$auto_func;
   }
}

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

my %op_descr=( '+' => [ ':add', 1 ], '-' => [ ':sub', 1 ], '*' => [ ':mul', 1 ], '/' => [ ':div', 1 ], '%' => [ ':mod', 1 ],
               '<<' => [ ':lsh', 1 ], '>>' => [ ':rsh', 1 ], '&' => [ ':and', 1 ], '|' => [ ':_or', 1 ], '^' => [ ':xor', 1 ],
               '+=' => [ '=add', 1+$func_is_lvalue ], '-=' => [ '=sub', 1+$func_is_lvalue ], '*=' => [ '=mul', 1+$func_is_lvalue ],
               '/=' => [ '=div', 1+$func_is_lvalue ], '%=' => [ '=mod', 1+$func_is_lvalue ], '<<=' => [ '=lsh', 1+$func_is_lvalue ],
               '>>=' => [ '=rsh', 1+$func_is_lvalue ], '&=' => [ '=and', 1+$func_is_lvalue ], '|=' => [ '=_or', 1+$func_is_lvalue ],
               '^=' => [ '=xor', 1+$func_is_lvalue ],
               'neg' => [ '.neg', 0 ], '!' => [ '.not', 0 ], '~' => [ '.com', 0 ], 'bool' => [ '.boo', 0 ],
               '++' => [ '.inc', $func_is_lvalue ], '--' => [ '.dec', $func_is_lvalue ],
               '==' => [ ':_eq', 1 ], '!=' => [ ':_ne', 1 ], '<' => [ ':_lt', 1 ],
               '<=' => [ ':_le', 1 ], '>' => [ ':_gt', 1 ], '>=' => [ ':_ge', 1 ],
               '<=>' => [ 'cmp', 1 ], '**' => [ 'pow', 1 ], 'abs' => [ 'abs', 0 ],
             );

my %op_groups=( arith => [ qw( neg ! + - * / += -= *= /= ) ],
                arith_nofloat => [ qw( neg ! +F -F *F /F +=F -=F *=F /=F ) ],
                arith_nodiv => [ qw( neg + - * += -= *= ) ],
                sets => [ qw( ~ + += - -= * *= ^ ^= ) ],
                bits => [ qw( ~ & | ^ &= |= ^= ) ],
                compare => [ qw( == != < <= > >= ) ],
                string => [ ],                                  # just to enable the default string ops in define_operators
              );

my @assoc_descr=(
   [ $assoc_helem,       ":brk",          "[]",           1+$func_is_lvalue_opt ],
   [ $assoc_find,        "assoc_find",    "*,*",          0,
     name => "pm::perl::find_element", include => [ "polymake/perl/assoc.h" ] ],
   [ $assoc_exists,      "exists",        "*",            $func_is_method ],
   [ $assoc_delete_void, "erase",         "*",            $func_is_method+$func_is_non_const+$func_is_void ],
   [ $assoc_delete_ret,  "assoc_delete",  "*:lvalue,*",  0,
     name => "pm::perl::delayed_erase", include => [ "polymake/perl/assoc.h" ], macro_call => "Tmp( " ],
);

sub create_assoc_methods {
   $#{$root->auto_assoc_methods}=$#{$root->auto_set_methods}=$#assoc_descr;
   foreach my $descr (@assoc_descr) {
      my ($i, $name, $signature, $flags, @options)=@$descr;
      if ($name =~ /^\w/) {
         my $auto_func=new AutoFunction($name, $flags, undef, @options);
         $auto_func->prepare($signature);
         $root->auto_functions->{$auto_func->wrapper_name}=$auto_func;
         my $code=$root->auto_assoc_methods->[$i]=sub { &{resolve_auto_function($auto_func, \@_)} };
         set_method($code) if $flags & $func_is_method;
         declare_lvalue($code, 1) if $flags & ($func_is_lvalue|$func_is_lvalue_opt);
      } else {
         my $op=new Operator($name, $flags, $signature);
         $root->auto_functions->{$name}=$op;
         $root->auto_assoc_methods->[$i]=$op->code;
      }
   }
   $root->auto_set_methods->[$assoc_helem]=\&no_set_method;
   $root->auto_set_methods->[$assoc_find]=\&no_set_method;
   $root->auto_set_methods->[$assoc_exists]=$root->auto_assoc_methods->[$assoc_exists];
   $root->auto_set_methods->[$assoc_delete_void]=$root->auto_assoc_methods->[$assoc_delete_void];
   $root->auto_set_methods->[$assoc_delete_ret]=\&no_set_method;
}

sub no_set_method { croak("This operation is not defined on sets") }

sub add_operator {
   my ($self, $sign, $pkg)=@_;
   my ($op, $code);

   if ($sign =~ s/^ ([^\s(]+) \s*\(\s* ($qual_id_re) (?: \s*\( ($balanced_re) \) )? ((?: \s*:\s* $id_re)*) \s*\)\s*$/$1/xo) {
      my ($cppname, $signature, $attrs)=($2,$3,$4);
      my $descr=$op_descr{$sign} or croak( "operator $sign can't have C++ binding" );
      my $flags=0;
      while ($attrs =~ /$id_re/go) {
         if ($& eq "method") {
            $flags|=$func_is_method;
         } elsif ($& eq "wary") {
            $flags|=$func_is_wary;
         } elsif ($& eq "lvalue") {
            $flags|=$func_is_lvalue;
         } elsif ($& eq "lvalue_opt") {
            $flags|=$func_is_lvalue_opt;
         } else {
            croak( "unknown function attribute '$1'" );
         }
      }
      $signature ||= $descr->[1] ? "*,*" : "*";
      $op=new AutoFunction($descr->[0], $flags, $self->application);
      $op->prepare($signature, $pkg, undef);
      check_twins($op);

      if ($sign eq '<=>') {
         $code=sub {
            if (pop) {
               - &{ resolve_auto_function($op,\@_) }
            } else {
               &{ resolve_auto_function($op,\@_) }
            }
         }
      } elsif ($sign eq '**') {
         $code=sub {
            if (pop) {
               missing_op(@_,1,'**');
            } else {
               &{ resolve_auto_function($op,\@_) }
            }
         }
      } else {
         $code=sub { splice @_,-2; &{ resolve_auto_function($op,\@_) } }
      }

      $op->name=$cppname;
   } else {
      my $wary= $sign =~ s/\s*:\s*wary$//;
      $sign =~ s/([A-Z])$// and
      my $special_flag=$1;
      my $descr=$op_descr{$sign} or croak( "operator $sign can't have C++ binding" );
      if ($descr->[0] !~ /^[.:=]/) {
         croak( "operator $sign must be matched to a C++ function or method" );
      }
      $code=($op=($root->auto_functions->{$descr->[0]} ||= new Operator(@$descr, $sign)))->code($special_flag, $wary);
   }

   ($op->flags & $func_is_lvalue) && !$_[3]++ ? ($sign => $code, '=' => \&overload_clone_op) : ($sign => $code);
}

sub define_operators {
   my ($self, $opts, $pkg, $proto)=@_;
   if (length($opts->operators)) {
      my $clone_added;
      overload::OVERLOAD(
         $pkg, fallback => 0, nomethod => \&missing_op,
         '""' => \&convert_to_string,
         @PropertyType::string_ops,
         map { add_operator($self, $_, $pkg, $clone_added) }
         map { /^\@($id_re) (:$id_re)?/xo
               ? ( map { $_.$2 } @{$op_groups{$1} or croak( "unknown operator group $1" )} )
               : $_
         } ($opts->operators =~ /[^\s\(]+ (?:\s*\( $balanced_re \))?/gxo)
      );
   }
   if (defined $opts->fields) {
      if (defined $proto) {
         PropertyParamedType::set_field_names($proto, @{$opts->fields});
      } else {
         my $i=0;
         foreach my $field_name (@{$opts->fields}) {
            define_function($pkg, $field_name, Struct::create_accessor($i++, \&composite_access));
         }
      }
   }
}

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

sub construct_any : method {
   assign_array_to_cpp_object((shift)->construct->(),@_,$PropertyType::trusted_value);
}

sub assign_any : method {
   if ($#_==1 && (ref($_[1]) eq "ARRAY" || UNIVERSAL::isa($_[1], ref($_[0])))) {
      assign_to_cpp_object(@_,$PropertyType::trusted_value);
   } else {
      assign_array_to_cpp_object(@_,$PropertyType::trusted_value);
   }
}

sub construct_parsed : method {
   my $proto=shift;
   if ($_[0] =~ /\S/) {
      my $obj=eval { assign_to_cpp_object($proto->construct->(),$_[0],$PropertyType::trusted_value) };
      if (!defined($obj)) {
         if ($@ =~ /^(\d+)\t/) {
            local $_=$_[0];
            pos($_)=$1;
            $proto->parse_error;
         } else {
            die $@;
         }
      }
      $obj;
   } else {
      $proto->construct->();
   }
}

# called from within a parse method belonging to Tuple or some other pure perl container
# the string to be parsed is passed in $_
sub construct_nested_parsed : method {
   if ($PropertyType::nesting_level && /\G\s* (?: (?:(<)|\() ($balanced_re) (?(1)>|\)) | (\{ $balanced_re \}) )/xogc) {
      my $text=defined($2 || $3);
      &PropertyType::parse_fallback;    # consume the delimiter after the embraced value
      $_[0]->parse_string->($text);
   } else {
      $_[0]->parse_string->(&PropertyType::parse_fallback);
   }
}

sub construct_composite_cpp_value : method {
   my ($proto)=@_;
   if (@_>2 && !($#_%2)) {
      my ($i,$last)=(1,$#_-1);
      for (; $i<=$last; $i+=2) {
         if (!is_keyword($_[$i])) {
            return &construct_any;
         }
      }
      my $x=$proto->construct->();
      for ($i=1; $i<=$last; $i+=2) {
         my $field=$_[$i];
         $x->$field=$_[$i+1];
      }
      $x;
   } else {
      &construct_any;
   }
}

sub std_default_constructor : method {
   &{resolve_auto_function($root->auto_default_constructor, \@_)}
}

sub std_parsing_constructor : method {
   assign_to_cpp_object($_[0]->construct->(),$_[1],$PropertyType::trusted_value);
}

sub std_convert_constructor : method {
   if (ref($_[1]) eq "ARRAY") {
      &std_parsing_constructor;
   } else {
      &{resolve_auto_function($root->auto_convert_constructor, \@_)};
   }
}

Struct::pass_original_object($_) for (\&construct_parsed, \&construct_nested_parsed);

sub define_constructors {
   my ($proto, $pkg, $symtab)=@_;
   if (defined($symtab) ||
       do { $symtab=get_pkg($pkg); no strict 'refs'; !${"$pkg\::construct"}++ }) {
      my $opts=$proto->cppoptions;
      if ($opts->default_constructor) {
         Overload::_add($pkg, "construct", "", \&std_default_constructor);
         Overload::_add($pkg, "construct", "\$", \&std_convert_constructor);
         Overload::add_fallback($pkg, "construct",
                                ($opts->descr->kind & $class_is_kind_mask) == $class_is_composite
                                ? \&construct_composite_cpp_value
                                : \&construct_any);
      }
   }
   $proto->construct=Struct::pass_original_object(\&{$symtab->{construct}});
}

sub can_inherit_constructors {
   my ($proto)=@_;
   defined($proto) && $proto->cppoptions && !$proto->cppoptions->builtin && !is_code($proto->cppoptions->descr);
}

sub create_methods {
   my ($self, $proto, $generic_opts)=@_;
   my $descr=provide_cpp_type_descr($proto, defined($generic_opts));
   # this is only called for types declared in perl (i.e. "persistent types"),
   # the relation between PropertyType and C++ class descriptors is unambigous
   $proto->dimension=obj_dimension($descr->vtbl);
   my $opts=$proto->cppoptions;
   $opts->descr=$descr;

   my $symtab=get_pkg($proto->pkg);
   my $kind=$descr->kind & $class_is_kind_mask;
   if ($kind==$class_is_container) {
      if ($descr->kind & $class_is_assoc_container) {
         $proto->toXML=\&assoc_container_toXML;
         no strict 'refs';
         push @{$proto->pkg."::ISA"}, "Polymake::Core::CPlusPlus::TiedHash";
         $proto->toString=\&convert_to_string;
      } else {
         $proto->toXML=\&container_toXML;
         no strict 'refs';
         push @{$proto->pkg."::ISA"}, "Polymake::Core::CPlusPlus::TiedArray";
         if ($descr->kind & $class_is_set) {
            $proto->toString=\&convert_to_string;
         } else {
            $proto->toString=sub {
               if ($PropertyType::nesting_level) {
                  my $text=&convert_to_string;
                  substr($text,-1,1) eq "\n" ? "<$text>\n" : substr($text,0,1) eq "{" ? $text : "<$text>"
               } else { &convert_to_string }
            };
         }
      }

   } elsif ($kind==$class_is_composite) {
      if ($proto->cppoptions->fields) {
         if (get_type_proto($descr->vtbl, 3) != scalar(@{$proto->cppoptions->fields})) {
            croak( "number of field names does not match the C++ description of class ", $proto->full_name );
         }
      }
      $proto->toXML=\&composite_toXML;
      no strict 'refs';
      push @{$proto->pkg."::ISA"}, "Polymake::Core::CPlusPlus::TiedCompositeArray";
      $proto->toString=sub { $PropertyType::nesting_level ? "(".&convert_to_string.")" : &convert_to_string };

   } else {
      if (!length($proto->cppoptions->operators)) {
         overload::OVERLOAD($proto->pkg,
                            fallback => 0,
                            nomethod => \&missing_op,
                            '""' => \&convert_to_string,
                            @PropertyType::string_ops,
                           );
      }
      $proto->toString=\&convert_to_string;
      if ($kind==$class_is_scalar) {
         Overload::_add($root->builtins->{int}->pkg,    "construct", $proto->pkg, \&convert_to_int);
         Overload::_add($root->builtins->{double}->pkg, "construct", $proto->pkg, \&convert_to_float);
      } elsif ($descr->kind & $class_is_serializable) {
         unless (defined $proto->toXML) {
            $proto->toXML=\&serialized_toXML;
         }
      }
   }

   if (exists $symtab->{construct}) {
      # already have at least one special constructor
      define_constructors($proto, $proto->pkg, $symtab);

   } elsif ($generic_opts) {
      if ($generic_opts->builtin) {
         # each instance must have its own construction method
         define_constructors($proto, $proto->pkg, $symtab);

      } elsif (!can_inherit_constructors($proto->super)) {
         # no base class to inherit constructors from: define them in the generic SUPER-package
         define_constructors($proto, *{$symtab->{ISA}}->[0]);
      }
   } elsif (!can_inherit_constructors($proto->super)) {
      # no base class to inherit constructors from
      define_constructors($proto, $proto->pkg, $symtab);
   }

   # even if the class has no default constructor, it can still have an explicitly defined constructor consuming a string
   $proto->parse_string= $opts->default_constructor ? \&construct_parsed : $proto->construct;
   $proto->parse=\&construct_nested_parsed;

   if (!defined($generic_opts) || is_code($generic_opts->builtin)) {
      # operators for never-builtin parameterized types are created earlier: in add_type_template
      define_operators($self, $proto->cppoptions, $proto->pkg);
   }
}

# defer the choice of the right method until the first real usage,
# when all prototypes are created
sub container_toXML : method {
   my $proto=shift;
   my $descr=$proto->cppoptions->descr;
   $proto->toXML= do {
      if (defined (my $val_proto=get_type_proto($descr->vtbl, 1))) {
         if ($descr->kind & $class_is_sparse_container) {
            if (defined (my $elem_proto=get_type_proto($descr->vtbl, 0))) {
               my $own_dim=$proto->dimension-$elem_proto->dimension;
               if ($own_dim==1) {
                  sub { PropertyType::sparseArray_toXML($elem_proto, @_) };
               } elsif ($own_dim==2) {
                  sub { PropertyType::sparseMatrix_toXML($val_proto, @_) };
               } else {
                  undef;
               }
            } else {
               undef;
            }
         } else {
            defined($val_proto->toXML)
            ? sub { PropertyType::nontrivialArray_toXML($val_proto, @_) }
            : sub { PropertyType::trivialArray_toXML($val_proto, @_) };
         }
      } else {
         undef;
      }
   };
   $proto->toXML->(@_);
}

sub assoc_container_toXML : method {
   my $proto=shift;
   my $descr=$proto->cppoptions->descr;
   $proto->toXML= do {
      my @kv_proto=map { get_type_proto($descr->vtbl, $_) } 0,1;
      if (defined($kv_proto[0]) && defined($kv_proto[1])) {
         my $pair_proto=$root->builtins->{pair}->generic_type(@kv_proto);
         sub { PropertyType::assocContainer_toXML($pair_proto, @_) }
      } else {
         undef
      }
   };
   $proto->toXML->(@_);
}

sub composite_toXML : method {
   my $proto=shift;
   my $descr=$proto->cppoptions->descr;
   $proto->toXML= do {
      my $elem_protos=get_type_proto($descr->vtbl, 2);
      my $trivial=1;
      foreach my $elem_proto (@$elem_protos) {
         if (defined $elem_proto) {
            if (defined($elem_proto->toXML)) {
               $trivial=0;
            }
         } else {
            undef $trivial; last;
         }
      }
      if (defined $trivial) {
         $trivial
         ? \&PropertyType::trivialComposite_toXML
         : sub { PropertyType::nontrivialComposite_toXML($elem_protos, @_) };
      } else {
         undef;
      }
   };
   $proto->toXML->(@_);
}

sub serialized_toXML : method {
   my $proto=shift;
   my $descr=$proto->cppoptions->descr;
   my $serialized_proto=get_type_proto($descr->vtbl, 4);
   $proto->toXML= sub {
      my $serialized=convert_to_serialized(shift);
      $serialized_proto->toXML->($serialized, @_)
   };
   $proto->toXML->(@_);
}

#######################################################################################
sub dump_arg {
   if (&is_object) {
      if (my $proto=UNIVERSAL::can($_[0],"prototype")) {
         $proto->()->full_name;
      } else {
         ref($_[0]);
      }
   } else {
      ref($_[0]) || "'$_[0]'"
   }
}

sub missing_op {
   defined($_[1])
   ? $_[2]
     ? croak( "undefined operator ", dump_arg($_[1]), " $_[3] ", dump_arg($_[0]) )
     : croak( "undefined operator ", dump_arg($_[0]), " $_[3] ", dump_arg($_[1]) )
   : croak( "undefined operator $_[3] ", dump_arg($_[0]) );
}
#######################################################################################
sub load_shared_module {
   my $so_name=shift;
   DynaLoader::dl_load_file($so_name, 0x01)
      or die "Can't load shared module $so_name: ", DynaLoader::dl_error(), "\n";
}
#######################################################################################
sub create_extension_build_dir {
   my ($app, $ext_dir, $for_private)=@_;
   $ext_dir ||= (my $primary=1, $app->installTop);
   my $build_dir="$ext_dir/build.$Arch";
   my $MF;
   unless ($for_private || -d $build_dir) {
      unless (-f "$ext_dir/Makefile") {
         open $MF, ">$ext_dir/Makefile";
         print $MF <<".";
ProjectTop := $InstallTop
include \${ProjectTop}/support/extension.make
.
         close $MF;
      }
      if (-d "$ext_dir/.svn") {
         my $ignore=`svn propget svn:ignore $ext_dir`;
         if ($ignore !~ /^build\.\*$/m) {
            my $tf=new Tempfile;
            open my $IGN, ">$tf.prop";
            print $IGN $ignore, "Makefile\nbuild.*\n";
            close $IGN;
            system("svn propset svn:ignore -F $tf.prop $ext_dir")
            and warn_print( <<"." );
Adding 'Makefile' and 'build.*' to svn:ignore property of directory $ext_dir failed;
Please investigate the reason and perform it manually.
.
         }
      }
   }

   my $dir="$build_dir/apps/".$app->name;
   File::Path::mkpath(["$build_dir/lib", $dir], 0, 0755);

   unless (-f "$build_dir/conf.make") {
      open $MF, ">$build_dir/conf.make" or die "Can't create $build_dir/conf.make: $!\n";
      print $MF <<".";
include $InstallArch/conf.make
### rule configuration below this line ###
.
      close $MF;
      unlink "$dir/Makefile";   # delete previous versions' Makefiles
   }
   unless (-f "$dir/Makefile") {
      open $MF, ">$dir/Makefile" or die "Can't create $dir/Makefile: $!\n";
      if ($primary) {
         if ($app->installTop ne $InstallTop) {
            print $MF "AppTop := $ext_dir\n";
         }
      } else {
         if ($app->installTop ne $ext_dir) {
            print $MF "AppTop := ".$app->installTop."\n";
         }
         print $MF "ExtensionTop := $ext_dir\n";
      }
      print $MF <<".";
BuildDir := ../..
ProjectTop := $InstallTop
include \${ProjectTop}/support/build.make
.
      close $MF;
   }
}
#######################################################################################
sub create_private_wrapper_dir {
   my $src_top=shift;
   my ($stem)=$src_top eq $InstallTop ? ("core") : $src_top =~ $filename_re;
   my $dir;
   if ($PrivateDir) {
      my $cnt;
      while (-d ($dir="$PrivateDir/wrappers/$stem".($cnt && ".$cnt"))) { ++$cnt }

      # FIXME: remove this after some transitional period
      if (-d "$PrivateDir/mirrors") {
         File::Path::rmtree("$PrivateDir/mirrors");
      }

      dbg_print( "Creating tree $dir for automatically generated private C++/perl wrappers" );
      File::Path::mkpath($dir);
      $private_wrappers{$src_top}=$dir;
      $custom_handler->set('%private_wrappers');
   } else {
      $dir=Tempfile->new_dir;
      $private_wrappers{$src_top}=$dir;
   }
   $dir
}

sub delete_private_wrapper_dir {
   my $src_top=shift;
   if (defined (my $dir=delete $private_wrappers{$src_top})) {
      $custom_handler->set('%private_wrappers');
      File::Path::rmtree($dir);
      dbg_print( "Deleted tree $dir for automatically generated private C++/perl wrappers" );
   }
}
#######################################################################################
sub create_source_dir {
   my $path=shift;
   my @to_create;
   my $use_svn;
   while ($path =~ $filename_re) {
      $path=substr($path,0,$-[0]-1);
      if (-d $path) {
         $use_svn=-d "$path/.svn";
         last;
      } else {
         push @to_create, $path;
      }
   }
   foreach (reverse @to_create) {
      if ($use_svn) {
         my $svn_success=qx( svn mkdir $_ );
         if ($svn_success !~ /^A /) {
            die "Could not create directory $_ in your svn working copy.\n",
                "Please investigate the reason and perform 'svn mkdir $_' manually!\n";
         }
      } elsif (!mkdir($_, 0755)) {
         die "Could not create directory $_: $!\n";
      }
   }
   $use_svn
}
#######################################################################################
sub has_source_files {
   my $dir=shift;
   scalar(grep { not m{/(?:Makefile\.inc|native/[^/]+)$} } glob("$dir/{src,include}/*"))
}
#######################################################################################
sub create_source_file {
   my ($file, $template, %vars)=@_;
   $template="$InstallTop/lib/core/skel/$template";
   local $/;
   open my $tf, $template
     or die "Could not read the source file template $template: $!\n",
            "Unable to maintain persistent C++ bindings!\n";
   my $content=<$tf>;  close $tf;

   my $use_svn=create_source_dir($file);

   # don't parse the copyright notice at the file top
   # discard the SVN Id: line if not needed
   local $"="\n";
   $content =~ /^-{2,}\n.*\n/m;
   $content = $` . ($use_svn && $&) . eval "<<\".#.#.#.\";\n$'.#.#.#.\n";
   if ($@) {
      die "Error processing the source file template $template: $@";
   }
   # kill superfluous empty lines
   $content =~ s/^\n{2,}/\n/m;

   if (open $tf, ">", $file) {
      dbg_print( "Creating C++ source file $file" ) if $Verbose::cpp;
      print $tf $content;
      close $tf;
   } else {
      die "Could not create the C++ source file $file: $!\n",
          "Unable to maintain persistent C++ bindings!\n";
   }

   if ($use_svn) {
      my $svn_success=qx( svn add $file );
      if ($svn_success !~ /^A /) {
         warn_print( "Could not add $file to your svn working copy.\n",
                     "Please investigate the reason and perform 'svn add $file' manually!\n" );
      }
   }
}
#######################################################################################

my $cpp_include_re=qr{^\s*\#\s*include\s+[<"](.*?)[">]};
my $cpp_start_namespace_re=qr{^\s*namespace +polymake\b};

sub modify_source_file {
   my $what=shift;
   my $filename=$what->{filename};
   open my $F, $filename;
   my ($Fnew, $F_k)=new OverwriteFile($filename);
   local $_;
   my $inst_count=0;
   my $inst_max;

   # copy the preamble till the first #include
   while (defined ($_=<$F>) && ! /(?:$cpp_include_re|$cpp_start_namespace_re)/o) {
      if (m{^///.*max\.instances=(\d+)}) {
         $inst_max=$1;
      }
      print $Fnew $_;
   }

   my $includes=$what->{includes};
   if (defined($includes) && @$includes) {
      # merge the include directives avoiding duplicates
      my @read_includes;
      push @read_includes, "polymake/client.h" if $filename !~ m{/src/perl/wrap-};
      while ($_ =~ $cpp_include_re) {
         push @read_includes, $1;
         $_=<$F>;
      }
      print $Fnew "#include \"$_\"\n" for (uniq(@read_includes, @$includes));
      print $Fnew "\n" unless @read_includes;
   }

   do {
      print $Fnew $_;
   } while (! /Automatically generated contents follow/ && defined ($_=<$F>));

   # insert new template declarations
   if (defined (my $declarations=$what->{declarations})) {
      print $Fnew @$declarations;
   }

   # delete obsolete template declarations and duplicates
   my ($obsolete, $dup_func, $dup_class)=@$what{qw(obsolete dup_func dup_class)};
   if (defined($obsolete || $dup_func || $dup_class)) {
      my %seen;
      $obsolete ||= { };
      $dup_func ||= { };
      $dup_class ||= { };
      while (<$F>) {
         my $theader;
         if (/^\s*template\s+</) {
            $theader=$_;
            $_=<$F>;
         }
         if (/^\s*FunctionInterface4perl\s*\(\s* ($id_re) /xo) {
            if (defined (my $auto_func=$obsolete->{$1})) {
               $seen{$auto_func}|=1;
               do { $_=<$F> } while (/\S/);
               next;
            }

         } elsif (!defined($theader) &&
                  /^\s*(?:(?:Function|Operator|Method)Instance4perl|DisabledFunction4perl)\s*\(\s* ($id_re) /xo) {

            if (defined (my $auto_func=$obsolete->{$1})) {
               $seen{$auto_func}|=2;
               next;
            } elsif (defined (my $inst_list=$dup_func->{$1})) {
               my $i=0;
               foreach my $inst (@$inst_list) {
                  last if $. == $inst->descr->source_line;
                  ++$i;
               }
               if ($i <= $#$inst_list) {
                  splice @$inst_list, $i, 1;
                  delete $dup_func->{$1} if @$inst_list==0;
                  next;
               }
            }
            ++$inst_count;

         } elsif (!defined($theader) &&
                  /^\s*Class4perl \s*\(\s* "($qual_id_re)"/xo) {

            if (defined (my $inst=$dup_class->{$1})) {
               if ($. == $inst->source_line) {
                  delete $dup_class->{$1};
                  next;
               }
            }
            ++$inst_count;

         } elsif (/Automatically generated contents end here/) {
            last;
         }
         print $Fnew $theader, $_;
      }

      if (my @missed=grep { $seen{$_}!=3 } values %$obsolete  or  keys %$dup_func  or  keys %$dup_class) {
         warn_print( "Wrapper declarations and/or instantiations to be deleted from the source file $filename have not been found there:\n",
                     (map { ("  ", $_->wrapper_name, "\n") } @missed),
                     (map { ("  ", $_->is_instance_of->wrapper_name, "\n") } map { @$_ } values %$dup_func),
                     (map { ("  $_\n") } keys %$dup_class),
                     "Please edit the source code manually\n" );
      }
   } else {
      while (defined ($_=<$F>) && ! /Automatically generated contents end here/) {
         ++$inst_count if $inst_max && /^\s*(?:(?:Function|Operator|Method)Instance4perl|Class4perl)/;
         print $Fnew $_;
      }
   }

   # insert new instances
   if (defined (my $instances=$what->{instances})) {
      $inst_count+=@$instances;
      print $Fnew @$instances;
   }

   # copy the trailer
   do { print $Fnew $_ } while (<$F>);
   close $F; close $Fnew;

   if ($inst_max && $inst_count >= $inst_max) {
      # maximal length reached

      # compose a new unique name
      my ($dir, $stem, $suffix)= $filename =~ m{^ (.*?) / ([^/]+) (\. [^/.]+) $ }x;
      my $ord=1;
      my $new_name;
      ++$ord while -e ($new_name="$dir/$stem-$ord$suffix");

      if (-d "$dir/.svn") {
         qx(svn copy $filename $new_name);
      }

      # store the current data under the new name
      $F_k->dst=$new_name;
      undef $F_k;

      # filter out all automatic contents from the original file; preserve the #defines and settings
      open $F, $new_name;
      ($Fnew, $F_k)=new OverwriteFile($filename);

      while (defined ($_=<$F>) && ! /(?:$cpp_include_re|$cpp_start_namespace_re)/o) {
         print $Fnew $_;
      }

      while ($_ =~ $cpp_include_re) {
         print $Fnew $_ if $1 eq "polymake/client.h";
         $_=<$F>;
      }

      do {
         print $Fnew $_;
      } while (! /Automatically generated contents follow/ && defined ($_=<$F>));

      while (<$F>) {
         last if /Automatically generated contents end here/;
      }

      do { print $Fnew $_ } while (<$F>);
      close $F; close $Fnew;
   }
}
#######################################################################################
sub modify_ext_makefile {
   my $dir=shift;
   my $mf_name="$dir/Makefile";
   open my $MF, $mf_name or die "Can't process $mf_name: $!\n";
   dbg_print( "Updating $mf_name" ) if $Verbose::cpp;
   my ($MFnew, $MF_k)=new OverwriteFile($mf_name);
   local $_;
   while (<$MF>) {
      if (/^\s*ImportExts\s*:?=\s*/) {
         my @extensions=@_;
         set_extension(\@extensions, map { add Extension($_) } $' =~ /\S+/g);
         print $MFnew "ImportExts := ", join(" ", map { $_->dir } @extensions), "\n";
         last;
      } elsif (/^\s*BuildDir\s*:?=\s*/) {
         print $MFnew "ImportExts := ", join(" ", map { $_->dir } @_), "\n", $_;
         last;
      } else {
         print $MFnew $_;
      }
   }
   while (<$MF>) { print $MFnew $_; }
   close $MF; close $MFnew;
}
#######################################################################################
sub create_include_links {
   my ($app, $ext_dir)=@_;
   my $dir="$ext_dir/include/apps/polymake";
   unless (-d $dir) {
      File::Path::mkpath($dir);
      if (-d "$ext_dir/.svn") {
	 system("svn add $ext_dir/include")
           and warn_print( "svn add $ext_dir/include failed!\nPlease investigate the reason and run it manually\n" );
      }
   }
   my $app_name=$app->name;
   my $link="$dir/$app_name";
   if (-l $link) {
      unlink $link;
   } elsif (-e _) {
      File::Path::rmtree($link);
   }
   symlink "../../../apps/$app_name/include", $link
      or die "can't create symlink $link: $!\n";
   if (-d "$ext_dir/.svn") {
      system("svn add $link")
        and warn_print( "svn add $link failed!\nPlease investigate the reason and run it manually\n" );
   }
}
#######################################################################################
sub found_application {
   my ($app, $core)=@_;
   create_extension_build_dir($app,"",$core);
   create_include_links($app, $core ? $InstallTop : $app->installTop);
}
#######################################################################################
sub private_jni_libdir {
   my ($app, $jni_headers)=@_;
   my $private_top=$private_wrappers{$app->installTop} || create_private_wrapper_dir($app->installTop);
   my $app_name=$app->name;
   create_extension_build_dir($app, $private_top, "native");
   unless (-e (my $native_link="$private_top/apps/$app_name/src/native")) {
      my $native_src="$InstallTop/apps/$app_name/src/native";
      create_source_dir($native_link);
      symlink $native_src, $native_link;
   }
   unless ($MAKE) {
      require Polymake::Core::CPlusPlus_config;
      configure_make($custom_handler);
   }
   my $errfile=new Tempfile;
   my $debug_flag= $debug && "Debug=y";
   my $rc=system("$MAKE -C $private_top/build.$Arch/apps/$app_name all-native $debug_flag $MAKEFLAGS JNI_HEADERS=$jni_headers" . (!$Verbose::cpp && ">/dev/null") . " 2>$errfile.err");
   if ($rc) {
      die "native library compilation failed; see the error log below\n\n", `cat $errfile.err`;
   }
   "$private_top/build.$Arch/lib/jni"
}
#######################################################################################

my ($cppf_out, $cppf_in);

sub demangle {
   unless (defined $cppf_in) {
      unless (@to_mangled_typeinfo || @to_mangled_defconstr) {
         require Polymake::Core::CPlusPlus_config;
         study_name_mangling($custom_handler);
      }
      require Polymake::Background;
      ($cppf_out, $cppf_in)=new Background::Pipe($cppfilt_util);
   }

   foreach my $rule (@to_mangled_typeinfo) {
      local $_=$_[0];
      eval $rule or $@ ? die "syntax error in mangling regex: $@\n" : next;
      print $cppf_out $_, "\n";
      $_=readline($cppf_in);
      chomp;
      if ($_ =~ $wrapped_typeinfo_re) {
         return $1;
      } elsif ($_ =~ $typeinfo_re) {
         return $';
      }
   }

   my $case=0;
   foreach my $rule (@to_mangled_defconstr) {
      local $_=$_[0];
      eval $rule or $@ ? die "syntax error in mangling regex: $@\n" : next;
      print $cppf_out $_, "\n";
      $_=readline($cppf_in);
      if (++$case<=2) {
         if ($_ =~ $constructor_re) {
            return $`;
         }
      } else {
         if ($_ =~ $wrapped_constructor_re) {
            return $1;
         }
      }
   }
   undef
}

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

sub gen_proxy_op {
   eval <<".";
sub {
   if (\$_[2]) {
      \$_[1] $_ convert_to_$_[0](\$_[0])
   } else {
      convert_to_$_[0](\$_[0]) $_ \$_[1]
   }
}
.
}

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

package Polymake::Core::CPlusPlus::Iterator;

use overload '++' => \&incr, 'bool' => \&not_at_end,    
             '${}' => \&deref_to_scalar, '@{}' => \&deref, '%{}' => \&deref,
             '=' => \&overload_clone_op,
             fallback => 0, nomethod => \&missing_op, '""' => sub { &not_at_end ? "ITERATOR" : "VOID ITERATOR" };

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

package Polymake::Core::CPlusPlus::NumProxy;

use overload '0+' => \&convert_to_serialized,
             neg => sub { - convert_to_serialized($_[0]) },
             abs => sub { abs( convert_to_serialized($_[0]) ) },
             (map { $_ => gen_proxy_op("serialized") } qw(+ - * / % ** <=>));

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

package Polymake::Core::CPlusPlus::BoolProxy;

use overload 'bool' => \&convert_to_serialized,
             (map { $_ => gen_proxy_op("serialized") } qw(& | ^));

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

package Polymake::Core::CPlusPlus::StringProxy;

use overload '""' => \&convert_to_string,
             (map { $_ => gen_proxy_op("string") } qw(x . cmp));

1

# Local Variables:
# cperl-indent-level:3
# indent-tabs-mode:nil
# End:
