/* Copyright (c) 1997-2021
   Ewgenij Gawrilow, Michael Joswig, and the polymake team
   Technische Universität Berlin, Germany
   https://polymake.org

   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.
--------------------------------------------------------------------------------
*/

#include "polymake/perl/glue.h"
#include <cxxabi.h>

// had to be copied from mg.c
struct magic_state {
    SV* mgs_sv;
    I32 mgs_ss_ix;
    U32 mgs_flags;
#if PerlVersion < 5220
    bool mgs_readonly;
#endif
    bool mgs_bumped;
};

namespace pm { namespace perl { namespace glue {

using polymake::AnyString;
using polymake::Int;

HV *FuncDescr_stash = nullptr,
   *TypeDescr_stash = nullptr,
   *User_stash = nullptr,
   *Object_InitTransaction_stash = nullptr;

const CV* cur_wrapper_cv = nullptr;
const base_vtbl* cur_class_vtbl = nullptr;
GV *CPP_root = nullptr,
   *PropertyType_nested_instantiation = nullptr,
   *User_application = nullptr,
   *Debug_level = nullptr;
SV *negative_indices_key = nullptr,
   *Serializer_Sparse_dim_key = nullptr,
   *temporary_value_flag = nullptr;

int Object_name_index, Object_description_index,
    Object_parent_index, Object_transaction_index, Object_attachments_index,
    Application_pkg_index, Application_eval_expr_index,
    TypeDescr_pkg_index, TypeDescr_vtbl_index, TypeDescr_cpperl_file_index, TypeDescr_typeid_index, TypeDescr_generated_by_index,
    CPPOptions_builtin_index, CPPOptions_descr_index,
    FuncDescr_wrapper_index, FuncDescr_return_type_reg_index, FuncDescr_name_index, FuncDescr_cpperl_file_index,
    FuncDescr_arg_types_index, FuncDescr_cross_apps_index, FuncDescr_return_type_index,
    PropertyType_pkg_index, PropertyType_cppoptions_index, PropertyType_params_index,
    CPP_functions_index, CPP_regular_functions_index, CPP_embedded_rules_index,
    CPP_duplicate_class_instances_index, CPP_type_descr_index, CPP_builtins_index,
    CPP_templates_index, CPP_typeids_index,
    CPP_auto_assignment_index, CPP_auto_conversion_index,
    CPP_auto_assoc_methods_index, CPP_auto_set_methods_index,
    FuncDescr_fill, FuncDescr_fill_visible, TypeDescr_fill;

namespace {

int CPP_Assoc_helem_index, CPP_Assoc_find_index, CPP_Assoc_exists_index,
    CPP_Assoc_delete_void_index, CPP_Assoc_delete_ret_index;
int returns_lvalue_flag;

// don't report C++ exceptions as coming from these files - go deeper down the call stack
const char* skip_contexts[]={ "/Polymake/Core/CPlusPlus.pm",
                              "/Polymake/Core/PropertyType.pm",
                              "/Polymake/Core/Serializer.pm",
                              "/Polymake/Overload.pm"
                            };
// don't report C++ exceptions as coming from lines labelled with this - go deeper down the call stack
const char skip_label[]="CROAK_SKIP";

bool report_position(pTHX_ COP* o)
{
   const char* const file = CopFILE(o);
   for (int i = 0, end = sizeof(skip_contexts) / sizeof(skip_contexts[0]); i < end; ++i) {
      if (strstr(file, skip_contexts[i])) return false;
   }

   STRLEN label_len = 0;
   const char* const label = CopLABEL_len(o, &label_len);
   if (label && label_len == sizeof(skip_label)-1 && !strncmp(label, skip_label, label_len))
      return false;

   sv_catpvf(ERRSV, " at %s line %d.\n", file, int(CopLINE(o)));
   return true;
}

void raise_exception(pTHX) __attribute__noreturn__;

void raise_exception(pTHX_ const AnyString& errmsg) __attribute__noreturn__;

void raise_exception(pTHX)
{
   STRLEN l;
   const char* errmsg = SvPV(ERRSV, l);
   if (l > 0 && errmsg[l-1] != '\n') {
      if (!report_position(aTHX_ PL_curcop)) {
         for (PERL_CONTEXT *cx_bottom=cxstack, *cx=cx_bottom+cxstack_ix;
              cx >= cx_bottom && !(CxTYPE(cx)==CXt_SUB && report_position(aTHX_ cx->blk_oldcop));
              --cx) ;
      }
   }
   Perl_croak(aTHX_ Nullch);
}

void raise_exception(pTHX_ const AnyString& errmsg)
{
   sv_setpvn(ERRSV, errmsg.ptr, errmsg.len);
   raise_exception(aTHX);
}

template <typename T>
class localize_var {
public:
   using Tptr = T*;
   localize_var(Tptr& global_var_, const Tptr new_value)
      : global_var(global_var_)
      , saved_value(global_var_)
   {
      global_var = new_value;
   }

   ~localize_var()
   {
      global_var = saved_value;
   }

private:
   localize_var(const localize_var&) = delete;
   localize_var(localize_var&&) = delete;

