The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
/* -*- Mode: C -*- */

#define PERL_NO_GET_CONTEXT 1

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

#include "ppport.h"

#define KEY0 3

static int
sv_icmp(pTHX_ SV *a, SV *b) {
    IV iv1 = SvIV(a);
    IV iv2 = SvIV(b);
    return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
}

static int
sv_ucmp(pTHX_ SV *a, SV *b) {
    UV uv1 = SvUV(a);
    UV uv2 = SvUV(b);
    return uv1 < uv2 ? -1 : uv1 > uv2 ? 1 : 0;
}

static int
sv_ncmp(pTHX_ SV *a, SV *b) {
    NV nv1 = SvNV(a);
    NV nv2 = SvNV(b);
    return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
}



/* WARNING: _resort(type, src) does NOT check if its arguments are
 * properly structured, neither it does support magic on them!,
 * calling module has to ensure that these conditions are meet */



MODULE = Sort::Key::Merger		PACKAGE = Sort::Key::Merger		
PROTOTYPES: DISABLE

void
_resort(SV *type, AV *src)
PREINIT:
    I32 (*cmp)(pTHX_ SV *, SV *);
    int min, max, pivot;
    SV **srci, **key0, **keypivot;
    SV *src0;
    STRLEN type_len;
    unsigned char *type_pv;
PPCODE:
    type_pv = SvPV(type, type_len);
    max = av_len(src);
    /* printf("max: %d\n", max); fflush(stdout); */
    if (max > 0) {
	min = 0;
	srci = AvARRAY(src);
	src0 = srci[0];
	key0 = AvARRAY((AV*)(SvRV(src0))) + KEY0;

        for (pivot = 1; min < max; pivot = (max + min + 1) / 2) {
            int k;
	    SV **keypivot = AvARRAY((AV*)(SvRV(srci[pivot]))) + KEY0;

            /* fprintf(stderr, "min: %d, max: %d\n", min, max); fflush(stderr); */
            
            for (k = 0; ; k++) {
                int cmp;

                if (k > type_len)
                    Perl_croak(aTHX_ "internal error: sorting order is ambiguous");
                
                switch (type_pv[k]) {
                case 0:
                    cmp = sv_cmp(key0[k], keypivot[k]);
                    break;
                case 1:
                    cmp = sv_cmp_locale(key0[k], keypivot[k]);
                    break;
                case 2:
                    cmp = sv_ncmp(aTHX_ key0[k], keypivot[k]);
                    break;
                case 3:
                    cmp = sv_icmp(aTHX_ key0[k], keypivot[k]);
                    break;
                case 4:
                    cmp = sv_ucmp(aTHX_ key0[k], keypivot[k]);
                    break;
                case 128:
                    cmp = sv_cmp(keypivot[k], key0[k]);
                    break;
                case 129:
                    cmp = sv_cmp_locale(keypivot[k], key0[k]);
                    break;
                case 130:
                    cmp = sv_ncmp(aTHX_ keypivot[k], key0[k]);
                    break;
                case 131:
                    cmp = sv_icmp(aTHX_ keypivot[k], key0[k]);
                    break;
                case 132:
                    cmp = sv_ucmp(aTHX_ keypivot[k], key0[k]);
                    break;
                default:
                    Perl_croak(aTHX_ "bad key type %d", type_pv[k]);
                }

                if (cmp < 0) {
                    max = pivot - 1;
                    break;
                }
                if (cmp > 0) {
                    min = pivot;
                    break;
                }
	    }
        }
	if (min > 0) {
	    int i;
	    for (i = 0; i < min; i++) {
		srci[i] = srci[i + 1];
	    }
	    srci[min] = src0;
	}
    }
    XSRETURN(0);