/*
 * This file was generated automatically by ExtUtils::ParseXS version 3.34 from the
 * contents of SkewHeap.xs. Do not edit this file, edit SkewHeap.xs instead.
 *
 *    ANY CHANGES MADE HERE WILL BE LOST!
 *
 */

#line 1 "SkewHeap.xs"
#define PERL_NO_GET_CONTEXT

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"

/*
 * Allocate memory with Newx if it's
 * available - if it's an older perl
 * that doesn't have Newx then we
 * resort to using New.
 */
#ifndef Newx
#define Newx(v, n, t) New(0, v, n, t)
#endif

/*
 * perl object ref to skewheap_t*
 */
#ifndef SKEW
#define SKEW(obj) ((skewheap_t*) SvIV(SvRV(obj)))
#endif

typedef struct SkewNode {
  struct SkewNode *left;
  struct SkewNode *right;
  SV *value;
} skewnode_t;

typedef struct SkewHeap {
  skewnode_t *root;
  IV size;
  CV *cmp;
} skewheap_t;

skewnode_t* new_node(pTHX_ SV *value) {
  skewnode_t *node;
  Newx(node, 1, skewnode_t);
  node->left  = NULL;
  node->right = NULL;
  node->value = value;
  SvREFCNT_inc(value);
  return node;
}

void free_node(pTHX_ skewnode_t *node) {
  if (node->left != NULL)  free_node(aTHX_ node->left);
  if (node->right != NULL) free_node(aTHX_ node->right);
  Safefree(node);
}

SV* new(pTHX_ const char *class, CV *cmp) {
  skewheap_t *heap;
  SV *obj;
  SV *ref;

  Newx(heap, 1, skewheap_t);
  heap->root = NULL;
  heap->size = 0;
  heap->cmp  = cmp;

  obj = newSViv((IV) heap);
  ref = newRV_noinc(obj);
  sv_bless(ref, gv_stashpv(class, GV_ADD));
  SvREADONLY_on(obj);

  return ref;
}

void DESTROY(pTHX_ SV *ref) {
  skewheap_t *heap = SKEW(ref);
  if (heap->root != NULL) free_node(aTHX_ heap->root);
  Safefree(heap);
}

void sort_nodes(pTHX_ skewnode_t *nodes[], int length, CV *cmp) {
  skewnode_t *tmp, *x;
  int p, j;
  int start = 0;
  int end = length - 1;
  int top = 1;
  int stack[end - start + 1];

  stack[0] = start;
  stack[1] = end;

  // set up multicall
  dSP;
  GV *agv, *bgv, *gv;
  HV *stash;

  agv = gv_fetchpv("main::a", GV_ADD, SVt_PV);
  bgv = gv_fetchpv("main::b", GV_ADD, SVt_PV);
  SAVESPTR(GvSV(agv));
  SAVESPTR(GvSV(bgv));

  dMULTICALL;
  I8 gimme = G_SCALAR;

  PUSH_MULTICALL(cmp);
  // multicall ready

  while (top >= 0) {
    end   = stack[top--];
    start = stack[top--];

    x = nodes[end];
    p = start - 1;

    for (j = start; j <= end - 1; ++j) {
      GvSV(agv) = nodes[j]->value;
      GvSV(bgv) = x->value;
      MULTICALL;

      int test = SvIV(*PL_stack_sp);

      if (test < 1) {
        p++;
        tmp = nodes[p];
        nodes[p] = nodes[j];
        nodes[j] = tmp;
      }
    }

    tmp = nodes[++p];
    nodes[p] = nodes[end];
    nodes[end] = tmp;

    if (p - 1 > start) {
      stack[++top] = start;
      stack[++top] = p - 1;
    }

    if (p + 1 < end) {
      stack[++top] = p + 1;
      stack[++top] = end;
    }
  }

  POP_MULTICALL;
}

