new fallback for equality `__eq'

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.196 2002/06/06 12:40:22 roberto Exp roberto $
+** $Id: lapi.c,v 1.197 2002/06/12 14:51:31 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -211,11 +211,24 @@ LUA_API int lua_isstring (lua_State *L, int index) {
 }
 
 
-LUA_API int lua_equal (lua_State *L, int index1, int index2) {
+LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
   StkId o1 = luaA_indexAcceptable(L, index1);
   StkId o2 = luaA_indexAcceptable(L, index2);
   return (o1 == NULL || o2 == NULL) ? 0  /* index out of range */
-                                 : luaO_equalObj(o1, o2);
+                                    : luaO_rawequalObj(o1, o2);
+}
+
+
+LUA_API int lua_equal (lua_State *L, int index1, int index2) {
+  StkId o1, o2;
+  int i;
+  lua_lock(L);  /* may call tag method */
+  o1 = luaA_indexAcceptable(L, index1);
+  o2 = luaA_indexAcceptable(L, index2);
+  i = (o1 == NULL || o2 == NULL) ? 0  /* index out of range */
+                                 : equalobj(L, o1, o2);
+  lua_unlock(L);
+  return i;
 }
 
 

lbaselib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbaselib.c,v 1.78 2002/06/05 17:24:04 roberto Exp roberto $
+** $Id: lbaselib.c,v 1.79 2002/06/06 12:39:48 roberto Exp roberto $
 ** Basic library
 ** See Copyright Notice in lua.h
 */
@@ -115,6 +115,15 @@ static int luaB_globals (lua_State *L) {
   return 1;
 }
 
+
+static int luaB_rawequal (lua_State *L) {
+  luaL_check_any(L, 1);
+  luaL_check_any(L, 2);
+  lua_pushboolean(L, lua_rawequal(L, 1, 2));
+  return 1;
+}
+
+
 static int luaB_rawget (lua_State *L) {
   luaL_check_type(L, 1, LUA_TTABLE);
   luaL_check_any(L, 2);
@@ -400,6 +409,7 @@ static const luaL_reg base_funcs[] = {
   {"type", luaB_type},
   {"assert", luaB_assert},
   {"unpack", luaB_unpack},
+  {"rawequal", luaB_rawequal},
   {"rawget", luaB_rawget},
   {"rawset", luaB_rawset},
   {"pcall", luaB_pcall},

lcode.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lcode.c,v 1.106 2002/06/03 12:59:26 roberto Exp roberto $
+** $Id: lcode.c,v 1.107 2002/06/12 14:51:31 roberto Exp roberto $
 ** Code generator for Lua
 ** See Copyright Notice in lua.h
 */
@@ -138,7 +138,7 @@ static void luaK_patchlistaux (FuncState *fs, int list,
 }
 
 
-void luaK_dischargejpc (FuncState *fs) {
+static void luaK_dischargejpc (FuncState *fs) {
   luaK_patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc, NO_REG, fs->pc);
   fs->jpc = NO_JUMP;
 }
@@ -207,7 +207,7 @@ static void freeexp (FuncState *fs, expdesc *e) {
 static int addk (FuncState *fs, TObject *k, TObject *v) {
   const TObject *index = luaH_get(fs->h, k);
   if (ttype(index) == LUA_TNUMBER) {
-    lua_assert(luaO_equalObj(&fs->f->k[cast(int, nvalue(index))], v));
+    lua_assert(luaO_rawequalObj(&fs->f->k[cast(int, nvalue(index))], v));
     return cast(int, nvalue(index));
   }
   else {  /* constant not found; create a new entry */

ldebug.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 1.117 2002/05/16 18:39:46 roberto Exp roberto $
+** $Id: ldebug.c,v 1.118 2002/06/06 18:17:33 roberto Exp roberto $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@@ -165,7 +165,7 @@ static const char *travglobals (lua_State *L, const TObject *o) {
   int i = sizenode(g);
   while (i--) {
     Node *n = node(g, i);
-    if (luaO_equalObj(o, val(n)) && ttype(key(n)) == LUA_TSTRING)
+    if (luaO_rawequalObj(o, val(n)) && ttype(key(n)) == LUA_TSTRING)
       return getstr(tsvalue(key(n)));
   }
   return NULL;

lobject.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.c,v 1.82 2002/06/03 14:08:43 roberto Exp roberto $
+** $Id: lobject.c,v 1.83 2002/06/05 12:34:19 roberto Exp roberto $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -55,23 +55,28 @@ int luaO_log2 (unsigned int x) {
 }
 
 
-/*
-** warning: this function must return 1 for true (see opcode OP_TESTEQ)
-*/
-int luaO_equalObj (const TObject *t1, const TObject *t2) {
+int luaO_rawequalObj (const TObject *t1, const TObject *t2) {
   if (ttype(t1) != ttype(t2)) return 0;
   switch (ttype(t1)) {
     case LUA_TNUMBER:
       return nvalue(t1) == nvalue(t2);
     case LUA_TNIL:
       return 1;
+    case LUA_TSTRING:
+      return tsvalue(t1) == tsvalue(t2);
     case LUA_TBOOLEAN:
       return bvalue(t1) == bvalue(t2);  /* boolean true must be 1 !! */
     case LUA_TUDATAVAL:
       return pvalue(t1) == pvalue(t2);
-    default:  /* other types are equal if struct pointers are equal */
-      return tsvalue(t1) == tsvalue(t2);
+    case LUA_TUSERDATA:
+      return uvalue(t1) == uvalue(t2);
+    case LUA_TTABLE:
+      return hvalue(t1) == hvalue(t2);
+    case LUA_TFUNCTION:
+      return clvalue(t1) == clvalue(t2);
   }
+  lua_assert(0);
+  return 0;  /* to avoid warnings */
 }
 
 

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.133 2002/05/16 18:39:46 roberto Exp roberto $
+** $Id: lobject.h,v 1.134 2002/06/12 14:56:22 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -34,14 +34,14 @@ typedef struct lua_TObject {
 
 
 /* Macros to access values */
-#define ttype(o)        ((o)->tt)
-#define pvalue(o)	((o)->value.p)
-#define nvalue(o)       ((o)->value.n)
-#define tsvalue(o)      ((o)->value.ts)
-#define uvalue(o)      ((o)->value.u)
-#define clvalue(o)      ((o)->value.cl)
-#define hvalue(o)       ((o)->value.h)
-#define bvalue(o)	((o)->value.b)
+#define ttype(o)	((o)->tt)
+#define pvalue(o)	check_exp(ttype(o)==LUA_TUDATAVAL, (o)->value.p)
+#define nvalue(o)	check_exp(ttype(o)==LUA_TNUMBER, (o)->value.n)
+#define tsvalue(o)	check_exp(ttype(o)==LUA_TSTRING, (o)->value.ts)
+#define uvalue(o)	check_exp(ttype(o)==LUA_TUSERDATA, (o)->value.u)
+#define clvalue(o)	check_exp(ttype(o)==LUA_TFUNCTION, (o)->value.cl)
+#define hvalue(o)	check_exp(ttype(o)==LUA_TTABLE, (o)->value.h)
+#define bvalue(o)	check_exp(ttype(o)==LUA_TBOOLEAN, (o)->value.b)
 
 #define l_isfalse(o)	(ttype(o) == LUA_TNIL || \
 			(ttype(o) == LUA_TBOOLEAN && bvalue(o) == 0))
@@ -50,7 +50,8 @@ typedef struct lua_TObject {
 #define setnvalue(obj,x) \
   { TObject *i_o=(obj); i_o->tt=LUA_TNUMBER; i_o->value.n=(x); }
 
-#define chgnvalue(obj,x)	((obj)->value.n=(x))
+#define chgnvalue(obj,x) \
+	check_exp(ttype(obj)==LUA_TNUMBER, (obj)->value.n=(x))
 
 #define setpvalue(obj,x) \
   { TObject *i_o=(obj); i_o->tt=LUA_TUDATAVAL; i_o->value.p=(x); }
@@ -222,7 +223,8 @@ typedef struct Table {
 /*
 ** `module' operation for hashing (size is always a power of 2)
 */
