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 = 2; 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.2
Committed:	Fri Jul 24 21:29:07 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.1:	+1 -1 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			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	root	1.2	for (i = 2; i < items; i++)
208	root	1.1	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