void _merge(pTHX_ skewheap_t *heap, skewnode_t *a, skewnode_t *b) {
  skewnode_t* todo[heap->size];
  skewnode_t* nodes[heap->size];
  skewnode_t* node;
  skewnode_t* prev;
  int tidx = 0;
  int nidx = 0;
  int i;

  if (a == NULL) {
    heap->root = b;
    return;
  }
  else if (b == NULL) {
    heap->root = a;
    return;
  }

  // Cut the right subtree from each path
  todo[tidx++] = a;
  todo[tidx++] = b;

  while (tidx > 0) {
    node = todo[--tidx];

    if (node->right != NULL) {
      todo[tidx++] = node->right;
      node->right = NULL;
    }

    nodes[nidx++] = node;
  }

  if (nidx == 0) {
    heap->root = NULL;
  }
  else {
    // Sort the subtrees
    if (nidx > 1) {
      sort_nodes(aTHX_ nodes, nidx, heap->cmp);
    }

    // Recombine subtrees
    for (i = nidx; i > 1; --i) {
      node = nodes[i - 1]; // last node
      prev = nodes[i - 2]; // second to last node

      // Set penultimate node's right child to its left (and only) subtree
      if (prev->left != NULL) {
        prev->right = prev->left;
      }

      // Set its left child to the ultimate node
      prev->left = node;
    }

    heap->root = nodes[0];
  }
}

IV put_one(pTHX_ SV *ref, SV *value) {
  skewheap_t *heap = SKEW(ref);
  skewnode_t *node;

  node = new_node(aTHX_ value);
  ++heap->size;

  if (heap->root == NULL) {
    heap->root = node;
  } else {
    _merge(aTHX_ heap, heap->root, node);
  }

  return heap->size;
}

SV* take(pTHX_ SV *ref) {
  skewheap_t *heap = SKEW(ref);
  skewnode_t *root = heap->root;
  SV *item;

  if (root != NULL) {
    item = root->value;
    --heap->size;
    _merge(aTHX_ heap, root->left, root->right);
    root->left  = NULL;
    root->right = NULL;
    free_node(aTHX_ root);
  }
  else {
    item = &PL_sv_undef;
  }

  return item;
}

SV* top(pTHX_ SV *ref) {
  skewheap_t *heap = SKEW(ref);
  return heap->root == NULL
      ? &PL_sv_undef
      : newSVsv(heap->root->value);
}

IV size(pTHX_ SV *ref) {
  skewheap_t *heap = SKEW(ref);
  return heap->size;
}

IV merge(pTHX_ SV *heap_a, SV *heap_b) {
  skewheap_t *a = SKEW(heap_a);
  skewheap_t *b = SKEW(heap_b);

  if (a->root == NULL) {
    a->root = b->root;
  } else if (b->root != NULL) {
    _merge(aTHX_ a, a->root, b->root);
  }

  a->size += b->size;
  b->size = 0;
  b->root = NULL;

  return a->size;
}


#line 280 "SkewHeap.c"
#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#ifndef dVAR
#  define dVAR		dNOOP
#endif


/* This stuff is not part of the API! You have been warned. */
#ifndef PERL_VERSION_DECIMAL
#  define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
#endif
#ifndef PERL_DECIMAL_VERSION
#  define PERL_DECIMAL_VERSION \
	  PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
