Mercurial > vba-clojure

annotate src/lua/ltablib.c @ 613:e1dcad3ce967

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
misc. fixes.
author Robert McIntyre <rlm@mit.edu>
date Thu, 22 Nov 2012 11:36:07 -0600
parents 27763b933818
children
rev   line source
rlm@1 1 /*
rlm@1 2 ** $Id: ltablib.c,v 1.38.1.3 2008/02/14 16:46:58 roberto Exp $
rlm@1 3 ** Library for Table Manipulation
rlm@1 4 ** See Copyright Notice in lua.h
rlm@1 5 */
rlm@1 6
rlm@1 7
rlm@1 8 #include <stddef.h>
rlm@1 9
rlm@1 10 #define ltablib_c
rlm@1 11 #define LUA_LIB
rlm@1 12
rlm@1 13 #include "lua.h"
rlm@1 14
rlm@1 15 #include "lauxlib.h"
rlm@1 16 #include "lualib.h"
rlm@1 17
rlm@1 18
rlm@1 19 #define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_getn(L, n))
rlm@1 20
rlm@1 21
rlm@1 22 static int foreachi (lua_State *L) {
rlm@1 23 int i;
rlm@1 24 int n = aux_getn(L, 1);
rlm@1 25 luaL_checktype(L, 2, LUA_TFUNCTION);
rlm@1 26 for (i=1; i <= n; i++) {
rlm@1 27 lua_pushvalue(L, 2); /* function */
rlm@1 28 lua_pushinteger(L, i); /* 1st argument */
rlm@1 29 lua_rawgeti(L, 1, i); /* 2nd argument */
rlm@1 30 lua_call(L, 2, 1);
rlm@1 31 if (!lua_isnil(L, -1))
rlm@1 32 return 1;
rlm@1 33 lua_pop(L, 1); /* remove nil result */
rlm@1 34 }
rlm@1 35 return 0;
rlm@1 36 }
rlm@1 37
rlm@1 38
rlm@1 39 static int foreach (lua_State *L) {
rlm@1 40 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 41 luaL_checktype(L, 2, LUA_TFUNCTION);
rlm@1 42 lua_pushnil(L); /* first key */
rlm@1 43 while (lua_next(L, 1)) {
rlm@1 44 lua_pushvalue(L, 2); /* function */
rlm@1 45 lua_pushvalue(L, -3); /* key */
rlm@1 46 lua_pushvalue(L, -3); /* value */
rlm@1 47 lua_call(L, 2, 1);
rlm@1 48 if (!lua_isnil(L, -1))
rlm@1 49 return 1;
rlm@1 50 lua_pop(L, 2); /* remove value and result */
rlm@1 51 }
rlm@1 52 return 0;
rlm@1 53 }
rlm@1 54
rlm@1 55
rlm@1 56 static int maxn (lua_State *L) {
rlm@1 57 lua_Number max = 0;
rlm@1 58 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 59 lua_pushnil(L); /* first key */
rlm@1 60 while (lua_next(L, 1)) {
rlm@1 61 lua_pop(L, 1); /* remove value */
rlm@1 62 if (lua_type(L, -1) == LUA_TNUMBER) {
rlm@1 63 lua_Number v = lua_tonumber(L, -1);
rlm@1 64 if (v > max) max = v;
rlm@1 65 }
rlm@1 66 }
rlm@1 67 lua_pushnumber(L, max);
rlm@1 68 return 1;
rlm@1 69 }
rlm@1 70
rlm@1 71
rlm@1 72 static int getn (lua_State *L) {
rlm@1 73 lua_pushinteger(L, aux_getn(L, 1));
rlm@1 74 return 1;
rlm@1 75 }
rlm@1 76
rlm@1 77
rlm@1 78 static int setn (lua_State *L) {
rlm@1 79 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 80 #ifndef luaL_setn
rlm@1 81 luaL_setn(L, 1, luaL_checkint(L, 2));
rlm@1 82 #else
rlm@1 83 luaL_error(L, LUA_QL("setn") " is obsolete");
rlm@1 84 #endif
rlm@1 85 lua_pushvalue(L, 1);
rlm@1 86 return 1;
rlm@1 87 }
rlm@1 88
rlm@1 89
rlm@1 90 static int tinsert (lua_State *L) {
rlm@1 91 int e = aux_getn(L, 1) + 1; /* first empty element */
rlm@1 92 int pos; /* where to insert new element */
rlm@1 93 switch (lua_gettop(L)) {
rlm@1 94 case 2: { /* called with only 2 arguments */
rlm@1 95 pos = e; /* insert new element at the end */
rlm@1 96 break;
rlm@1 97 }
rlm@1 98 case 3: {
rlm@1 99 int i;
rlm@1 100 pos = luaL_checkint(L, 2); /* 2nd argument is the position */
rlm@1 101 if (pos > e) e = pos; /* `grow' array if necessary */
rlm@1 102 for (i = e; i > pos; i--) { /* move up elements */
rlm@1 103 lua_rawgeti(L, 1, i-1);
rlm@1 104 lua_rawseti(L, 1, i); /* t[i] = t[i-1] */
rlm@1 105 }
rlm@1 106 break;
rlm@1 107 }
rlm@1 108 default: {
rlm@1 109 return luaL_error(L, "wrong number of arguments to " LUA_QL("insert"));
rlm@1 110 }
rlm@1 111 }
rlm@1 112 luaL_setn(L, 1, e); /* new size */
rlm@1 113 lua_rawseti(L, 1, pos); /* t[pos] = v */
rlm@1 114 return 0;
rlm@1 115 }
rlm@1 116
rlm@1 117
rlm@1 118 static int tremove (lua_State *L) {
rlm@1 119 int e = aux_getn(L, 1);
rlm@1 120 int pos = luaL_optint(L, 2, e);
rlm@1 121 if (!(1 <= pos && pos <= e)) /* position is outside bounds? */
rlm@1 122 return 0; /* nothing to remove */
rlm@1 123 luaL_setn(L, 1, e - 1); /* t.n = n-1 */
rlm@1 124 lua_rawgeti(L, 1, pos); /* result = t[pos] */
rlm@1 125 for ( ;pos<e; pos++) {
rlm@1 126 lua_rawgeti(L, 1, pos+1);
rlm@1 127 lua_rawseti(L, 1, pos); /* t[pos] = t[pos+1] */
rlm@1 128 }
rlm@1 129 lua_pushnil(L);
rlm@1 130 lua_rawseti(L, 1, e); /* t[e] = nil */
rlm@1 131 return 1;
rlm@1 132 }
rlm@1 133
rlm@1 134
rlm@1 135 static void addfield (lua_State *L, luaL_Buffer *b, int i) {
rlm@1 136 lua_rawgeti(L, 1, i);
rlm@1 137 if (!lua_isstring(L, -1))
rlm@1 138 luaL_error(L, "invalid value (%s) at index %d in table for "
rlm@1 139 LUA_QL("concat"), luaL_typename(L, -1), i);
rlm@1 140 luaL_addvalue(b);
rlm@1 141 }
rlm@1 142
rlm@1 143
rlm@1 144 static int tconcat (lua_State *L) {
rlm@1 145 luaL_Buffer b;
rlm@1 146 size_t lsep;
rlm@1 147 int i, last;
rlm@1 148 const char *sep = luaL_optlstring(L, 2, "", &lsep);
rlm@1 149 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 150 i = luaL_optint(L, 3, 1);
rlm@1 151 last = luaL_opt(L, luaL_checkint, 4, luaL_getn(L, 1));
rlm@1 152 luaL_buffinit(L, &b);
rlm@1 153 for (; i < last; i++) {
rlm@1 154 addfield(L, &b, i);
rlm@1 155 luaL_addlstring(&b, sep, lsep);
rlm@1 156 }
rlm@1 157 if (i == last) /* add last value (if interval was not empty) */
rlm@1 158 addfield(L, &b, i);
rlm@1 159 luaL_pushresult(&b);
rlm@1 160 return 1;
rlm@1 161 }
rlm@1 162
rlm@1 163
rlm@1 164
rlm@1 165 /*
rlm@1 166 ** {======================================================
rlm@1 167 ** Quicksort
rlm@1 168 ** (based on `Algorithms in MODULA-3', Robert Sedgewick;
rlm@1 169 ** Addison-Wesley, 1993.)
rlm@1 170 */
rlm@1 171
rlm@1 172
rlm@1 173 static void set2 (lua_State *L, int i, int j) {
rlm@1 174 lua_rawseti(L, 1, i);
rlm@1 175 lua_rawseti(L, 1, j);
rlm@1 176 }
rlm@1 177
rlm@1 178 static int sort_comp (lua_State *L, int a, int b) {
rlm@1 179 if (!lua_isnil(L, 2)) { /* function? */
rlm@1 180 int res;
rlm@1 181 lua_pushvalue(L, 2);
rlm@1 182 lua_pushvalue(L, a-1); /* -1 to compensate function */
rlm@1 183 lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */
rlm@1 184 lua_call(L, 2, 1);
rlm@1 185 res = lua_toboolean(L, -1);
rlm@1 186 lua_pop(L, 1);
rlm@1 187 return res;
rlm@1 188 }
rlm@1 189 else /* a < b? */
rlm@1 190 return lua_lessthan(L, a, b);
rlm@1 191 }
rlm@1 192
rlm@1 193 static void auxsort (lua_State *L, int l, int u) {
rlm@1 194 while (l < u) { /* for tail recursion */
rlm@1 195 int i, j;
rlm@1 196 /* sort elements a[l], a[(l+u)/2] and a[u] */
rlm@1 197 lua_rawgeti(L, 1, l);
rlm@1 198 lua_rawgeti(L, 1, u);
rlm@1 199 if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */
rlm@1 200 set2(L, l, u); /* swap a[l] - a[u] */
rlm@1 201 else
rlm@1 202 lua_pop(L, 2);
rlm@1 203 if (u-l == 1) break; /* only 2 elements */
rlm@1 204 i = (l+u)/2;
rlm@1 205 lua_rawgeti(L, 1, i);
rlm@1 206 lua_rawgeti(L, 1, l);
rlm@1 207 if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */
rlm@1 208 set2(L, i, l);
rlm@1 209 else {
rlm@1 210 lua_pop(L, 1); /* remove a[l] */
rlm@1 211 lua_rawgeti(L, 1, u);
rlm@1 212 if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */
rlm@1 213 set2(L, i, u);
rlm@1 214 else
rlm@1 215 lua_pop(L, 2);
rlm@1 216 }
rlm@1 217 if (u-l == 2) break; /* only 3 elements */
rlm@1 218 lua_rawgeti(L, 1, i); /* Pivot */
rlm@1 219 lua_pushvalue(L, -1);
rlm@1 220 lua_rawgeti(L, 1, u-1);
rlm@1 221 set2(L, i, u-1);
rlm@1 222 /* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
rlm@1 223 i = l; j = u-1;
rlm@1 224 for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
rlm@1 225 /* repeat ++i until a[i] >= P */
rlm@1 226 while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) {
rlm@1 227 if (i>u) luaL_error(L, "invalid order function for sorting");
rlm@1 228 lua_pop(L, 1); /* remove a[i] */
rlm@1 229 }
rlm@1 230 /* repeat --j until a[j] <= P */
rlm@1 231 while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) {
rlm@1 232 if (j<l) luaL_error(L, "invalid order function for sorting");
rlm@1 233 lua_pop(L, 1); /* remove a[j] */
rlm@1 234 }
rlm@1 235 if (j<i) {
rlm@1 236 lua_pop(L, 3); /* pop pivot, a[i], a[j] */
rlm@1 237 break;
rlm@1 238 }
rlm@1 239 set2(L, i, j);
rlm@1 240 }
rlm@1 241 lua_rawgeti(L, 1, u-1);
rlm@1 242 lua_rawgeti(L, 1, i);
rlm@1 243 set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */
rlm@1 244 /* a[l..i-1] <= a[i] == P <= a[i+1..u] */
rlm@1 245 /* adjust so that smaller half is in [j..i] and larger one in [l..u] */
rlm@1 246 if (i-l < u-i) {
rlm@1 247 j=l; i=i-1; l=i+2;
rlm@1 248 }
rlm@1 249 else {
rlm@1 250 j=i+1; i=u; u=j-2;
rlm@1 251 }
rlm@1 252 auxsort(L, j, i); /* call recursively the smaller one */
rlm@1 253 } /* repeat the routine for the larger one */
rlm@1 254 }
rlm@1 255
rlm@1 256 static int sort (lua_State *L) {
rlm@1 257 int n = aux_getn(L, 1);
rlm@1 258 luaL_checkstack(L, 40, ""); /* assume array is smaller than 2^40 */
rlm@1 259 if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
rlm@1 260 luaL_checktype(L, 2, LUA_TFUNCTION);
rlm@1 261 lua_settop(L, 2); /* make sure there is two arguments */
rlm@1 262 auxsort(L, 1, n);
rlm@1 263 return 0;
rlm@1 264 }
rlm@1 265
rlm@1 266 /* }====================================================== */
rlm@1 267
rlm@1 268
rlm@1 269 static const luaL_Reg tab_funcs[] = {
rlm@1 270 {"concat", tconcat},
rlm@1 271 {"foreach", foreach},
rlm@1 272 {"foreachi", foreachi},
rlm@1 273 {"getn", getn},
rlm@1 274 {"maxn", maxn},
rlm@1 275 {"insert", tinsert},
rlm@1 276 {"remove", tremove},
rlm@1 277 {"setn", setn},
rlm@1 278 {"sort", sort},
rlm@1 279 {NULL, NULL}
rlm@1 280 };
rlm@1 281
rlm@1 282
rlm@1 283 LUALIB_API int luaopen_table (lua_State *L) {
rlm@1 284 luaL_register(L, LUA_TABLIBNAME, tab_funcs);
rlm@1 285 return 1;
rlm@1 286 }
rlm@1 287