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

/* pre-5.8 compatibility */
#ifndef PERL_MAGIC_tied
# define PERL_MAGIC_tied 'P'
#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 **elems, int nelems)
{
  int i;

  av_extend (av, AvFILLp (av) + nelems);

  /* we do it in two steps, as the perl cmp function might copy the stack */
  for (i = 0; i < nelems; ++i)
    AvARRAY (av)[++AvFILLp (av)] = newSVsv (elems [i]);

  for (i = 0; i < nelems; ++i)
    upheap (av, cmp, cmp_data, AvFILLp (av) - i);
}

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:
        push_heap (array (heap), cmp_nv, 0, &(ST(1)), items - 1);

void
push_heap_lex (SV *heap, ...)
        PROTOTYPE: \@@
        CODE:
        push_heap (array (heap), cmp_sv, 0, &(ST(1)), items - 1);

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