   Tptr& global_var;
   const Tptr saved_value;
};

template <typename Expr>
auto guarded_call(pTHX_ const Expr& expr) -> decltype(expr())
{
   try { return expr(); }
   catch (const pm::perl::exception&) {}
   catch (const std::exception& ex) {
      sv_setpv(ERRSV, ex.what());
   }
   catch (...) {
      sv_setpv(ERRSV, "unknown exception");
   }
   raise_exception(aTHX);
}

template <typename Expr>
auto guarded_call(pTHX_ const Expr& expr, const base_vtbl* t) -> decltype(expr())
{
   localize_var<const base_vtbl> loc(cur_class_vtbl, t);
   return guarded_call(aTHX_ expr);
}

template <typename Expr>
auto guarded_call(pTHX_ const Expr& expr, const CV* cv)
{
   localize_var<const CV> loc(cur_wrapper_cv, cv);
   return guarded_call(aTHX_ expr);
}

const uint8_t read_only_flag = uint8_t(ValueFlags::read_only);

template <typename VTable>
const VTable* get_vtable(SV* descr)
{
   return reinterpret_cast<const VTable*>(SvPVX(PmArray(descr)[TypeDescr_vtbl_index]));
}

}

int canned_dup(pTHX_ MAGIC* mg, CLONE_PARAMS* param)
{
   return 0;
}

MAGIC* allocate_canned_magic(pTHX_ SV* sv, SV* descr, ValueFlags flags, unsigned int n_anchors)
{
   const auto t = get_vtable<base_vtbl>(descr);
   (t->sv_maker)(aTHX_ sv, descr, flags, n_anchors);
   return SvMAGIC(SvRV(sv));
}

int destroy_canned(pTHX_ SV* sv, MAGIC* mg)
{
   if (!(mg->mg_flags & MGf_GSKIP)) {
      if (mg->mg_len) {
         const auto t = as_vtbl<base_vtbl>(mg);
         if (t->destructor) (t->destructor)(mg->mg_ptr);
      }
      if (mg->mg_private) {
         for (Value::Anchor *anchor_ptr = MagicAnchors::first(mg), *anchor_end = anchor_ptr+mg->mg_private;
              anchor_ptr < anchor_end; ++anchor_ptr)
            SvREFCNT_dec(anchor_ptr->stored);
      }
   }
   return 0;
}

namespace {

void defuse_lval_magic(pTHX_ SV* sv)
{
   MGS *mgs;
   I32 mgs_ix;
   assert(PL_savestack[PL_savestack_ix-1].any_uv == SAVEt_DESTRUCTOR_X);
   mgs_ix = static_cast<I32>(PL_savestack[PL_savestack_ix-2].any_uv);
   mgs = SSPTR(mgs_ix, MGS*);
   assert(mgs->mgs_sv == sv);
   mgs->mgs_flags = 0;
   SvMAGIC(sv) = nullptr;
}

int assigned_to_canned_lvalue(pTHX_ SV* lval_sv, MAGIC* lval_mg)
{
   SV* sv = lval_mg->mg_obj;
   MAGIC* mg = get_cpp_magic(sv);
   const int local = PL_localizing;

   if (local != 0) {
      // can happen during map or foreach iteration over a container,
      // some nested function tries to localize $_
      if (local == 1) defuse_lval_magic(aTHX_ lval_sv);
   } else if ((mg->mg_flags & read_only_flag) ||
              SvIVX(as_vtbl<base_vtbl>(mg)->mutable_ref_typeid_name_sv) == 0) {
      // a read-only reference or an immutable object
      switch (PL_op->op_type) {
      case OP_AASSIGN:
      case OP_SASSIGN:
      case OP_ORASSIGN:
      case OP_ANDASSIGN:
         // for these operations it's safe (and the only possibility)
         // to raise the exception right here
         raise_exception(aTHX_ "Attempt to modify a read-only C++ object");
      default:
         // all others like += or *= will complain in the operator body
         // raising an exception here leads to memory leaks
         break;
      }
   } else {
      const auto t = as_vtbl<base_vtbl>(mg);
      guarded_call(aTHX_ [=](){ (t->assignment)(mg->mg_ptr, lval_sv, ValueFlags::not_trusted); });
      if (SvROK(lval_sv)) {
         if (SvRV(lval_sv)==sv) return 0;
         SvREFCNT_dec(SvRV(lval_sv));
      } else {
         if (SvPOK(lval_sv) && SvPVX(lval_sv) && SvLEN(lval_sv)) {
#if PerlVersion >= 5200
            if (SvIsCOW(lval_sv)) {
               sv_force_normal_flags(lval_sv, SV_COW_DROP_PV);
            } else
#endif
            {
               Safefree(SvPVX(lval_sv));
               SvPVX(lval_sv) = nullptr;
               SvLEN(lval_sv) = 0;
            }
         }
         SvFLAGS(lval_sv) &= ~SVf_OK;
         SvROK_on(lval_sv);
      }
      SvRV(lval_sv) = SvREFCNT_inc_simple_NN(sv);
   }
   return 0;
}

MGVTBL magic_lval_vtbl={ 0, &assigned_to_canned_lvalue, 0, 0, 0 };

void destroy_iterators(pTHX_ AV* av, MAGIC* mg, bool final)
{
   SV* it_sv = AvARRAY(av)[1];
   auto acct = as_vtbl<container_vtbl>(mg)->acc + (mg->mg_flags & read_only_flag);
   if (it_sv && SvIOK(it_sv)) {
      if (acct->destructor) (acct->destructor)(SvPVX(it_sv));
      SvIOK_off(it_sv);
   }
   if (final) SvREFCNT_dec(it_sv);

   acct += 2;
   if (acct->begin) {
      it_sv=AvARRAY(av)[2];
      if (it_sv && SvIOK(it_sv)) {
         if (acct->destructor) (acct->destructor)(SvPVX(it_sv));
         SvIOK_off(it_sv);
      }
      if (final) SvREFCNT_dec(it_sv);
   }
}

void destroy_assoc_iterator(pTHX_ HV* hv, MAGIC* mg)
{
   const auto acct = as_vtbl<container_vtbl>(mg)->acc + (mg->mg_flags & read_only_flag);
   char* it = (char*)HvARRAY(hv);
   if (it[acct->obj_size]) {
      if (acct->destructor) (acct->destructor)(it);
      Zero(it, HvMAX(hv)+1, HE*);
   }
}

#ifdef SVs_PADBUSY
#  define SaveSVflags (SVs_PADBUSY | SVs_PADTMP | SVs_PADMY | SVs_TEMP)
#else
#  define SaveSVflags (SVs_PADTMP | SVs_PADMY | SVs_TEMP)
#endif

SV* new_magic_ref(pTHX_ SV* dst_ref, SV* sv, SV* pkg_ref, ValueFlags flags)
{
   if (!(SvTYPE(dst_ref)==SVt_PVLV && (LvTYPE(dst_ref)=='t' || LvTYPE(dst_ref)==0))) {
      if (SvTYPE(dst_ref)) {
         U32 refc=SvREFCNT(dst_ref),
             save_flags=SvFLAGS(dst_ref) & SaveSVflags;
         SvREFCNT(dst_ref)=0;
         sv_clear(dst_ref);
         SvREFCNT(dst_ref)=refc;
         SvFLAGS(dst_ref)=save_flags;
      }
      sv_upgrade(dst_ref, flags * ValueFlags::expect_lval ? SVt_PVLV : SVt_RV);
   }
   SvRV_set(dst_ref,sv);
   SvROK_on(dst_ref);
   if (flags * ValueFlags::expect_lval)
      sv_magicext(dst_ref, sv, PERL_MAGIC_ext, &magic_lval_vtbl, 0, 0);

   return SvROK(pkg_ref) ? sv_bless(dst_ref, (HV*)SvRV(pkg_ref)) : dst_ref;
}

#undef SaveSVflags

MAGIC* allocate_magic(pTHX_ SV* sv, char how, const base_vtbl* vtab, ValueFlags flags, unsigned int n_anchors)
{
   const size_t mgsz = n_anchors ? sizeof(MagicAnchors) + (n_anchors-1) * sizeof(Value::Anchor) : sizeof(MAGIC);
   char* mg_raw;
   Newxz(mg_raw, mgsz, char);
   MagicAnchors* anch = (MagicAnchors*)mg_raw;
   MAGIC* mg = &anch->magic;
   mg->mg_moremagic = SvMAGIC(sv);
   SvMAGIC_set(sv, mg);
   mg->mg_type = how;
   mg->mg_private = U16(n_anchors);
   if (flags * ValueFlags::alloc_magic) {
      mg->mg_len = vtab->obj_size;
      Newxz(mg->mg_ptr, vtab->obj_size, char);
   }
   mg->mg_virtual = const_cast<base_vtbl*>(vtab);
   mg_magical(sv);
   return mg;
}

SV* new_builtin_magic_sv(pTHX_ const base_vtbl* t, ValueFlags flags, unsigned int n_anchors)
{
   SV* sv = newSV_type(SVt_PVMG);
   allocate_magic(aTHX_ sv, PERL_MAGIC_ext, t, flags, n_anchors);
   return sv;
}

SV* prepare_scalar_magic_sv(pTHX_ SV* sv, const base_vtbl* t, ValueFlags flags, unsigned int n_anchors)
{
   MAGIC* mg = allocate_magic(aTHX_ sv, PERL_MAGIC_ext, t, flags, n_anchors);
   set_bit_flags(mg->mg_flags, I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv)));
   SvRMAGICAL_on(sv);
   return sv;
}

SV* new_container_magic_sv(pTHX_ const container_vtbl* t, ValueFlags flags, unsigned int n_anchors)
{
   AV* av = newAV();
   const int last_it = t->acc[2].begin ? 2 : 1; // has reverse_iterator?
   av_extend(av, last_it);
   AvARRAY(av)[0] = reinterpret_cast<SV *>((IV)-1); // loop context index
   AvFILLp(av) = -1;                     // cached real container size
   AvREAL_off(av);                       // we'll destroy the iterator SVs manually

   MAGIC* mg = allocate_magic(aTHX_ (SV*)av, PERL_MAGIC_tied, t, flags, n_anchors);
   set_bit_flags(mg->mg_flags, MGf_COPY | I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv)));
   SvRMAGICAL_on(av);
   return (SV*)av;
}

SV* new_composite_magic_sv(pTHX_ const composite_vtbl* t, ValueFlags flags, unsigned int n_anchors)
{
   AV* av = newAV();
   MAGIC* mg = allocate_magic(aTHX_ (SV*)av, PERL_MAGIC_tied, t, flags, n_anchors);
   set_bit_flags(mg->mg_flags, MGf_COPY | I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv)));
   SvRMAGICAL_on(av);
   return (SV*)av;
}

SV* new_assoc_container_magic_sv(pTHX_ const container_vtbl* t, ValueFlags flags, unsigned int n_anchors)
{
   HV* hv = newHV();
   MAGIC* mg;
   const container_access_vtbl* acct = t->acc + int(flags & ValueFlags::read_only);
   // let it reserve at least one additional byte after the iterator to hold the 'iterator created' flag
   HvMAX(hv) = acct->obj_size/sizeof(HE*)+1;
   hv_iterinit(hv);
   mg = allocate_magic(aTHX_ (SV*)hv, PERL_MAGIC_tied, t, flags, n_anchors);
   set_bit_flags(mg->mg_flags, MGf_COPY | I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv)));
   SvRMAGICAL_on(hv);
   return (SV*)hv;
}