#endif
#ifndef PERL_VERSION_GE
#  define PERL_VERSION_GE(r,v,s) \
	  (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
#endif
#ifndef PERL_VERSION_LE
#  define PERL_VERSION_LE(r,v,s) \
	  (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
#endif

/* XS_INTERNAL is the explicit static-linkage variant of the default
 * XS macro.
 *
 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
 * "STATIC", ie. it exports XSUB symbols. You probably don't want that
 * for anything but the BOOT XSUB.
 *
 * See XSUB.h in core!
 */


/* TODO: This might be compatible further back than 5.10.0. */
#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
#  undef XS_EXTERNAL
#  undef XS_INTERNAL
#  if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
#    define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
#    define XS_INTERNAL(name) STATIC XSPROTO(name)
#  endif
#  if defined(__SYMBIAN32__)
#    define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
#    define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
#  endif
#  ifndef XS_EXTERNAL
#    if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
#      define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
#      define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
#    else
#      ifdef __cplusplus
#        define XS_EXTERNAL(name) extern "C" XSPROTO(name)
#        define XS_INTERNAL(name) static XSPROTO(name)
#      else
#        define XS_EXTERNAL(name) XSPROTO(name)
#        define XS_INTERNAL(name) STATIC XSPROTO(name)
#      endif
#    endif
#  endif
#endif

/* perl >= 5.10.0 && perl <= 5.15.1 */


/* The XS_EXTERNAL macro is used for functions that must not be static
 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
 * macro defined, the best we can do is assume XS is the same.
 * Dito for XS_INTERNAL.
 */
#ifndef XS_EXTERNAL
#  define XS_EXTERNAL(name) XS(name)
#endif
#ifndef XS_INTERNAL
#  define XS_INTERNAL(name) XS(name)
#endif

/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
 * internal macro that we're free to redefine for varying linkage due
 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
 */

#undef XS_EUPXS
#if defined(PERL_EUPXS_ALWAYS_EXPORT)
#  define XS_EUPXS(name) XS_EXTERNAL(name)
#else
   /* default to internal */
#  define XS_EUPXS(name) XS_INTERNAL(name)
#endif

#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)

/* prototype to pass -Wmissing-prototypes */
STATIC void
S_croak_xs_usage(const CV *const cv, const char *const params);

STATIC void
S_croak_xs_usage(const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
	    Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
        else
	    Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
	Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
    }
}
#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE

#define croak_xs_usage        S_croak_xs_usage

#endif

/* NOTE: the prototype of newXSproto() is different in versions of perls,
 * so we define a portable version of newXSproto()
 */
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
#endif /* !defined(newXS_flags) */

#if PERL_VERSION_LE(5, 21, 5)
#  define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
#else
#  define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
#endif

#line 424 "SkewHeap.c"

XS_EUPXS(XS_SkewHeap_new); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_new)
{
    dVAR; dXSARGS;
    if (items != 2)
       croak_xs_usage(cv,  "class, cmp");
    {
	SV *	RETVAL;
	const char *	class = (const char *)SvPV_nolen(ST(0))
;
	CV *	cmp;

	STMT_START {
                HV *st;
                GV *gvp;
		SV * const xsub_tmp_sv = ST(1);
		SvGETMAGIC(xsub_tmp_sv);
                cmp = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);
		if (!cmp) {
		    Perl_croak_nocontext("%s: %s is not a CODE reference",
				"SkewHeap::new",
				"cmp");
		}
	} STMT_END
;
#line 278 "SkewHeap.xs"
    RETVAL = new(aTHX_ class, cmp);
#line 453 "SkewHeap.c"
	RETVAL = sv_2mortal(RETVAL);
	ST(0) = RETVAL;
    }
    XSRETURN(1);
}


XS_EUPXS(XS_SkewHeap_DESTROY); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_DESTROY)
{
    dVAR; dXSARGS;
    if (items != 1)
       croak_xs_usage(cv,  "heap");
    {
	SV *	heap = ST(0)
;
#line 284 "SkewHeap.xs"
    DESTROY(aTHX_ heap);
#line 472 "SkewHeap.c"
    }
    XSRETURN_EMPTY;
}


