#  Copyright (c) 1997-2011
#  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: RuleFilter.pm 10198 2011-05-11 06:29:24Z gawrilow $

use strict;
use namespaces;
use re 'eval';

#################################################################################
package Polymake::Core;

sub multiple_func_definition {
   croak( "Multiple definition of a non-overloaded function" );
}

sub multiple_type_definition {
   croak( "Multiple definition of a property type" );
}

sub check_application_pkg {
   my $app_expected=$_[0];
   if (compiling_in(\%application::) != $app_expected) {
      croak( "This declaration ",
             $app_expected ? "is only allowed" : "is not allowed",
             " in the top-level (application) scope" );
   }
}

declare $warn_options="use strict 'refs'; use warnings 'void', 'syntax'";

#################################################################################
package Polymake::Core::ScriptLoader;
use Polymake::Struct (
   [ new => '$$' ],
   [ '$handle' => '#1' ],
   [ '$prologue' => '#2' ],
);

sub new {
   my $self=&_new;
   (\&get, $self);
}

sub get {
   my ($maxlen, $self)=@_;
   if (@{$self->prologue}) {
      $_ .= shift @{$self->prologue};
   } else {
      $_ .= readline $self->handle;
   }
   return length;
}
#################################################################################
package Polymake::Core::ScriptFilter;
use Polymake::Struct (
   [ '@ISA' => 'ScriptLoader' ],
   [ new => '$$@' ],
   [ '@conv' => '@' ],
);

sub new {
   my $self=&_new;
   (\&get, $self);
}

sub get {
   my ($maxlen, $self)=@_;
   if (@{$self->prologue}) {
      $_ .= shift @{$self->prologue};
   } else {
      namespaces::temp_disable();
      my $line=readline $self->handle;
      foreach my $conv (@{$self->conv}) {
         last if $conv->($line);
      }
      $_ .= $line;
   }
   return length;
}
#################################################################################
#
#   Rule parser

package Polymake::Core::Application::RuleFilter;

use Polymake::Struct (
   [ new => '$$$@' ],
   [ '$handle' => '#1' ],
   [ '$application' => '#2' ],
   [ '$path' => '#3' ],
   '@buffer',
   [ '$gap' => '1' ],           # 1 - empty line, 2 - comment block
   '$start_comments',
   '$len_comments',
   '$after_rule',
   '@trailer',
   '&filter',
   '$header_line',
   [ '$preamble_end' => '0' ],
);

sub new {
   my $self=&_new;
   splice @_, 0, 3;
   if (@_>1) {
      @{$self->buffer}=@_;
   } else {
      @{$self->buffer}=split /(?<=\n)/, shift;
   }
   (\&get, $self);
}

sub get {
   my ($maxlen, $self)=@_;
   unless (@{$self->buffer}) {
      namespaces::temp_disable();
      fill($self);
   }
   print STDERR ">>> ", $self->buffer->[0] if $DebugLevel>3;
   $_ .= shift @{$self->buffer};
   return length;
}
#################################################################################
my $funcnt="aaa000";

declare $interactive;