SV* call_extractor(type_reg_fn_type func, bool get_proto)
{
   const auto p = func(nullptr, nullptr, nullptr);
   return get_proto ? p.first : p.second;
}

SV* call_extractor(provide_type func, bool)
{
   return func();
}

template <typename VTable, typename ExtractorFunc>
SV* extract_type_info(pTHX_ SV* descr, ExtractorFunc VTable::* func_mem, ClassFlags mask, ClassFlags expected, bool get_proto = false)
{
   const auto t = get_vtable<VTable>(descr);
   if ((t->flags & mask) == expected) {
      if (const ExtractorFunc func = t->*func_mem) {
         return guarded_call(aTHX_ [=](){ return call_extractor(func, get_proto); }, t);
      }
   }
   return &PL_sv_undef;
}

int get_sizeof(pTHX_ HV* stash)
{
   dSP;
   CV* sizeof_cv = GvCV((GV*)*hv_fetch(stash, "sizeof", 6, FALSE));
   PUSHMARK(SP);
   call_sv((SV*)sizeof_cv, G_SCALAR);
   SPAGAIN;
   IV s = POPi;
   PUTBACK;
   return I32(s);
}

int count_refs(pTHX_ SV* ref, SV* obj, bool ref_is_known)
{
   if (ref_is_known || SvROK(ref) && SvRV(ref) == obj) {
      // magic lvalue objects are refcounted twice, for the direct object reference and for mg_obj
      if (SvTYPE(ref) >= SVt_PVMG) {
         MAGIC* mg = SvMAGIC(ref);
         if (mg && mg->mg_virtual == &magic_lval_vtbl &&
             (mg->mg_flags & MGf_REFCOUNTED) && mg->mg_obj == obj)
            return 2;
      }
      return 1;
   }
   return 0;
}

bool is_temporary(pTHX_ SV* ref, SV* obj)
{
   // An object is deemed temporary and movable if:
   // - it's pointed to by a single reference
   // - that reference is kept in the argument list which has been "reified" by taking a reference when passing it to resolve_node or resolve_auto_function
   // - that reference is a temporary variable

   if ((SvFLAGS(ref) & SVs_PADTMP) || SvREFCNT(ref) != 2)
      return false;

   int obj_refc = SvREFCNT(obj);
#if PerlVersion >= 5240
   if (obj_refc == count_refs(aTHX_ ref, obj, true)) {
      return std::find(PL_tmps_stack, PL_tmps_stack+PL_tmps_ix, ref) != PL_tmps_stack+PL_tmps_ix;
   }
#else
   // In perls older than 5.24 there can be duplicate temporary references produced in pp_leave closing the wrappers where the object has been created.
   if (obj_refc <= 3) {
      for (SV **tmps_bottom = PL_tmps_stack, **tmps = tmps_bottom + PL_tmps_ix-1; tmps >= tmps_bottom; --tmps) {
         SV* sv = *tmps;
         if (int c = count_refs(aTHX_ sv, obj, sv == ref)) {
            if (!(obj_refc -= c)) return true;
         }
      }
   }
#endif
   return false;
}

} // end anonymous namespace

int assigned_to_primitive_lvalue(pTHX_ SV* lval_sv, MAGIC* lval_mg)
{
   const int local = PL_localizing;
   if (local != 0) {
      /* can happen during map or foreach iteration over a container,
         some nested function tries to localize $_ */
      if (local == 1) defuse_lval_magic(aTHX_ lval_sv);
   } else if (lval_mg->mg_flags & read_only_flag) {
      raise_exception(aTHX_ "Attempt to modify an element in a read-only C++ object");
   } else {
      const auto t = as_vtbl<base_vtbl>(lval_mg);
      guarded_call(aTHX_ [=](){ (t->assignment)(lval_mg->mg_ptr, lval_sv, ValueFlags::not_trusted); });
   }
   return 0;
}

mg_size_ret_t canned_container_size(pTHX_ SV* sv, MAGIC* mg)
{
   const auto t = as_vtbl<container_vtbl>(mg);
   Int s;
   if (mg->mg_flags & read_only_flag) {
      // can cache the size
      if (AvFILLp(sv) < 0)
         AvFILLp(sv) = (t->size)(mg->mg_ptr);
      s = AvFILLp(sv);
   } else {
      s = (t->size)(mg->mg_ptr);
   }
   if (sizeof(mg_size_ret_t) < sizeof(Int) &&
       static_cast<inherit_signed_t<Int, mg_size_ret_t>>(s) >= std::numeric_limits<mg_size_ret_t>::max())
      Perl_croak(aTHX_ "container size exceeds the current perl implementation limit");
   return static_cast<mg_size_ret_t>(s-1);
}

int clear_canned_container(pTHX_ SV* sv, MAGIC* mg)
{
   if (mg->mg_flags & read_only_flag)
      raise_exception(aTHX_ "Attempt to modify a read-only C++ object");
   destroy_iterators(aTHX_ (AV*)sv, mg, false);
   AvFILLp(sv) = -1;
   return 1;
}

int clear_canned_assoc_container(pTHX_ SV *sv, MAGIC* mg)
{
   const auto t = as_vtbl<container_vtbl>(mg);
   if (mg->mg_flags & read_only_flag)
      raise_exception(aTHX_ "Attempt to modify a read-only C++ object");
   destroy_assoc_iterator(aTHX_ (HV*)sv, mg);
   guarded_call(aTHX_ [=](){ (t->resize)(mg->mg_ptr, 0); });
   return 1;
}

int destroy_canned_container(pTHX_ SV *sv, MAGIC* mg)
{
   destroy_iterators(aTHX_ (AV*)sv, mg, true);
   return destroy_canned(aTHX_ sv, mg);
}

int destroy_canned_assoc_container(pTHX_ SV *sv, MAGIC* mg)
{
   destroy_assoc_iterator(aTHX_ (HV*)sv, mg);
   return destroy_canned(aTHX_ sv, mg);
}

mg_size_ret_t canned_composite_size(pTHX_ SV *sv, MAGIC* mg)
{
   const auto t = as_vtbl<composite_vtbl>(mg);
   return t->n_members-1;         // compatible to AvFILL
}

MAGIC* upgrade_to_builtin_magic_sv(pTHX_ SV* dst, SV* descr, unsigned int n_anchors)
{
   (void)SvUPGRADE(dst, SVt_PVMG);
   return allocate_magic(aTHX_ dst, PERL_MAGIC_ext, get_vtable<base_vtbl>(descr), ValueFlags::is_mutable, n_anchors);
}

SV* create_builtin_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors)
{
   return new_magic_ref(aTHX_ dst_ref,
                        new_builtin_magic_sv(aTHX_ get_vtable<base_vtbl>(descr), flags, n_anchors),
                        PmArray(descr)[TypeDescr_pkg_index], flags);
}

SV* clone_builtin_magic_sv(pTHX_ SV* src)
{
   MAGIC *mg=SvMAGIC(src);
   return sv_bless(newRV_noinc(new_builtin_magic_sv(aTHX_ as_vtbl<base_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src));
}

SV* create_scalar_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors)
{
   return new_magic_ref(aTHX_ dst_ref,
                        prepare_scalar_magic_sv(aTHX_ newSV_type(SVt_PVMG), get_vtable<base_vtbl>(descr), flags, n_anchors),
                        PmArray(descr)[TypeDescr_pkg_index], flags);
}

SV* clone_scalar_magic_sv(pTHX_ SV* src)
{
   MAGIC* mg=SvMAGIC(src);
   SV* sv=prepare_scalar_magic_sv(aTHX_
                                  SvFLAGS(src) & (SVf_ROK|SVf_POK|SVp_POK|SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK)
                                  ? newSVsv(src) : newSV_type(SVt_PVMG),
                                  as_vtbl<base_vtbl>(mg), ValueFlags::alloc_magic, 0);
   return sv_bless(newRV_noinc(sv), SvSTASH(src));
}

SV* create_container_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors)
{
   return new_magic_ref(aTHX_ dst_ref,
                        new_container_magic_sv(aTHX_ get_vtable<container_vtbl>(descr), flags, n_anchors),
                        PmArray(descr)[TypeDescr_pkg_index], flags);
}

