Array-Heap/Heap.xs

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

static int
cmp_nv (SV *a, SV *b, SV *data)
{
  if (SvROK (a) && SvTYPE (SvRV (a)) == SVt_PVAV) a = *av_fetch ((AV *)SvRV (a), 0, 1);
  if (SvROK (b) && SvTYPE (SvRV (b)) == SVt_PVAV) b = *av_fetch ((AV *)SvRV (b), 0, 1);

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

static int
cmp_sv (SV *a, SV *b, SV *data)
{
  if (SvROK (a) && SvTYPE (SvRV (a)) == SVt_PVAV) a = *av_fetch ((AV *)SvRV (a), 0, 1);
  if (SvROK (b) && SvTYPE (SvRV (b)) == SVt_PVAV) b = *av_fetch ((AV *)SvRV (b), 0, 1);

  return sv_cmp(a, b) > 0;
}

static int
cmp_custom (SV *a, SV *b, SV *data)
{
  SV *old_a, *old_b;
  int ret;
  dSP;

  if (!PL_firstgv)  PL_firstgv  = gv_fetchpv ("a", 1, SVt_PV);
  if (!PL_secondgv) PL_secondgv = gv_fetchpv ("b", 1, SVt_PV);

  old_a = GvSV (PL_firstgv);
  old_b = GvSV (PL_secondgv);

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

  PUSHMARK (SP);
  PUTBACK;
  ret = call_sv (data, G_SCALAR | G_NOARGS | G_EVAL);
  SPAGAIN;

  GvSV (PL_firstgv)  = old_a;
  GvSV (PL_secondgv) = old_b;

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

  if (ret != 1)
    croak ("sort function must return exactly one return value");

  return POPi >= 0;
}

typedef int (*f_cmp)(SV *, SV *, SV *);

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

  croak ("argument 'heap' must be an array");
}

#define geta(i) (*av_fetch (av, (i), 1))
#define gt(a,b) cmp ((a), (b), data)
#define seta(i,v) seta_helper (av_fetch (av, (i), 1), v)

static void
seta_helper (SV **i, SV *v)
{
  SvREFCNT_dec (*i);
  *i = v;
}

static void
push_heap_aux (AV *av, f_cmp cmp, SV *data, int hole_index, int top, SV *value)
{
  int parent = (hole_index - 1) / 2;

  while (hole_index > top && gt (geta (parent), value))
    {
      seta (hole_index, SvREFCNT_inc (geta (parent)));
      hole_index = parent;
      parent = (hole_index - 1) / 2;
    }

  seta (hole_index, value);
}

static void
adjust_heap (AV *av, f_cmp cmp, SV *data, int hole_index, int len, SV *elem)
{
  int top = hole_index;
  int second_child = 2 * (hole_index + 1);

  while (second_child < len)
    {
      if (gt (geta (second_child), geta (second_child - 1)))
        second_child--;

      seta (hole_index, SvREFCNT_inc (geta (second_child)));
      hole_index = second_child;
      second_child = 2 * (second_child + 1);
    }

  if (second_child == len)
    {
      seta (hole_index, SvREFCNT_inc (geta (second_child - 1)));
      hole_index = second_child - 1;
    }

  push_heap_aux (av, cmp, data, hole_index, top, elem);
}

static void
make_heap (AV *av, f_cmp cmp, SV *data)
{
  if (av_len (av) > 0)
    {
      int len = av_len (av) + 1;
      int parent = (len - 2) / 2;

      do {
          adjust_heap (av, cmp, data, parent, len, SvREFCNT_inc (geta (parent)));
      } while (parent--);
    }
}

static void
push_heap (AV *av, f_cmp cmp, SV *data, SV *elem)
{
  elem = newSVsv (elem);
  av_push (av, elem);
  push_heap_aux (av, cmp, data, av_len (av), 0, SvREFCNT_inc (elem));
}

static SV *
pop_heap (AV *av, f_cmp cmp, SV *data)
{
  if (av_len (av) < 0)
    return &PL_sv_undef;
  else if (av_len (av) == 0)
    return av_pop (av);
  else
    {
      SV *result = newSVsv (geta (0));
      SV *top = av_pop (av);

      adjust_heap (av, cmp, data, 0, av_len (av) + 1, top);

      return result;
    }
}

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

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

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

