Array-Heap/Heap.xs

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

/* pre-5.10 compatibility */
#ifndef GV_NOTQUAL
# define GV_NOTQUAL 1
#endif
#ifndef gv_fetchpvs
# define gv_fetchpvs gv_fetchpv
#endif

#include "multicall.h"

/* workaround for buggy multicall API */
#ifndef cxinc
# define cxinc() Perl_cxinc (aTHX)
#endif

#define dCMP                    \
  dMULTICALL;                   \
  void *cmp_data;               \
  I32 gimme = G_SCALAR;

#define CMP_PUSH(sv)            \
  PUSH_MULTICALL (cmp_push_ (sv));\
  cmp_data = multicall_cop;

#define CMP_POP                 \
  POP_MULTICALL;

#define dCMP_CALL(data)         \
  OP *multicall_cop = (OP *)data;

static void *
cmp_push_ (SV *sv)
{
  HV *st;
  GV *gvp;
  CV *cv;

  cv = sv_2cv (sv, &st, &gvp, 0);

  if (!cv)
    croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (sv));

  if (!PL_firstgv)  PL_firstgv  = gv_fetchpvs ("a", GV_ADD | GV_NOTQUAL, SVt_PV);
  if (!PL_secondgv) PL_secondgv = gv_fetchpvs ("b", GV_ADD | GV_NOTQUAL, SVt_PV);

  SAVESPTR (GvSV (PL_firstgv));
  SAVESPTR (GvSV (PL_secondgv));

  return cv;
}

/*****************************************************************************/

static SV *
sv_first (SV *sv)
{
  if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)
    {
      AV *av = (AV *)SvRV (sv);

      sv = AvFILLp (av) < 0 ? &PL_sv_undef : AvARRAY (av)[0];
    }

  return sv;
}

static int
cmp_nv (SV *a, SV *b, void *cmp_data)
{
  a = sv_first (a);
  b = sv_first (b);

  return SvNV (a) > SvNV (b);
}

static int
cmp_sv (SV *a, SV *b, void *cmp_data)
{
  a = sv_first (a);
  b = sv_first (b);

  return sv_cmp (a, b) > 0;
}

static int
cmp_custom (SV *a, SV *b, void *cmp_data)
{
  dCMP_CALL (cmp_data);

  GvSV (PL_firstgv)  = a;
  GvSV (PL_secondgv) = b;

  MULTICALL;

  if (SvTRUE (ERRSV))
    croak (NULL);

  {
    dSP;
    return TOPi > 0;
  }
}

/*****************************************************************************/

typedef int (*f_cmp)(SV *a, SV *b, void *cmp_data);

static AV *
array (SV *ref)
{
  if (SvROK (ref)
      && SvTYPE (SvRV (ref)) == SVt_PVAV
      && !SvTIED_mg (SvRV (ref), PERL_MAGIC_tied))
    return (AV *)SvRV (ref);

  croak ("argument 'heap' must be a (non-tied) array");
}

#define gt(a,b) cmp ((a), (b), cmp_data)

/*****************************************************************************/

/* away from the root */
static void
downheap (AV *av, f_cmp cmp, void *cmp_data, int N, int k)
{
  SV **heap = AvARRAY (av);
  SV *he = heap [k];

  for (;;)
    {
      int c = (k << 1) + 1;

      if (c >= N)
        break;

      c += c + 1 < N && gt (heap [c], heap [c + 1])
           ? 1 : 0;

      if (!(gt (he, heap [c])))
        break;

      heap [k] = heap [c];

      k = c;
    }

  heap [k] = he;
}

/* towards the root */
static void
upheap (AV *av, f_cmp cmp, void *cmp_data, int k)
{
  SV **heap = AvARRAY (av);
  SV *he = heap [k];

  while (k)
    {
      int p = (k - 1) >> 1;

      if (!(gt (heap [p], he)))
        break;

      heap [k] = heap [p];
      k = p;
    }

  heap [k] = he;
}

/* move an element suitably so it is in a correct place */
static void
adjustheap (AV *av, f_cmp cmp, void *cmp_data, int N, int k)
{
  SV **heap = AvARRAY (av);

  if (k > 0 && !gt (heap [k], heap [(k - 1) >> 1]))
    upheap (av, cmp, cmp_data, k);
  else
    downheap (av, cmp, cmp_data, N, k);
}

/*****************************************************************************/