SV* clone_container_magic_sv(pTHX_ SV* src)
{
   MAGIC* mg=get_cpp_magic(src);
   return sv_bless(newRV_noinc(new_container_magic_sv(aTHX_ as_vtbl<container_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src));
}

SV* create_composite_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors)
{
   return new_magic_ref(aTHX_ dst_ref,
                        new_composite_magic_sv(aTHX_ get_vtable<composite_vtbl>(descr), flags, n_anchors),
                        PmArray(descr)[TypeDescr_pkg_index], flags);
}

SV* clone_composite_magic_sv(pTHX_ SV* src)
{
   MAGIC* mg=get_cpp_magic(src);
   return sv_bless(newRV_noinc(new_composite_magic_sv(aTHX_ as_vtbl<composite_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src));
}

SV* create_assoc_container_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors)
{
   return new_magic_ref(aTHX_ dst_ref,
                        new_assoc_container_magic_sv(aTHX_ get_vtable<container_vtbl>(descr), flags, n_anchors),
                        PmArray(descr)[TypeDescr_pkg_index], flags);
}

SV* clone_assoc_container_magic_sv(pTHX_ SV* src)
{
   MAGIC* mg=get_cpp_magic(src);
   return sv_bless(newRV_noinc(new_assoc_container_magic_sv(aTHX_ as_vtbl<container_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src));
}

namespace {

constexpr bool is_random_access_op(const OPCODE opc)
{
   return opc == OP_AELEM || opc == OP_ASLICE
#if PerlVersion >= 5220
       || opc == OP_MULTIDEREF
#endif
   ;
}

template <typename ContainerVtbl, typename AccessVtbl>
int dereference_iterator(pTHX_ const ContainerVtbl* t, const AccessVtbl* acct, char* obj, char* it, SV* sv, SV* nsv, Int index)
{
   if (SvOK(nsv)) {
      // we are called from av_store (during aassign): nsv carries the RHS value
      guarded_call(aTHX_ [=](){ (t->store_at_ref)(obj, it, index, nsv); }, t);
   } else {
      guarded_call(aTHX_ [=](){ (acct->deref)(obj, it, index, nsv, sv); }, t);
   }
   return 1;
}

template <typename ContainerVtbl, typename AccessVtbl>
int dereference_new_iterator(pTHX_ const ContainerVtbl* t, const AccessVtbl* acct, char* obj, SV* it_sv, char* it, SV* sv, SV* nsv, Int index)
{
   guarded_call(aTHX_ [=](){ (acct->begin)(it, obj); });
   SvIVX(it_sv) = index;
   SvIOK_on(it_sv);
   return dereference_iterator(aTHX_ t, acct, obj, it, sv, nsv, index);
}

}

int canned_container_access(pTHX_ SV* sv, MAGIC* mg, SV* nsv, const char* dummy, const mg_copy_index_t index)
{
   const OPCODE opc = PL_op ? PL_op->op_type : OP_AELEM;   // assume a plain array access when called directly from the callable library
   auto t = as_vtbl<container_vtbl>(mg);
   char* obj = mg->mg_ptr;
   char* it;
   auto acct = t->acc + (mg->mg_flags & read_only_flag);
   AV* my_av = (AV*)sv;
   SV* it_sv;
   Int it_index, it_incr;

   if (opc == OP_ITER) {
      int cix = cxstack_ix;
      PERL_CONTEXT* cx = cxstack + cix;
      if (cx->blk_loop.state_u.ary.ary == my_av) {
         // direct iterating over a C++ container: each loop requires its own iterator
         if (PL_op->op_private & OPpITER_REVERSED) {
            it_index = 2;  it_incr = -1;  acct += 2;
         } else {
            it_index = 1;  it_incr = 1;
         }
         if (AvARRAY(my_av)[0] != reinterpret_cast<SV*>(static_cast<IV>(cix))) {
            // new loop detected: need a new iterator

            if (!acct->begin)
               raise_exception(aTHX_ "No access in reverse order");

            if (SvREFCNT(sv) > 1) {
               // Create a temporary magical array sharing the C++ object and store it as the loop's array.
               // It will be recycled automatically after the loop completion.
               SvREFCNT_dec(sv);
               sv = new_container_magic_sv(aTHX_ t, ValueFlags(mg->mg_flags) & ValueFlags::read_only, 0);
               my_av = (AV*)sv;
               mg = SvMAGIC(sv);
               mg->mg_ptr = obj;
               cx->blk_loop.state_u.ary.ary = my_av;
            }
            AvARRAY(my_av)[0] = reinterpret_cast<SV*>(static_cast<IV>(cix));
            AvARRAY(my_av)[it_index] = it_sv = newSV_type(SVt_PVIV);
            sv_grow(it_sv, acct->obj_size);
            it = SvPVX(it_sv);
            return dereference_new_iterator(aTHX_ t, acct, obj, it_sv, it, sv, nsv, index);
         }

         it_sv = AvARRAY(my_av)[it_index];
         it = SvPVX(it_sv);
         if ((SvIVX(it_sv) += it_incr) != index)
            raise_exception(aTHX_ "Attempt to access array elements out of natural order");
         return dereference_iterator(aTHX_ t, acct, obj, it, sv, nsv, index);
      }

   } else if (is_random_access_op(opc) && acct->random) {
      guarded_call(aTHX_ [=](){ (acct->random)(obj, nullptr, index, nsv, sv); }, t);
      return 1;
   }

   if (index >= 0) {
      it_incr = 1;  it_index = 1;
   } else {
      it_incr = -1; it_index = 2;
      acct += 2;
   }
   it_sv = AvARRAY(my_av)[it_index];
   if (it_sv && SvIOK(it_sv)) {
      // iterator already created
      it = SvPVX(it_sv);
      if ((SvIVX(it_sv) += it_incr) == index)
         return dereference_iterator(aTHX_ t, acct, obj, it, sv, nsv, index);
      if (acct->destructor)
         (acct->destructor)(it);
      SvIOK_off(it_sv);
   } else {
      AvARRAY(my_av)[it_index] = it_sv = newSV_type(SVt_PVIV);
      sv_grow(it_sv, acct->obj_size);
      it = SvPVX(it_sv);
   }

   if (index != 0) {
      if (index == -1) {
         if (!acct->begin)
            raise_exception(aTHX_ "No access in reverse order");
      } else {
         if (is_random_access_op(opc))
            raise_exception(aTHX_ "No random access");
         else
            raise_exception(aTHX_ "Attempt to access array elements out of natural order");
      }
   }
   return dereference_new_iterator(aTHX_ t, acct, obj, it_sv, it, sv, nsv, index);
}

int canned_assoc_container_access(pTHX_ SV* obj_sv, MAGIC* mg, SV* val_sv, const char* key, mg_copy_index_t klen)
{
   const auto t = as_vtbl<container_vtbl>(mg);
   const auto acct = t->acc + (mg->mg_flags & read_only_flag);
   char* it = reinterpret_cast<char*>(HvARRAY(obj_sv));
   guarded_call(aTHX_ [=](){ (acct->deref)(nullptr, it, 1, val_sv, obj_sv); }, t);
   return 1;
}

int canned_composite_access(pTHX_ SV* sv, MAGIC* mg, SV* nsv, const char *dummy, mg_copy_index_t index)
{
   const auto t = as_vtbl<composite_vtbl>(mg);
   const auto acct = t->acc + index;
   char* obj = mg->mg_ptr;

   if (SvOK(nsv)) {
      // we are called from av_store (during aassign): nsv carries the RHS value
      if (mg->mg_flags & read_only_flag)
         raise_exception(aTHX_ "Attempt to modify a read-only C++ object");
      guarded_call(aTHX_ [=](){ (acct->store)(obj, nsv); }, t);
   } else {
      guarded_call(aTHX_ [=](){ (acct->get[mg->mg_flags & read_only_flag])(obj, nsv, sv); }, t);
   }
   return 1;
}

OP* cpp_helem(pTHX_ HV* hv, const MAGIC* mg)
{
   dSP;
   U8 save_private=PL_op->op_private;
   const auto t = as_vtbl<container_vtbl>(mg);
   TOPm1s=sv_2mortal(newRV((SV*)hv));   // Restore the reference to the map object
   PUSHMARK(SP-2);
   XPUSHs(AvARRAY(t->assoc_methods)[PL_op->op_flags & OPf_MOD ? CPP_Assoc_helem_index : CPP_Assoc_find_index]);
   PUTBACK;
   PL_op->op_flags |= OPf_STACKED;
   PL_op->op_private=0;
   OP* next=Perl_pp_entersub(aTHX);
   PL_op->op_private=save_private;
   return next;
}

OP* cpp_hslice(pTHX_ HV* hv, const MAGIC* mg)
{
   dSP;
   const auto t = as_vtbl<container_vtbl>(mg);
   SV* brk_cv = AvARRAY(t->assoc_methods)[PL_op->op_flags & OPf_MOD ? CPP_Assoc_helem_index : CPP_Assoc_find_index];
   EXTEND(SP, 3);
   dMARK;
   SSize_t key = MARK - SP, key1 = key;
   SV* val = nullptr;
   I32 gimme = GIMME_V;
   SV* hvref = sv_2mortal(newRV((SV*)hv));
   while (++key <= 0) {
      ENTER;
      PUSHMARK(SP);
      val = SP[key];
      PUSHs(hvref);
      PUSHs(val);
      PUTBACK;
      call_sv(brk_cv, G_SCALAR);
      SPAGAIN;
      val = POPs;
      SP[key] = val;
      LEAVE;
   }
   if (gimme != G_ARRAY) {
      SP -= key1-1;
      SETs(val);
   }
   RETURN;
}

OP* cpp_exists(pTHX_ HV* hv, const MAGIC* mg)
{
   dSP;
   U8 save_private = PL_op->op_private;
   const auto t = as_vtbl<const container_vtbl>(mg);
   TOPm1s = sv_2mortal(newRV((SV*)hv));   // Restore the reference to the map object
   PUSHMARK(SP-2);
   XPUSHs(AvARRAY(t->assoc_methods)[CPP_Assoc_exists_index]);
   PUTBACK;
   PL_op->op_flags |= OPf_STACKED;
   PL_op->op_private = 0;
   OP* next = Perl_pp_entersub(aTHX);
   PL_op->op_private = save_private;
   return next;
}

OP* cpp_delete_hslice(pTHX_ HV* hv, const MAGIC* mg)
{
   dSP;
   const auto t = as_vtbl<container_vtbl>(mg);
   SV* hvref = sv_2mortal(newRV((SV*)hv)), *brk_cv;
   I32 gimme = GIMME_V;
   brk_cv = AvARRAY(t->assoc_methods)[gimme == G_VOID ? CPP_Assoc_delete_void_index : CPP_Assoc_delete_ret_index];
   I32 discard = gimme == G_VOID ? G_DISCARD : G_SCALAR;
   EXTEND(SP,3);
   dMARK;
   SSize_t key = MARK - SP, key1 = key;
   SV* val = nullptr;
   while (++key <= 0) {
      ENTER;
      PUSHMARK(SP);
      val = SP[key];
      PUSHs(hvref);
      PUSHs(val);
      PUTBACK;
      call_sv(brk_cv, discard);
      SPAGAIN;
      if (gimme != G_VOID) {
         val=POPs; SP[key]=val;
      }
      LEAVE;
   }
   if (gimme != G_ARRAY) {
      SP -= key1;
      if (gimme == G_SCALAR) *++SP = val;
   }
   RETURN;
}

OP* cpp_delete_helem(pTHX_ HV* hv, const MAGIC* mg)
{
   dSP;
   U8 save_private = PL_op->op_private;
   const auto t = as_vtbl<container_vtbl>(mg);
   I32 gimme = GIMME_V;
   TOPm1s = sv_2mortal(newRV((SV*)hv));   // Restore the reference to the map object
   PUSHMARK(SP-2);
   XPUSHs(AvARRAY(t->assoc_methods)[gimme == G_VOID ? CPP_Assoc_delete_void_index : CPP_Assoc_delete_ret_index]);
   PUTBACK;
   PL_op->op_flags |= OPf_STACKED;
   PL_op->op_private = 0;
   OP* next = Perl_pp_entersub(aTHX);
   PL_op->op_private = save_private;
   return next;
}

OP* cpp_keycnt(pTHX_ HV* hv, const MAGIC* mg)
{
   const auto t = as_vtbl<container_vtbl>(mg);
   const Int s = (t->size)(mg->mg_ptr);
   dSP;
   SETs(sv_2mortal(newSViv(s)));
   return NORMAL;
}

SSize_t cpp_hassign(pTHX_ HV* hv, MAGIC* mg, I32* firstRp, I32 lastR, bool return_size)
{
   dSP;
   I32 firstR = *firstRp;
   clear_canned_assoc_container(aTHX_ (SV*)hv, mg);
   if (firstR < lastR) {
      const auto t = as_vtbl<container_vtbl>(mg);
      SV* brk_cv = AvARRAY(t->assoc_methods)[CPP_Assoc_helem_index];
      EXTEND(SP, 3);
      ENTER; SAVETMPS;
      SV* hvref = sv_2mortal(newRV((SV*)hv));
      do {
         PUSHMARK(SP);
         PUSHs(hvref);
         PUSHs(PL_stack_base[firstR]);  ++firstR;
         PUTBACK;
         call_sv(brk_cv, G_SCALAR);
         SPAGAIN;
         SV* helem = POPs;
         if (firstR <= lastR) {
            SvSetMagicSV(helem, PL_stack_base[firstR]); ++firstR;
         } else {
            SvSetMagicSV(helem, &PL_sv_undef);
         }
      } while (firstR < lastR);
      FREETMPS; LEAVE;
      *firstRp = firstR;
      if (return_size)
         return (t->size)(mg->mg_ptr);
   }
   return 0;
}

bool cpp_has_assoc_methods(const MAGIC* mg)
{
   return as_vtbl<container_vtbl>(mg)->assoc_methods != nullptr;
}

} } } // end namespace pm::perl

