new function "sort" + many small changes

This commit is contained in:
Roberto Ierusalimschy 1998-07-12 13:16:43 -03:00
parent 1d8edd347d
commit afb5ef72e1
3 changed files with 142 additions and 61 deletions

View File

@ -1,5 +1,5 @@
/* /*
** $Id: lbuiltin.c,v 1.31 1998/06/19 18:47:06 roberto Exp roberto $ ** $Id: lbuiltin.c,v 1.32 1998/06/29 18:24:06 roberto Exp roberto $
** Built-in functions ** Built-in functions
** See Copyright Notice in lua.h ** See Copyright Notice in lua.h
*/ */
@ -23,6 +23,7 @@
#include "ltm.h" #include "ltm.h"
#include "lua.h" #include "lua.h"
#include "lundump.h" #include "lundump.h"
#include "lvm.h"
@ -35,18 +36,17 @@ static void pushstring (TaggedString *s)
} }
static void nextvar (void) static void nextvar (void) {
{
TObject *o = luaA_Address(luaL_nonnullarg(1)); TObject *o = luaA_Address(luaL_nonnullarg(1));
TaggedString *g; TaggedString *g;
if (ttype(o) == LUA_T_NIL) if (ttype(o) == LUA_T_NIL)
g = (TaggedString *)L->rootglobal.next; g = (TaggedString *)L->rootglobal.next; /* first variable */
else { else {
luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected"); luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
g = tsvalue(o); g = tsvalue(o); /* find given variable name */
/* check whether name is in global var list */ /* check whether name is in global var list */
luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected"); luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
g = (TaggedString *)g->head.next; g = (TaggedString *)g->head.next; /* get next */
} }
while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */ while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */
g = (TaggedString *)g->head.next; g = (TaggedString *)g->head.next;
@ -54,26 +54,26 @@ static void nextvar (void)
pushstring(g); pushstring(g);
luaA_pushobject(&g->u.s.globalval); luaA_pushobject(&g->u.s.globalval);
} }
else lua_pushnil(); else lua_pushnil(); /* no more globals */
} }
static void foreachvar (void) static void foreachvar (void) {
{
TObject f = *luaA_Address(luaL_functionarg(1)); TObject f = *luaA_Address(luaL_functionarg(1));
GCnode *g; GCnode *g;
StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */ StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */
luaD_checkstack(4); /* for var name, f, s, and globalvar */
ttype(L->stack.stack+name) = LUA_T_NIL; ttype(L->stack.stack+name) = LUA_T_NIL;
L->stack.top++; L->stack.top++; /* top == base */
for (g = L->rootglobal.next; g; g = g->next) { for (g = L->rootglobal.next; g; g = g->next) {
TaggedString *s = (TaggedString *)g; TaggedString *s = (TaggedString *)g;
if (s->u.s.globalval.ttype != LUA_T_NIL) { if (s->u.s.globalval.ttype != LUA_T_NIL) {
ttype(L->stack.stack+name) = LUA_T_STRING; ttype(L->stack.stack+name) = LUA_T_STRING;
tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */ tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */
luaA_pushobject(&f); *(L->stack.top++) = f;
pushstring(s); pushstring(s);
luaA_pushobject(&s->u.s.globalval); *(L->stack.top++) = s->u.s.globalval;
luaD_call((L->stack.top-L->stack.stack)-2, 1); luaD_calln(2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL) if (ttype(L->stack.top-1) != LUA_T_NIL)
return; return;
L->stack.top--; L->stack.top--;
@ -82,11 +82,9 @@ static void foreachvar (void)
} }
static void next (void) static void next (void) {
{ Node *n = luaH_next(luaA_Address(luaL_tablearg(1)),
lua_Object o = luaL_tablearg(1); luaA_Address(luaL_nonnullarg(2)));
lua_Object r = luaL_nonnullarg(2);
Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
if (n) { if (n) {
luaA_pushobject(&n->ref); luaA_pushobject(&n->ref);
luaA_pushobject(&n->val); luaA_pushobject(&n->val);
@ -95,18 +93,18 @@ static void next (void)
} }
static void foreach (void) static void foreach (void) {
{
TObject t = *luaA_Address(luaL_tablearg(1)); TObject t = *luaA_Address(luaL_tablearg(1));
TObject f = *luaA_Address(luaL_functionarg(2)); TObject f = *luaA_Address(luaL_functionarg(2));
int i; int i;
luaD_checkstack(3); /* for f, ref, and val */
for (i=0; i<avalue(&t)->nhash; i++) { for (i=0; i<avalue(&t)->nhash; i++) {
Node *nd = &(avalue(&t)->node[i]); Node *nd = &(avalue(&t)->node[i]);
if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) { if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
luaA_pushobject(&f); *(L->stack.top++) = f;
luaA_pushobject(ref(nd)); *(L->stack.top++) = *ref(nd);
luaA_pushobject(val(nd)); *(L->stack.top++) = *val(nd);
luaD_call((L->stack.top-L->stack.stack)-2, 1); luaD_calln(2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL) if (ttype(L->stack.top-1) != LUA_T_NIL)
return; return;
L->stack.top--; L->stack.top--;
@ -138,8 +136,8 @@ static void internaldofile (void)
static void to_string (void) { static void to_string (void) {
lua_Object obj = lua_getparam(1); lua_Object obj = lua_getparam(1);
char *buff = luaL_openspace(30);
TObject *o = luaA_Address(obj); TObject *o = luaA_Address(obj);
char buff[32];
switch (ttype(o)) { switch (ttype(o)) {
case LUA_T_NUMBER: case LUA_T_NUMBER:
lua_pushstring(lua_getstring(obj)); lua_pushstring(lua_getstring(obj));
@ -184,10 +182,10 @@ static void luaI_print (void) {
while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) { while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) {
luaA_pushobject(&ts->u.s.globalval); luaA_pushobject(&ts->u.s.globalval);
lua_pushobject(obj); lua_pushobject(obj);
luaD_call((L->stack.top-L->stack.stack)-1, 1); luaD_calln(1, 1);
if (ttype(L->stack.top-1) != LUA_T_STRING) if (ttype(L->stack.top-1) != LUA_T_STRING)
lua_error("`tostring' must return a string to `print'"); lua_error("`tostring' must return a string to `print'");
printf("%s\t", svalue(L->stack.top-1)); printf("%.200s\t", svalue(L->stack.top-1));
L->stack.top--; L->stack.top--;
} }
printf("\n"); printf("\n");
@ -197,12 +195,12 @@ static void luaI_print (void) {
static void luaI_type (void) static void luaI_type (void)
{ {
lua_Object o = luaL_nonnullarg(1); lua_Object o = luaL_nonnullarg(1);
lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]); lua_pushstring(luaO_typename(luaA_Address(o)));
lua_pushnumber(lua_tag(o)); lua_pushnumber(lua_tag(o));
} }
static void tonumber (void) static void luaB_tonumber (void)
{ {
int base = luaL_opt_number(2, 10); int base = luaL_opt_number(2, 10);
if (base == 10) { /* standard conversion */ if (base == 10) { /* standard conversion */
@ -270,16 +268,30 @@ static void luatag (void)
} }
static int getnarg (lua_Object table) static int getsize (TObject *t) {
{ int max = 0;
int i;
Hash *h = avalue(t);
LUA_ASSERT(ttype(t) == LUA_T_ARRAY, "table expected");
for (i = 0; i<nhash(h); i++) {
Node *n = h->node+i;
if (ttype(ref(n)) == LUA_T_NUMBER && ttype(val(n)) != LUA_T_NIL &&
(int)nvalue(ref(n)) > max)
max = nvalue(ref(n));
}
return max;
}
static int getnarg (lua_Object table) {
lua_Object temp; lua_Object temp;
/* temp = table.n */ /* temp = table.n */
lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable(); lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable();
return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_INT); return (lua_isnumber(temp) ? lua_getnumber(temp) :
getsize(luaA_Address(table)));
} }
static void luaI_call (void) static void luaI_call (void) {
{
lua_Object f = luaL_nonnullarg(1); lua_Object f = luaL_nonnullarg(1);
lua_Object arg = luaL_tablearg(2); lua_Object arg = luaL_tablearg(2);
char *options = luaL_opt_string(3, ""); char *options = luaL_opt_string(3, "");
@ -291,14 +303,9 @@ static void luaI_call (void)
err = lua_seterrormethod(); err = lua_seterrormethod();
} }
/* push arg[1...n] */ /* push arg[1...n] */
for (i=0; i<narg; i++) { luaD_checkstack(narg);
lua_Object temp; for (i=0; i<narg; i++)
/* temp = arg[i+1] */ *(L->stack.top++) = *luaH_getint(avalue(luaA_Address(arg)), i+1);
lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable();
if (narg == MAX_INT && lua_isnil(temp))
break;
lua_pushobject(temp);
}
status = lua_callfunction(f); status = lua_callfunction(f);
if (err != LUA_NOOBJECT) { /* restore old error method */ if (err != LUA_NOOBJECT) { /* restore old error method */
lua_pushobject(err); lua_pushobject(err);
@ -390,6 +397,79 @@ static void luaI_collectgarbage (void)
} }
static void swap (Hash *a, int i, int j) {
/* notice: must use two temporary vars, because luaH_setint may cause a
rehash and change the addresses of values in the array */
TObject ai = *luaH_getint(a, i);
TObject aj = *luaH_getint(a, j);
luaH_setint(a, i, &aj);
luaH_setint(a, j, &ai);
}
static int sort_comp (TObject *f, TObject *a, TObject *b) {
/* notice: the caller (auxsort) must check stack space */
if (f) {
*(L->stack.top++) = *f;
*(L->stack.top++) = *a;
*(L->stack.top++) = *b;
luaD_calln(2, 1);
}
else { /* a < b? */
*(L->stack.top++) = *a;
*(L->stack.top++) = *b;
luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
}
return ttype(--(L->stack.top)) != LUA_T_NIL;
}
/*
** quicksort algorithm from "Programming Pearls", pg. 112
*/
static void auxsort (Hash *a, int l, int u, TObject *f) {
if (u <= l) return; /* 0 or 1 element */
luaD_checkstack(4); /* for pivot, f, a, b (sort_comp) */
if (u-l == 1) { /* only two elements? */
if (sort_comp(f, luaH_getint(a, u), luaH_getint(a, l))) /* a[u] < a[l]? */
swap(a, l, u);
}
else {
int i;
int m = l;
swap(a, l, (l+u)/2); /* put middle element as pivot (a[l]) */
*(L->stack.top++) = *luaH_getint(a, l); /* save pivot on stack (for GC) */
for (i=l+1; i<=u; i++) {
/* invariant: a[l+1..m] < P <= a[m+1..i-1] */
if (sort_comp(f, luaH_getint(a, i), L->stack.top-1)) { /* a[i] < P? */
m++;
swap(a, m, i);
}
}
L->stack.top--; /* remove pivot from stack */
swap(a, l, m);
/* a[l..m-1] < a[m] <= a[m+1..u] */
auxsort(a, l, m-1, f);
auxsort(a, m+1, u, f);
}
}
static void luaB_sort (void) {
lua_Object t = luaL_tablearg(1);
int n = getnarg(t);
Hash *a = avalue(luaA_Address(t));
lua_Object func = lua_getparam(2);
TObject *f;
if (func == LUA_NOOBJECT)
f = NULL;
else {
luaL_arg_check(lua_isfunction(func), 2, "function expected");
f = luaA_Address(func);
}
auxsort(a, 1, n, f);
lua_pushobject(t);
}
/* /*
** ======================================================= ** =======================================================
** some DEBUG functions ** some DEBUG functions
@ -504,7 +584,8 @@ static struct luaL_reg int_funcs[] = {
{"settagmethod", settagmethod}, {"settagmethod", settagmethod},
{"gettagmethod", gettagmethod}, {"gettagmethod", gettagmethod},
{"settag", settag}, {"settag", settag},
{"tonumber", tonumber}, {"sort", luaB_sort},
{"tonumber", luaB_tonumber},
{"tostring", to_string}, {"tostring", to_string},
{"tag", luatag}, {"tag", luatag},
{"type", luaI_type} {"type", luaI_type}

27
lvm.c
View File

@ -1,5 +1,5 @@
/* /*
** $Id: lvm.c,v 1.29 1998/05/31 22:18:24 roberto Exp roberto $ ** $Id: lvm.c,v 1.30 1998/06/11 18:21:37 roberto Exp roberto $
** Lua virtual machine ** Lua virtual machine
** See Copyright Notice in lua.h ** See Copyright Notice in lua.h
*/ */
@ -112,7 +112,7 @@ void luaV_gettable (void)
im = luaT_getim(tg, IM_GETTABLE); im = luaT_getim(tg, IM_GETTABLE);
if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */
TObject *h = luaH_get(avalue(S->top-2), S->top-1); TObject *h = luaH_get(avalue(S->top-2), S->top-1);
if (h != NULL && ttype(h) != LUA_T_NIL) { if (ttype(h) != LUA_T_NIL) {
--S->top; --S->top;
*(S->top-1) = *h; *(S->top-1) = *h;
} }
@ -242,7 +242,7 @@ static int strcomp (char *l, long ll, char *r, long lr)
} }
} }
static void comparison (lua_Type ttype_less, lua_Type ttype_equal, void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal,
lua_Type ttype_great, IMS op) lua_Type ttype_great, IMS op)
{ {
struct Stack *S = &L->stack; struct Stack *S = &L->stack;
@ -269,22 +269,19 @@ void luaV_pack (StkId firstel, int nvararg, TObject *tab)
{ {
TObject *firstelem = L->stack.stack+firstel; TObject *firstelem = L->stack.stack+firstel;
int i; int i;
Hash *htab;
if (nvararg < 0) nvararg = 0; if (nvararg < 0) nvararg = 0;
avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */ htab = avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */
ttype(tab) = LUA_T_ARRAY; ttype(tab) = LUA_T_ARRAY;
for (i=0; i<nvararg; i++) { for (i=0; i<nvararg; i++)
TObject index; luaH_setint(htab, i+1, firstelem+i);
ttype(&index) = LUA_T_NUMBER;
nvalue(&index) = i+1;
*(luaH_set(avalue(tab), &index)) = *(firstelem+i);
}
/* store counter in field "n" */ { /* store counter in field "n" */ {
TObject index, extra; TObject index, extra;
ttype(&index) = LUA_T_STRING; ttype(&index) = LUA_T_STRING;
tsvalue(&index) = luaS_new("n"); tsvalue(&index) = luaS_new("n");
ttype(&extra) = LUA_T_NUMBER; ttype(&extra) = LUA_T_NUMBER;
nvalue(&extra) = nvararg; nvalue(&extra) = nvararg;
*(luaH_set(avalue(tab), &index)) = extra; *(luaH_set(htab, &index)) = extra;
} }
} }
@ -528,19 +525,19 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
} }
case LTOP: case LTOP:
comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
break; break;
case LEOP: case LEOP:
comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); luaV_comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
break; break;
case GTOP: case GTOP:
comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); luaV_comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
break; break;
case GEOP: case GEOP:
comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); luaV_comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
break; break;
case ADDOP: { case ADDOP: {

5
lvm.h
View File

@ -1,5 +1,5 @@
/* /*
** $Id: lvm.h,v 1.3 1997/10/16 10:59:34 roberto Exp roberto $ ** $Id: lvm.h,v 1.4 1997/12/15 16:17:20 roberto Exp roberto $
** Lua virtual machine ** Lua virtual machine
** See Copyright Notice in lua.h ** See Copyright Notice in lua.h
*/ */
@ -10,6 +10,7 @@
#include "ldo.h" #include "ldo.h"
#include "lobject.h" #include "lobject.h"
#include "ltm.h"
#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0)) #define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0))
@ -25,5 +26,7 @@ void luaV_getglobal (TaggedString *ts);
void luaV_setglobal (TaggedString *ts); void luaV_setglobal (TaggedString *ts);
StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base); StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base);
void luaV_closure (int nelems); void luaV_closure (int nelems);
void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal,
lua_Type ttype_great, IMS op);
#endif #endif