static void
make_heap (AV *av, f_cmp cmp, void *cmp_data)
{
  int i, len = AvFILLp (av);

  /* do not use floyds algorithm, as I expect the simpler and more cache-efficient */
  /* upheap is actually faster */
  for (i = 0; i <= len; ++i)
    upheap (av, cmp, cmp_data, i);
}

static void
push_heap (AV *av, f_cmp cmp, void *cmp_data, SV *elem)
{
  av_push (av, newSVsv (elem));
  upheap (av, cmp, cmp_data, AvFILLp (av));
}

static SV *
pop_heap (AV *av, f_cmp cmp, void *cmp_data)
{
  int len = AvFILLp (av);

  if (len < 0)
    return &PL_sv_undef;
  else if (len == 0)
    return av_pop (av);
  else
    {
      SV *top = av_pop (av);
      SV *result = AvARRAY (av)[0];
      AvARRAY (av)[0] = top;
      downheap (av, cmp, cmp_data, len, 0);
      return result;
    }
}

static SV *
splice_heap (AV *av, f_cmp cmp, void *cmp_data, int idx)
{
  int len = AvFILLp (av);

  if (len < 0 || idx > len)
    return &PL_sv_undef;
  else if (len == 0 || idx == len)
    return av_pop (av); /* the only or last element */
  else
    {
      SV *top = av_pop (av);
      SV *result = AvARRAY (av)[idx];
      AvARRAY (av)[idx] = top;
      adjustheap (av, cmp, cmp_data, len, idx);
      return result;
    }
}

static void
adjust_heap (AV *av, f_cmp cmp, void *cmp_data, int idx)
{
  adjustheap (av, cmp, cmp_data, AvFILLp (av) + 1, idx);
}

MODULE = Array::Heap            PACKAGE = Array::Heap

void
make_heap (SV *heap)
        PROTOTYPE: \@
        CODE:
        make_heap (array (heap), cmp_nv, 0);

void
make_heap_lex (SV *heap)
        PROTOTYPE: \@
        CODE:
        make_heap (array (heap), cmp_sv, 0);

void
make_heap_cmp (SV *cmp, SV *heap)
        PROTOTYPE: &\@
        CODE:
{
        dCMP;
        CMP_PUSH (cmp);
        make_heap (array (heap), cmp_custom, cmp_data);
        CMP_POP;
}

void
push_heap (SV *heap, ...)
        PROTOTYPE: \@@
        CODE:
{
        int i;
        for (i = 1; i < items; i++)
          push_heap (array (heap), cmp_nv, 0, ST(i));
}

void
push_heap_lex (SV *heap, ...)
        PROTOTYPE: \@@
        CODE:
{
        int i;
        for (i = 1; i < items; i++)
          push_heap (array (heap), cmp_sv, 0, ST(i));
}

void
push_heap_cmp (SV *cmp, SV *heap, ...)
        PROTOTYPE: &\@@
        CODE:
{
        int i;
        dCMP;

        CMP_PUSH (cmp);
        for (i = 2; i < items; i++)
          push_heap (array (heap), cmp_custom, cmp_data, ST(i));
        CMP_POP;
}

SV *
pop_heap (SV *heap)
        PROTOTYPE: \@
        CODE:
        RETVAL = pop_heap (array (heap), cmp_nv, 0);
        OUTPUT:
        RETVAL

SV *
pop_heap_lex (SV *heap)
        PROTOTYPE: \@
        CODE:
        RETVAL = pop_heap (array (heap), cmp_sv, 0);
        OUTPUT:
        RETVAL

SV *
pop_heap_cmp (SV *cmp, SV *heap)
        PROTOTYPE: &\@
        CODE:
{
        dCMP;
        CMP_PUSH (cmp);
        RETVAL = pop_heap (array (heap), cmp_custom, cmp_data);
        CMP_POP;
}
        OUTPUT:
        RETVAL

SV *
splice_heap (SV *heap, int idx)
        PROTOTYPE: \@$
        CODE:
        RETVAL = splice_heap (array (heap), cmp_nv, 0, idx);
        OUTPUT:
        RETVAL

SV *
splice_heap_lex (SV *heap, int idx)
        PROTOTYPE: \@$
        CODE:
        RETVAL = splice_heap (array (heap), cmp_sv, 0, idx);
        OUTPUT:
        RETVAL

SV *
splice_heap_cmp (SV *cmp, SV *heap, int idx)
        PROTOTYPE: &\@$
        CODE:
{
        dCMP;
        CMP_PUSH (cmp);
        RETVAL = splice_heap (array (heap), cmp_custom, cmp_data, idx);
        CMP_POP;
}
        OUTPUT:
        RETVAL