using namespace pm::perl;
using namespace pm::perl::glue;

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::CPlusPlus

PROTOTYPES: DISABLE

void assign_to_cpp_object(SV* obj, SV* value, SV* flags_sv)
PPCODE:
{
   MAGIC* mg = get_cpp_magic(SvRV(obj));
   const auto t = as_vtbl<base_vtbl>(mg);
   const ValueFlags flags = (SvTRUE(flags_sv) ? ValueFlags::is_trusted : ValueFlags::not_trusted) | ValueFlags::ignore_magic;
   PUTBACK;
   guarded_call(aTHX_ [=](){ (t->assignment)(mg->mg_ptr, value, flags); }, t);
   XSprePUSH;
   PUSHs(obj);
}

void convert_to_string(SV* src, ...)
PPCODE:
{
   MAGIC* mg = get_cpp_magic(SvRV(src));
   const auto t = as_vtbl<common_vtbl>(mg);
   PUTBACK;
   SV* result = guarded_call(aTHX_ [=](){ return (t->to_string)(mg->mg_ptr); });
   XSprePUSH;
   PUSHs(result);
}

void convert_to_serialized(SV* src, ...)
PPCODE:
{
   // TODO: rename to convert_to_tuple when the result becomes always a tuple
   src = SvRV(src);
   MAGIC* mg = get_cpp_magic(src);
   const auto t = as_vtbl<common_vtbl>(mg);
   PUTBACK;
   SV* result = guarded_call(aTHX_ [=](){ return (t->to_serialized)(mg->mg_ptr, src); }, t);
   XSprePUSH;
   PUSHs(result);
}