XS_EUPXS(XS_SkewHeap_put_one); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_put_one)
{
    dVAR; dXSARGS;
    if (items != 2)
       croak_xs_usage(cv,  "heap, value");
    {
	IV	RETVAL;
	dXSTARG;
	SV *	heap = ST(0)
;
	SV *	value = ST(1)
;
#line 288 "SkewHeap.xs"
    RETVAL = put_one(aTHX_ heap, value);
#line 493 "SkewHeap.c"
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS_EUPXS(XS_SkewHeap_take); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_take)
{
    dVAR; dXSARGS;
    if (items != 1)
       croak_xs_usage(cv,  "heap");
    {
	SV *	RETVAL;
	SV *	heap = ST(0)
;
#line 294 "SkewHeap.xs"
    RETVAL = take(aTHX_ heap);
#line 512 "SkewHeap.c"
	RETVAL = sv_2mortal(RETVAL);
	ST(0) = RETVAL;
    }
    XSRETURN(1);
}


XS_EUPXS(XS_SkewHeap_size); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_size)
{
    dVAR; dXSARGS;
    if (items != 1)
       croak_xs_usage(cv,  "heap");
    {
	IV	RETVAL;
	dXSTARG;
	SV *	heap = ST(0)
;
#line 300 "SkewHeap.xs"
    RETVAL = size(aTHX_ heap);
#line 533 "SkewHeap.c"
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS_EUPXS(XS_SkewHeap_merge); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_merge)
{
    dVAR; dXSARGS;
    if (items != 2)
       croak_xs_usage(cv,  "heap_a, heap_b");
    {
	IV	RETVAL;
	dXSTARG;
	SV *	heap_a = ST(0)
;
	SV *	heap_b = ST(1)
;
#line 306 "SkewHeap.xs"
    RETVAL = merge(aTHX_ heap_a, heap_b);
#line 555 "SkewHeap.c"
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS_EUPXS(XS_SkewHeap_top); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_SkewHeap_top)
{
    dVAR; dXSARGS;
    if (items != 1)
       croak_xs_usage(cv,  "heap");
    {
	SV *	RETVAL;
	SV *	heap = ST(0)
;
#line 312 "SkewHeap.xs"
    RETVAL = top(aTHX_ heap);
#line 574 "SkewHeap.c"
	RETVAL = sv_2mortal(RETVAL);
	ST(0) = RETVAL;
    }
    XSRETURN(1);
}

#ifdef __cplusplus
extern "C"
#endif
XS_EXTERNAL(boot_SkewHeap); /* prototype to pass -Wmissing-prototypes */
XS_EXTERNAL(boot_SkewHeap)
{
#if PERL_VERSION_LE(5, 21, 5)
    dVAR; dXSARGS;
#else
    dVAR; dXSBOOTARGSXSAPIVERCHK;
#endif
#if (PERL_REVISION == 5 && PERL_VERSION < 9)
    char* file = __FILE__;
#else
    const char* file = __FILE__;
#endif

    PERL_UNUSED_VAR(file);

    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
#if PERL_VERSION_LE(5, 21, 5)
    XS_VERSION_BOOTCHECK;
#  ifdef XS_APIVERSION_BOOTCHECK
    XS_APIVERSION_BOOTCHECK;
#  endif
#endif

        newXS_deffile("SkewHeap::new", XS_SkewHeap_new);
        newXS_deffile("SkewHeap::DESTROY", XS_SkewHeap_DESTROY);
        newXS_deffile("SkewHeap::put_one", XS_SkewHeap_put_one);
        newXS_deffile("SkewHeap::take", XS_SkewHeap_take);
        newXS_deffile("SkewHeap::size", XS_SkewHeap_size);
        newXS_deffile("SkewHeap::merge", XS_SkewHeap_merge);
        newXS_deffile("SkewHeap::top", XS_SkewHeap_top);
#if PERL_VERSION_LE(5, 21, 5)
#  if PERL_VERSION_GE(5, 9, 0)
    if (PL_unitcheckav)
        call_list(PL_scopestack_ix, PL_unitcheckav);
#  endif
    XSRETURN_YES;
#else
    Perl_xs_boot_epilog(aTHX_ ax);
#endif
}

