all order operators use a single tag method (<)

6 files changed, 68 insertions, 79 deletions

diff --git a/lbuiltin.c b/lbuiltin.c
index 260dd8a7..7e0c832c 100644
--- a/lbuiltin.c
+++ b/lbuiltin.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lbuiltin.c,v 1.91 1999/12/30 18:27:03 roberto Exp roberto $
+** $Id: lbuiltin.c,v 1.92 2000/01/19 16:50:30 roberto Exp roberto $
 ** Built-in functions
 ** See Copyright Notice in lua.h
 */
@@ -539,13 +539,16 @@ static int sort_comp (lua_State *L, lua_Object f, const TObject *a,
     *(L->top+2) = *b;
     L->top += 3;
     luaD_call(L, L->top-3, 1);
+    L->top--;
+    return (ttype(L->top) != LUA_T_NIL);
   }
   else {  /* a < b? */
-    *(L->top++) = *a;
-    *(L->top++) = *b;
-    luaV_comparison(L);
+    int res;
+    *(L->top) = *a;
+    *(L->top+1) = *b;
+    res = luaV_lessthan(L, L->top, L->top+1);
+    return res;
   }
-  return ttype(--(L->top)) != LUA_T_NIL;
 }
 
 static void auxsort (lua_State *L, Hash *a, int l, int u, lua_Object f) {
diff --git a/ltm.c b/ltm.c
index 93a806d8..f9812bc9 100644
--- a/ltm.c
+++ b/ltm.c
@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.30 1999/12/23 18:19:57 roberto Exp roberto $
+** $Id: ltm.c,v 1.31 2000/01/19 12:00:45 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -18,9 +18,8 @@
 
 
 const char *const luaT_eventname[] = {  /* ORDER IM */
-  "gettable", "settable", "index", "getglobal", "setglobal", "add",
-  "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
-  "concat", "gc", "function", NULL
+  "gettable", "settable", "index", "getglobal", "setglobal", "add", "sub",
+  "mul", "div", "pow", "unm", "lt", "concat", "gc", "function", NULL
 };
 
 
@@ -38,13 +37,13 @@ static int luaI_checkevent (lua_State *L, const char *name, const char *const li
 */
 /* ORDER LUA_T, ORDER IM */
 static const char luaT_validevents[NUM_TAGS][IM_N] = {
-{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1},  /* LUA_T_USERDATA */
-{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_NUMBER */
-{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
-{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1},  /* LUA_T_ARRAY */
-{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_LPROTO */
-{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_CPROTO */
-{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}   /* LUA_T_NIL */
+{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1},  /* LUA_T_USERDATA */
+{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1},  /* LUA_T_NUMBER */
+{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
+{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1},  /* LUA_T_ARRAY */
+{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_LPROTO */
+{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_CPROTO */
+{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}   /* LUA_T_NIL */
 };
 
 int luaT_validevent (int t, int e) {  /* ORDER LUA_T */
@@ -122,7 +121,13 @@ int luaT_effectivetag (const TObject *o) {
 
 
 const TObject *luaT_gettagmethod (lua_State *L, int t, const char *event) {
-  int e = luaI_checkevent(L, event, luaT_eventname);
+  int e;
+#ifdef LUA_COMPAT_ORDER_TM
+  static const char *old_order[] = {"le", "gt", "ge", NULL};
+  if (luaL_findstring(event, old_order) >= 0)
+     return &luaO_nilobject;
+#endif
+  e = luaI_checkevent(L, event, luaT_eventname);
   checktag(L, t);
   if (luaT_validevent(t, e))
     return luaT_getim(L, t,e);
@@ -133,7 +138,13 @@ const TObject *luaT_gettagmethod (lua_State *L, int t, const char *event) {
 
 void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func) {
   TObject temp;
-  int e = luaI_checkevent(L, event, luaT_eventname);
+  int e;
+#ifdef LUA_COMPAT_ORDER_TM
+  static const char *old_order[] = {"le", "gt", "ge", NULL};
+  if (luaL_findstring(event, old_order) >= 0)
+     return;  /* do nothing for old operators */
+#endif
+  e = luaI_checkevent(L, event, luaT_eventname);
   checktag(L, t);
   if (!luaT_validevent(t, e))
     luaL_verror(L, "cannot change tag method `%.20s' for type `%.20s'%.20s",
@@ -146,7 +157,8 @@ void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func) {
 }
 
 
-const char *luaT_travtagmethods (lua_State *L, int (*fn)(lua_State *, TObject *)) {  /* ORDER IM */
+const char *luaT_travtagmethods (lua_State *L,
+                         int (*fn)(lua_State *, TObject *)) {  /* ORDER IM */
   int e;
   for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {
     int t;
diff --git a/ltm.h b/ltm.h
index fde74b84..3d517e3e 100644
--- a/ltm.h
+++ b/ltm.h
@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.h,v 1.7 1999/09/20 14:57:29 roberto Exp roberto $
+** $Id: ltm.h,v 1.8 1999/11/22 13:12:07 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -28,15 +28,12 @@ typedef enum {
   IM_POW,
   IM_UNM,
   IM_LT,
-  IM_LE,
-  IM_GT,
-  IM_GE,
   IM_CONCAT,
   IM_GC,
   IM_FUNCTION
 } IMS;
 
-#define IM_N 18
+#define IM_N 15
 
 
 struct IM {
diff --git a/lvm.c b/lvm.c
index 79f6800e..f88f0cd1 100644
--- a/lvm.c
+++ b/lvm.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.87 2000/02/14 16:51:08 roberto Exp roberto $
+** $Id: lvm.c,v 1.88 2000/02/22 13:31:30 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -138,7 +138,6 @@ void luaV_gettable (lua_State *L, StkId top) {
 
 /*
 ** Receives table at *t, index at *(t+1) and value at `top'.
-** WARNING: caller must assure 3 extra stack slots (to call a tag method)
 */
 void luaV_settable (lua_State *L, StkId t, StkId top) {
   const TObject *im;
@@ -158,6 +157,7 @@ void luaV_settable (lua_State *L, StkId t, StkId top) {
   }
   /* object is not a table, or it has a `settable' method */
   /* prepare arguments and call the tag method */
+  luaD_checkstack(L, 3);
   *(top+2) = *(top-1);
   *(top+1) = *(t+1);
   *(top) = *t;
@@ -177,15 +177,13 @@ void luaV_rawsettable (lua_State *L, StkId t) {
 }
 
 
-/*
-** WARNING: caller must assure 3 extra stack slots (to call a tag method)
-*/
 void luaV_getglobal (lua_State *L, GlobalVar *gv, StkId top) {
   const TObject *value = &gv->value;
   TObject *im = luaT_getimbyObj(L, value, IM_GETGLOBAL);
   if (ttype(im) == LUA_T_NIL)  /* is there a tag method? */
     *top = *value;  /* default behavior */
   else {  /* tag method */
+    luaD_checkstack(L, 3);
     *top = *im;
     ttype(top+1) = LUA_T_STRING;
     tsvalue(top+1) = gv->name;  /* global name */
@@ -196,15 +194,13 @@ void luaV_getglobal (lua_State *L, GlobalVar *gv, StkId top) {
 }
 
 
-/*
-** WARNING: caller must assure 3 extra stack slots (to call a tag method)
-*/
 void luaV_setglobal (lua_State *L, GlobalVar *gv, StkId top) {
   const TObject *oldvalue = &gv->value;
   const TObject *im = luaT_getimbyObj(L, oldvalue, IM_SETGLOBAL);
   if (ttype(im) == LUA_T_NIL)  /* is there a tag method? */
     gv->value = *(top-1);
   else {
+    luaD_checkstack(L, 3);
     *(top+2) = *(top-1);  /* new value */
     *(top+1) = *oldvalue;
     ttype(top) = LUA_T_STRING;
@@ -258,30 +254,31 @@ static int luaV_strcomp (const TaggedString *ls, const TaggedString *rs) {
   }
 }
 
-void luaV_comparison (lua_State *L) {
-  const TObject *l = L->top-2;
-  const TObject *r = L->top-1;
-  int result;
+
+int luaV_lessthan (lua_State *L, TObject *l, TObject *r) {
   if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
-    result = nvalue(l) < nvalue(r);
+    return (nvalue(l) < nvalue(r));
   else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
-    result = luaV_strcomp(tsvalue(l), tsvalue(r)) < 0;
+    return (luaV_strcomp(tsvalue(l), tsvalue(r)) < 0);
   else {
+    /* update top and put arguments in correct order to call Tag Method */
+    if (l<r)  /* are arguments in correct order? */
+      L->top = r+1;  /* yes; 2nd is on top */
+    else {  /* no; exchange them */
+      TObject temp = *r;
+      *r = *l;
+      *l = temp;
+      L->top = l+1;  /* 1st is on top */
+    }
     call_binTM(L, L->top, IM_LT, "unexpected type in comparison");
-    return;
+    L->top--;
+    return (ttype(L->top) != LUA_T_NIL);
   }
-  L->top--;
-  if (result) {
-    nvalue(L->top-1) = 1.0;
-    ttype(L->top-1) = LUA_T_NUMBER;
-  }
-  else
-    ttype(L->top-1) = LUA_T_NIL;
 }
 
 
 #define setbool(o,cond) if (cond) { \
-                              ttype(o) = LUA_T_NUMBER; nvalue(o) = 1.0; } \
+                             ttype(o) = LUA_T_NUMBER; nvalue(o) = 1.0; } \
                         else ttype(o) = LUA_T_NIL
 
 
@@ -484,42 +481,22 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
 
       case LTOP:
         top--;
-        if (ttype(top-1) == LUA_T_NUMBER && ttype(top) == LUA_T_NUMBER)
-          setbool(top-1, nvalue(top-1) < nvalue(top));
-        else if (ttype(top-1) == LUA_T_STRING && ttype(top) == LUA_T_STRING)
-          setbool(top-1, luaV_strcomp(tsvalue(top-1), tsvalue(top)) < 0);
-        else
-          call_binTM(L, top+1, IM_LT, "unexpected type in comparison");
+        setbool(top-1, luaV_lessthan(L, top-1, top));
         break;
 
-      case LEOP:
+      case LEOP:  /* a <= b  ===  !(b<a) */
         top--;
-        if (ttype(top-1) == LUA_T_NUMBER && ttype(top) == LUA_T_NUMBER)
-          setbool(top-1, nvalue(top-1) <= nvalue(top));
-        else if (ttype(top-1) == LUA_T_STRING && ttype(top) == LUA_T_STRING)
-          setbool(top-1, luaV_strcomp(tsvalue(top-1), tsvalue(top)) <= 0);
-        else
-          call_binTM(L, top+1, IM_LE, "unexpected type in comparison");
+        setbool(top-1, !luaV_lessthan(L, top, top-1));
         break;
 
-      case GTOP:
+      case GTOP:  /* a > b  ===  (b<a) */
         top--;
-        if (ttype(top-1) == LUA_T_NUMBER && ttype(top) == LUA_T_NUMBER)
-          setbool(top-1, nvalue(top-1) > nvalue(top));
-        else if (ttype(top-1) == LUA_T_STRING && ttype(top) == LUA_T_STRING)
-          setbool(top-1, luaV_strcomp(tsvalue(top-1), tsvalue(top)) > 0);
-        else
-          call_binTM(L, top+1, IM_GT, "unexpected type in comparison");
+        setbool(top-1, luaV_lessthan(L, top, top-1));
         break;
 
-      case GEOP:
+      case GEOP:  /* a >= b  ===  !(a<b) */
         top--;
-        if (ttype(top-1) == LUA_T_NUMBER && ttype(top) == LUA_T_NUMBER)
-          setbool(top-1, nvalue(top-1) >= nvalue(top));
-        else if (ttype(top-1) == LUA_T_STRING && ttype(top) == LUA_T_STRING)
-          setbool(top-1, luaV_strcomp(tsvalue(top-1), tsvalue(top)) >= 0);
-        else
-          call_binTM(L, top+1, IM_GE, "unexpected type in comparison");
+        setbool(top-1, !luaV_lessthan(L, top-1, top));
         break;
 
       case ADDOP:
diff --git a/lvm.h b/lvm.h
index 682364a7..14b83bb7 100644
--- a/lvm.h
+++ b/lvm.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.14 2000/01/19 16:50:30 roberto Exp roberto $
+** $Id: lvm.h,v 1.15 2000/01/24 20:14:07 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -28,6 +28,6 @@ void luaV_getglobal (lua_State *L, GlobalVar *gv, StkId top);
 void luaV_setglobal (lua_State *L, GlobalVar *gv, StkId top);
 StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf, StkId base);
 void luaV_closure (lua_State *L, int nelems);
-void luaV_comparison (lua_State *L);
+int luaV_lessthan (lua_State *L, TObject *l, TObject *r);
 
 #endif
diff --git a/makefile b/makefile
index e2d1593a..6ecb282e 100644
--- a/makefile
+++ b/makefile
@@ -1,5 +1,5 @@
 #
-## $Id: makefile,v 1.21 1999/10/04 17:51:04 roberto Exp roberto $
+## $Id: makefile,v 1.22 2000/02/22 13:31:43 roberto Exp roberto $
 ## Makefile
 ## See Copyright Notice in lua.h
 #
@@ -24,8 +24,8 @@
 # define COMPAT_READPATTERN if you need read patterns
 # (only for compatibility with previous versions)
 
-CONFIG = -DPOPEN -D_POSIX_SOURCE
-#CONFIG = -DOLD_ANSI -DDEBUG -DLUA_COMPAT_GC -DCOMPAT_READPATTERN
+CONFIG = -DPOPEN -D_POSIX_SOURCE -DDEBUG -DLUA_COMPAT_ORDER_TM
+#CONFIG = -DOLD_ANSI -DDEBUG -DLUA_COMPAT_GC -DCOMPAT_READPATTERN -DLUA_COMPAT_ORDER_TM
 
 
 # Compilation parameters