declare %rule_headers=(
   USE => sub {
      my ($self, $header)=@_;
      $self->filter=\&erase_comments_filter;
      $header =~ s/\#.*$//;
      push @{$self->buffer}, "BEGIN { application::self()->use_apps(0, qw($header\n";
      push @{$self->trailer}, ")) }\n";
   },

   IMPORT => sub {
      my ($self, $header)=@_;
      $self->filter=\&erase_comments_filter;
      $header =~ s/\#.*$//;
      push @{$self->buffer}, "BEGIN { application::self()->use_apps(1, qw($header\n";
      push @{$self->trailer}, ")) }\n";
   },

   INCLUDE => sub {
      my ($self, $header)=@_;
      $self->filter=\&erase_comments_filter;
      $header =~ s/\#.*$//;
      push @{$self->buffer}, "application::self()->include_rule_block(0, q($header\n";
      push @{$self->trailer}, "));\n";
   },

   REQUIRE => sub {
      my ($self, $header)=@_;
      $self->filter=\&erase_comments_filter;
      $header =~ s/\#.*$//;
      push @{$self->buffer},
           &start_preamble . "->include_required(q($header\n";
      push @{$self->trailer},
           "), __FILE__, $.) || return 1;\n";
   },

   CREDIT => sub {
      my ($self, $header)=@_;
      if ($header =~ /\s*(?:-|none|off)\s*$/) {
         push @{$self->buffer},
              "my \$__cur_credit;\n";
      } elsif (my ($product)= $header =~ /\s*(\w+)\s*$/) {
         push @{$self->buffer},
              "my \$__cur_credit=application::self()->add_credit('$product', <<'_#_#_#_', __FILE__);\n";
         push @{$self->trailer}, "_#_#_#_\n";
         $self->application->credits_by_rulefile->{$extension ? $self->path : ($self->path =~ $filename_re)[0]}=$product;
      } else {
         push @{$self->buffer},
              "BEGIN { die 'invalid product name in credit definition' }\n";
      }
   },

   CONFIGURE => sub { process_configure(@_[0,1], 0) },

   CONFIGURE_OPT => sub { process_configure(@_[0,1], 1) },

   CONFIGURE_BUILD => sub {
      my ($self, $header)=@_;
      if (defined $extension) {
         ++$funcnt;
         $header =~ s/^/sub __conf__$funcnt /;
         push @{$self->buffer},
              &start_preamble . "->configure_build(\\&__conf__$funcnt, __FILE__, $.) || return 1; $header\n";
      } else {
         push @{$self->buffer},
              "BEGIN { die 'CONFIGURE_BUILD clause is only allowed in extensions' }\n";
      }
   },

   object => sub { reopen_type(@_, "object") },

   property_type => sub { reopen_type(@_, "property") },

   default_object => sub {
      my ($self, $header)=@_;
      if ($header =~ /($type_re) \s*;$/xo) {
         push @{$self->buffer},
              "application::self()->default_type=application::self()->eval_type('$1');\n";
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid type name' }\n";
      }
   },

   property => sub {
      my ($self, $header)=@_;
      if (my ($prop_name, $prop_type, $attrs, $default, $open_scope, $override, $alias)=
          $header =~ /^($id_re) (?: \s*:\s* ($type_re) \s* ((?: : [^:;{=]+ )*) (?: (=\s*[^;]+)? ; | (\{))
                                  | \s*=\s* (override \s+)? ($id_re) \s*; ) \s*$/xo) {
         if (defined($alias)) {
            if ($Help::gather) {
               push @{$self->buffer},
                    "self(1)->help_topic(1)->add(['properties', '$prop_name'], <<'_#_#_#_');\n",
                    cut_comments($self),
                    "# Alias for property [[$alias]].\n",
                    "_#_#_#_\n";
            }
            $override=0+length($override);
            push @{$self->buffer},
                 "self(1)->add_property_alias('$prop_name', '$alias', $override);\n",
                 "#line ".($.+1)."\n";

         } else {
            translate_type($prop_type);
            fill_help($self, "self(1)", "'properties', '$prop_name'") if $Help::gather;
            my @attrs;
            my $flags=0;
            while ($attrs =~ s/:\s* (mutable|multiple) \s* (?=:|$)//ox) {
               no strict 'refs';
               $flags |= ${"Polymake::Core::Property::is_$1"};
            }
            push @attrs, "flags=>$flags" if $flags;
            while ($attrs =~ s/:\s* (canonical|equal) \s*\( ($balanced_re) \)\s*//ox) {
               push @attrs, "$1=>$2";
            }
            if ($attrs =~ /\S/) {
               push @{$self->buffer},
                    "BEGIN { die 'unknown property attributes $attrs' }\n";
               return;
            }
            ++$funcnt if defined($default);
            push @{$self->buffer},
                 ($open_scope && "{ my \$prop=") .
                 "self(1)->add_property_definition('$prop_name', $prop_type, @attrs);\n",
                 defined($default)
                 ? ( "self(1)->add_default_value_rule('$prop_name : ', \\&__prod__$funcnt);\n",
                     "#line $.\n",
                     "sub __prod__$funcnt : method { \$_[0]->$prop_name$default }\n" ) :
                 $open_scope
                 ? ( "  package _::_prop_$prop_name; \$prop->analyze(__PACKAGE__); undef \$prop;\n",
                     "#line ".($.+1)."\n" )
                 : ();
         }

      } elsif (($prop_name)=
               $header =~ /^($hier_id_re) \s*\{\s*$/xo) {
         (my $pkg=$prop_name) =~ s/(?:^|\.)/::_prop_/g;
         push @{$self->buffer},
              "{ self(1)->reopen_subobject('$prop_name'); package _$pkg;\n";

      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid property declaration' }\n";
      }
   },

   custom => sub {
      my ($self, $header)=@_;
      my ($varname, $tail);
      if ($header =~ /^[\$\@%] $id_re (?!:) (?= \s*(=))?/xo) {
         substr($header,0,0)="declare ";
         $varname=$&;
         $tail= (defined($1) ? "0" : "$. < \$__preamble_end && \$Core::Customize::state_config") . ", __PACKAGE__";
         push @{$self->buffer}, "$header\n";
      } elsif ($header =~ /^[\$\@%] $qual_id_re (?= \s*(=))?/xo) {
         $varname=$&;
         push @{$self->buffer}, "$header\n" if defined($1);
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid custom variable name' }\n";
         return;
      }
      push @{$self->trailer},
           "application::self()->add_custom('$varname', <<'_#_#_#_', $tail);\n",
           cut_comments($self),
           "_#_#_#_\n";

      # must collect embedded comments in the hashes
      if ($header =~ /% $qual_id_re \s*=\s* \(/xo) {
         $self->filter=$self->custom_hash_filter;
      }
   },

   options => sub {
      my ($self, $header)=@_;
      if ($header =~ s/^%($qual_id_re)\s*//o) {
         my $varname=$1;
         push @{$self->buffer},
              $varname =~ /::($id_re)$/
              ? "%{namespaces::declare_var('$`', '%$1')}$header\n"
              : "declare %$varname$header\n";

         if ($Help::gather) {
            push @{$self->trailer},
                 "application::self()->help->add(['options', '$varname'], <<'_#_#_#_');\n",
                 cut_comments($self),
                 "_#_#_#_\n";
            $self->filter=$self->custom_hash_filter(1);
         }
      } else {
         push @{$self->buffer}, "BEGIN { die 'options must be declared as a hash variable' }\n";
      }
   },

   label => sub {
      my ($self, $header)=@_;
      if ($header =~ $id_only_re) {
         fill_help($self, "", "'preferences', '$1'") if $Help::gather;
         push @{$self->buffer},
              "application::self()->add_top_label('$1');\n",
              "#line ".($.+1)."\n";
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid label name' }\n";
      }
   },

   prefer => sub {
      my ($self, $header)=@_;
      $header =~ s/\s+$//;
      push @{$self->buffer},
           "application::self()->prefs->add_preference('$header', 3);\n";
   },

   function => sub { prepare_function(@_, 0, "", 0) },

   method => sub { prepare_function(@_, 1, "", 0, "Core::check_application_pkg(0);") },

   user_function => sub { prepare_function(@_, 0, "", 1, "Core::check_application_pkg(1);") },

   user_method => sub { prepare_function(@_, 1, "", 1, "Core::check_application_pkg(0);") },

   global_method => sub { prepare_function(@_, 1, "_global", 0, "Core::check_application_pkg(0);") },

   typecheck => \&prepare_typecheck,

   file_suffix => sub {
      my ($self, $header)=@_;
      if ($header =~ /(\w+)\s*$/) {
         push @{$self->buffer},
              "self(-2)->set_file_suffix('$1');\n";
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid file suffix' }\n";
      }
   },

   rule => sub {
      my ($self, $header, $prolonged)=@_;
      if ($header =~ s/^ ($hier_id_re \s*=\s* (?: $hier_id_re | \$this)) \s*;//xo) {
         my $rule_header=$1;
         $self->after_rule=1;
         push @{$self->buffer},
              "self(1)->add_production_rule('$rule_header');\n",
              $prolonged ? "#line ".($.+1)."\n" : ();

      } elsif ($header =~ s/^ $hier_id_re (?: \s*[:|,]\s* $hier_id_re )* (?: \s*: )?//xo) {
         my $rule_header=$&;
         unless ($header =~ /\s*;\s*$/) {
            $self->filter=\&provide_rule_prologue;
            provide_rule_prologue($self,$header);
            $self->after_rule=1;
         };
         ++$funcnt;
         push @{$self->buffer},
              "self(1)->add_production_rule('$rule_header', \\&__prod__$funcnt, \$__cur_credit); sub __prod__$funcnt : method $header\n",
              $prolonged ? "#line ".($.+1)."\n" : ();

      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid rule header' }\n";
      }
   },

   auto_cast => sub {
      my ($self, $header, $prolonged)=@_;
      if ($header =~ /^: \s* ($type_re) \s*;\s* $/xo) {
         my $type=$1;
         translate_type($type);
         $self->after_rule=1;
         push @{$self->buffer},
              "self(1)->add_auto_cast($type);\n",
              $prolonged ? "#line ".($.+1)."\n" : ();
         
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid auto_cast declaration' }\n";
      }
   },
);

sub provide_rule_prologue {
   if ($_[1] =~ s/^\s*\{/$& my \$this=shift;/) {
      undef $_[0]->filter;
   }
}

sub provide_credit_display {
   if ($_[1] =~ s/(?: ^ | \bsub \s+ $id_re) \s*\{/$& \$__cur_credit->display if \$__cur_credit && \$Verbose::credits > \$__cur_credit->shown;/xo) {
      undef $_[0]->filter;
   }
}

declare %decl_headers=(
   object => \&process_object_decl,

   property_type => \&process_property_type,

   permutation => \&process_permutation_decl,
);

declare %rule_subheaders=(
   precondition => sub {
      my ($self, $header, $prolonged)=@_;
      if ($header =~ s/^ :\s* (!\s*)? (defined \s*\(\s*)? ((?(2) $hier_id_alt_re | $hier_id_re )) (?(2) (\s*\))) \s*;\s*$//xo) {
         my ($not, $def, $prop, $def2)=($1,$2,$3,$4);
         (my $expr=$prop) =~ s/\./->/g;
         push @{$self->buffer},
              "self(1)->append_rule_precondition(': $prop', sub { $not$def\$_[0]->$expr$def2 }, ".defined($def).");\n";

      } elsif ($header =~ s/^ :\s* ($hier_id_alt_re) \s*;\s*$//xo) {
         my $expr=$1;
         push @{$self->buffer},
              "self(1)->append_rule_precondition(': $expr', sub { my \$this=shift; " .
              join(" || ", map { "\$this->lookup('$_')" } split /\s*\|\s*/, $expr) . " }, 0);\n";

      } elsif ($header =~ s/^ :\s* $hier_id_re (?: \s*[|,]\s* $hier_id_re )*//xo) {
         my $rule_header=$&;
         $self->filter=\&provide_rule_prologue;
         provide_rule_prologue($self,$header);
         ++$funcnt;
         push @{$self->buffer},
              "self(1)->append_rule_precondition('$rule_header', \\&__prec__$funcnt); sub __prec__$funcnt : method $header\n";

      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid rule header' }\n";
         return;
      }
      if ($prolonged) {
         push @{$self->buffer}, "#line ".($.+1)."\n";
      }
      $self->after_rule=1;
   },

   weight => sub {
      my ($self, $header, $prolonged)=@_;
      if ($header =~ s/^ (?: (\d+)\.(\d+) (\s*;)? )? \s* (?(3) $ | (:\s* $hier_id_re (?: \s*[|,]\s* $hier_id_re )*)?)//xo
          and defined($3) || defined($4)) {
         $self->after_rule=1;
         my $static= defined($1) ? "$1,$2" : "undef,undef";
         if (defined (my $rule_header=$4)) {
            $self->filter=\&provide_rule_prologue;
            provide_rule_prologue($self,$header);
            ++$funcnt;
            push @{$self->buffer},
                 "self(1)->append_rule_weight($static, \\&__dynw__$funcnt); sub __dynw__$funcnt : method $header\n";
         } else {
            push @{$self->buffer},
                 "self(1)->append_rule_weight($static);\n";
         }
         push @{$self->buffer}, "#line ".($.+1)."\n" if $prolonged;
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid rule header' }\n";
      }
   },

   override => sub {
      my ($self, $header, $prolonged)=@_;
      my $line="";
      my $good= $header =~ s/^:\s*(.*);\s*$/$1/;
      while ($header =~ s{^ ($type_qual_re) :: ($hier_id_re) \s* (?: ,\s* | $)}{}xo) {
         my ($super, $label)=($1, $2);
         if ($super eq "SUPER") {
            $super="'SUPER'";
         } else {
            translate_type($super);
         }
         $line.="self(1)->append_overriden_rule($super,'$label'); ";
      }
      if ($good && $header !~ /\S/) {
         $self->after_rule=1;
         push @{$self->buffer}, $line."\n";
         push @{$self->buffer}, "#line ".($.+1)."\n" if $prolonged;
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid rule header' }\n";
      }
   },

   permutation => sub {
      my ($self, $header, $prolonged)=@_;
      if ($header =~ s/^ :\s* ($id_re) \s*; $//xo) {
         $self->after_rule=1;
         push @{$self->buffer},
              "self(1)->append_rule_permutation('$1');\n";
         push @{$self->buffer}, "#line ".($.+1)."\n" if $prolonged;
      } else {
         push @{$self->buffer}, "BEGIN { die 'invalid rule header' }\n";
      }
   },
);

#####################################################################################################
sub process_configure {
   my ($self, $header, $optional)=@_;
   ++$funcnt;
   $header =~ s/^/sub __conf__$funcnt /;
   push @{$self->buffer},
        &start_preamble . "->configure(\\&__conf__$funcnt, __FILE__, $., $optional) || return 1; $header\n";
   
}
#####################################################################################################
sub no_configure {
   $rule_headers{CONFIGURE}=sub {
      my ($self, $header)=@_;
      push @{$self->buffer},
           &start_preamble . "->configure(sub { 0 }, __FILE__, $.);\n",
           "1; __END__\n";
      close $self->handle;
   };
   $rule_headers{CONFIGURE_OPT}=
   $rule_headers{CONFIGURE_BUILD}=sub {
      my ($self, $header)=@_;
      ++$funcnt;
      $header =~ s/^/sub __conf__$funcnt /;
      push @{$self->buffer}, "$header\n";
   };
}
#####################################################################################################
sub start_preamble {
   my $self=$_[0];
   my $start=!$self->preamble_end;
   $self->preamble_end=$.;
   'application::self()' .
   ($start && $interactive && '->start_preamble(__FILE__, Polymake::Core::rescue_static_code(0))')
}
#####################################################################################################
#  helper routines common for object and property type declaration processing

sub process_template_params($$\@\@$\@\@) {
   my ($text, $super_text, $param_names, $prologue, $concept_checks, $super_abstract, $super_instance)=@_;

   my ($i, $defaults_seen)=(0,0);
   foreach my $param (split /\s*,\s*/, $text) {
      my ($name, $default, $concept_check)= $param =~ m{^ ($id_re) (?: \s*=\s* ($type_re) )? (?: \s*\[ ($balanced_re) \] )? }ox;
      push @$param_names, $name;
      if (defined $default) {
         for ($i=0; $i<$#$param_names; ++$i) {
            $default =~ s/\b$param_names->[$i]\b/\$_[$i]/g;
         }
         translate_type($default);
         push @$prologue,
              "    push \@_, $default if \$#_ < $i;\n";
         ++$defaults_seen;

      } elsif ($defaults_seen) {
         return "wrong order of parameters with and without default types";
      }
      if (defined $concept_check) {
         for ($i=0; $i<=$#$param_names; ++$i) {
            $concept_check =~ s/\b$param_names->[$i]\b/\$_[$i]/g;
         }
         $concept_checks .= "$concept_check;";
      }
   }

   if (@$param_names>1) {
      push @$prologue,
           "    my \$type_inst=\$type_inst;\n",
           "    foreach my \$arg (\@_[0.." . ($#$param_names-1) ."]) { \$type_inst=( \$type_inst->{\$arg} ||= { } ) }\n",
           "    \$type_inst->{\$_[$#$param_names]}\n";
   } else {
      push @$prologue,
           "    \$type_inst->{\$_[0]}\n",
   }

   if ($defaults_seen) {
      unshift @$prologue,
         $#$param_names >= $defaults_seen ?
         ( "    croak('too few type parameters for ', __PACKAGE__) if \$#_ < " . ($#$param_names - $defaults_seen) . ";\n" ) : (),
           "    croak('too many type parameters for ', __PACKAGE__) if \$#_ > $#$param_names;\n";
   } else {
      unshift @$prologue,
           "    croak('wrong number of type parameters for ', __PACKAGE__) if \$#_ != $#$param_names;\n";
   }

   while ($super_text =~ m{\G ((?> (?: $id_re \s*=>\s*)?) ($qual_id_re) (?: \s* (?= <)($balanced_re) )?) \s*(?:,\s*)?}xgo) {
      my ($super_expr, $super_type)=($1, $2);
      if (defined $3) {
         my $dependent;
         for ($i=0; $i<=$#$param_names; ++$i) {
            $super_expr =~ s/\b$param_names->[$i]\b/\$_[$i]/g
            and
            $dependent=1;
         }
         translate_type($super_expr);
         if ($dependent) {
            push @$super_abstract, "$super_type->self";
            push @$super_instance, $super_expr;
         } else {
            push @$super_abstract, $super_expr;
         }
      } else {
         push @$super_abstract, "$super_expr->type";
      }
   }

   $_[4]=$concept_checks;

   $defaults_seen;
}

sub process_enum {
   my %bag;
   local $_=shift;
   my $cnt=-1;
   while (pos($_) < length($_)) {
      if (/\G \s* (["'])? ($id_re) (?: \s*=\s* (\d+))? (?(1) \1) (?: , | \s+ | $)/xgco) {
         $bag{$2}= defined($3) ? ( $cnt=$3 ) : ++$cnt;
      } else {
         croak( "invalid enum declaration" );
      }
   }
   bless \%bag, "Polymake::Enum";
}
#####################################################################################################

my $property_type_decl_re=qr{ ^($id_re) (?: (?:\s*<\s* ($type_params_re | \.\.\. | \*) \s*>)?
                                            (?:\s*:\s* (?!c\+\+)($super_type_re))?
                                            (?:\s*:\s* (c\+\+) (?:\s*\( ($balanced_re) \))? )?
                                            \s* (?: ; | (\{))
                                          | \s*=\s* ($super_type_re) ) (?: \s*;)? \s*$ }xo;

my @ellipsis_prologue=split /(?<=\n)/, <<'.';
   my $type_inst=my $root=$type_inst;
   $type_inst=( $type_inst->{$_} ||= { } ) for @_;
   $type_inst->{$root}
.

sub process_property_type {
   my ($self, $header)=@_;
   my $first_line=@{$self->buffer};

   if (my ($type_name, $params, $super, $cpp_binding, $cpp_opts, $open_scope, $alias)= $header =~ $property_type_decl_re) {
      if (defined($alias)) {
         my $outer_pkg=compiling_in();
         translate_type($alias);
         push @{$self->buffer},
              $plausibility_checks
              ? "BEGIN { exists \$$outer_pkg\::{'$type_name\::'} and Core::multiple_type_definition() }\n"
              : (),
              "*$outer_pkg\::$type_name\::=get_pkg($alias->pkg);\n";

      } else {
         fill_help($self, "", "'property_types', '$type_name'") if $Help::gather;

         my $type_pkg=$self->application->pkg."::$type_name";
         push @{$self->buffer},
              "{ package $type_pkg; " . 
              ($plausibility_checks ? "BEGIN { exists &type and Core::multiple_type_definition(); } " : "") .
              "namespaces::memorize_lexical_scope;\n";

         my $appendix="";

         if (defined($params)) {
            # parameterized template type

            my (@param_names, @prologue, $concept_checks, @super_abstract, @super_instance, $n_defaults);
            if ($params eq "...") {
               if (defined($super)) {
                  $self->buffer->[$first_line]="BEGIN { die 'type with arbitrary many parameters may not be derived' }\n";
                  return;
               }
               @prologue=@ellipsis_prologue;
               $n_defaults=0;
            } elsif ($params eq "*") {
               if (defined($super)) {
                  if ($super =~ /</) {
                     push @super_abstract, "application::self()->eval_type('$super')->pkg";
                  } else {
                     push @super_abstract, "namespaces::lookup_class(__PACKAGE__,'$super','application')";
                  }
               }
               push @prologue, "    \$type_inst->{\$_[0]}\n";
               push @param_names, $params;
            } else {
               $n_defaults=process_template_params($params,$super,@param_names,@prologue,$concept_checks,@super_abstract,@super_instance);
               if (is_string($n_defaults)) {
                  $self->buffer->[$first_line]="BEGIN { die 'invalid property type declaration: $n_defaults' }\n";
                  return;
               }
               $_.="->pkg" for @super_abstract;
            }

            push @{$self->buffer},
                 "using namespaces 'Polymake::Core::PropertyParamedType';\n",
                 "{ my \$type_inst={ };" . ($cpp_binding ? " my \$cpp_opts_sub;\n" : "\n");

            if (@param_names) {
               if ($cpp_binding) {
                  $appendix='$app->cpp->add_template_instance($t,$cpp_opts_sub,$nesting_level);';
               }
            } else {
               if ($cpp_binding) {
                  $self->buffer->[$first_line]="BEGIN { die 'type with arbitrary many parameters cannot have C++ binding' }\n";
                  return;
               }
            }

            my $super_arg= @super_instance
                           ? "do { local_incr(\$nesting_level); @super_instance }"
                           : "undef";

            push @{$self->buffer},
                 "  sub generic_type { shift unless is_object(\$_[0]);\n",
                 @prologue,
                 "    ||= do { my \$app=application::self();\n",
               defined($concept_checks)
               ? "       $concept_checks\n" : (),
               $params eq "*"
               ? "       my \$t=new Polymake::Core::PropertyTypeInstance('$type_name', __PACKAGE__, \$app, $super_arg, \@_);\n"
               : "       my \$t=new Polymake::Core::PropertyParamedType('$type_name', __PACKAGE__, \$app, $super_arg, \\\@_);\n",
                 "       $appendix \$t } }\n",
               $params ne "*"
               ? "  new_generic Polymake::Core::PropertyParamedType('$type_name', __PACKAGE__, application::self(), [$n_defaults, qw(@param_names)]);\n" : (),
               @super_abstract
               ? "  \@ISA=(@super_abstract);  using namespaces \@ISA;\n" : (),
               @super_instance
               ? "  *rebind_type=Polymake::Core::PropertyParamedType::prepare_rebind(__PACKAGE__, \\&generic_type, q{$super}, qw(@param_names));\n"
               : "  sub rebind_type { undef }\n",
               $cpp_binding
               ? '  $cpp_opts_sub=application::self()->cpp->add_type_template(__PACKAGE__, template_params=>' . ($params eq "*" ? "'*'" : scalar(@param_names)) . ",$cpp_opts);\n" : (),
                 "  *type=\\&generic_type;\n",
                 (!$open_scope && "} ")."}\n";

         } else {
            # non-parameterized type
            if ($cpp_binding) {
               $cpp_opts =~ s/enum\s*(?=[({])($balanced_re)/Polymake::Core::Application::RuleFilter::process_enum(q$1)/o;
               $cpp_opts =~ s/\bembedded\b/descr=>'embedded'/;
            }
            translate_type($super) if defined($super);

            push @{$self->buffer},
                 "  my \$_type_inst=new Polymake::Core::PropertyType('$type_name', __PACKAGE__, application::self(), $super);\n",
               defined($super)
               ? "  \@ISA=( \$_type_inst->super->pkg ); using namespaces \@ISA;\n"
               : "  using namespaces 'Polymake::Core::PropertyType';\n",
               $cpp_binding
               ? "  application::self()->cpp->add_type(\$_type_inst,$cpp_opts);\n"
               : (),
               $open_scope
               ? "  my \$_analyzer=bless \\\$_type_inst, 'Polymake::Core::PropertyType::Analyzer';\n"
               : "}\n";
         }
      }
      push @{$self->buffer}, "#line ".($.+1)."\n";
   } else {
      push @{$self->buffer}, "BEGIN { die 'invalid property type declaration' }\n";
   }
}
#####################################################################################################
sub reopen_type {
   my ($self, $header, $prolonged, $what)=@_;
   if (my ($type)= $header =~ /^($type_re) \s*\{\s*$/xo) {
      my $pkg=$type;
      my $check_existence;
      if ($type =~ /</) {
         my $main=$`;
         $pkg=substr($type,$-[0]);
         translate_type($check_existence=$type);
         # can't call $proto->mangled_name here, since the XxxType object might not exist yet (declared above in the same rulefile);
         # but package requires a string literal, so we need to reconstruct the mangled name
         $pkg =~ s/\s+//g;
         while ($pkg =~ s/<(\w+)>/__$1/g) { }
         $pkg =~ s/,/_I_/g;
         while ($pkg =~ s/<(\w+)>/_A_${1}_Z/g) { }
         if ($main =~ /::/) {
            $pkg=namespaces::lookup_class($self->application->pkg, $main)."::$pkg";
         } else {
            $pkg=$self->application->pkg . "::$main$pkg";
         }
      } else {
         if ($pkg =~ /::/) {
            $pkg=namespaces::lookup_class($self->application->pkg, $pkg);
         } else {
            $pkg=$self->application->pkg . "::$pkg";
         }
         $check_existence="exists &type";
      }
      push @{$self->buffer},
           "{ package $pkg;  $check_existence or die 'unknown $what type'; local *object_type::=get_pkg(__PACKAGE__);\n";
   } else {
      push @{$self->buffer}, "BEGIN { die 'invalid $what type reference' }\n";
   }
}
#####################################################################################################
sub process_object_decl {
   my ($self, $header)=@_;
   my $first_line=@{$self->buffer};
   if (my ($type_name, $params, $super, $open_scope, $alias)=
       $header =~ /^($id_re) (?: (?:\s*<\s* ($type_params_re) \s*>)? (?:\s*:\s* ($types_re))? \s*(?: ; | (\{))
                               | \s*=\s* ($type_re) (?: \s*;)?) \s*$/xo) {

      my $object_pkg=$self->application->pkg."::$type_name";
      if ($plausibility_checks) {
         push @{$self->buffer},
              "BEGIN { application::self()->multiple_object_definition('$type_name', q{$params}) }\n";
      }

      if (defined($alias)) {
         translate_type($alias);
         push @{$self->buffer},
              "*$object_pkg\::=get_pkg($alias->pkg);\n";

      } else {
         # defining a new object type
         fill_help($self, "", "'objects', '$type_name'") if $Help::gather;
         push @{$self->buffer},
              "{ package $object_pkg; local *object_type::=get_pkg(__PACKAGE__); namespaces::memorize_lexical_scope;\n";

         if (defined($params)) {
            # parameterized template

            my (@param_names, @prologue, $concept_checks, @super_abstract, @super_instance, $all_params_have_defaults);
            my $n_defaults=process_template_params($params,$super,@param_names,@prologue,$concept_checks,@super_abstract,@super_instance);
            if (is_string($n_defaults)) {
               $self->buffer->[$first_line]="BEGIN { die 'invalid object declaration: $n_defaults' }\n";
               return;
            }

            push @{$self->buffer},
                 "{ my \$type_inst={ };\n",
                 "  sub generic_type { shift unless is_object(\$_[0]);\n",
                 @prologue,
                 "    ||= " . (defined($concept_checks) && "do { $concept_checks ")
                            . "new Polymake::Core::ObjectType('$type_name', undef, \\\@_, self(1), " . join(",", @super_instance) . ");"
                            . (defined($concept_checks) && " } ") . "}\n",
                 "  new Polymake::Core::ObjectType('$type_name', application::self(), [$n_defaults, qw(@param_names)], " . join(",", @super_abstract) . ");\n",
                 "  *type=\\&generic_type\n",
                 "}\n";

            if ($n_defaults == @param_names) {
               push @{$self->buffer},
                    "application::self()->default_type ||= generic_type();\n";
            }
         } else {
            # non-parameterized type
            translate_type($super) if defined $super;

            push @{$self->buffer},
                 "new Polymake::Core::ObjectType('$type_name', application::self(), undef, $super);\n",
                 "application::self()->default_type ||= type();\n";
         }

         push @{$self->buffer}, "}\n" unless $open_scope;
      }
      push @{$self->buffer}, "#line ".($.+1)."\n";

   } elsif ((my $forw_app_name, $type_name, $params)=
            $header =~ /^($id_re)::($id_re) (?:\s*<\s* ($type_params_re) \s*>)? \s*;$/xo) {

      # forward declaration
      if (defined (my $app=lookup Application($forw_app_name))) {
         # application already loaded
         if ($plausibility_checks) {
            my $proto;
            if (defined ($proto=UNIVERSAL::can($app->pkg."::$type_name", "self")) &&
                instanceof ObjectType(($proto=$proto->(1)))) {
               if (defined (my $diag=$proto->check_consistency($params))) {
                  push @{$self->buffer},
                       "BEGIN { die '$diag' }\n";
               }
            } else {
               push @{$self->buffer},
                    "BEGIN { die 'forward declaration does not match any object type in application $forw_app_name' }\n";
            }
         }

      } else {
         $app=forward Application($forw_app_name);
         push @{$self->buffer},
              "{\n",
              $app->forward_decls,
              "  if (defined (my \$proto=UNIVERSAL::can('".$app->pkg."::$type_name', 'self'))) {\n",
              $plausibility_checks
              ? ( "     (\$proto)=\$proto->(1); \$proto->check_consistency(q{$params});\n" ) : (),
              "  } else {\n";
         my $cnt=0;
         if (defined $params) {
            ++$cnt while $params =~ /$type_param_re/go;
         }
         push @{$self->buffer},
              "  new Polymake::Core::ObjectType::ForwardDecl('$type_name', self(), $cnt, $.);\n",
              "} }\n";
      }
      push @{$self->buffer}, "#line ".($.+1)."\n";

   } else {
      push @{$self->buffer}, "BEGIN { die 'invalid object declaration' }\n";
   }
}
#####################################################################################################
sub process_permutation_decl {
   my ($self, $header)=@_;
   if (my ($name)= $header =~ /^($id_re) \s*\{\s*$/xo) {
      push @{$self->buffer},
           "self(1)->add_permutation('$name');\n",
           "{ package _::_prop_$name;\n",
           "#line ".($.+1)."\n";
   } else {
      push @{$self->buffer}, "BEGIN { die 'invalid permutation declaration' }\n";
   }
}
#####################################################################################################
sub prepare_function {
   my ($self, $header, $prolonged, $method, $global, $user, $context_check)=@_;
   if (my ($labels, $name, $template_params, $signature)= $header =~ $labeled_sub_re) {
      $header=$';
      my ($kw, $sig);
      if (defined $signature) {
         if (($sig=$signature) =~ s/(^|[,;]\s*|\s+) ((?: \\?% | \{ ) .*)/$1%/x) {
            ($kw=", keywords=>[$2]") =~ s/(?<! \\) \s* %(?=$qual_id_re)/\\%/gxo         # pass hash references, not copies
            or $kw =~ s/\[\s*%\s*\]/[]/;
         }
         $sig="q{$sig}";
      } else {
         $sig="undef";
      }

      if ($user) {
         if ($Help::gather) {
            fill_help($self,
                      $method ? ("self(-1)", "'methods', '$name'")
                              : ("", "'functions', '$name'"),
                      "q($signature)");
            push @{$self->buffer}, "#line ".$self->header_line."\n";
         }
         $self->application->EXPORT->{$name} ||= $method ? "meth" : "user";
      }

      my $meth_decl= $method ? " : method" : "";
      if ($header =~ s/^([^\#]*?) :\s* c\+\+ \s* (?: \(\s* ($balanced_re) \s*\)\s* )? (?=[:;\{])/$1/xo) {
         my $options=$2;
         if ($plausibility_checks) {
            if (!defined $signature) {
               $context_check="$context_check exists &$name and Core::multiple_func_definition() ";
            }
            $context_check &&= "BEGIN { $context_check }";
         } else {
            $context_check="";
         }
         my @attrs=("method=>$method");
         while ($header =~ s/^([^\#]*?) :\s* (\w+) \s* (?: \(\s* ($balanced_re) \s*\)\s*)? (?=[:;\{])/$1/x) {
            push @attrs, "$2=>".( defined($3) ? "'$3'" : 1);
         }
         if ($header =~ /^\s* (?: ;\s* (?: \#.*)? $ | (\{))/x) {
            my $credit='undef';
            if ($1) {
               ++$funcnt;
               my $subname="__${name}__OV__$funcnt";
               push @attrs, "ext_code=>\\&$subname";
               $header="; sub $subname $header";
               if ($user || $global) {
                  $self->filter=\&provide_credit_display;
                  provide_credit_display($self,$header);
               }
            } elsif ($user || $global) {
               $credit='$__cur_credit';
            }
            if ($template_params) {
               $template_params="extra_template_params=>q{$template_params}, ";
               $context_check="sub $name; $context_check";
            }
            $labels &&= ", label=>[ application::self()->add_labels('$labels') ]";
            push @{$self->buffer},
                 "$context_check add$global Overload(application::self()->cpp->add_auto_function('$name', $sig, $credit, {".join(",",@attrs)."$kw}, {$template_params$options})$labels)$header\n";
         } else {
            push @{$self->buffer}, "BEGIN { die 'unknown attributes for C++ " . ($method ? "method" : "function") . "' }\n";
         }

      } elsif (defined($signature) || defined($labels)) {
         $context_check &&= $plausibility_checks ? "BEGIN { $context_check }" : "";
         my @attrs=("context=>application::self()");
         if ($template_params) {
            push @attrs, "extra_template_params=>q{$template_params}";
            $context_check="sub $name; $context_check";
         }
         ++$funcnt;
         my $subref="\\&__${name}__OV__$funcnt";
         while ($header =~ s/^([^\#]*?) (?<! :) :\s* (\w+) \s* (?: \(\s* ($balanced_re) \s*\)\s*)/$1/x) {
            push @attrs, "$2=>'$3'";
         }
         if ($header =~ s/^([^\#]*?) (?<!:) (:\s* $rule_input_re)/$1/xo) {
            if (!$method || !$user || $global) {
               push @{$self->buffer}, "BEGIN { die 'only user_methods can have rule-like input properties' }\n";
               return;
            }
            $subref="self(1)->add_method_rule('$labels$2', $subref)";
            $labels=", label=>[ 'Polymake::Core::MethodAsRule' ]";
            $self->after_rule=1;
         } else {
            $labels &&= ", label=>[ application::self()->add_labels('$labels') ]";
         }
         if ($user || $global) {
            $self->filter=\&provide_credit_display;
            provide_credit_display($self,$header);
         }
         push @{$self->buffer},
              "$context_check add$global Overload('$name', $sig, $subref,".join(",",@attrs)."$kw$labels); sub __${name}__OV__$funcnt$meth_decl $header\n";

      } elsif ($global) {
         push @{$self->buffer},
              "BEGIN { die 'global method must have a signature and/or labels' }\n";
         return;

      } else {
         $context_check= $plausibility_checks ? "BEGIN { $context_check exists &$name and Core::multiple_func_definition() }" : "";
         if (defined $template_params) {
            push @{$self->buffer},
                 "BEGIN { die 'function template must have a signature' }\n";

         } elsif ($header =~ s/^([^\#]*?) (?<!:) (:\s* $rule_input_re)/$1/xo) {
            unless ($method && $user) {
               push @{$self->buffer},
                    "BEGIN { die 'only user_methods can have rule-like input properties' }\n";
               return;
            }
            $self->filter=\&provide_credit_display;
            provide_credit_display($self,$header);
            ++$funcnt;
            push @{$self->buffer},
                 "$context_check self(1)->add_method_rule('$2', \\&__meth__$funcnt, '$name'); sub __meth__$funcnt : method $header\n";
            $self->after_rule=1;

         } elsif ($header =~ /^\s* = \s* ($hier_id_re) \s*;\s*$/xo) {
            unless ($method && $user) {
               push @{$self->buffer},
                    "BEGIN { die 'only user_methods may be defined as short-cuts to other properties' }\n";
               return;
            }
            push @{$self->buffer},
                 "$context_check sub $name$meth_decl { \$_[0]->give('$1') }\n";

         } else {
            if ($user) {
               $self->filter=\&provide_credit_display;
               provide_credit_display($self,$header);
            }
            push @{$self->buffer},
                 "$context_check sub $name$meth_decl $header\n";
         }
      }
      push @{$self->buffer}, "#line ".($.+1)."\n" if $prolonged;

   } else {
      push @{$self->buffer}, "BEGIN { die 'invalid function header' }\n";
   }
}
#################################################################################
sub prepare_typecheck {
   my ($self, $header, $prolonged)=@_;
   if (my ($name, $signature)= $header =~ $sub_re) {
      if (defined $signature) {
         $header=$';
         my $context_check= $plausibility_checks && "BEGIN { Core::check_application_pkg(1) }";
         ++$funcnt;
         my $subref="\\&__${name}__OV__$funcnt";
         get_pkg("application::typechecks", 1);
         push @{$self->buffer},
              "$context_check add Overload(__PACKAGE__.'::typechecks::$name', q{$signature}, $subref, typeofs=>1, context=>application::self()); sub __${name}__OV__$funcnt $header\n";
         push @{$self->buffer}, "#line ".($.+1)."\n" if $prolonged;
      } else {
         push @{$self->buffer}, "BEGIN { die 'typecheck function must have a signature' }\n";
      }
   } else {
      push @{$self->buffer}, "BEGIN { die 'invalid typecheck function header' }\n";
   }
}
#################################################################################
sub fill_help {
   my ($self, $whence, $path, $signature)=@_;
   return if $self->len_comments
          && $self->buffer->[$self->start_comments] =~ /^\# (?: \s* \@$id_re)* \s* \@hide (?: \s* \@$id_re)* \s*$/xio;

   my $topic= $whence ? "$whence->help_topic(1)" : "application::self()->help";
   push @{$self->buffer},
        "$topic->add([$path], <<'_#_#_#_', $signature);\n",
        cut_comments($self),
        "_#_#_#_\n";
}

sub cut_comments {
   my $self=shift;
   splice @{$self->buffer}, $self->start_comments, $self->len_comments;
}

sub scan_comments {
   my $self=shift;
   @{$self->buffer}[$self->start_comments .. $self->start_comments + $self->len_comments - 1];
}
#################################################################################
sub custom_hash_filter {
   my ($self, $watch_for_includes)=@_;
   my $last_comment_block=$#{$self->trailer};
   return sub : method {
      my ($self, $line)=@_;
      if ($line =~ /^\s* (?: (\w+) | (['"])(.*?)\2 ) \s* => [^\#\n]+ (?:\#\s* ($type_re))?/xo) {
         my $key=defined($1 || $3);
         if (defined($4)) {
            # description in the trailing comments after the key => value pair
            splice @{$self->trailer}, -1, 0, "# \@key $4 $key $'";

         } else {
            # assume description to be in the comment lines above
            $self->trailer->[$last_comment_block] =~ s/^\s*\#\s* ($type_re)/# \@key $1 $key/xo
            or croak("key comment block does not start with a valid type expression");
         }
         $last_comment_block=$#{$self->trailer};

      } elsif ($watch_for_includes && $line =~ /^\s* %($qual_id_re) \s*,?/xo) {
         splice @{$self->trailer}, -1, 0, "# \@relates $1\n";
         $last_comment_block=$#{$self->trailer};

      } elsif ($line =~ /^\s*\#\s*\S/) {
         splice @{$self->trailer}, -1, 0, $line;

      } elsif ($line =~ /^\s*\)\s*;\s*$/) {
         # end of the list
         undef $self->filter;
      }
   };
}

sub erase_comments_filter : method {
   my $self=shift;
   unless ($_[0] =~ s/\#.*$//) {
      # an empty line marks the end of the block
      undef $self->filter if $_[0] !~ /\S/;
   }
}
#################################################################################

sub fill {
   my $self=shift;
   $self->start_comments=$self->len_comments=0;
   my $trailer_pending=@{$self->trailer};

 READ: {
      my $line=readline $self->handle;
      if (!length($line)) {
         # EOF
         my $lastline=$.;
         close $self->handle or die "Syntax error near the end of file at ", $self->path, ", line ", $self->header_line, "\n";
         if (@{$self->trailer}) {
            my $firstline=$lastline-@{$self->buffer}+1;
            unshift @{$self->buffer}, @{$self->trailer}, "#line $firstline\n";
         }
         if ($self->preamble_end) {
            $self->application->preamble_end->{$self->path}=$self->preamble_end;
         }
         push @{$self->buffer}, "1; __END__\n";
         $self->header_line=$lastline;
         last;
      }

      if ($line =~ /^(?:(\#line)\s+\d+.*|\s*)?$/) {
         # empty line
         if ($self->filter) {
            $self->filter->($line);
            if ($self->filter) {
               push @{$self->buffer}, $line;
               redo;
            }
         }

         if (@{$self->trailer}) {
            push @{$self->buffer}, splice(@{$self->trailer}, 0), "#line $.\n";
         } elsif ($self->gap==2) {
            my $set_line_number=$1;
            my $digest_comment;
            if ($self->buffer->[$self->start_comments] =~ m{^\#\s* \@topic \s+ ((\w+) (?:/\S+)?) (?:\s* (\($balanced_re\)) )? \s*$}xi) {
               if ($1 eq "custom") {
                  $digest_comment="application::self()->custom->pkg_help->{__PACKAGE__}=<<'_#_#_#_';\n";
               } elsif ($Help::gather) {
                  my $signature= defined($4) && ", q$4";
                  if ($2 eq "properties" || $2 eq "methods") {
                     $digest_comment="self(1)->help_topic(1)->add('$1', <<'_#_#_#_'$signature);\n";
                  } else {
                     $digest_comment="application::self()->help->add('" . ($1 ne "application" && $1) . "', <<'_#_#_#_'$signature);\n";
                  }
               }
            }
            if (defined($digest_comment)) {
               $self->buffer->[$self->start_comments]=$digest_comment;
               if (defined($set_line_number)) {
                  push @{$self->buffer}, "_#_#_#_\n";
               } else {
                  $line="_#_#_#_\n";
               }
               $self->start_comments=$self->len_comments=0;
            }
         }

         $self->gap=1;
         push @{$self->buffer}, $line;
         redo;
      }

      if ($line =~ /^\s*\#/) {
         # comment line
         if ($self->gap) {
            if ($self->gap==1) {
               # ... after an empty line - starts a new comment block
               $self->start_comments=@{$self->buffer}; $self->len_comments=0;
               $self->gap=2;
            }
            push @{$self->buffer}, $line;
            ++$self->len_comments;
            redo;
         }
         # comments amidst the code
         if ($self->filter) {
            $self->filter->($line);
         }
         push @{$self->buffer}, $line;
         last;
      }

      if (!$self->gap && !$self->after_rule || !$trailer_pending && compiling_in_sub()) {
         if ($self->filter) {
            $self->filter->($line);
         }
         push @{$self->buffer}, $line;
         last;
      }

      $self->gap=0;
      if ($line =~ m{^[ \t]* (?> (declare \s+)?) ($id_re) (?: $|\s+)}xo  and
          my $header_sub= $1 ? $decl_headers{$2} : $rule_headers{$2} || ($self->after_rule && $rule_subheaders{$2})) {

         # header recognized
         $line=$';
         $self->header_line=$.;
         $self->after_rule=0;
         my $prolonged;

         # concatenate header continuation lines
         for (;;) {
            chomp $line;
            last if substr($line,-1,1) ne '\\';
            if (defined (my $cont=readline($self->handle))) {
               $cont =~ s/^\s{2,}/ /;
               substr($line,-1,1)=$cont;
               $prolonged=1;
            } else {
               push @{$self->buffer}, "die 'unexpected EOF after continuation mark';\n";
               return;
            }
         }
         $header_sub->($self, $line, $prolonged);

      } else {
         # some perl code
         push @{$self->buffer}, $line;
      }
   }
}

#################################################################################
package Polymake::Core::Application;

sub multiple_object_definition {
   my ($self, $type_name, $tparams)=@_;
   no strict 'refs';
   if (exists ${ $self->pkg."::" }{"$type_name\::"}) {
      if (exists ${ $self->pkg."::$type_name\::" }{object_type}) {
         croak( "Multiple definition of an object type" );
      }
      if (defined (my $fwd_self=UNIVERSAL::can($self->pkg."::$type_name", "self"))) {
         ($fwd_self)=$fwd_self->(1);
         if (defined (my $diag=$fwd_self->check_consistency($tparams))) {
            croak( $diag );
         }
      }
   }
}
#################################################################################

# freeze the lexical enviroment (namespace lookup)
my $namespace_decls=<<'_#_#_#_';
self()->eval_expr=sub { eval $_[0] };
namespaces::memorize_lexical_scope;
export_sub namespaces(\&Polymake::temporary);
_#_#_#_

# named constant to be used in put(), take(), and add()
sub Polymake::temporary() { $PropertyValue::is_temporary }

# private:
# must be qualified, otherwise would land in main::
sub Polymake::Core::Application::INC {
   my ($self, $filename)=@_;
   my $handle;
   if (defined($self->compile_scope) && $filename =~ s/^(?:(rules)|c\+\+)://) {
      if ($1) {
         open $handle, $filename or die "can't read rule file $filename: $!\n";
      } else {
         $handle=$self->cpp->get_embedded_rules;
      }
      my $app_pkg=$self->pkg;
      $self->compile_scope->begin_locals;
      local *application::=get_pkg($app_pkg);
      $self->compile_scope->end_locals;
      my $decls= !$self->declared && $namespace_decls;
      $self->declared|=1;
      new RuleFilter($handle, $self, $filename, <<"_#_#_#_");
$warn_options;
use namespaces '$app_pkg';
package $app_pkg;
${decls}my \$__cur_credit;
my \$__preamble_end=self()->preamble_end->{'$filename'};
#line 1 "$filename"
_#_#_#_

   } elsif ($filename =~ s/^script([:=])//) {
      open $handle, $filename or die "can't read script file $filename: $!\n";
      my $tm=(stat $handle)[9];
      new ScriptLoader($handle, [ "package Polymake::User; $warn_options; use " . ($1 eq ':' ? "application undef, " : "namespaces ") . "\$namespaces::destroy_declare;\n",
                                  "Polymake::Core::StoredScript->new(\"$filename\", $tm, Polymake::Core::rescue_static_code(1));\n",
                                  "#line 1 \"$filename\"\n"
                                ]);

   } elsif (defined (my $full_path=find_file($filename, @{$self->myINC}))) {
      open $handle, $full_path or die "can't read file $full_path: $!\n";
      new ScriptLoader($handle, [ "$warn_options; use namespaces \"".$self->pkg."\";\n",
                                  "#line 1 \"$full_path\"\n"
                                ]);
   } else {
      undef
   }
}

# private:
sub forward_decls {
   my $self=shift;
   my $decls= !$self->declared && $namespace_decls;
   $self->declared=1;
   my $app_pkg=$self->pkg;
   split /(?<=\n)/, <<"_#_#_#_";
use namespaces '$app_pkg';
package $app_pkg;
$decls
_#_#_#_
}

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

$INC{"application.pm"}=$INC{"Polymake/Core/Application.pm"};

package application;

sub import {
   (undef, my ($app_name, $flags))=@_;
   if (defined $app_name) {
      package Polymake::User;
      eval {
         namespaces::temp_disable();
         application($app_name);
      };
      if ($@) {
         err_print($@);
         exit 1;
      }
      $INC[0]=$application if $INC[0] != \&Polymake::Core::Shell::interactive_INC;
      import namespaces(1, $application->eval_expr);
      namespaces::import_subs();
   } else {
      import namespaces(1 | $flags, $Polymake::User::application->eval_expr);
   }
}

$namespaces::special_imports{"application.pm"}=1;

####################################################################################
package Polymake::Core::NeutralScriptLoader;

# fake object mimicking an empty Application
use Polymake::Struct (
   [ '@ISA' => 'Application' ],
   [ new => '' ],
   [ '$name' => '"none"' ],
);

*new=\&_new;

sub Polymake::Core::NeutralScriptLoader::INC {
   my ($self, $filename)=@_;
   if ($filename =~ s/^script[:=]//) {
      open my $handle, $filename or die "can't read script file $filename: $!\n";
      new ScriptLoader($handle, [ "package Polymake::User; $warn_options; use namespaces;\n",
                                  "#line 1 \"$filename\"\n"
                                ]);
   } elsif ($User::application != $self) {
      $User::application->INC($filename);
   } else {
      undef;
   }
}

####################################################################################
my %script_repo;

package Polymake::Core::StoredScript;
use Polymake::Struct (
   [ 'new' => '$$$' ],
   [ '$path' => '#1' ],
   [ '$timestamp' => '#2' ],
   [ '&code' => '#3' ],
);

sub new {
   my $self=&_new;
   $script_repo{$self->path}=$self;
}

sub locate_file {
   my $filename=shift;
   my $full_path;
   if (defined ($full_path=find_file_in_path($filename, $User::application->scriptpath))) {
      return ($full_path, (stat _)[9], $User::application);
   }
   foreach my $app (values %{$User::application->imported}) {
      if (defined ($full_path=find_file_in_path($filename, $app->scriptpath))) {
         return ($full_path, (stat _)[9], $app);
      }
   }
   if (defined ($full_path=find_file_in_path($filename, \@User::lookup_scripts)) ||
       -f ($full_path="$InstallTop/scripts/$filename")) {
      return ($full_path, (stat _)[9]);
   }
   if (-f $filename) {
      my $tm=(stat _)[9];
      return (Cwd::abs_path($filename), $tm);
   }
   ();
}

sub find {
   my $filename=pop;
   if (my ($path, $tm, $app)=locate_file($filename)) {
      if (defined (my $script=$script_repo{$path})) {
         if ($tm==$script->timestamp) {
            return $script->code;
         }
      }
      (undef, $path, $app);
   } else {
      croak( "script file \"$filename\" not found" );
   }
}

#################################################################################
# A "virtual" package:
# per default offers dummy methods which do not store anything.
# Should be redefined when needed

package Polymake::Core::Help;

my $dummy=bless [ ];

sub clone { $dummy }
sub add {}
*add_function=\&add;
*merge=\&add;
sub get { undef }
sub related { [ ] }

my $impl;
declare $gather;
sub redefine { $gather=defined($impl=$_[1] || caller) }

sub new {
   if ($impl) {
      shift;
      $impl->new(@_);
   } else {
      $dummy;
   }
}

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

1

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