void get_magic_typeid(SV* x, I32 arg_flags)
PPCODE:
{
   SV* result = &PL_sv_undef;
   SV* obj;
   if (SvROK(x) && (obj=SvRV(x), SvOBJECT(obj))) {
      if (SvSTASH(obj) == TypeDescr_stash) {
         result = AvARRAY((AV*)obj)[TypeDescr_typeid_index];
      } else if (MAGIC* mg = get_cpp_magic(obj)) {
         const auto t = as_vtbl<base_vtbl>(mg);
         if (arg_flags == arg_is_const_ref || mg->mg_flags & read_only_flag) {
            result = t->const_ref_typeid_name_sv;
         } else if (arg_flags == arg_is_lval_ref) {
            result = t->mutable_ref_typeid_name_sv;
         } else if (mg->mg_len != 0 && is_temporary(aTHX_ x, obj)) {
            // canned object, referenced solely from a temp ref living in the argument list:
            // can be moved if needed
            result = t->typeid_name_sv;
         } else if (arg_flags == arg_is_univ_ref) {
            result = t->mutable_ref_typeid_name_sv;
         } else {
            result = t->const_ref_typeid_name_sv;
         }
      }
   }
   PUSHs(result);
}

void must_be_copied(SV* x, SV* for_temp, SV* will_be_lval_ref)
PPCODE:
{
   MAGIC* mg;
   PUSHs(&PL_sv_yes);
   if (SvROK(x) && (x=SvRV(x), SvOBJECT(x) && (mg=get_cpp_magic(x)) && mg->mg_len)) {
      // is an object canned here
      if ((SvTRUE(for_temp) || as_vtbl<base_vtbl>(mg)->flags * ClassFlags::is_declared)
          // is of a declared property type, or it'll be just a temp value
          && !(SvTRUE(will_be_lval_ref) &&
               ((mg->mg_flags & read_only_flag) ||
                SvIVX(as_vtbl<base_vtbl>(mg)->mutable_ref_typeid_name_sv) == 0))
               // can be passed by lvalue reference
          )
         SETs(&PL_sv_no);
   }
}

void composite_access(SV* src)
PPCODE:
{
   src = SvRV(src);
   MAGIC* mg = get_cpp_magic(src);
   const auto t = as_vtbl<composite_vtbl>(mg);
   SV* result = sv_newmortal();
   PUTBACK;
   guarded_call(aTHX_ [=](){ (t->acc[CvDEPTH(cv)].get[mg->mg_flags & read_only_flag])(mg->mg_ptr, result, src); }, t);
   XSprePUSH;
   PUSHs(result);
}

void call_function(...)
PPCODE:
{
   AV* descr = (AV*)CvXSUBANY(cv).any_ptr;
   const int n_args = CvDEPTH(cv);
   if (items != n_args) {
      PERL_CONTEXT *cx_bottom = cxstack, *cx = cx_bottom + cxstack_ix;
      while (cx >= cx_bottom) {
         if (CxTYPE(cx) == CXt_SUB) {
            cv = cx->blk_sub.cv;
            if (!skip_debug_sub(aTHX_ cv) && !CvANON(cv)) {
               GV* gv = CvGV(cv);
               sv_setpvf(ERRSV,
                         "%.*s::%.*s : got %d argument(s) while %d expected",
                         PmPrintHvNAME(GvSTASH(gv)), PmPrintGvNAME(gv), int(items), n_args);
               raise_exception(aTHX);
            }
         }
         --cx;
      }
      sv_setpvf(ERRSV, "ANONYMOUS C++ function : got %d argument(s) while %d expected", int(items), n_args);
      raise_exception(aTHX);
   }
   PUTBACK;
   const wrapper_type wrapper = reinterpret_cast<wrapper_type>(AvARRAY(descr)[FuncDescr_wrapper_index]);
   SV* ret = guarded_call(aTHX_ [=](){ return wrapper(SP+1); }, cv);
   SPAGAIN;
   if (ret) PUSHs(ret);
}

void create_function_wrapper(SV* descr, SV* app_stash_ref, I32 n_args, SV* returns)
PPCODE:
{
   AV* descr_av = (AV*)SvRV(descr);
   if (AvARRAY(descr_av)[FuncDescr_wrapper_index]) {
      SV* sub = newSV_type(SVt_PVCV);
      CvXSUB(sub) = &XS_Polymake__Core__CPlusPlus_call_function;
      CvFLAGS(sub) = CvFLAGS(cv) | CVf_ANON;
      CvDEPTH(sub) = n_args;
      CvXSUBANY(sub).any_ptr = descr_av;
      CvSTASH_set((CV*)sub, (HV*)SvRV(app_stash_ref));

      SV* type_reg_sv = AvARRAY(descr_av)[FuncDescr_return_type_reg_index];
      if (type_reg_sv) {
         const auto type_reg_fn = reinterpret_cast<type_reg_fn_type>(type_reg_sv);
         SV* result_proto = nullptr;
         PUTBACK;
         if (SvPOK(returns)) {
            guarded_call(aTHX_ [=](){ type_reg_fn(returns, app_stash_ref, descr); });
         } else if (SvROK(returns)) {
            // for containers, key and/or value types may also be prescribed
            if (SvTYPE(SvRV(returns)) != SVt_PVAV || AvFILLp(SvRV(returns)) < 1 || !SvPOK(PmArray(returns)[0]))
               Perl_croak(aTHX_ "Invalid return type description");
            SV* container_descr = guarded_call(aTHX_ [=](){ return type_reg_fn(PmArray(returns)[0], app_stash_ref, descr).second; });
            const auto vtbl = get_vtable<container_vtbl>(container_descr);
            if ((vtbl->flags & (ClassFlags::kind_mask | ClassFlags::is_assoc_container)) == ClassFlags::is_container) {
               if (AvFILLp(SvRV(returns)) != 1 || !SvPOK(PmArray(returns)[1]))
                  Perl_croak(aTHX_ "Invalid container return type description");
               guarded_call(aTHX_ [=](){ vtbl->provide_value_type(PmArray(returns)[1], app_stash_ref, descr); });
            } else if ((vtbl->flags & (ClassFlags::kind_mask | ClassFlags::is_assoc_container)) == (ClassFlags::is_container | ClassFlags::is_assoc_container)) {
               if (AvFILLp(SvRV(returns)) != 2)
                  Perl_croak(aTHX_ "Invalid associative container return type description");
               if (SvPOK(PmArray(returns)[1])) {
                  guarded_call(aTHX_ [=](){ vtbl->provide_key_type(PmArray(returns)[1], app_stash_ref, descr); });
               }
               if (SvPOK(PmArray(returns)[2])) {
                  guarded_call(aTHX_ [=](){ vtbl->provide_value_type(PmArray(returns)[2], app_stash_ref, descr); });
               }
            } else {
               Perl_croak(aTHX_ "Invalid return type description: is not a container");
            }
         } else {
            result_proto = guarded_call(aTHX_ [=](){ return type_reg_fn(nullptr, nullptr, descr).first; });
         }
         SPAGAIN;
         if (result_proto)
            AvARRAY(descr_av)[FuncDescr_return_type_index] = SvREFCNT_inc_simple_NN(result_proto);
      }
      if (SvIOK(returns) && SvIVX(returns) == returns_lvalue_flag)
         CvFLAGS(sub) |= CVf_LVALUE | CVf_NODEBUG;

      PUSHs(sv_2mortal(newRV_noinc(sub)));
   }
}

void overload_clone_op(SV* ref, ...)
PPCODE:
{
   SV* obj = SvRV(ref);
   if (SvTYPE(ref) == SVt_PVLV) {
      // It's the result of a lvalue function (like container random access).
      // The second reference to the object is stored in the ref's set-magic.
      // We shall return the same reference, it won't be checked by perl afterwards.
      ++SP;
   } else {
      MAGIC* mg = get_cpp_magic(obj);
      const auto t = as_vtbl<base_vtbl>(mg);
      if (!(mg->mg_flags & read_only_flag) && t->copy_constructor) {
         // Should clone only if persistent and really mutable
         SV* copy = (t->sv_cloner)(aTHX_ obj);
         PUTBACK;
         guarded_call(aTHX_ [=](){ (t->copy_constructor)(SvMAGIC(SvRV(copy))->mg_ptr, mg->mg_ptr); });
         XSprePUSH;
         PUSHs(sv_2mortal(copy));
      } else {
         ++SP;
      }
   }
}

void convert_to_Int(SV* proto, SV* obj)
PPCODE:
{
   dTARGET;
   const Int result = guarded_call(aTHX_ [=](){ return pm::perl::Scalar::convert_to_Int(obj); });
   PUSHi(result);
   PERL_UNUSED_ARG(proto);
}