-#define lmod(s,size)	(cast(int, (s) & ((size)-1)))
+#define lmod(s,size) \
+	check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1))))
 
 
 #define twoto(x)	(1<<(x))
@@ -239,7 +241,7 @@ int luaO_log2 (unsigned int x);
 #define luaO_openspace(L,n,t)	cast(t *, luaO_openspaceaux(L,(n)*sizeof(t)))
 void *luaO_openspaceaux (lua_State *L, size_t n);
 
-int luaO_equalObj (const TObject *t1, const TObject *t2);
+int luaO_rawequalObj (const TObject *t1, const TObject *t2);
 int luaO_str2d (const char *s, lua_Number *result);
 
 const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp);

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 1.108 2002/05/15 18:57:44 roberto Exp roberto $
+** $Id: ltable.c,v 1.109 2002/05/27 20:35:40 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -76,9 +76,15 @@ Node *luaH_mainposition (const Table *t, const TObject *key) {
       return hashboolean(t, bvalue(key));
     case LUA_TUDATAVAL:
       return hashpointer(t, pvalue(key));
-    default:  /* other types are hashed as (struct *) */
-      return hashpointer(t, tsvalue(key));
+    case LUA_TUSERDATA:
+      return hashpointer(t, uvalue(key));
+    case LUA_TFUNCTION:
+      return hashpointer(t, clvalue(key));
+    case LUA_TTABLE:
+      return hashpointer(t, hvalue(key));
   }
+  lua_assert(0);
+  return 0;  /* to avoid warnings */
 }
 
 
