new fallback __le (less equal), for partial order

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.195 2002/06/03 20:11:07 roberto Exp roberto $
+** $Id: lapi.c,v 1.196 2002/06/06 12:40:22 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -226,7 +226,7 @@ LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {
   o1 = luaA_indexAcceptable(L, index1);
   o2 = luaA_indexAcceptable(L, index2);
   i = (o1 == NULL || o2 == NULL) ? 0  /* index out-of-range */
-                                 : luaV_cmp(L, o1, o2, CMP_LT);
+                                 : luaV_lessthan(L, o1, o2);
   lua_unlock(L);
   return i;
 }

lcode.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lcode.c,v 1.105 2002/05/27 20:35:40 roberto Exp roberto $
+** $Id: lcode.c,v 1.106 2002/06/03 12:59:26 roberto Exp roberto $
 ** Code generator for Lua
 ** See Copyright Notice in lua.h
 */
@@ -460,19 +460,8 @@ void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
 
 static void invertjump (FuncState *fs, expdesc *e) {
   Instruction *pc = getjumpcontrol(fs, e->info);
-  OpCode op = GET_OPCODE(*pc);
-  switch (op) {
-    case OP_EQ: {
-      SETARG_B(*pc, !(GETARG_B(*pc)));
-      return;
-    }
-    case OP_CMP: {
-      SETARG_B(*pc, ~(GETARG_B(*pc)));
-      return;
-    }
-    default: lua_assert(0);  /* invalid jump instruction */
-  }
-  SET_OPCODE(*pc, op);
+  lua_assert(testOpMode(GET_OPCODE(*pc), OpModeT));
+  SETARG_B(*pc, !(GETARG_B(*pc)));
 }
 
 
@@ -629,12 +618,6 @@ void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
 }
 
 
