Mercurial > vba-clojure
view src/lua/lbaselib.c @ 507:24b459a95b46
saving progress.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Wed, 20 Jun 2012 19:51:50 -0500 |
parents | 27763b933818 |
children |
line wrap: on
line source
1 /*2 ** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto Exp $3 ** Basic library4 ** See Copyright Notice in lua.h5 */9 #include <ctype.h>10 #include <stdio.h>11 #include <stdlib.h>12 #include <string.h>14 #define lbaselib_c15 #define LUA_LIB17 #include "lua.h"19 #include "lauxlib.h"20 #include "lualib.h"25 /*26 ** If your system does not support `stdout', you can just remove this function.27 ** If you need, you can define your own `print' function, following this28 ** model but changing `fputs' to put the strings at a proper place29 ** (a console window or a log file, for instance).30 */31 static int luaB_print (lua_State *L) {32 int n = lua_gettop(L); /* number of arguments */33 int i;34 lua_getglobal(L, "tostring");35 for (i=1; i<=n; i++) {36 const char *s;37 lua_pushvalue(L, -1); /* function to be called */38 lua_pushvalue(L, i); /* value to print */39 lua_call(L, 1, 1);40 s = lua_tostring(L, -1); /* get result */41 if (s == NULL)42 return luaL_error(L, LUA_QL("tostring") " must return a string to "43 LUA_QL("print"));44 if (i>1) fputs("\t", stdout);45 fputs(s, stdout);46 lua_pop(L, 1); /* pop result */47 }48 fputs("\n", stdout);49 return 0;50 }53 static int luaB_tonumber (lua_State *L) {54 int base = luaL_optint(L, 2, 10);55 if (base == 10) { /* standard conversion */56 luaL_checkany(L, 1);57 if (lua_isnumber(L, 1)) {58 lua_pushnumber(L, lua_tonumber(L, 1));59 return 1;60 }61 }62 else {63 const char *s1 = luaL_checkstring(L, 1);64 char *s2;65 unsigned long n;66 luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");67 n = strtoul(s1, &s2, base);68 if (s1 != s2) { /* at least one valid digit? */69 while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */70 if (*s2 == '\0') { /* no invalid trailing characters? */71 lua_pushnumber(L, (lua_Number)n);72 return 1;73 }74 }75 }76 lua_pushnil(L); /* else not a number */77 return 1;78 }81 static int luaB_error (lua_State *L) {82 int level = luaL_optint(L, 2, 1);83 lua_settop(L, 1);84 if (lua_isstring(L, 1) && level > 0) { /* add extra information? */85 luaL_where(L, level);86 lua_pushvalue(L, 1);87 lua_concat(L, 2);88 }89 return lua_error(L);90 }93 static int luaB_getmetatable (lua_State *L) {94 luaL_checkany(L, 1);95 if (!lua_getmetatable(L, 1)) {96 lua_pushnil(L);97 return 1; /* no metatable */98 }99 luaL_getmetafield(L, 1, "__metatable");100 return 1; /* returns either __metatable field (if present) or metatable */101 }104 static int luaB_setmetatable (lua_State *L) {105 int t = lua_type(L, 2);106 luaL_checktype(L, 1, LUA_TTABLE);107 luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,108 "nil or table expected");109 if (luaL_getmetafield(L, 1, "__metatable"))110 luaL_error(L, "cannot change a protected metatable");111 lua_settop(L, 2);112 lua_setmetatable(L, 1);113 return 1;114 }117 static void getfunc (lua_State *L, int opt) {118 if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);119 else {120 lua_Debug ar;121 int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1);122 luaL_argcheck(L, level >= 0, 1, "level must be non-negative");123 if (lua_getstack(L, level, &ar) == 0)124 luaL_argerror(L, 1, "invalid level");125 lua_getinfo(L, "f", &ar);126 if (lua_isnil(L, -1))127 luaL_error(L, "no function environment for tail call at level %d",128 level);129 }130 }133 static int luaB_getfenv (lua_State *L) {134 getfunc(L, 1);135 if (lua_iscfunction(L, -1)) /* is a C function? */136 lua_pushvalue(L, LUA_GLOBALSINDEX); /* return the thread's global env. */137 else138 lua_getfenv(L, -1);139 return 1;140 }143 static int luaB_setfenv (lua_State *L) {144 luaL_checktype(L, 2, LUA_TTABLE);145 getfunc(L, 0);146 lua_pushvalue(L, 2);147 if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) {148 /* change environment of current thread */149 lua_pushthread(L);150 lua_insert(L, -2);151 lua_setfenv(L, -2);152 return 0;153 }154 else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0)155 luaL_error(L,156 LUA_QL("setfenv") " cannot change environment of given object");157 return 1;158 }161 static int luaB_rawequal (lua_State *L) {162 luaL_checkany(L, 1);163 luaL_checkany(L, 2);164 lua_pushboolean(L, lua_rawequal(L, 1, 2));165 return 1;166 }169 static int luaB_rawget (lua_State *L) {170 luaL_checktype(L, 1, LUA_TTABLE);171 luaL_checkany(L, 2);172 lua_settop(L, 2);173 lua_rawget(L, 1);174 return 1;175 }177 static int luaB_rawset (lua_State *L) {178 luaL_checktype(L, 1, LUA_TTABLE);179 luaL_checkany(L, 2);180 luaL_checkany(L, 3);181 lua_settop(L, 3);182 lua_rawset(L, 1);183 return 1;184 }187 static int luaB_gcinfo (lua_State *L) {188 lua_pushinteger(L, lua_getgccount(L));189 return 1;190 }193 static int luaB_collectgarbage (lua_State *L) {194 static const char *const opts[] = {"stop", "restart", "collect",195 "count", "step", "setpause", "setstepmul", NULL};196 static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,197 LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};198 int o = luaL_checkoption(L, 1, "collect", opts);199 int ex = luaL_optint(L, 2, 0);200 int res = lua_gc(L, optsnum[o], ex);201 switch (optsnum[o]) {202 case LUA_GCCOUNT: {203 int b = lua_gc(L, LUA_GCCOUNTB, 0);204 lua_pushnumber(L, res + ((lua_Number)b/1024));205 return 1;206 }207 case LUA_GCSTEP: {208 lua_pushboolean(L, res);209 return 1;210 }211 default: {212 lua_pushnumber(L, res);213 return 1;214 }215 }216 }219 static int luaB_type (lua_State *L) {220 luaL_checkany(L, 1);221 lua_pushstring(L, luaL_typename(L, 1));222 return 1;223 }226 static int luaB_next (lua_State *L) {227 luaL_checktype(L, 1, LUA_TTABLE);228 lua_settop(L, 2); /* create a 2nd argument if there isn't one */229 if (lua_next(L, 1))230 return 2;231 else {232 lua_pushnil(L);233 return 1;234 }235 }238 static int luaB_pairs (lua_State *L) {239 luaL_checktype(L, 1, LUA_TTABLE);240 lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */241 lua_pushvalue(L, 1); /* state, */242 lua_pushnil(L); /* and initial value */243 return 3;244 }247 static int ipairsaux (lua_State *L) {248 int i = luaL_checkint(L, 2);249 luaL_checktype(L, 1, LUA_TTABLE);250 i++; /* next value */251 lua_pushinteger(L, i);252 lua_rawgeti(L, 1, i);253 return (lua_isnil(L, -1)) ? 0 : 2;254 }257 static int luaB_ipairs (lua_State *L) {258 luaL_checktype(L, 1, LUA_TTABLE);259 lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */260 lua_pushvalue(L, 1); /* state, */261 lua_pushinteger(L, 0); /* and initial value */262 return 3;263 }266 static int load_aux (lua_State *L, int status) {267 if (status == 0) /* OK? */268 return 1;269 else {270 lua_pushnil(L);271 lua_insert(L, -2); /* put before error message */272 return 2; /* return nil plus error message */273 }274 }277 static int luaB_loadstring (lua_State *L) {278 size_t l;279 const char *s = luaL_checklstring(L, 1, &l);280 const char *chunkname = luaL_optstring(L, 2, s);281 return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));282 }285 static int luaB_loadfile (lua_State *L) {286 const char *fname = luaL_optstring(L, 1, NULL);287 return load_aux(L, luaL_loadfile(L, fname));288 }291 /*292 ** Reader for generic `load' function: `lua_load' uses the293 ** stack for internal stuff, so the reader cannot change the294 ** stack top. Instead, it keeps its resulting string in a295 ** reserved slot inside the stack.296 */297 static const char *generic_reader (lua_State *L, void *ud, size_t *size) {298 (void)ud; /* to avoid warnings */299 luaL_checkstack(L, 2, "too many nested functions");300 lua_pushvalue(L, 1); /* get function */301 lua_call(L, 0, 1); /* call it */302 if (lua_isnil(L, -1)) {303 *size = 0;304 return NULL;305 }306 else if (lua_isstring(L, -1)) {307 lua_replace(L, 3); /* save string in a reserved stack slot */308 return lua_tolstring(L, 3, size);309 }310 else luaL_error(L, "reader function must return a string");311 return NULL; /* to avoid warnings */312 }315 static int luaB_load (lua_State *L) {316 int status;317 const char *cname = luaL_optstring(L, 2, "=(load)");318 luaL_checktype(L, 1, LUA_TFUNCTION);319 lua_settop(L, 3); /* function, eventual name, plus one reserved slot */320 status = lua_load(L, generic_reader, NULL, cname);321 return load_aux(L, status);322 }325 static int luaB_dofile (lua_State *L) {326 const char *fname = luaL_optstring(L, 1, NULL);327 int n = lua_gettop(L);328 if (luaL_loadfile(L, fname) != 0) lua_error(L);329 lua_call(L, 0, LUA_MULTRET);330 return lua_gettop(L) - n;331 }334 static int luaB_assert (lua_State *L) {335 luaL_checkany(L, 1);336 if (!lua_toboolean(L, 1))337 return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));338 return lua_gettop(L);339 }342 static int luaB_unpack (lua_State *L) {343 int i, e, n;344 luaL_checktype(L, 1, LUA_TTABLE);345 i = luaL_optint(L, 2, 1);346 e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));347 if (i > e) return 0; /* empty range */348 n = e - i + 1; /* number of elements */349 if (n <= 0 || !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */350 return luaL_error(L, "too many results to unpack");351 lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */352 while (i++ < e) /* push arg[i + 1...e] */353 lua_rawgeti(L, 1, i);354 return n;355 }358 static int luaB_select (lua_State *L) {359 int n = lua_gettop(L);360 if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {361 lua_pushinteger(L, n-1);362 return 1;363 }364 else {365 int i = luaL_checkint(L, 1);366 if (i < 0) i = n + i;367 else if (i > n) i = n;368 luaL_argcheck(L, 1 <= i, 1, "index out of range");369 return n - i;370 }371 }374 static int luaB_pcall (lua_State *L) {375 int status;376 luaL_checkany(L, 1);377 status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);378 lua_pushboolean(L, (status == 0));379 lua_insert(L, 1);380 return lua_gettop(L); /* return status + all results */381 }384 static int luaB_xpcall (lua_State *L) {385 int status;386 luaL_checkany(L, 2);387 lua_settop(L, 2);388 lua_insert(L, 1); /* put error function under function to be called */389 status = lua_pcall(L, 0, LUA_MULTRET, 1);390 lua_pushboolean(L, (status == 0));391 lua_replace(L, 1);392 return lua_gettop(L); /* return status + all results */393 }396 static int luaB_tostring (lua_State *L) {397 luaL_checkany(L, 1);398 if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */399 return 1; /* use its value */400 switch (lua_type(L, 1)) {401 case LUA_TNUMBER:402 lua_pushstring(L, lua_tostring(L, 1));403 break;404 case LUA_TSTRING:405 lua_pushvalue(L, 1);406 break;407 case LUA_TBOOLEAN:408 lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));409 break;410 case LUA_TNIL:411 lua_pushliteral(L, "nil");412 break;413 default:414 lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));415 break;416 }417 return 1;418 }421 static int luaB_newproxy (lua_State *L) {422 lua_settop(L, 1);423 lua_newuserdata(L, 0); /* create proxy */424 if (lua_toboolean(L, 1) == 0)425 return 1; /* no metatable */426 else if (lua_isboolean(L, 1)) {427 lua_newtable(L); /* create a new metatable `m' ... */428 lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */429 lua_pushboolean(L, 1);430 lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */431 }432 else {433 int validproxy = 0; /* to check if weaktable[metatable(u)] == true */434 if (lua_getmetatable(L, 1)) {435 lua_rawget(L, lua_upvalueindex(1));436 validproxy = lua_toboolean(L, -1);437 lua_pop(L, 1); /* remove value */438 }439 luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");440 lua_getmetatable(L, 1); /* metatable is valid; get it */441 }442 lua_setmetatable(L, 2);443 return 1;444 }447 static const luaL_Reg base_funcs[] = {448 {"assert", luaB_assert},449 {"collectgarbage", luaB_collectgarbage},450 {"dofile", luaB_dofile},451 {"error", luaB_error},452 {"gcinfo", luaB_gcinfo},453 {"getfenv", luaB_getfenv},454 {"getmetatable", luaB_getmetatable},455 {"loadfile", luaB_loadfile},456 {"load", luaB_load},457 {"loadstring", luaB_loadstring},458 {"next", luaB_next},459 {"pcall", luaB_pcall},460 {"print", luaB_print},461 {"rawequal", luaB_rawequal},462 {"rawget", luaB_rawget},463 {"rawset", luaB_rawset},464 {"select", luaB_select},465 {"setfenv", luaB_setfenv},466 {"setmetatable", luaB_setmetatable},467 {"tonumber", luaB_tonumber},468 {"tostring", luaB_tostring},469 {"type", luaB_type},470 {"unpack", luaB_unpack},471 {"xpcall", luaB_xpcall},472 {NULL, NULL}473 };476 /*477 ** {======================================================478 ** Coroutine library479 ** =======================================================480 */482 #define CO_RUN 0 /* running */483 #define CO_SUS 1 /* suspended */484 #define CO_NOR 2 /* 'normal' (it resumed another coroutine) */485 #define CO_DEAD 3487 static const char *const statnames[] =488 {"running", "suspended", "normal", "dead"};490 static int costatus (lua_State *L, lua_State *co) {491 if (L == co) return CO_RUN;492 switch (lua_status(co)) {493 case LUA_YIELD:494 return CO_SUS;495 case 0: {496 lua_Debug ar;497 if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */498 return CO_NOR; /* it is running */499 else if (lua_gettop(co) == 0)500 return CO_DEAD;501 else502 return CO_SUS; /* initial state */503 }504 default: /* some error occured */505 return CO_DEAD;506 }507 }510 static int luaB_costatus (lua_State *L) {511 lua_State *co = lua_tothread(L, 1);512 luaL_argcheck(L, co, 1, "coroutine expected");513 lua_pushstring(L, statnames[costatus(L, co)]);514 return 1;515 }518 static int auxresume (lua_State *L, lua_State *co, int narg) {519 int status = costatus(L, co);520 if (!lua_checkstack(co, narg))521 luaL_error(L, "too many arguments to resume");522 if (status != CO_SUS) {523 lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);524 return -1; /* error flag */525 }526 lua_xmove(L, co, narg);527 lua_setlevel(L, co);528 status = lua_resume(co, narg);529 if (status == 0 || status == LUA_YIELD) {530 int nres = lua_gettop(co);531 if (!lua_checkstack(L, nres + 1))532 luaL_error(L, "too many results to resume");533 lua_xmove(co, L, nres); /* move yielded values */534 return nres;535 }536 else {537 lua_xmove(co, L, 1); /* move error message */538 return -1; /* error flag */539 }540 }543 static int luaB_coresume (lua_State *L) {544 lua_State *co = lua_tothread(L, 1);545 int r;546 luaL_argcheck(L, co, 1, "coroutine expected");547 r = auxresume(L, co, lua_gettop(L) - 1);548 if (r < 0) {549 lua_pushboolean(L, 0);550 lua_insert(L, -2);551 return 2; /* return false + error message */552 }553 else {554 lua_pushboolean(L, 1);555 lua_insert(L, -(r + 1));556 return r + 1; /* return true + `resume' returns */557 }558 }561 static int luaB_auxwrap (lua_State *L) {562 lua_State *co = lua_tothread(L, lua_upvalueindex(1));563 int r = auxresume(L, co, lua_gettop(L));564 if (r < 0) {565 if (lua_isstring(L, -1)) { /* error object is a string? */566 luaL_where(L, 1); /* add extra info */567 lua_insert(L, -2);568 lua_concat(L, 2);569 }570 lua_error(L); /* propagate error */571 }572 return r;573 }576 static int luaB_cocreate (lua_State *L) {577 lua_State *NL = lua_newthread(L);578 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,579 "Lua function expected");580 lua_pushvalue(L, 1); /* move function to top */581 lua_xmove(L, NL, 1); /* move function from L to NL */582 return 1;583 }586 static int luaB_cowrap (lua_State *L) {587 luaB_cocreate(L);588 lua_pushcclosure(L, luaB_auxwrap, 1);589 return 1;590 }593 static int luaB_yield (lua_State *L) {594 return lua_yield(L, lua_gettop(L));595 }598 static int luaB_corunning (lua_State *L) {599 if (lua_pushthread(L))600 lua_pushnil(L); /* main thread is not a coroutine */601 return 1;602 }605 static const luaL_Reg co_funcs[] = {606 {"create", luaB_cocreate},607 {"resume", luaB_coresume},608 {"running", luaB_corunning},609 {"status", luaB_costatus},610 {"wrap", luaB_cowrap},611 {"yield", luaB_yield},612 {NULL, NULL}613 };615 /* }====================================================== */618 static void auxopen (lua_State *L, const char *name,619 lua_CFunction f, lua_CFunction u) {620 lua_pushcfunction(L, u);621 lua_pushcclosure(L, f, 1);622 lua_setfield(L, -2, name);623 }626 static void base_open (lua_State *L) {627 /* set global _G */628 lua_pushvalue(L, LUA_GLOBALSINDEX);629 lua_setglobal(L, "_G");630 /* open lib into global table */631 luaL_register(L, "_G", base_funcs);632 lua_pushliteral(L, LUA_VERSION);633 lua_setglobal(L, "_VERSION"); /* set global _VERSION */634 /* `ipairs' and `pairs' need auxliliary functions as upvalues */635 auxopen(L, "ipairs", luaB_ipairs, ipairsaux);636 auxopen(L, "pairs", luaB_pairs, luaB_next);637 /* `newproxy' needs a weaktable as upvalue */638 lua_createtable(L, 0, 1); /* new table `w' */639 lua_pushvalue(L, -1); /* `w' will be its own metatable */640 lua_setmetatable(L, -2);641 lua_pushliteral(L, "kv");642 lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */643 lua_pushcclosure(L, luaB_newproxy, 1);644 lua_setglobal(L, "newproxy"); /* set global `newproxy' */645 }648 LUALIB_API int luaopen_base (lua_State *L) {649 base_open(L);650 luaL_register(L, LUA_COLIBNAME, co_funcs);651 return 2;652 }