@@ -391,7 +397,7 @@ static const TObject *luaH_getany (Table *t, const TObject *key) {
   else {
     Node *n = luaH_mainposition(t, key);
     do {  /* check whether `key' is somewhere in the chain */
-      if (luaO_equalObj(key(n), key)) return val(n);  /* that's it */
+      if (luaO_rawequalObj(key(n), key)) return val(n);  /* that's it */
       else n = n->next;
     } while (n);
     return &luaO_nilobject;

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.93 2002/06/03 14:09:57 roberto Exp roberto $
+** $Id: ltm.c,v 1.94 2002/06/12 14:51:31 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -26,7 +26,7 @@ const char *const luaT_typenames[] = {
 void luaT_init (lua_State *L) {
   static const char *const luaT_eventname[] = {  /* ORDER TM */
     "__gettable", "__settable", "__index", "__newindex",
-    "__gc", "__weakmode",
+    "__gc", "__eq", "__weakmode",
     "__add", "__sub", "__mul", "__div",
     "__pow", "__unm", "__lt", "__le",
     "__concat", "__call"

ltm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.h,v 1.33 2002/05/27 20:35:40 roberto Exp roberto $
+** $Id: ltm.h,v 1.34 2002/06/12 14:51:31 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -20,6 +20,7 @@ typedef enum {
   TM_INDEX,
   TM_NEWINDEX,
   TM_GC,
+  TM_EQ,
   TM_WEAKMODE,  /* last tag method with `fast' access */
   TM_ADD,
   TM_SUB,

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.137 2002/06/05 12:34:19 roberto Exp roberto $
+** $Id: lua.h,v 1.138 2002/06/06 12:40:22 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil
 ** http://www.lua.org	mailto:[email protected]
@@ -130,6 +130,7 @@ LUA_API int             lua_type (lua_State *L, int index);
 LUA_API const char     *lua_typename (lua_State *L, int type);
 
 LUA_API int            lua_equal (lua_State *L, int index1, int index2);
+LUA_API int            lua_rawequal (lua_State *L, int index1, int index2);
 LUA_API int            lua_lessthan (lua_State *L, int index1, int index2);
 
 LUA_API lua_Number      lua_tonumber (lua_State *L, int index);

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.236 2002/06/06 18:17:33 roberto Exp roberto $
+** $Id: lvm.c,v 1.237 2002/06/12 14:51:31 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -250,6 +250,34 @@ static int luaV_lessequal (lua_State *L, const TObject *l, const TObject *r) {
 }
 
 
+int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2) {
+  const TObject *tm = NULL;
+  lua_assert(ttype(t1) == ttype(t2));
+  switch (ttype(t1)) {
+    case LUA_TNIL: return 1;
+    case LUA_TNUMBER: return nvalue(t1) == nvalue(t2);
+    case LUA_TSTRING: return tsvalue(t1) == tsvalue(t2);
+    case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2);  /* true must be 1 !! */
+    case LUA_TUDATAVAL: return pvalue(t1) == pvalue(t2);
+    case LUA_TFUNCTION: return clvalue(t1) == clvalue(t2);
+    case LUA_TUSERDATA:
+      if (uvalue(t1) == uvalue(t2)) return 1;
+      else if ((tm = fasttm(L, uvalue(t1)->uv.metatable, TM_EQ)) == NULL &&
+               (tm = fasttm(L, uvalue(t2)->uv.metatable, TM_EQ)) == NULL)
+        return 0;  /* no TM */
+      else break;  /* will try TM */
+    case LUA_TTABLE:
+      if (hvalue(t1) == hvalue(t2)) return 1;
+      else if ((tm = fasttm(L, hvalue(t1)->metatable, TM_EQ)) == NULL &&
+               (tm = fasttm(L, hvalue(t2)->metatable, TM_EQ)) == NULL)
+        return 0;  /* no TM */
+      else break;  /* will try TM */
+  }
+  callTMres(L, tm, t1, t2, L->top);  /* call TM */
+  return !l_isfalse(L->top);
+}
+
+
 void luaV_concat (lua_State *L, int total, int last) {
   do {
     StkId top = L->ci->base + last + 1;
@@ -464,7 +492,7 @@ StkId luaV_execute (lua_State *L) {
         break;
       }
       case OP_EQ: {  /* skip next instruction if test fails */
-        if (luaO_equalObj(ra, RKC(i)) != GETARG_B(i)) pc++;
+        if (equalobj(L, ra, RKC(i)) != GETARG_B(i)) pc++;
         else dojump(pc, GETARG_sBx(*pc) + 1);
         break;
       }

lvm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.40 2002/06/03 14:08:43 roberto Exp roberto $
+** $Id: lvm.h,v 1.41 2002/06/12 14:51:31 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -18,8 +18,12 @@
 #define tonumber(o,n)	(ttype(o) == LUA_TNUMBER || \
                          (((o) = luaV_tonumber(o,n)) != NULL))
 
+#define equalobj(L,o1,o2) \
+	(ttype(o1) == ttype(o2) && luaV_equalval(L, o1, o2))
+
 
 int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r);
+int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2);
 const TObject *luaV_tonumber (const TObject *obj, TObject *n);
 int luaV_tostring (lua_State *L, TObject *obj);
 void luaV_gettable (lua_State *L, const TObject *t, TObject *key, StkId res);