emulation of tag methods

[Roberto Ierusalimschy <rieru@...>]

Follows a draft of a compatibility library for 4.0 tag methods.

-- Roberto

/*
** emulate tags and tag-methods using event tables
*/


#include "lua.h"
#include "lauxlib.h"


#define TAGS	"TagsTable"


static const char *translate_event (const char *event) {
  if (strcmp(event, "function") == 0) return "call";
  else return event;
}


static void gettagtable (lua_State *L, int t, const char *err) {
  lua_getstr(L, LUA_REGISTRYINDEX, TAGS);
  lua_rawgeti(L, -1, t);
  lua_remove(L, -2);  /* remove TAGS */
  if (!lua_istable(L, -1))
    luaL_verror(L, "invalid `tag' for %.30s", err);
}


int lua_newtag (lua_State *L) {
  int n;
  lua_getstr(L, LUA_REGISTRYINDEX, TAGS);
  n = lua_getn(L, -1);
  if (n < LUA_TFUNCTION) n = LUA_TFUNCTION;  /* after basic types */
  n++;
  lua_newtable(L);
  lua_pushnumber(L, n);
  lua_setstr(L, -2, "tag");  /* t.tag = n */
  lua_rawseti(L, -2, n);  /* TAGS[n] = {tag = n} */
  lua_pop(L, 1);  /* remove TAGS */
  return n;
}


int lua_tag (lua_State *L, int index) {
  int tag = lua_type(L, index);
  lua_geteventtable(L, index);
  if (lua_istable(L, -1)) {
    int t;
    lua_pushliteral(L, "tag");
    lua_rawget(L, -2);
    t = lua_tonumber(L, -1);
    if (t) tag = t;
    lua_pop(L, 1);
  }
  lua_pop(L, 1);
  return tag;
}


void lua_settag (lua_State *L, int tag) {
  gettagtable(L, tag, "settag");
  lua_seteventtable (L, -2);
}


void lua_gettagmethod (lua_State *L, int t, const char *event) {
  gettagtable(L, t, "gettagmethod");
  lua_getstr(L, -1, translate_event(event));
  lua_remove(L, -2);  /* remove event table */
}


void lua_settagmethod (lua_State *L, int t, const char *event) {
  if (t <= LUA_TFUNCTION)
    lua_error(L, "tag methods for basic types are obsolete");
  if (strcmp(event, "getglobal") == 0 || strcmp(event, "setglobal") == 0)
    lua_error(L, "getglobal/setglobal tag methods are obsolete");
  gettagtable(L, t, "settagmethod");
  lua_pushvalue(L, -2);  /* put new tag method on top */
  lua_setstr(L, -2, translate_event(event));
  lua_remove(L, -1);  /* remove event table */
  lua_remove(L, -1);  /* remove new tag method */
}



/* -------------------------------------------------------------------------*/

static int luaB_tag (lua_State *L) {
  luaL_check_any(L, 1);
  lua_pushnumber(L, lua_tag(L, 1));
  return 1;
}


static int luaB_settag (lua_State *L) {
  luaL_check_type(L, 1, LUA_TTABLE);
  lua_pushvalue(L, 1);  /* push table */
  lua_settag(L, luaL_check_int(L, 2));
  return 1;  /* return table */
}


static int luaB_newtag (lua_State *L) {
  lua_pushnumber(L, lua_newtag(L));
  return 1;
}


static int luaB_settagmethod (lua_State *L) {
  int tag = luaL_check_int(L, 1);
  const char *event = luaL_check_string(L, 2);
  luaL_arg_check(L, lua_isfunction(L, 3) || lua_isnil(L, 3), 3,
                 "function or nil expected");
  if (strcmp(event, "gc") == 0)
    lua_error(L, "deprecated use: cannot set the `gc' tag method from Lua");
  lua_gettagmethod(L, tag, event);
  lua_pushvalue(L, 3);
  lua_settagmethod(L, tag, event);
  return 1;
}


static int luaB_gettagmethod (lua_State *L) {
  int tag = luaL_check_int(L, 1);
  const char *event = luaL_check_string(L, 2);
  if (strcmp(event, "gc") == 0)
    lua_error(L, "deprecated use: cannot get the `gc' tag method from Lua");
  lua_gettagmethod(L, tag, event);
  return 1;
}



static const struct luaL_reg tag_funcs[] = {
  {"gettagmethod", luaB_gettagmethod},
  {"newtag", luaB_newtag},
  {"settag", luaB_settag},
  {"settagmethod", luaB_settagmethod},
  {"tag", luaB_tag}
};


void lua_taglibopen (lua_State *L) {
  luaL_openl(L, tag_funcs);
  lua_newtable(L);
  lua_setstr(L, LUA_REGISTRYINDEX, TAGS);
}