void convert_to_Float(SV* proto, SV* obj)
PPCODE:
{
   dTARGET;
   const double result = guarded_call(aTHX_ [=](){ return pm::perl::Scalar::convert_to_Float(obj); });
   PUSHn(result);
   PERL_UNUSED_ARG(proto);
}

void classify_scalar(SV* x ,...)
PPCODE:
{
   // @retval: 0 - string, 1 - double, 2 - Int, 3 - bool, undef - the rest
   dTARGET;
   const bool require_numeric = items == 2 && SvTRUE(ST(1));
   if (x == &PL_sv_yes || x == &PL_sv_no) {
      PUSHi(require_numeric ? 2 : 3);
   } else if (SvIOK(x)) {
      PUSHi(2);
   } else if (SvNOK(x)) {
      PUSHi(1);
   } else if (SvPOK(x)) {
      int flags;
      if (SvCUR(x) > 0 && (flags = looks_like_number(x)) != 0) {
         if ((flags & (IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV)) == IS_NUMBER_IN_UV)
            PUSHi(2);
         else
            PUSHi(1);
      } else {
         PUSHs(require_numeric ? &PL_sv_undef : &PL_sv_no);
      }
   } else {
      PUSHs(&PL_sv_undef);
   }
}

void demangle(const char* sym)
PPCODE:
{
   dTARGET;
   std::string s = polymake::legible_typename(sym);
   PUSHp(s.c_str(), s.size());
}

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::CPlusPlus::TypeDescr

void value_type(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_value_type,
                                ClassFlags::kind_mask, ClassFlags::is_container, true);
   XSprePUSH;
   PUSHs(result);
}

void value_descr(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_value_type,
                                ClassFlags::kind_mask, ClassFlags::is_container);
   XSprePUSH;
   PUSHs(result);
}

void element_type(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type,
                                ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container, true);
   XSprePUSH;
   PUSHs(result);
}

void element_descr(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type,
                                ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container);
   XSprePUSH;
   PUSHs(result);
}

void key_type(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type,
                                ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container | ClassFlags::is_assoc_container, true);
   XSprePUSH;
   PUSHs(result);
}

void key_descr(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type,
                                ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container | ClassFlags::is_assoc_container);
   XSprePUSH;
   PUSHs(result);
}

void member_types(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &composite_vtbl::provide_member_types,
                                ClassFlags::kind_mask, ClassFlags::is_composite);
   XSprePUSH;
   PUSHs(result);
}

void member_descrs(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &composite_vtbl::provide_member_descrs,
                                ClassFlags::kind_mask, ClassFlags::is_composite);
   XSprePUSH;
   PUSHs(result);
}

void member_names(SV* descr)
PPCODE:
{
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &composite_vtbl::provide_member_names,
                                ClassFlags::kind_mask, ClassFlags::is_composite);
   XSprePUSH;
   PUSHs(result);
}

void num_members(SV* descr)
PPCODE:
{
   dTARGET;
   const auto t = get_vtable<composite_vtbl>(descr);
   if ((t->flags & ClassFlags::kind_mask) == ClassFlags::is_composite)
      PUSHi(t->n_members);
   else
      PUSHs(&PL_sv_undef);
}

void serialized_type(SV* descr)
PPCODE:
{
   // TODO: rename to tuple_type
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &common_vtbl::provide_serialized_type,
                                ClassFlags::is_serializable, ClassFlags::is_serializable, true);
   XSprePUSH;
   PUSHs(result);
}

void serialized_descr(SV* descr)
PPCODE:
{
   // TODO: rename to tuple_descr
   PUTBACK;
   SV* result=extract_type_info(aTHX_ descr, &common_vtbl::provide_serialized_type,
                                ClassFlags::is_serializable, ClassFlags::is_serializable);
   XSprePUSH;
   PUSHs(result);
}

void dimension(SV* descr)
PPCODE:
{
   dTARGET;
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHi(t->obj_dimension);
}

void own_dimension(SV* descr)
PPCODE:
{
   dTARGET;
   const auto t = get_vtable<container_vtbl>(descr);
   if ((t->flags & ClassFlags::kind_mask) == ClassFlags::is_container)
      PUSHi(t->own_dimension);
   else
      PUSHs(&PL_sv_undef);
}

void is_scalar(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_scalar ? &PL_sv_yes : &PL_sv_no);
}

void is_container(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_container ? &PL_sv_yes : &PL_sv_no);
}

void is_composite(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_composite ? &PL_sv_yes : &PL_sv_no);
}

void is_opaque(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_opaque ? &PL_sv_yes : &PL_sv_no);
}

void is_assoc_container(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs((t->flags & (ClassFlags::kind_mask | ClassFlags::is_assoc_container)) == (ClassFlags::is_container | ClassFlags::is_assoc_container) ? &PL_sv_yes : &PL_sv_no);
}

void is_sparse_container(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs((t->flags & (ClassFlags::kind_mask | ClassFlags::is_sparse_container)) == (ClassFlags::is_container | ClassFlags::is_sparse_container) ? &PL_sv_yes : &PL_sv_no);
}

void is_set(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs(t->flags * ClassFlags::is_set ? &PL_sv_yes : &PL_sv_no);
}

void is_serializable(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs(t->flags * ClassFlags::is_serializable ? &PL_sv_yes : &PL_sv_no);
}

void is_sparse_serialized(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs(t->flags * ClassFlags::is_sparse_serialized ? &PL_sv_yes : &PL_sv_no);
}

void is_ordered(SV* descr)
PPCODE:
{
   const auto t = get_vtable<base_vtbl>(descr);
   PUSHs(t->flags * ClassFlags::is_ordered ? &PL_sv_yes : &PL_sv_no);
}

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::CPlusPlus::Iterator

void incr(SV* ref, ...)
PPCODE:
{
   MAGIC* mg = SvMAGIC(SvRV(ref));
   const auto t = as_vtbl<iterator_vtbl>(mg);
   PUTBACK;
   guarded_call(aTHX_ [=](){ (t->incr)(mg->mg_ptr); });
   XSprePUSH;
   PUSHs(ref);
}

void not_at_end(SV* ref, ...)
PPCODE:
{
   MAGIC* mg = SvMAGIC(SvRV(ref));
   const auto t = as_vtbl<iterator_vtbl>(mg);
   // we don't expect any perl objects be accessed or created in at_end() methods, therefore the stack can't change
   const bool at_end = guarded_call(aTHX_ [=](){ return (t->at_end)(mg->mg_ptr); });
   if (at_end)
      PUSHs(&PL_sv_no);
   else
      PUSHs(&PL_sv_yes);
}

void deref(SV* ref, ...)
PPCODE:
{
   MAGIC* mg = SvMAGIC(SvRV(ref));
   const auto t = as_vtbl<iterator_vtbl>(mg);
   PUTBACK;
   SV* result = guarded_call(aTHX_ [=](){ return (t->deref)(mg->mg_ptr); }, t);
   XSprePUSH;
   PUSHs(result);
}

void deref_to_scalar(SV* ref, ...)
PPCODE:
{
   MAGIC* mg = SvMAGIC(SvRV(ref));
   const auto t = as_vtbl<iterator_vtbl>(mg);
   PUTBACK;
   SV* result = guarded_call(aTHX_ [=](){ return (t->deref)(mg->mg_ptr); }, t);
   XSprePUSH;
   PUSHs(sv_2mortal(newRV(result)));
}

void index(SV* ref)
PPCODE:
{
   MAGIC* mg = SvMAGIC(SvRV(ref));
   const auto t = as_vtbl<iterator_vtbl>(mg);
   // we don't expect any perl objects be accessed or created in index() methods, therefore the stack can't change
   if (t->index) {
      dTARGET;
      const Int ret = guarded_call(aTHX_ [=](){ return (t->index)(mg->mg_ptr); });
      PUSHi(ret);
   } else {
      PUSHs(&PL_sv_undef);
   }
}

void hidden(SV* ref, ...)
PPCODE:
{
   PUSHs(SvRV(ref));
}

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::CPlusPlus::TiedArray

void EXTEND(SV* obj, I32 n)
PPCODE:
{
   MAGIC* mg = get_cpp_magic(SvRV(obj));
   const auto t = as_vtbl<container_vtbl>(mg);
   if ((mg->mg_flags & read_only_flag) || !t->resize)
      raise_exception(aTHX_ "Attempt to overwrite elements in a read-only C++ object");
   guarded_call(aTHX_ [=](){ (t->resize)(mg->mg_ptr, n); });
}

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::CPlusPlus::TiedCompositeArray

