diff options
Diffstat (limited to '')
-rw-r--r-- | ltablib.c | 450 |
1 files changed, 450 insertions, 0 deletions
diff --git a/ltablib.c b/ltablib.c new file mode 100644 index 0000000..98b2f87 --- /dev/null +++ b/ltablib.c | |||
@@ -0,0 +1,450 @@ | |||
1 | /* | ||
2 | ** $Id: ltablib.c,v 1.93 2016/02/25 19:41:54 roberto Exp $ | ||
3 | ** Library for Table Manipulation | ||
4 | ** See Copyright Notice in lua.h | ||
5 | */ | ||
6 | |||
7 | #define ltablib_c | ||
8 | #define LUA_LIB | ||
9 | |||
10 | #include "lprefix.h" | ||
11 | |||
12 | |||
13 | #include <limits.h> | ||
14 | #include <stddef.h> | ||
15 | #include <string.h> | ||
16 | |||
17 | #include "lua.h" | ||
18 | |||
19 | #include "lauxlib.h" | ||
20 | #include "lualib.h" | ||
21 | |||
22 | |||
23 | /* | ||
24 | ** Operations that an object must define to mimic a table | ||
25 | ** (some functions only need some of them) | ||
26 | */ | ||
27 | #define TAB_R 1 /* read */ | ||
28 | #define TAB_W 2 /* write */ | ||
29 | #define TAB_L 4 /* length */ | ||
30 | #define TAB_RW (TAB_R | TAB_W) /* read/write */ | ||
31 | |||
32 | |||
33 | #define aux_getn(L,n,w) (checktab(L, n, (w) | TAB_L), luaL_len(L, n)) | ||
34 | |||
35 | |||
36 | static int checkfield (lua_State *L, const char *key, int n) { | ||
37 | lua_pushstring(L, key); | ||
38 | return (lua_rawget(L, -n) != LUA_TNIL); | ||
39 | } | ||
40 | |||
41 | |||
42 | /* | ||
43 | ** Check that 'arg' either is a table or can behave like one (that is, | ||
44 | ** has a metatable with the required metamethods) | ||
45 | */ | ||
46 | static void checktab (lua_State *L, int arg, int what) { | ||
47 | if (lua_type(L, arg) != LUA_TTABLE) { /* is it not a table? */ | ||
48 | int n = 1; /* number of elements to pop */ | ||
49 | if (lua_getmetatable(L, arg) && /* must have metatable */ | ||
50 | (!(what & TAB_R) || checkfield(L, "__index", ++n)) && | ||
51 | (!(what & TAB_W) || checkfield(L, "__newindex", ++n)) && | ||
52 | (!(what & TAB_L) || checkfield(L, "__len", ++n))) { | ||
53 | lua_pop(L, n); /* pop metatable and tested metamethods */ | ||
54 | } | ||
55 | else | ||
56 | luaL_checktype(L, arg, LUA_TTABLE); /* force an error */ | ||
57 | } | ||
58 | } | ||
59 | |||
60 | |||
61 | #if defined(LUA_COMPAT_MAXN) | ||
62 | static int maxn (lua_State *L) { | ||
63 | lua_Number max = 0; | ||
64 | luaL_checktype(L, 1, LUA_TTABLE); | ||
65 | lua_pushnil(L); /* first key */ | ||
66 | while (lua_next(L, 1)) { | ||
67 | lua_pop(L, 1); /* remove value */ | ||
68 | if (lua_type(L, -1) == LUA_TNUMBER) { | ||
69 | lua_Number v = lua_tonumber(L, -1); | ||
70 | if (v > max) max = v; | ||
71 | } | ||
72 | } | ||
73 | lua_pushnumber(L, max); | ||
74 | return 1; | ||
75 | } | ||
76 | #endif | ||
77 | |||
78 | |||
79 | static int tinsert (lua_State *L) { | ||
80 | lua_Integer e = aux_getn(L, 1, TAB_RW) + 1; /* first empty element */ | ||
81 | lua_Integer pos; /* where to insert new element */ | ||
82 | switch (lua_gettop(L)) { | ||
83 | case 2: { /* called with only 2 arguments */ | ||
84 | pos = e; /* insert new element at the end */ | ||
85 | break; | ||
86 | } | ||
87 | case 3: { | ||
88 | lua_Integer i; | ||
89 | pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */ | ||
90 | luaL_argcheck(L, 1 <= pos && pos <= e, 2, "position out of bounds"); | ||
91 | for (i = e; i > pos; i--) { /* move up elements */ | ||
92 | lua_geti(L, 1, i - 1); | ||
93 | lua_seti(L, 1, i); /* t[i] = t[i - 1] */ | ||
94 | } | ||
95 | break; | ||
96 | } | ||
97 | default: { | ||
98 | return luaL_error(L, "wrong number of arguments to 'insert'"); | ||
99 | } | ||
100 | } | ||
101 | lua_seti(L, 1, pos); /* t[pos] = v */ | ||
102 | return 0; | ||
103 | } | ||
104 | |||
105 | |||
106 | static int tremove (lua_State *L) { | ||
107 | lua_Integer size = aux_getn(L, 1, TAB_RW); | ||
108 | lua_Integer pos = luaL_optinteger(L, 2, size); | ||
109 | if (pos != size) /* validate 'pos' if given */ | ||
110 | luaL_argcheck(L, 1 <= pos && pos <= size + 1, 1, "position out of bounds"); | ||
111 | lua_geti(L, 1, pos); /* result = t[pos] */ | ||
112 | for ( ; pos < size; pos++) { | ||
113 | lua_geti(L, 1, pos + 1); | ||
114 | lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */ | ||
115 | } | ||
116 | lua_pushnil(L); | ||
117 | lua_seti(L, 1, pos); /* t[pos] = nil */ | ||
118 | return 1; | ||
119 | } | ||
120 | |||
121 | |||
122 | /* | ||
123 | ** Copy elements (1[f], ..., 1[e]) into (tt[t], tt[t+1], ...). Whenever | ||
124 | ** possible, copy in increasing order, which is better for rehashing. | ||
125 | ** "possible" means destination after original range, or smaller | ||
126 | ** than origin, or copying to another table. | ||
127 | */ | ||
128 | static int tmove (lua_State *L) { | ||
129 | lua_Integer f = luaL_checkinteger(L, 2); | ||
130 | lua_Integer e = luaL_checkinteger(L, 3); | ||
131 | lua_Integer t = luaL_checkinteger(L, 4); | ||
132 | int tt = !lua_isnoneornil(L, 5) ? 5 : 1; /* destination table */ | ||
133 | checktab(L, 1, TAB_R); | ||
134 | checktab(L, tt, TAB_W); | ||
135 | if (e >= f) { /* otherwise, nothing to move */ | ||
136 | lua_Integer n, i; | ||
137 | luaL_argcheck(L, f > 0 || e < LUA_MAXINTEGER + f, 3, | ||
138 | "too many elements to move"); | ||
139 | n = e - f + 1; /* number of elements to move */ | ||
140 | luaL_argcheck(L, t <= LUA_MAXINTEGER - n + 1, 4, | ||
141 | "destination wrap around"); | ||
142 | if (t > e || t <= f || (tt != 1 && !lua_compare(L, 1, tt, LUA_OPEQ))) { | ||
143 | for (i = 0; i < n; i++) { | ||
144 | lua_geti(L, 1, f + i); | ||
145 | lua_seti(L, tt, t + i); | ||
146 | } | ||
147 | } | ||
148 | else { | ||
149 | for (i = n - 1; i >= 0; i--) { | ||
150 | lua_geti(L, 1, f + i); | ||
151 | lua_seti(L, tt, t + i); | ||
152 | } | ||
153 | } | ||
154 | } | ||
155 | lua_pushvalue(L, tt); /* return destination table */ | ||
156 | return 1; | ||
157 | } | ||
158 | |||
159 | |||
160 | static void addfield (lua_State *L, luaL_Buffer *b, lua_Integer i) { | ||
161 | lua_geti(L, 1, i); | ||
162 | if (!lua_isstring(L, -1)) | ||
163 | luaL_error(L, "invalid value (%s) at index %d in table for 'concat'", | ||
164 | luaL_typename(L, -1), i); | ||
165 | luaL_addvalue(b); | ||
166 | } | ||
167 | |||
168 | |||
169 | static int tconcat (lua_State *L) { | ||
170 | luaL_Buffer b; | ||
171 | lua_Integer last = aux_getn(L, 1, TAB_R); | ||
172 | size_t lsep; | ||
173 | const char *sep = luaL_optlstring(L, 2, "", &lsep); | ||
174 | lua_Integer i = luaL_optinteger(L, 3, 1); | ||
175 | last = luaL_optinteger(L, 4, last); | ||
176 | luaL_buffinit(L, &b); | ||
177 | for (; i < last; i++) { | ||
178 | addfield(L, &b, i); | ||
179 | luaL_addlstring(&b, sep, lsep); | ||
180 | } | ||
181 | if (i == last) /* add last value (if interval was not empty) */ | ||
182 | addfield(L, &b, i); | ||
183 | luaL_pushresult(&b); | ||
184 | return 1; | ||
185 | } | ||
186 | |||
187 | |||
188 | /* | ||
189 | ** {====================================================== | ||
190 | ** Pack/unpack | ||
191 | ** ======================================================= | ||
192 | */ | ||
193 | |||
194 | static int pack (lua_State *L) { | ||
195 | int i; | ||
196 | int n = lua_gettop(L); /* number of elements to pack */ | ||
197 | lua_createtable(L, n, 1); /* create result table */ | ||
198 | lua_insert(L, 1); /* put it at index 1 */ | ||
199 | for (i = n; i >= 1; i--) /* assign elements */ | ||
200 | lua_seti(L, 1, i); | ||
201 | lua_pushinteger(L, n); | ||
202 | lua_setfield(L, 1, "n"); /* t.n = number of elements */ | ||
203 | return 1; /* return table */ | ||
204 | } | ||
205 | |||
206 | |||
207 | static int unpack (lua_State *L) { | ||
208 | lua_Unsigned n; | ||
209 | lua_Integer i = luaL_optinteger(L, 2, 1); | ||
210 | lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1)); | ||
211 | if (i > e) return 0; /* empty range */ | ||
212 | n = (lua_Unsigned)e - i; /* number of elements minus 1 (avoid overflows) */ | ||
213 | if (n >= (unsigned int)INT_MAX || !lua_checkstack(L, (int)(++n))) | ||
214 | return luaL_error(L, "too many results to unpack"); | ||
215 | for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */ | ||
216 | lua_geti(L, 1, i); | ||
217 | } | ||
218 | lua_geti(L, 1, e); /* push last element */ | ||
219 | return (int)n; | ||
220 | } | ||
221 | |||
222 | /* }====================================================== */ | ||
223 | |||
224 | |||
225 | |||
226 | /* | ||
227 | ** {====================================================== | ||
228 | ** Quicksort | ||
229 | ** (based on 'Algorithms in MODULA-3', Robert Sedgewick; | ||
230 | ** Addison-Wesley, 1993.) | ||
231 | ** ======================================================= | ||
232 | */ | ||
233 | |||
234 | |||
235 | /* type for array indices */ | ||
236 | typedef unsigned int IdxT; | ||
237 | |||
238 | |||
239 | /* | ||
240 | ** Produce a "random" 'unsigned int' to randomize pivot choice. This | ||
241 | ** macro is used only when 'sort' detects a big imbalance in the result | ||
242 | ** of a partition. (If you don't want/need this "randomness", ~0 is a | ||
243 | ** good choice.) | ||
244 | */ | ||
245 | #if !defined(l_randomizePivot) /* { */ | ||
246 | |||
247 | #include <time.h> | ||
248 | |||
249 | /* size of 'e' measured in number of 'unsigned int's */ | ||
250 | #define sof(e) (sizeof(e) / sizeof(unsigned int)) | ||
251 | |||
252 | /* | ||
253 | ** Use 'time' and 'clock' as sources of "randomness". Because we don't | ||
254 | ** know the types 'clock_t' and 'time_t', we cannot cast them to | ||
255 | ** anything without risking overflows. A safe way to use their values | ||
256 | ** is to copy them to an array of a known type and use the array values. | ||
257 | */ | ||
258 | static unsigned int l_randomizePivot (void) { | ||
259 | clock_t c = clock(); | ||
260 | time_t t = time(NULL); | ||
261 | unsigned int buff[sof(c) + sof(t)]; | ||
262 | unsigned int i, rnd = 0; | ||
263 | memcpy(buff, &c, sof(c) * sizeof(unsigned int)); | ||
264 | memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int)); | ||
265 | for (i = 0; i < sof(buff); i++) | ||
266 | rnd += buff[i]; | ||
267 | return rnd; | ||
268 | } | ||
269 | |||
270 | #endif /* } */ | ||
271 | |||
272 | |||
273 | /* arrays larger than 'RANLIMIT' may use randomized pivots */ | ||
274 | #define RANLIMIT 100u | ||
275 | |||
276 | |||
277 | static void set2 (lua_State *L, IdxT i, IdxT j) { | ||
278 | lua_seti(L, 1, i); | ||
279 | lua_seti(L, 1, j); | ||
280 | } | ||
281 | |||
282 | |||
283 | /* | ||
284 | ** Return true iff value at stack index 'a' is less than the value at | ||
285 | ** index 'b' (according to the order of the sort). | ||
286 | */ | ||
287 | static int sort_comp (lua_State *L, int a, int b) { | ||
288 | if (lua_isnil(L, 2)) /* no function? */ | ||
289 | return lua_compare(L, a, b, LUA_OPLT); /* a < b */ | ||
290 | else { /* function */ | ||
291 | int res; | ||
292 | lua_pushvalue(L, 2); /* push function */ | ||
293 | lua_pushvalue(L, a-1); /* -1 to compensate function */ | ||
294 | lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */ | ||
295 | lua_call(L, 2, 1); /* call function */ | ||
296 | res = lua_toboolean(L, -1); /* get result */ | ||
297 | lua_pop(L, 1); /* pop result */ | ||
298 | return res; | ||
299 | } | ||
300 | } | ||
301 | |||
302 | |||
303 | /* | ||
304 | ** Does the partition: Pivot P is at the top of the stack. | ||
305 | ** precondition: a[lo] <= P == a[up-1] <= a[up], | ||
306 | ** so it only needs to do the partition from lo + 1 to up - 2. | ||
307 | ** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up] | ||
308 | ** returns 'i'. | ||
309 | */ | ||
310 | static IdxT partition (lua_State *L, IdxT lo, IdxT up) { | ||
311 | IdxT i = lo; /* will be incremented before first use */ | ||
312 | IdxT j = up - 1; /* will be decremented before first use */ | ||
313 | /* loop invariant: a[lo .. i] <= P <= a[j .. up] */ | ||
314 | for (;;) { | ||
315 | /* next loop: repeat ++i while a[i] < P */ | ||
316 | while (lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) { | ||
317 | if (i == up - 1) /* a[i] < P but a[up - 1] == P ?? */ | ||
318 | luaL_error(L, "invalid order function for sorting"); | ||
319 | lua_pop(L, 1); /* remove a[i] */ | ||
320 | } | ||
321 | /* after the loop, a[i] >= P and a[lo .. i - 1] < P */ | ||
322 | /* next loop: repeat --j while P < a[j] */ | ||
323 | while (lua_geti(L, 1, --j), sort_comp(L, -3, -1)) { | ||
324 | if (j < i) /* j < i but a[j] > P ?? */ | ||
325 | luaL_error(L, "invalid order function for sorting"); | ||
326 | lua_pop(L, 1); /* remove a[j] */ | ||
327 | } | ||
328 | /* after the loop, a[j] <= P and a[j + 1 .. up] >= P */ | ||
329 | if (j < i) { /* no elements out of place? */ | ||
330 | /* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */ | ||
331 | lua_pop(L, 1); /* pop a[j] */ | ||
332 | /* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */ | ||
333 | set2(L, up - 1, i); | ||
334 | return i; | ||
335 | } | ||
336 | /* otherwise, swap a[i] - a[j] to restore invariant and repeat */ | ||
337 | set2(L, i, j); | ||
338 | } | ||
339 | } | ||
340 | |||
341 | |||
342 | /* | ||
343 | ** Choose an element in the middle (2nd-3th quarters) of [lo,up] | ||
344 | ** "randomized" by 'rnd' | ||
345 | */ | ||
346 | static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) { | ||
347 | IdxT r4 = (up - lo) / 4; /* range/4 */ | ||
348 | IdxT p = rnd % (r4 * 2) + (lo + r4); | ||
349 | lua_assert(lo + r4 <= p && p <= up - r4); | ||
350 | return p; | ||
351 | } | ||
352 | |||
353 | |||
354 | /* | ||
355 | ** QuickSort algorithm (recursive function) | ||
356 | */ | ||
357 | static void auxsort (lua_State *L, IdxT lo, IdxT up, | ||
358 | unsigned int rnd) { | ||
359 | while (lo < up) { /* loop for tail recursion */ | ||
360 | IdxT p; /* Pivot index */ | ||
361 | IdxT n; /* to be used later */ | ||
362 | /* sort elements 'lo', 'p', and 'up' */ | ||
363 | lua_geti(L, 1, lo); | ||
364 | lua_geti(L, 1, up); | ||
365 | if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */ | ||
366 | set2(L, lo, up); /* swap a[lo] - a[up] */ | ||
367 | else | ||
368 | lua_pop(L, 2); /* remove both values */ | ||
369 | if (up - lo == 1) /* only 2 elements? */ | ||
370 | return; /* already sorted */ | ||
371 | if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */ | ||
372 | p = (lo + up)/2; /* middle element is a good pivot */ | ||
373 | else /* for larger intervals, it is worth a random pivot */ | ||
374 | p = choosePivot(lo, up, rnd); | ||
375 | lua_geti(L, 1, p); | ||
376 | lua_geti(L, 1, lo); | ||
377 | if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */ | ||
378 | set2(L, p, lo); /* swap a[p] - a[lo] */ | ||
379 | else { | ||
380 | lua_pop(L, 1); /* remove a[lo] */ | ||
381 | lua_geti(L, 1, up); | ||
382 | if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */ | ||
383 | set2(L, p, up); /* swap a[up] - a[p] */ | ||
384 | else | ||
385 | lua_pop(L, 2); | ||
386 | } | ||
387 | if (up - lo == 2) /* only 3 elements? */ | ||
388 | return; /* already sorted */ | ||
389 | lua_geti(L, 1, p); /* get middle element (Pivot) */ | ||
390 | lua_pushvalue(L, -1); /* push Pivot */ | ||
391 | lua_geti(L, 1, up - 1); /* push a[up - 1] */ | ||
392 | set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */ | ||
393 | p = partition(L, lo, up); | ||
394 | /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */ | ||
395 | if (p - lo < up - p) { /* lower interval is smaller? */ | ||
396 | auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */ | ||
397 | n = p - lo; /* size of smaller interval */ | ||
398 | lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */ | ||
399 | } | ||
400 | else { | ||
401 | auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */ | ||
402 | n = up - p; /* size of smaller interval */ | ||
403 | up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */ | ||
404 | } | ||
405 | if ((up - lo) / 128 > n) /* partition too imbalanced? */ | ||
406 | rnd = l_randomizePivot(); /* try a new randomization */ | ||
407 | } /* tail call auxsort(L, lo, up, rnd) */ | ||
408 | } | ||
409 | |||
410 | |||
411 | static int sort (lua_State *L) { | ||
412 | lua_Integer n = aux_getn(L, 1, TAB_RW); | ||
413 | if (n > 1) { /* non-trivial interval? */ | ||
414 | luaL_argcheck(L, n < INT_MAX, 1, "array too big"); | ||
415 | if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */ | ||
416 | luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */ | ||
417 | lua_settop(L, 2); /* make sure there are two arguments */ | ||
418 | auxsort(L, 1, (IdxT)n, 0); | ||
419 | } | ||
420 | return 0; | ||
421 | } | ||
422 | |||
423 | /* }====================================================== */ | ||
424 | |||
425 | |||
426 | static const luaL_Reg tab_funcs[] = { | ||
427 | {"concat", tconcat}, | ||
428 | #if defined(LUA_COMPAT_MAXN) | ||
429 | {"maxn", maxn}, | ||
430 | #endif | ||
431 | {"insert", tinsert}, | ||
432 | {"pack", pack}, | ||
433 | {"unpack", unpack}, | ||
434 | {"remove", tremove}, | ||
435 | {"move", tmove}, | ||
436 | {"sort", sort}, | ||
437 | {NULL, NULL} | ||
438 | }; | ||
439 | |||
440 | |||
441 | LUAMOD_API int luaopen_table (lua_State *L) { | ||
442 | luaL_newlib(L, tab_funcs); | ||
443 | #if defined(LUA_COMPAT_UNPACK) | ||
444 | /* _G.unpack = table.unpack */ | ||
445 | lua_getfield(L, -1, "unpack"); | ||
446 | lua_setglobal(L, "unpack"); | ||
447 | #endif | ||
448 | return 1; | ||
449 | } | ||
450 | |||