-
-static const int cmp_masks[] = {  /* ORDER OPR */
-  CMP_LT, (CMP_LT | CMP_EQ), CMP_GT, (CMP_GT | CMP_EQ)
-};
-
-
 static void codebinop (FuncState *fs, expdesc *res, BinOpr op,
                        int o1, int o2, int ic) {
   switch (op) {
@@ -644,7 +627,7 @@ static void codebinop (FuncState *fs, expdesc *res, BinOpr op,
       lua_assert(!ic);
       /* go through */
     case OPR_ADD:
-    case OPR_MULT: {
+    case OPR_MULT: {  /* ORDER OPR */
       OpCode opc = cast(OpCode, (op - OPR_ADD) + OP_ADD);
       res->info = luaK_codeABC(fs, opc, 0, o1, o2);
       res->k = VRELOCABLE;
@@ -659,11 +642,13 @@ static void codebinop (FuncState *fs, expdesc *res, BinOpr op,
     case OPR_LT:
     case OPR_LE:
     case OPR_GT:
-    case OPR_GE: {
-      int mask = cmp_masks[op - OPR_LT];
+    case OPR_GE: {  /* ORDER OPR */
+      OpCode opc;
+      int i = op - OPR_LT;
       if (ic)  /* operands were interchanged? */
-        mask ^= (CMP_LT | CMP_GT);  /*  correct condition */
-      res->info = luaK_condjump(fs, OP_CMP, o1, mask, o2);
+        i = (i+2)&3;  /* correct operator */
+      opc = cast(OpCode, i + OP_LT);
+      res->info = luaK_condjump(fs, opc, o1, 1, o2);
       res->k = VJMP;
       break;
     }

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.132 2002/05/15 18:57:44 roberto Exp roberto $
+** $Id: lobject.h,v 1.133 2002/05/16 18:39:46 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -230,14 +230,6 @@ typedef struct Table {
 #define sizearray(t)	((t)->sizearray)
 
 
-/*
-** masks for comparison results
-*/
-#define CMP_EQ	1
-#define CMP_LT	2
-#define CMP_GT	4
-#define CMP_N	8	/* not comparable values (e.g. NaN) */
-
 
 extern const TObject luaO_nilobject;
 

lopcodes.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lopcodes.c,v 1.18 2002/05/06 15:51:41 roberto Exp roberto $
+** $Id: lopcodes.c,v 1.19 2002/05/13 13:09:00 roberto Exp roberto $
 ** extracted automatically from lopcodes.h by mkprint.lua
 ** DO NOT EDIT
 ** See Copyright Notice in lua.h
@@ -37,7 +37,10 @@ const char *const luaP_opnames[] = {
   "CONCAT",
   "JMP",
   "EQ",
-  "CMP",
+  "LT",
+  "LE",
+  "GT",
+  "GE",
   "TEST",
   "CALL",
   "TAILCALL",
@@ -82,7 +85,10 @@ const lu_byte luaP_opmodes[NUM_OPCODES] = {
  ,opmode(0,0,1,1, 1,0,iABC)		/* OP_CONCAT */
  ,opmode(0,0,0,0, 0,0,iAsBx)		/* OP_JMP */
  ,opmode(1,0,0,1, 0,0,iABC)		/* OP_EQ */
- ,opmode(1,0,0,1, 0,0,iABC)		/* OP_CMP */
+ ,opmode(1,0,0,1, 0,0,iABC)		/* OP_LT */
+ ,opmode(1,0,0,1, 0,0,iABC)		/* OP_LE */
+ ,opmode(1,0,0,1, 0,0,iABC)		/* OP_GT */
+ ,opmode(1,0,0,1, 0,0,iABC)		/* OP_GE */
  ,opmode(1,0,0,1, 1,0,iABC)		/* OP_TEST */
  ,opmode(0,0,0,0, 0,0,iABC)		/* OP_CALL */
  ,opmode(0,0,0,0, 0,0,iABC)		/* OP_TAILCALL */

lopcodes.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lopcodes.h,v 1.97 2002/05/13 13:09:00 roberto Exp roberto $
+** $Id: lopcodes.h,v 1.98 2002/06/06 18:17:33 roberto Exp roberto $
 ** Opcodes for Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -158,7 +158,10 @@ OP_CONCAT,/*	A B C	R(A) := R(B).. ... ..R(C)			*/
 OP_JMP,/*	sBx	PC += sBx					*/
 
 OP_EQ,/*	A B C	if ((R(A) == R/K(C)) ~= B) then pc++		*/
-OP_CMP,/*	A B C	if not (R(A) <B> R/K(C)) then pc++  (see note)	*/
+OP_LT,/*	A B C	if ((R(A) <  R/K(C)) ~= B) then pc++  		*/
+OP_LE,/*	A B C	if ((R(A) <= R/K(C)) ~= B) then pc++  		*/
+OP_GT,/*	A B C	if ((R(A) >  R/K(C)) ~= B) then pc++  		*/
+OP_GE,/*	A B C	if ((R(A) >= R/K(C)) ~= B) then pc++  		*/
 
 OP_TEST,/*	A B C	if (R(C) <=> B) then R(A) := R(C) else pc++	*/ 
 

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.92 2002/05/27 20:35:40 roberto Exp roberto $
+** $Id: ltm.c,v 1.93 2002/06/03 14:09:57 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -28,8 +28,8 @@ void luaT_init (lua_State *L) {
     "__gettable", "__settable", "__index", "__newindex",
     "__gc", "__weakmode",
     "__add", "__sub", "__mul", "__div",
-    "__pow", "__unm", "__lt", "__concat",
-    "__call"
+    "__pow", "__unm", "__lt", "__le",
+    "__concat", "__call"
   };
   int i;
   for (i=0; i<TM_N; i++) {
@@ -45,6 +45,7 @@ void luaT_init (lua_State *L) {
 */
 const TObject *luaT_gettm (Table *events, TMS event, TString *ename) {
   const TObject *tm = luaH_getstr(events, ename);
+  lua_assert(event <= TM_WEAKMODE);
   if (ttype(tm) == LUA_TNIL) {  /* no tag method? */
     events->flags |= (1u<<event);  /* cache this fact */
     return NULL;

ltm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.h,v 1.32 2002/05/20 19:51:06 roberto Exp roberto $
+** $Id: ltm.h,v 1.33 2002/05/27 20:35:40 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -20,7 +20,7 @@ typedef enum {
   TM_INDEX,
   TM_NEWINDEX,
   TM_GC,
-  TM_WEAKMODE,
+  TM_WEAKMODE,  /* last tag method with `fast' access */
   TM_ADD,
   TM_SUB,
   TM_MUL,
@@ -28,6 +28,7 @@ typedef enum {
   TM_POW,
   TM_UNM,
   TM_LT,
+  TM_LE,
   TM_CONCAT,
   TM_CALL,
   TM_N		/* number of elements in the enum */

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.235 2002/06/05 12:34:19 roberto Exp roberto $
+** $Id: lvm.c,v 1.236 2002/06/06 18:17:33 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -207,14 +207,13 @@ static int luaV_strcmp (const TString *ls, const TString *rs) {
   size_t lr = rs->tsv.len;
   for (;;) {
     int temp = strcoll(l, r);
-    if (temp < 0) return CMP_LT;
-    else if (temp > 0) return CMP_GT;
+    if (temp != 0) return temp;
     else {  /* strings are equal up to a `\0' */
       size_t len = strlen(l);  /* index of first `\0' in both strings */
       if (len == lr)  /* r is finished? */
-        return (len == ll) ? CMP_EQ : CMP_GT;  /* l is eq. or gt. than r */
+        return (len == ll) ? 0 : 1;
       else if (len == ll)  /* l is finished? */
-        return CMP_LT;  /* l is smaller than r (because r is not finished) */
+        return -1;  /* l is smaller than r (because r is not finished) */
       /* both strings longer than `len'; go on comparing (after the `\0') */
       len++;
       l += len; ll -= len; r += len; lr -= len;
@@ -223,24 +222,30 @@ static int luaV_strcmp (const TString *ls, const TString *rs) {
 }
 
 
-int luaV_cmp (lua_State *L, const TObject *l, const TObject *r, int cond) {
-  if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER) {
-    lua_Number n1 = nvalue(l);
-    lua_Number n2 = nvalue(r);
-    if (n1 < n2) return (cond & CMP_LT);
-    else if (n1 > n2) return (cond & CMP_GT);
-    else if (n1 == n2) return (cond & CMP_EQ);
-    else return (cond & CMP_N);
-  }
+int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) {
+  if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER)
+    return nvalue(l) < nvalue(r);
   else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING)
-    return luaV_strcmp(tsvalue(l), tsvalue(r)) & cond;
+    return luaV_strcmp(tsvalue(l), tsvalue(r)) < 0;
   else {  /* try TM */
-    if (cond & CMP_EQ ? cond & CMP_LT : cond & CMP_GT) {  /* `<=' or `>' ? */
-      const TObject *temp = l; l = r; r = temp;  /* exchange terms */
-    }
     if (!call_binTM(L, l, r, L->top, TM_LT))
       luaG_ordererror(L, l, r);
-    return (cond & CMP_EQ) ? l_isfalse(L->top) : !l_isfalse(L->top);
+    return !l_isfalse(L->top);
+  }
+}
+
+
+static int luaV_lessequal (lua_State *L, const TObject *l, const TObject *r) {
+  if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER)
+    return nvalue(l) <= nvalue(r);
+  else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING)
+    return luaV_strcmp(tsvalue(l), tsvalue(r)) <= 0;
+  else {  /* try TM */
+    if (call_binTM(L, l, r, L->top, TM_LE))  /* first try `le' */
+      return !l_isfalse(L->top);
+    else if (!call_binTM(L, r, l, L->top, TM_LT))  /* else try `lt' */
+      luaG_ordererror(L, l, r);
+    return l_isfalse(L->top);
   }
 }
 
@@ -463,8 +468,23 @@ StkId luaV_execute (lua_State *L) {
         else dojump(pc, GETARG_sBx(*pc) + 1);
         break;
       }
-      case OP_CMP: {
-        if (!(luaV_cmp(L, ra, RKC(i), GETARG_B(i)))) pc++;
+      case OP_LT: {
+        if (luaV_lessthan(L, ra, RKC(i)) != GETARG_B(i)) pc++;
+        else dojump(pc, GETARG_sBx(*pc) + 1);
+        break;
+      }
+      case OP_LE: {
+        if (luaV_lessequal(L, ra, RKC(i)) != GETARG_B(i)) pc++;
+        else dojump(pc, GETARG_sBx(*pc) + 1);
+        break;
+      }
+      case OP_GT: {
+        if (luaV_lessthan(L, RKC(i), ra) != GETARG_B(i)) pc++;
+        else dojump(pc, GETARG_sBx(*pc) + 1);
+        break;
+      }
+      case OP_GE: {
+        if (luaV_lessequal(L, RKC(i), ra) != GETARG_B(i)) pc++;
         else dojump(pc, GETARG_sBx(*pc) + 1);
         break;
       }

lvm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.39 2002/05/06 15:51:41 roberto Exp roberto $
+** $Id: lvm.h,v 1.40 2002/06/03 14:08:43 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -19,7 +19,7 @@
                          (((o) = luaV_tonumber(o,n)) != NULL))
 
 
-int luaV_cmp (lua_State *L, const TObject *l, const TObject *r, int cond);
+int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r);
 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);