void
make_heap_cmp (cmp, heap)
        SV *    cmp
        SV *    heap
        PROTOTYPE: &\@
        CODE:
        make_heap (array (heap), cmp_custom, cmp);

void
push_heap (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 (heap, ...)
        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 (cmp, heap, ...)
        SV *    cmp
        SV *    heap
        PROTOTYPE: &\@@
        CODE:
        int i;
        for (i = 1; i < items; i++)
          push_heap (array (heap), cmp_custom, cmp, ST(i));

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

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

SV *
pop_heap_cmp (cmp, heap)
        SV *    cmp
        SV *    heap
        PROTOTYPE: &\@
        CODE:
        RETVAL = pop_heap (array (heap), cmp_custom, cmp);
        OUTPUT:
        RETVAL


Revision:	1.1
Committed:	Wed Jul 1 08:31:34 2009 UTC (14 years, 10 months ago) by root
Branch:	MAIN
CVS Tags:	rel-1_2
Log Message:	1.2
#	Content
1	#include "EXTERN.h"
2	#include "perl.h"
3	#include "XSUB.h"
4
5	static int
6	cmp_nv (SV a, SV b, SV *data)
7	{
8	if (SvROK (a) && SvTYPE (SvRV (a)) == SVt_PVAV) a = av_fetch ((AV )SvRV (a), 0, 1);
9	if (SvROK (b) && SvTYPE (SvRV (b)) == SVt_PVAV) b = av_fetch ((AV )SvRV (b), 0, 1);
10
11	return SvNV (a) > SvNV (b);
12	}
13
14	static int
15	cmp_sv (SV a, SV b, SV *data)
16	{
17	if (SvROK (a) && SvTYPE (SvRV (a)) == SVt_PVAV) a = av_fetch ((AV )SvRV (a), 0, 1);
18	if (SvROK (b) && SvTYPE (SvRV (b)) == SVt_PVAV) b = av_fetch ((AV )SvRV (b), 0, 1);
19
20	return sv_cmp(a, b) > 0;
21	}
22
23	static int
24	cmp_custom (SV a, SV b, SV *data)
25	{
26	SV old_a, old_b;
27	int ret;
28	dSP;
29
30	if (!PL_firstgv) PL_firstgv = gv_fetchpv ("a", 1, SVt_PV);
31	if (!PL_secondgv) PL_secondgv = gv_fetchpv ("b", 1, SVt_PV);
32
33	old_a = GvSV (PL_firstgv);
34	old_b = GvSV (PL_secondgv);
35
36	GvSV (PL_firstgv) = a;
37	GvSV (PL_secondgv) = b;
38
39	PUSHMARK (SP);
40	PUTBACK;
41	ret = call_sv (data, G_SCALAR \| G_NOARGS \| G_EVAL);
42	SPAGAIN;
43
44	GvSV (PL_firstgv) = old_a;
45	GvSV (PL_secondgv) = old_b;
46
47	if (SvTRUE (ERRSV))
48	croak (NULL);
49
50	if (ret != 1)
51	croak ("sort function must return exactly one return value");
52
53	return POPi >= 0;
54	}
55
56	typedef int (f_cmp)(SV , SV , SV );
57
58	static AV *
59	array (SV *ref)
60	{
61	if (SvROK (ref) && SvTYPE (SvRV (ref)) == SVt_PVAV)
62	return (AV *)SvRV (ref);
63
64	croak ("argument 'heap' must be an array");
65	}
66
67	#define geta(i) (*av_fetch (av, (i), 1))
68	#define gt(a,b) cmp ((a), (b), data)
69	#define seta(i,v) seta_helper (av_fetch (av, (i), 1), v)
70
71	static void
72	seta_helper (SV *i, SV v)
73	{
74	SvREFCNT_dec (*i);
75	*i = v;
76	}
77
78	static void
79	push_heap_aux (AV av, f_cmp cmp, SV data, int hole_index, int top, SV *value)
80	{
81	int parent = (hole_index - 1) / 2;
82
83	while (hole_index > top && gt (geta (parent), value))
84	{
85	seta (hole_index, SvREFCNT_inc (geta (parent)));
86	hole_index = parent;
87	parent = (hole_index - 1) / 2;
88	}
89
90	seta (hole_index, value);
91	}
92
93	static void
94	adjust_heap (AV av, f_cmp cmp, SV data, int hole_index, int len, SV *elem)
95	{
96	int top = hole_index;
97	int second_child = 2 * (hole_index + 1);
98
99	while (second_child < len)
100	{
101	if (gt (geta (second_child), geta (second_child - 1)))
102	second_child--;
103
104	seta (hole_index, SvREFCNT_inc (geta (second_child)));
105	hole_index = second_child;
106	second_child = 2 * (second_child + 1);
107	}
108
109	if (second_child == len)
110	{
111	seta (hole_index, SvREFCNT_inc (geta (second_child - 1)));
112	hole_index = second_child - 1;
113	}
114
115	push_heap_aux (av, cmp, data, hole_index, top, elem);
116	}
117
118	static void
119	make_heap (AV av, f_cmp cmp, SV data)
120	{
121	if (av_len (av) > 0)
122	{
123	int len = av_len (av) + 1;
124	int parent = (len - 2) / 2;
125
126	do {
127	adjust_heap (av, cmp, data, parent, len, SvREFCNT_inc (geta (parent)));
128	} while (parent--);
129	}
130	}
131
132	static void
133	push_heap (AV av, f_cmp cmp, SV data, SV *elem)
134	{
135	elem = newSVsv (elem);
136	av_push (av, elem);
137	push_heap_aux (av, cmp, data, av_len (av), 0, SvREFCNT_inc (elem));
138	}
139
140	static SV *
141	pop_heap (AV av, f_cmp cmp, SV data)
142	{
143	if (av_len (av) < 0)
144	return &PL_sv_undef;
145	else if (av_len (av) == 0)
146	return av_pop (av);
147	else
148	{
149	SV *result = newSVsv (geta (0));
150	SV *top = av_pop (av);
151
152	adjust_heap (av, cmp, data, 0, av_len (av) + 1, top);
153
154	return result;
155	}
156	}
157
158	MODULE = Array::Heap PACKAGE = Array::Heap
159
160	void
161	make_heap (heap)
162	SV * heap
163	PROTOTYPE: \@
164	CODE:
165	make_heap (array (heap), cmp_nv, 0);
166
167	void
168	make_heap_lex (heap)
169	SV * heap
170	PROTOTYPE: \@
171	CODE:
172	make_heap (array (heap), cmp_sv, 0);
173
174	void
175	make_heap_cmp (cmp, heap)
176	SV * cmp
177	SV * heap
178	PROTOTYPE: &\@
179	CODE:
180	make_heap (array (heap), cmp_custom, cmp);
181
182	void
183	push_heap (heap, ...)
184	SV * heap
185	PROTOTYPE: \@@
186	CODE:
187	int i;
188	for (i = 1; i < items; i++)
189	push_heap (array (heap), cmp_nv, 0, ST(i));
190
191	void
192	push_heap_lex (heap, ...)
193	SV * heap
194	PROTOTYPE: \@@
195	CODE:
196	int i;
197	for (i = 1; i < items; i++)
198	push_heap (array (heap), cmp_sv, 0, ST(i));
199
200	void
201	push_heap_cmp (cmp, heap, ...)
202	SV * cmp
203	SV * heap
204	PROTOTYPE: &\@@
205	CODE:
206	int i;
207	for (i = 1; i < items; i++)
208	push_heap (array (heap), cmp_custom, cmp, ST(i));
209
210	SV *
211	pop_heap (heap)
212	SV * heap
213	PROTOTYPE: \@
214	CODE:
215	RETVAL = pop_heap (array (heap), cmp_nv, 0);
216	OUTPUT:
217	RETVAL
218
219	SV *
220	pop_heap_lex (heap)
221	SV * heap
222	PROTOTYPE: \@
223	CODE:
224	RETVAL = pop_heap (array (heap), cmp_sv, 0);
225	OUTPUT:
226	RETVAL
227
228	SV *
229	pop_heap_cmp (cmp, heap)
230	SV * cmp
231	SV * heap
232	PROTOTYPE: &\@
233	CODE:
234	RETVAL = pop_heap (array (heap), cmp_custom, cmp);
235	OUTPUT:
236	RETVAL
237
238