void EXTEND(SV* obj, I32 n)
PPCODE:
{
   MAGIC* mg = get_cpp_magic(SvRV(obj));
   const auto t = as_vtbl<composite_vtbl>(mg);
   if (n != t->n_members)
      raise_exception(aTHX_ "Wrong number of elements in a composite assignment");
}

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::CPlusPlus::TiedHash

void FIRSTKEY(SV* obj_ref)
PPCODE:
{
   SV* obj_sv = SvRV(obj_ref);
   SV* key_sv = sv_newmortal();
   MAGIC* mg = get_cpp_magic(obj_sv);
   char* obj = mg->mg_ptr;
   char* it = (char*)HvARRAY(obj_sv);
   const auto t = as_vtbl<container_vtbl>(mg);
   const auto acct = t->acc + (mg->mg_flags & read_only_flag);
   if (it[acct->obj_size]) {
      if (acct->destructor)
         (acct->destructor)(it);
      it[acct->obj_size] = 0;
   }
   PUTBACK;
   guarded_call(aTHX_ [=](){ (acct->begin)(it, obj); });
   it[acct->obj_size] = 1;
   guarded_call(aTHX_ [=](){ (acct->deref)(nullptr, it, -1, key_sv, obj_sv); }, t);
   XSprePUSH;
   PUSHs(key_sv);
}

void NEXTKEY(SV* obj_ref, SV* key_sv)
PPCODE:
{
   SV* obj_sv = SvRV(obj_ref);
   MAGIC* mg = get_cpp_magic(obj_sv);
   const auto t = as_vtbl<container_vtbl>(mg);
   const auto acct = t->acc + (mg->mg_flags & read_only_flag);
   char* it = (char*)HvARRAY(obj_sv);
   key_sv = sv_newmortal();
   PUTBACK;
   guarded_call(aTHX_ [=](){ (acct->deref)(nullptr, it, 0, key_sv, obj_sv); }, t);
   XSprePUSH;
   PUSHs(key_sv);
}

MODULE = Polymake::Core::CPlusPlus              PACKAGE = Polymake::Core::Serializer::Sparse

void dim_key()
PPCODE:
{
   XPUSHs(Serializer_Sparse_dim_key);
}

BOOT:
{
   CPP_root = get_named_variable(aTHX_ "Polymake::Core::CPlusPlus::root", SVt_PV);
   PropertyType_nested_instantiation = get_named_variable(aTHX_ "Polymake::Core::PropertyType::nested_instantiation", SVt_PV);
   User_application = get_named_variable(aTHX_ "Polymake::User::application", SVt_PV);
   Debug_level = get_named_variable(aTHX_ "Polymake::DebugLevel", SVt_PV);

   FuncDescr_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::FuncDescr");
   FuncDescr_fill_visible = get_sizeof(aTHX_ FuncDescr_stash)-1;
   FuncDescr_wrapper_index = FuncDescr_fill_visible+1;
   FuncDescr_return_type_reg_index = FuncDescr_wrapper_index+1;
   FuncDescr_fill = FuncDescr_return_type_reg_index;
   FuncDescr_name_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::name", false));
   FuncDescr_cpperl_file_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::cpperl_file", false));
   FuncDescr_arg_types_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::arg_types", false));
   FuncDescr_cross_apps_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::cross_apps", false));
   FuncDescr_return_type_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::return_type", false));

   TypeDescr_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::TypeDescr");
   TypeDescr_fill = get_sizeof(aTHX_ TypeDescr_stash)-1;
   TypeDescr_pkg_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::pkg", false));
   TypeDescr_vtbl_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::vtbl", false));
   TypeDescr_cpperl_file_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::cpperl_file", false));
   TypeDescr_typeid_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::typeid", false));
   TypeDescr_generated_by_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::generated_by", false));

   User_stash = get_named_stash(aTHX_ "Polymake::User");

   CPPOptions_builtin_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::Options::builtin", false));
   CPPOptions_descr_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::Options::descr", false));

   PropertyType_pkg_index = CvDEPTH(get_cv("Polymake::Core::PropertyType::pkg", false));
   PropertyType_cppoptions_index = CvDEPTH(get_cv("Polymake::Core::PropertyType::cppoptions", false));
   PropertyType_params_index = CvDEPTH(get_cv("Polymake::Core::PropertyType::params", false));

   CPP_functions_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::functions", false));
   CPP_regular_functions_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::regular_functions", false));
   CPP_embedded_rules_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::embedded_rules", false));
   CPP_duplicate_class_instances_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::duplicate_class_instances", false));
   CPP_type_descr_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::type_descr", false));
   CPP_builtins_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::builtins", false));
   CPP_templates_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::templates", false));
   CPP_typeids_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::typeids", false));
   CPP_auto_assignment_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_assignment", false));
   CPP_auto_conversion_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_conversion", false));
   CPP_auto_assoc_methods_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_assoc_methods", false));
   CPP_auto_set_methods_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_set_methods", false));

   HV* assoc_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::Assoc");
   CPP_Assoc_helem_index = get_named_constant(aTHX_ assoc_stash, "helem");
   CPP_Assoc_find_index = get_named_constant(aTHX_ assoc_stash, "find");
   CPP_Assoc_exists_index = get_named_constant(aTHX_ assoc_stash, "exists");
   CPP_Assoc_delete_void_index = get_named_constant(aTHX_ assoc_stash, "delete_void");
   CPP_Assoc_delete_ret_index = get_named_constant(aTHX_ assoc_stash, "delete_ret");

   Serializer_Sparse_dim_key = newSVpvn_share("_dim", 4, 0);

   Application_pkg_index = CvDEPTH(get_cv("Polymake::Core::Application::pkg", false));
   Application_eval_expr_index = CvDEPTH(get_cv("Polymake::Core::Application::eval_expr", false));

   Object_name_index = CvDEPTH(get_cv("Polymake::Core::BigObject::name", false));
   Object_description_index = CvDEPTH(get_cv("Polymake::Core::BigObject::description", false));
   Object_parent_index = CvDEPTH(get_cv("Polymake::Core::BigObject::parent", false));
   Object_transaction_index = CvDEPTH(get_cv("Polymake::Core::BigObject::transaction", false));
   Object_attachments_index = CvDEPTH(get_cv("Polymake::Core::BigObject::attachments", false));
   Object_InitTransaction_stash = get_named_stash(aTHX_ "Polymake::Core::InitTransaction");

   CvLVALUE_on(get_cv("Polymake::Core::CPlusPlus::Iterator::hidden", false));
   CvMETHOD_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Int", false));
   CvMETHOD_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Float", false));

   if (PL_DBgv) {
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::deref", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::deref_to_scalar", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::incr", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::not_at_end", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::hidden", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::call_function", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::composite_access", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::assign_to_cpp_object", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::overload_clone_op", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_string", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Int", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Float", false));
      CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_serialized", false));
   }

   HV* FuncFlag_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::FuncFlag");
   if (arg_is_lval_ref != get_named_constant(aTHX_ FuncFlag_stash, "arg_is_lval_ref") ||
       arg_is_univ_ref != get_named_constant(aTHX_ FuncFlag_stash, "arg_is_univ_ref") ||
       arg_is_const_or_rval_ref != get_named_constant(aTHX_ FuncFlag_stash, "arg_is_const_or_rval_ref"))
      Perl_croak(aTHX_ "internal error: mismatch between C++ and perl enum values for FuncFlags");
   returns_lvalue_flag = get_named_constant(aTHX_ FuncFlag_stash, "returns_lvalue");

   HV* PropertyValueFlags_stash = get_named_stash(aTHX_ "Polymake::Core::PropertyValue::Flags");
   temporary_value_flag = get_named_constant_sv(aTHX_ PropertyValueFlags_stash, "is_temporary");

   negative_indices_key = newSVpvn_share(NEGATIVE_INDICES_VAR, 16, 0);
   connect_cout(aTHX);
}

=pod
// Local Variables:
// mode:C++
// c-basic-offset:3
// indent-tabs-mode:nil
// End:
=cut