void
adjust_heap (SV *heap, int idx)
        PROTOTYPE: \@$
        CODE:
        adjust_heap (array (heap), cmp_nv, 0, idx);

void
adjust_heap_lex (SV *heap, int idx)
        PROTOTYPE: \@$
        CODE:
        adjust_heap (array (heap), cmp_sv, 0, idx);

void
adjust_heap_cmp (SV *cmp, SV *heap, int idx)
        PROTOTYPE: &\@$
        CODE:
{
        dCMP;
        CMP_PUSH (cmp);
        adjust_heap (array (heap), cmp_custom, cmp_data, idx);
        CMP_POP;
}

Revision:	1.3
Committed:	Sun Jul 26 04:50:02 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.2:	+257 -104 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5	root	1.3	/* pre-5.10 compatibility */
6			#ifndef GV_NOTQUAL
7			# define GV_NOTQUAL 1
8			#endif
9			#ifndef gv_fetchpvs
10			# define gv_fetchpvs gv_fetchpv
11			#endif
12
13			#include "multicall.h"
14
15			/* workaround for buggy multicall API */
16			#ifndef cxinc
17			# define cxinc() Perl_cxinc (aTHX)
18			#endif
19
20			#define dCMP \
21			dMULTICALL; \
22			void *cmp_data; \
23			I32 gimme = G_SCALAR;
24
25			#define CMP_PUSH(sv) \
26			PUSH_MULTICALL (cmp_push_ (sv));\
27			cmp_data = multicall_cop;
28
29			#define CMP_POP \
30			POP_MULTICALL;
31
32			#define dCMP_CALL(data) \
33			OP multicall_cop = (OP )data;
34
35			static void *
36			cmp_push_ (SV *sv)
37			{
38			HV *st;
39			GV *gvp;
40			CV *cv;
41
42			cv = sv_2cv (sv, &st, &gvp, 0);
43
44			if (!cv)
45			croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (sv));
46
47			if (!PL_firstgv) PL_firstgv = gv_fetchpvs ("a", GV_ADD \| GV_NOTQUAL, SVt_PV);
48			if (!PL_secondgv) PL_secondgv = gv_fetchpvs ("b", GV_ADD \| GV_NOTQUAL, SVt_PV);
49
50			SAVESPTR (GvSV (PL_firstgv));
51			SAVESPTR (GvSV (PL_secondgv));
52
53			return cv;
54			}
55
56			/*****************************************************************************/
57
58			static SV *
59			sv_first (SV *sv)
60			{
61			if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)
62			{
63			AV av = (AV )SvRV (sv);
64
65			sv = AvFILLp (av) < 0 ? &PL_sv_undef : AvARRAY (av)[0];
66			}
67
68			return sv;
69			}
70
71	root	1.1	static int
72	root	1.3	cmp_nv (SV a, SV b, void *cmp_data)
73	root	1.1	{
74	root	1.3	a = sv_first (a);
75			b = sv_first (b);
76	root	1.1
77			return SvNV (a) > SvNV (b);
78			}
79
80			static int
81	root	1.3	cmp_sv (SV a, SV b, void *cmp_data)
82	root	1.1	{
83	root	1.3	a = sv_first (a);
84			b = sv_first (b);
85	root	1.1
86	root	1.3	return sv_cmp (a, b) > 0;
87	root	1.1	}
88
89			static int
90	root	1.3	cmp_custom (SV a, SV b, void *cmp_data)
91	root	1.1	{
92	root	1.3	dCMP_CALL (cmp_data);
93	root	1.1
94			GvSV (PL_firstgv) = a;
95			GvSV (PL_secondgv) = b;
96
97	root	1.3	MULTICALL;
98	root	1.1
99			if (SvTRUE (ERRSV))
100			croak (NULL);
101
102	root	1.3	{
103			dSP;
104			return TOPi > 0;
105			}
106			}
107	root	1.1
108	root	1.3	/*****************************************************************************/
109	root	1.1
110	root	1.3	typedef int (f_cmp)(SV a, SV b, void cmp_data);
111	root	1.1
112			static AV *
113			array (SV *ref)
114			{
115	root	1.3	if (SvROK (ref)
116			&& SvTYPE (SvRV (ref)) == SVt_PVAV
117			&& !SvTIED_mg (SvRV (ref), PERL_MAGIC_tied))
118	root	1.1	return (AV *)SvRV (ref);
119
120	root	1.3	croak ("argument 'heap' must be a (non-tied) array");
121	root	1.1	}
122
123	root	1.3	#define gt(a,b) cmp ((a), (b), cmp_data)
124	root	1.1
125	root	1.3	/*****************************************************************************/
126	root	1.1
127	root	1.3	/* away from the root */
128	root	1.1	static void
129	root	1.3	downheap (AV av, f_cmp cmp, void cmp_data, int N, int k)
130	root	1.1	{
131	root	1.3	SV **heap = AvARRAY (av);
132			SV *he = heap [k];
133	root	1.1
134	root	1.3	for (;;)
135	root	1.1	{
136	root	1.3	int c = (k << 1) + 1;
137
138			if (c >= N)
139			break;
140
141			c += c + 1 < N && gt (heap [c], heap [c + 1])
142			? 1 : 0;
143
144			if (!(gt (he, heap [c])))
145			break;
146
147			heap [k] = heap [c];
148
149			k = c;
150	root	1.1	}
151
152	root	1.3	heap [k] = he;
153	root	1.1	}
154
155	root	1.3	/* towards the root */
156	root	1.1	static void
157	root	1.3	upheap (AV av, f_cmp cmp, void cmp_data, int k)
158	root	1.1	{
159	root	1.3	SV **heap = AvARRAY (av);
160			SV *he = heap [k];
161	root	1.1
162	root	1.3	while (k)
163	root	1.1	{
164	root	1.3	int p = (k - 1) >> 1;
165	root	1.1
166	root	1.3	if (!(gt (heap [p], he)))
167			break;
168
169			heap [k] = heap [p];
170			k = p;
171	root	1.1	}
172
173	root	1.3	heap [k] = he;
174			}
175
176			/* move an element suitably so it is in a correct place */
177			static void
178			adjustheap (AV av, f_cmp cmp, void cmp_data, int N, int k)
179			{
180			SV **heap = AvARRAY (av);
181	root	1.1
182	root	1.3	if (k > 0 && !gt (heap [k], heap [(k - 1) >> 1]))
183			upheap (av, cmp, cmp_data, k);
184			else
185			downheap (av, cmp, cmp_data, N, k);
186	root	1.1	}
187
188	root	1.3	/*****************************************************************************/
189
190	root	1.1	static void
191	root	1.3	make_heap (AV av, f_cmp cmp, void cmp_data)
192	root	1.1	{
193	root	1.3	int i, len = AvFILLp (av);
194	root	1.1
195	root	1.3	/* do not use floyds algorithm, as I expect the simpler and more cache-efficient */
196			/* upheap is actually faster */
197			for (i = 0; i <= len; ++i)
198			upheap (av, cmp, cmp_data, i);
199	root	1.1	}
200
201			static void
202	root	1.3	push_heap (AV av, f_cmp cmp, void cmp_data, SV *elem)
203	root	1.1	{
204	root	1.3	av_push (av, newSVsv (elem));
205			upheap (av, cmp, cmp_data, AvFILLp (av));
206	root	1.1	}
207
208			static SV *
209	root	1.3	pop_heap (AV av, f_cmp cmp, void cmp_data)
210	root	1.1	{
211	root	1.3	int len = AvFILLp (av);
212
213			if (len < 0)
214	root	1.1	return &PL_sv_undef;
215	root	1.3	else if (len == 0)
216	root	1.1	return av_pop (av);
217			else
218			{
219			SV *top = av_pop (av);
220	root	1.3	SV *result = AvARRAY (av)[0];
221			AvARRAY (av)[0] = top;
222			downheap (av, cmp, cmp_data, len, 0);
223			return result;
224			}
225			}
226	root	1.1
227	root	1.3	static SV *
228			splice_heap (AV av, f_cmp cmp, void cmp_data, int idx)
229			{
230			int len = AvFILLp (av);
231	root	1.1
232	root	1.3	if (len < 0 \|\| idx > len)
233			return &PL_sv_undef;
234			else if (len == 0 \|\| idx == len)
235			return av_pop (av); /* the only or last element */
236			else
237			{
238			SV *top = av_pop (av);
239			SV *result = AvARRAY (av)[idx];
240			AvARRAY (av)[idx] = top;
241			adjustheap (av, cmp, cmp_data, len, idx);
242	root	1.1	return result;
243			}
244			}
245
246	root	1.3	static void
247			adjust_heap (AV av, f_cmp cmp, void cmp_data, int idx)
248			{
249			adjustheap (av, cmp, cmp_data, AvFILLp (av) + 1, idx);
250			}
251
252	root	1.1	MODULE = Array::Heap PACKAGE = Array::Heap
253
254			void
255	root	1.3	make_heap (SV *heap)
256	root	1.1	PROTOTYPE: \@
257			CODE:
258			make_heap (array (heap), cmp_nv, 0);
259
260			void
261	root	1.3	make_heap_lex (SV *heap)
262	root	1.1	PROTOTYPE: \@
263			CODE:
264			make_heap (array (heap), cmp_sv, 0);
265
266			void
267	root	1.3	make_heap_cmp (SV cmp, SV heap)
268	root	1.1	PROTOTYPE: &\@
269			CODE:
270	root	1.3	{
271			dCMP;
272			CMP_PUSH (cmp);
273			make_heap (array (heap), cmp_custom, cmp_data);
274			CMP_POP;
275			}
276	root	1.1
277			void
278	root	1.3	push_heap (SV *heap, ...)
279	root	1.1	PROTOTYPE: \@@
280			CODE:
281	root	1.3	{
282	root	1.1	int i;
283			for (i = 1; i < items; i++)
284			push_heap (array (heap), cmp_nv, 0, ST(i));
285	root	1.3	}
286	root	1.1
287			void
288	root	1.3	push_heap_lex (SV *heap, ...)
289	root	1.1	PROTOTYPE: \@@
290			CODE:
291	root	1.3	{
292	root	1.1	int i;
293			for (i = 1; i < items; i++)
294			push_heap (array (heap), cmp_sv, 0, ST(i));
295	root	1.3	}
296	root	1.1
297			void
298	root	1.3	push_heap_cmp (SV cmp, SV heap, ...)
299	root	1.1	PROTOTYPE: &\@@
300			CODE:
301	root	1.3	{
302	root	1.1	int i;
303	root	1.3	dCMP;
304
305			CMP_PUSH (cmp);
306	root	1.2	for (i = 2; i < items; i++)
307	root	1.3	push_heap (array (heap), cmp_custom, cmp_data, ST(i));
308			CMP_POP;
309			}
310	root	1.1
311			SV *
312	root	1.3	pop_heap (SV *heap)
313	root	1.1	PROTOTYPE: \@
314			CODE:
315			RETVAL = pop_heap (array (heap), cmp_nv, 0);
316			OUTPUT:
317			RETVAL
318
319			SV *
320	root	1.3	pop_heap_lex (SV *heap)
321	root	1.1	PROTOTYPE: \@
322			CODE:
323			RETVAL = pop_heap (array (heap), cmp_sv, 0);
324			OUTPUT:
325			RETVAL
326
327			SV *
328	root	1.3	pop_heap_cmp (SV cmp, SV heap)
329	root	1.1	PROTOTYPE: &\@
330			CODE:
331	root	1.3	{
332			dCMP;
333			CMP_PUSH (cmp);
334			RETVAL = pop_heap (array (heap), cmp_custom, cmp_data);
335			CMP_POP;
336			}
337			OUTPUT:
338			RETVAL
339
340			SV *
341			splice_heap (SV *heap, int idx)
342			PROTOTYPE: \@$
343			CODE:
344			RETVAL = splice_heap (array (heap), cmp_nv, 0, idx);
345			OUTPUT:
346			RETVAL
347
348			SV *
349			splice_heap_lex (SV *heap, int idx)
350			PROTOTYPE: \@$
351			CODE:
352			RETVAL = splice_heap (array (heap), cmp_sv, 0, idx);
353			OUTPUT:
354			RETVAL
355
356			SV *
357			splice_heap_cmp (SV cmp, SV heap, int idx)
358			PROTOTYPE: &\@$
359			CODE:
360			{
361			dCMP;
362			CMP_PUSH (cmp);
363			RETVAL = splice_heap (array (heap), cmp_custom, cmp_data, idx);
364			CMP_POP;
365			}
366	root	1.1	OUTPUT:
367			RETVAL
368
369	root	1.3	void
370			adjust_heap (SV *heap, int idx)
371			PROTOTYPE: \@$
372			CODE:
373			adjust_heap (array (heap), cmp_nv, 0, idx);
374
375			void
376			adjust_heap_lex (SV *heap, int idx)
377			PROTOTYPE: \@$
378			CODE:
379			adjust_heap (array (heap), cmp_sv, 0, idx);
380
381			void
382			adjust_heap_cmp (SV cmp, SV heap, int idx)
383			PROTOTYPE: &\@$
384			CODE:
385			{
386			dCMP;
387			CMP_PUSH (cmp);
388			adjust_heap (array (heap), cmp_custom, cmp_data, idx);
389			CMP_POP;
390			}
391	root	1.1