/Lua/src/apl-lua.cpp

   1//#include "stdafx.h"
   2#include <assert.h>

   3#include <string>

   4#include <string.h>

   5#include <sstream>

   6#include <vector>

   7//#include <dirent.h>
   8#include <errno.h>

   9#include <a/k.h>

  10#include <a/f.h>

  11#include <a/fncdcls.h>

  12//#include "Aplus.h"
  13
  14extern "C" {
  15#include "lua.h"

  16#include "lauxlib.h"

  17#include "lualib.h"

  18}
  19
  20using namespace std;
  21
  22//////////////////////////////////////////////////////////////////////////////
  23// Forward function declarations
  24//////////////////////////////////////////////////////////////////////////////
  25
  26extern "C" void checkmem();
  27class Tok;
  28static A doeval(lua_State *L,E e,bool retdata);
  29static A getAObject(lua_State *L, const Tok& atok, bool reverseOrder = true);
  30static A doassign(lua_State *L, E e);
  31static A table2aobject(lua_State *L, int args);
  32
  33extern "C" A ep_alsf(A a);
  34extern "C" A ep_flat(A a);
  35extern "C" I ep_issf(A a);
  36extern "C" A ep_imp(A a);
  37extern "C" A ep_exp(A a);
  38extern "C" A ep_ssr(A s, A t, A r);
  39extern "C" A ep_ss(A s, A t);
  40
  41extern A aplus_nl;
  42
  43//////////////////////////////////////////////////////////////////////////////
  44// A+ operator definitions
  45//////////////////////////////////////////////////////////////////////////////
  46
  47const int op_assign = 0x04;
  48const int op_brackets = 0x07;
  49const int op_count = 0xA6;
  50const int op_each = 0x4C;
  51const int op_plus = 0x16;
  52const int op_match = 0xEE;
  53const int op_minus = 0x36;
  54const int op_multiply = 0x1E;
  55const int op_rank = 0x44;
  56const int op_divide = 0x3E;
  57const int op_strand = 0x3C;
  58
  59const int op_pow = 0x7E;
  60const int op_umn = 0x36;
  61const int op_le = 0x6E;
  62const int op_lt = 0x4E;
  63
  64struct APL_OPERATOR {
  65	const char* name;
  66	unsigned int code;
  67} APL_OPTABLE[] = { 
  68	{ "assigninto", 0x04 },
  69	{ "_in", 0x116 },
  70	{ "_and", 0x06 },
  71	{ "_or", 0x0E },
  72	{ "_not", 0xBE },
  73	{ "_type", 0x0E },
  74	{ "_unpack", 0xFE },
  75	{ "abs", 0x46 },
  76	{ "bag", 0x11E },
  77	{ "bins", 0xDE },
  78	{ "choose", 0xA6 },
  79	{ "compress", 0x106 },
  80	{ "concat", 0xB6 },
  81	{ "count", 0xA6 },
  82	{ "decode", 0xF6 },
  83	{ "depth", 0xEE },
  84	{ "disclose", 0x56 },
  85	{ "div", 0x3E },
  86	{ "drop", 0xD6 },
  87	{ "each", 0x4C },
  88	{ "enclose", 0x4E },
  89	{ "equals", 0x5E },
  90	{ "exp", 0x7E },
  91	{ "find", 0x9E },
  92	{ "gradeup", 0xDE },
  93	{ "gradedown", 0xE6 },
  94	{ "gt", 0x56 },
  95	{ "gte", 0x76 },
  96	{ "inner", 0x216 },
  97	{ "innermax", 0x226 },
  98	{ "innermin", 0x22E },
  99	{ "laminate", 0xBE },
 100	{ "lt", 0x4E },
 101	{ "lte", 0x6E },
 102	{ "log", 0x86 },
 103	{ "match", 0xEE },
 104	{ "mod", 0x46 },
 105	{ "minus", 0x36 },
 106	{ "mult", 0x1E },
 107	{ "neg", 0x36 },
 108	{ "outermult", 0x1ae },
 109	{ "outerplus", 0x1a6 },
 110	{ "outerdiv", 0x1ce },
 111	{ "outerminus", 0x1c6 },
 112	{ "outerequals", 0x1ee },
 113	{ "outergte", 0x206 },
 114	{ "outergt", 0x1e6 },
 115	{ "outerlt", 0x1de },
 116	{ "outerlte", 0x1fe },
 117	{ "outermax", 0x1b6 },
 118	{ "outermin", 0x1be},
 119	{ "pack", 0xF6 },
 120	{ "pi", 0x13E },
 121	{ "plus", 0x16 },
 122	{ "pick", 0x126 },
 123	{ "pow", 0x7E },
 124	{ "rake", 0x116 },
 125	{ "rand", 0x8E },
 126	{ "rank", 0x44 },
 127	{ "ravel", 0xB6 },
 128	{ "raze" , 0x126 },
 129	{ "replicate", 0x106 },
 130	{ "restructure", 0x136 },
 131	{ "right", 0x24E },
 132	{ "reverse", 0xC6 },
 133	{ "rot", 0xC6 },
 134	{ "shape", 0xAE},
 135	{ "solve", 0x12E },
 136	{ "sum", 0x186 },
 137	{ "take", 0xCE },
 138	{ "til", 0x9E },
 139	{ "iota", 0x9E },
 140	{ "transpose", 0x96 },
 141	{ NULL, 0 }
 142};
 143
 144static void registerOperator(lua_State *L,APL_OPERATOR* op) {
 145	lua_pushlightuserdata(L, (void*)op->code);
 146	lua_setglobal(L, op->name);
 147}
 148
 149//////////////////////////////////////////////////////////////////////////////
 150// Lua function call parsing
 151//////////////////////////////////////////////////////////////////////////////
 152
 153enum ETokType {
 154	NotSet, Invalid, Null, Int, Float, Char, Operator, Function, AObject
 155};
 156
 157class Tok 
 158{
 159public:
 160	Tok();
 161	void Append(A aobj);
 162	void Append(lua_State *L, int args);
 163	bool CanAppend(int luatype);
 164	int Length() const;
 165public:
 166	int iNumArgs;
 167	ETokType iType;
 168	long iOperator;
 169	vector<double> iNum;
 170	vector<string> iStr;
 171	vector<A> iA;
 172};
 173
 174Tok::Tok() {
 175// Constructor
 176	iNumArgs = 0;
 177	iOperator = 0;
 178	iType = NotSet;
 179}
 180
 181int Tok::Length() const {
 182// Return the number of AObjects held by the tok
 183	switch(iType) {
 184	case NotSet: return 0;
 185	case Invalid: return 0;
 186	case Null: return 0;
 187	case Int: return 1;
 188	case Float: return 1;
 189	case Char: return iStr.size();
 190	case Operator: return 1;
 191	case Function: return 1;
 192	case AObject: return iA.size();
 193	default:
 194		break;
 195	}
 196	return 0;
 197}
 198
 199void Tok::Append(A aobj) {
 200// Append an aobj
 201	assert((iType == AObject) || (iType == NotSet));
 202	if (iType==NotSet) iType = AObject;
 203	iA.push_back(aobj);
 204}
 205
 206void Tok::Append(lua_State *L, int args) {
 207// First arg of a new token - initialize type
 208	iNumArgs++;
 209	int luatype = lua_type(L,args);
 210	switch(luatype) {
 211		case LUA_TNIL:
 212			iType = Null;
 213			break;
 214		case LUA_TNUMBER: {
 215			if (iType==NotSet) iType = Int;
 216			double val = luaL_checknumber(L, args);
 217			iNum.push_back(val);
 218			if (fabs(double(int(val))-val)>CT) {
 219				iType = Float;
 220			}
 221			
 222			break;
 223			}
 224		case LUA_TBOOLEAN: {
 225			if (iType==NotSet) iType = Int;
 226			double val = lua_toboolean(L, args);
 227			iNum.push_back(val);
 228			break;
 229			}
 230	    case LUA_TSTRING: {
 231			iType = Char;
 232			string val = lua_tostring(L, args);
 233			iStr.push_back(val);
 234			break;
 235			}
 236			break;
 237		case LUA_TTABLE: {
 238			iType = AObject;
 239			A a = table2aobject(L,args);
 240			iA.push_back(a);
 241			break;
 242			}
 243		case LUA_TFUNCTION: {
 244			iType = Function;
 245			lua_pushvalue(L, args);
 246			iOperator = luaL_ref(L, LUA_REGISTRYINDEX);
 247			break;
 248			}
 249		case LUA_TUSERDATA:	{
 250			iType = AObject;
 251			void * ud = luaL_checkudata(L,args,"APLOBJ");
 252			iA.push_back(*(A*)ud);
 253			break;
 254			}
 255		case LUA_TTHREAD: {
 256			iType = Invalid;
 257			break;
 258			}
 259		case LUA_TLIGHTUSERDATA: { 
 260			iType = Operator;
 261			void* ud = lua_touserdata(L,args);
 262			iOperator = reinterpret_cast<long>(ud);
 263			break;
 264			}
 265	};
 266}
 267
 268bool Tok::CanAppend(int luatype) {
 269// Return true if we can append arg to the token
 270	if (iType==NotSet) return true;
 271	if (iType==Int) return (luatype==LUA_TNUMBER || luatype==LUA_TBOOLEAN);
 272	if (iType==Float) return (luatype==LUA_TNUMBER || luatype==LUA_TBOOLEAN);
 273	if (iType==AObject) return (luatype==LUA_TUSERDATA);
 274	return false;
 275}
 276
 277enum TokArgs { NoGrouping, NoAObjGrouping, Grouping };
 278
 279static bool tokgrouping(const Tok& tok, TokArgs dogrouping) {
 280// Return true if the tok can be grouped
 281	if (dogrouping==Grouping) return true;
 282	if (dogrouping==NoGrouping) return false;
 283	if (dogrouping==NoAObjGrouping && tok.iType==AObject) return false;
 284	return true;
 285}
 286
 287static A table2slotfiller(lua_State *L) {
 288// Loop over table and create slotfiller
 289	vector<string> syms;
 290	vector<A> objs;
 291	int count = 0;
 292
 293	lua_pushnil(L);
 294	while(lua_next(L, -2)) { 
 295		if(lua_isstring(L,-2)) {
 296			string key = lua_tostring(L, -2);
 297			syms.push_back(key);
 298		} else {
 299			std::stringstream result;
 300			result << count;
 301			syms.push_back(result.str());
 302		}
 303		Tok arg;
 304		arg.Append(L,-1);
 305		A a = getAObject(L,arg);
 306		objs.push_back(a);
 307		count++;
 308		lua_pop(L, 1);
 309	}
 310	A sf = gv(Et,2);
 311	int size = syms.size();
 312	A sym = gv(Et,size);
 313	for(int i=0;i<size;i++) {
 314		sym->p[i]=MS(si(syms[i].c_str()));
 315	}
 316	A obj = gv(Et,size);
 317	for(int i=0;i<size;i++) {
 318		obj->p[i]=(I)objs[i];
 319	}
 320	sf->p[0] = (I)sym;
 321	sf->p[1] = (I)obj;
 322	return sf;
 323}
 324
 325static A table2array(lua_State *L) {
 326	vector<A> objs;
 327	Tok tok;
 328	lua_pushnil(L);
 329	while(lua_next(L, -2)) { 
 330		int argtype = lua_type(L,-1);
 331		if (tok.iType==NotSet || (tokgrouping(tok,Grouping) && tok.CanAppend(argtype))) {
 332			tok.Append(L,-1);
 333		} else {
 334			A a = getAObject(L,tok,false);
 335		    objs.push_back(a);
 336			tok = Tok();
 337			tok.Append(L,-1);
 338		}
 339		lua_pop(L, 1);
 340	}
 341	A a = getAObject(L,tok,false);
 342	objs.push_back(a);
 343	int size = (int)objs.size();
 344	if (size==1) return a;
 345	a = gv(Et,size);
 346	for(int i=0;i<size;i++) { ((I*)(a->p))[i]=(I)objs[i]; }
 347	return a;
 348}
 349
 350static A table2aobject(lua_State *L, int args) {
 351// Loop over table key/value pairs
 352// If first key == string -> create slotfiller
 353// else create nested aobject
 354	lua_pushvalue(L,args);
 355	lua_pushnil(L);
 356	lua_next(L, -2);
 357	int keytype = lua_type(L,-2);
 358	lua_pop(L,2); // reset stack;
 359
 360	A a = NULL;
 361	if(keytype==LUA_TSTRING) {
 362		a = table2slotfiller(L);
 363	} else {
 364		a = table2array(L);
 365
 366	}
 367	lua_pop(L,1);
 368	return a;
 369}
 370
 371static void tokenizeArgs(lua_State *L, vector<Tok>& toks, TokArgs dogrouping=Grouping) {
 372// Loop through the arguments passed from Lua and create a vector of toks
 373// eg: group args 1,2,3 into a single A+ int vector.
 374	int argsInit=lua_gettop(L);
 375	int args = argsInit;
 376	Tok tok;
 377	while(args>0) {
 378		int argtype = lua_type(L,args);
 379		if (tok.iType==NotSet || (tokgrouping(tok,dogrouping) && tok.CanAppend(argtype))) {
 380			tok.Append(L,args);
 381		} else {
 382			toks.push_back(tok);
 383			tok = Tok();
 384			tok.Append(L,args);
 385		}
 386		args--;
 387	}
 388	toks.push_back(tok);
 389	int argsFinal=lua_gettop(L);
 390	lua_pop(L, argsInit);
 391}
 392
 393//////////////////////////////////////////////////////////////////////////////
 394// Lua function call
 395//////////////////////////////////////////////////////////////////////////////
 396extern "C" I *Y;
 397extern C* qs;
 398
 399extern "C"
 400I luaplCallLua(A fnc, I numargs) {
 401	lua_State *L = (lua_State*)(fnc->i);
 402	int stacksize=lua_gettop(L);
 403	long fnref = fnc->d[0];
 404	lua_rawgeti(L, LUA_REGISTRYINDEX, fnref); /* push stored function */
 405	stacksize=lua_gettop(L);
 406
 407	A* luaarg = (A*) lua_newuserdata(L, sizeof(A));
 408	luaL_getmetatable(L, "APLOBJ");
 409	lua_setmetatable(L, -2);
 410	(*luaarg) = (A)ic((A)Y[1]);
 411	if(numargs>1) {
 412	  A* luaarg2 = (A*) lua_newuserdata(L, sizeof(A));
 413	  luaL_getmetatable(L, "APLOBJ");
 414	  lua_setmetatable(L, -2);
 415	  (*luaarg2) = (A)ic((A)Y[2]);	   
 416	}
 417	int numresults = 1;
 418	stacksize=lua_gettop(L);
 419	int retcode = lua_pcall(L, numargs, numresults, 0);
 420	stacksize=lua_gettop(L); 
 421//	luaL_unref(L, LUA_REGISTRYINDEX, fnref);
 422	A res = 0;
 423	if(retcode!=0) { 
 424		q = 15; qs = (char*) lua_tostring(L, -1);
 425	} else {
 426	  Tok tok;
 427	  tok.Append(L,-1);
 428	  stacksize=lua_gettop(L);
 429	  A ret = getAObject(L,tok);
 430	  stacksize=lua_gettop(L);
 431	  if (QV(ret)) {
 432	    V v = XV(ret);
 433	    res = (A)ic((A)(v->a));
 434	  } else {
 435		res = ret;
 436	  }
 437	  lua_pop(L, 1);
 438	}
 439	return (I)res;
 440}
 441
 442//////////////////////////////////////////////////////////////////////////////
 443// A(...) function parameter parsing
 444//////////////////////////////////////////////////////////////////////////////
 445
 446static E newExpr(long fncode, int argCount, long a0, long a1)
 447// Return an expression structure
 448{
 449  E e=(E)(ma(2+argCount)); // 2+numArgs
 450  e->n=argCount;
 451  e->f=fncode;
 452  switch(argCount){
 453    case 0:break;
 454    case 1:e->a[0]=a0;break;
 455    default:e->a[0]=a0,e->a[1]=a1;break;
 456    }
 457  return e;
 458}
 459
 460static A getStrand(lua_State *L, const Tok& atok, bool reverseOrder = true) {
 461// Convert a tok into a tuple of A objects
 462	int args = atok.Length();
 463	E e=(E)(ma(2+args)); // 2+numArgs
 464    e->n=args;
 465    e->f=op_strand; // xli function id
 466	for(int i=0;i<args;i++) {
 467		Tok tmp;
 468		tmp.iType = atok.iType;
 469		if (tmp.iType==Char) tmp.iStr.push_back(atok.iStr[i]);
 470		if (tmp.iType==AObject) tmp.iA.push_back(atok.iA[i]);
 471		A arg = getAObject(L,tmp);
 472		e->a[reverseOrder ? args-i-1 : i]=(I)arg;
 473	}
 474	A res = doeval(L,(E)e,true);
 475	return res;
 476}
 477
 478static A getAObject(lua_State *L, const Tok& atok, bool reverseOrder) {
 479// Convert a Tok into an A object
 480	checkmem();
 481	if (atok.Length()>1 && (atok.iType==Char || atok.iType==AObject))
 482		return getStrand(L,atok);
 483
 484	A a = NULL;
 485	switch(atok.iType) {
 486	    case Null: {
 487			a = aplus_nl;
 488			break;
 489		}
 490		case Int: {
 491			unsigned int size = atok.iNum.size();
 492			if (size==1) {
 493				a = gi((I)atok.iNum[0]);
 494			} else {
 495			  a = gv(It,size);
 496			  for(unsigned int i=0;i<size;i++) { ((I*)(a->p))[(reverseOrder) ? size-i-1 : i]=(I)atok.iNum[i]; }
 497			}
 498			break;
 499		  }
 500		case Float: {
 501			unsigned int size = atok.iNum.size();
 502			if (size==1) {
 503				a = gf(atok.iNum[0]);
 504			} else {
 505			    a = gv(Ft,size);
 506			    for(unsigned int i=0;i<size;i++) { ((F*)(a->p))[(reverseOrder) ? size-i-1 : i]=(F)atok.iNum[i]; }
 507			}
 508			break;
 509		  }
 510		case Char: {
 511			assert(atok.iStr.size()==1); 
 512			unsigned int size = atok.iStr[0].size(); 
 513			if (size==1) {
 514				a = gi(atok.iStr[0][0]);
 515				a->t = Ct;
 516			} else {
 517			  a = gv(Ct,size);
 518			  for(unsigned int i=0;i<size;i++) { ((C*)(a->p))[i]=(C)atok.iStr[0][i]; }
 519			}
 520			break;
 521		  }
 522		case Operator:
 523			a = (A)atok.iOperator;
 524			break;
 525		case AObject: {
 526			assert(atok.iA.size()==1); 
 527			a = (A)ic(atok.iA[0]);
 528			break;
 529		  }
 530		case Function: 
 531		case NotSet:
 532		case Invalid:
 533		default:
 534			assert(0); // should never reach here
 535			break;
 536	}
 537	checkmem();
 538	return a;
 539}
 540
 541Tok parseGetArg(lua_State *L, int& index, const vector<Tok>& toks) {
 542// Return an AObject or NULL
 543	Tok empty;
 544	if (index>=(int)toks.size()) return empty;
 545	Tok arg = toks[index];
 546	Tok next;
 547	if (index+1<(int)toks.size()) next = toks[index+1];
 548	if ((arg.iType == Operator) || (arg.iType == Function)) return empty;
 549	if (next.iOperator==op_rank) return empty;
 550	index++;
 551	return arg;
 552}
 553
 554A parseGetAObj(lua_State *L, int& index, const vector<Tok>& toks) {
 555// Return an AObject or NULL
 556	if (index>=(int)toks.size()) return NULL;
 557	Tok arg(parseGetArg(L,index,toks));
 558	if (arg.iType==NotSet) return NULL;
 559	A a = getAObject(L,arg);
 560	return a;
 561}
 562
 563/*A evaleachfn(lua_State *L,long opcode) {
 564// Evaluate opcode with each to create an executable A+ object
 565    E e = newExpr(op_each,1,opcode,0);
 566	A d = doeval(L,e,true);
 567	return d;
 568}*/
 569
 570A evalrankfn(lua_State *L, Tok arg, long opcode) {
 571// Evaluate opcode with each to create an executable A+ object
 572	A a = getAObject(L,arg);
 573    E e = newExpr(op_rank,2,opcode,(I)a);
 574	A d = doeval(L,e,true);
 575	return d;
 576}
 577
 578static long getFunction(lua_State *L, const Tok& atok, int numargs) {
 579// Convert a tok into a function or operator code
 580	A a = gv(It,3);
 581	a->t = 9;
 582	a->n = 1;
 583	a->r = 2;
 584	if (numargs>1) a->r = 3;
 585	(a->d[0]) = atok.iOperator; (a->d[1]) = 0; (a->d[2]) = 0;
 586	(a->i) = (I)L; (a->p[0]) = (I)gv(Ct,4); // dummy function name 
 587	(a->p[1]) = 0; (a->p[2]) = 0;
 588	return (I)a;
 589}
 590
 591Tok parseGetOp(lua_State *L, int& index, const vector<Tok>& toks) {
 592// Return an operator or uninitialized token
 593	Tok arg;
 594	if (index>=(int)toks.size()) return arg;
 595	arg = toks[index];
 596	if ((arg.iType == Operator) || (arg.iType == Function)) {
 597		index++;
 598		if (arg.iType == Operator && arg.iOperator==op_each) {
 599			Tok fn = parseGetOp(L,index,toks);
 600			if (fn.iType==NotSet) luaL_error(L,"luAPL error: Parse - each must operate on a function");
 601			if (fn.iType==Function) {
 602				int peek = index;
 603				Tok nextarg = parseGetArg(L,peek,toks);
 604				int numargs = (nextarg.iType==NotSet) ? 1 : 2;
 605				fn.iOperator = getFunction(L,fn,numargs);
 606			}
 607//			arg.iOperator = (I)evaleachfn(L,fn.iOperator);
 608			A z = gv(Xt,0);
 609			z->r = 2;
 610			z->d[0] = op_each;
 611			z->d[1] = fn.iOperator;
 612			arg.iOperator = (I)z;
 613		}
 614		return arg;
 615	}
 616	Tok next;
 617	if (index+2>=(int)toks.size()) return next;
 618	if (toks[index+1].iOperator!=op_rank) return next;
 619	Tok fn = toks[index+2];
 620	if ((fn.iType != Operator) && (fn.iType != Function)) return next;
 621	if (fn.iType==Function) {
 622		int peek = index+3;
 623		Tok nextarg = parseGetArg(L,peek,toks);
 624		int numargs = (nextarg.iType==NotSet) ? 1 : 2;
 625		fn.iOperator = getFunction(L,fn,numargs);
 626	}
 627	index+=3;
 628	fn.iType = Operator;
 629	fn.iOperator = (I)evalrankfn(L,arg,fn.iOperator);
 630	return fn;
 631}
 632
 633static E parsetoks(lua_State *L, int& index, const vector<Tok>& toks, E e) {
 634// Create an expr from the incoming toks
 635
 636	if (e==NULL) {
 637		A arg1 = parseGetAObj(L,index,toks);
 638		if (arg1==NULL) {
 639			luaL_error(L,"luAPL error: Parse - expected value as first token");
 640		}
 641		Tok op = parseGetOp(L,index,toks);
 642		if (op.iType==NotSet) return (E)arg1;
 643		A arg2 = parseGetAObj(L,index,toks);
 644		if (arg2==NULL) { arg2=arg1; arg1=NULL; }
 645		if (op.iType==Operator && op.iOperator==op_assign) { A tmp=arg2; arg2=arg1; arg1=tmp; }
 646		if (op.iType==Function) { op.iOperator = getFunction(L,op,(arg1)?2:1); }
 647		E expr = newExpr(op.iOperator,(arg1)?2:1,(I)arg2,(I)arg1);
 648		return (E)ME(expr);
 649	}
 650
 651	Tok op = parseGetOp(L,index,toks);
 652	if (op.iType==NotSet) luaL_error(L,"luAPL error: Parse - expected operator or function");
 653	A arg1 = parseGetAObj(L,index,toks);
 654	if (arg1==NULL) { arg1=(A)e; e=NULL; }
 655	if (op.iOperator==op_assign) { I tmp=(I)e; e=(E)arg1; arg1=(A)tmp; }
 656	if (op.iType==Function) { op.iOperator = getFunction(L,op,(e)?2:1); }
 657	E expr = newExpr(op.iOperator,(e)?2:1,(I)arg1,(I)e);
 658	return (E)ME(expr);
 659}
 660
 661static E parseargs(lua_State *L) {
 662// Parse incoming arguments into an E
 663	vector<Tok> toks;
 664	tokenizeArgs(L,toks);
 665	
 666	E e = NULL;
 667	int i=0;
 668	while(i<(int)toks.size()) {
 669		e = parsetoks(L,i,toks,e);
 670	}
 671   return e;
 672}
 673
 674static A doeval(lua_State *L,E e,bool retdata=true) {
 675// Evaluate an A+ expression under a protective "do"
 676// Recursively frees the expr structure e
 677  checkmem();
 678  E e0=(E)(ma(3));
 679  e0->n=1;
 680  e0->f=(I)aplus_pi((char *)"do");
 681  e0->a[0]=ME(e);
 682  A result=(A)ez(ME(e0));
 683  A rc=(A)result->p[0];
 684  A data=(A)result->p[1];
 685  checkmem();
 686  ef(ME(e0));
 687  checkmem();
 688  if ( 0 == rc->p[0] )
 689    {
 690	  if(retdata) ic(data);
 691      dc(result);
 692	  if(retdata) return data;
 693      return 0;
 694    }
 695  string errname((qs)? qs : (char*)(data->p));
 696  int errcode = *(int*)rc->p;
 697  dc(result);
 698  luaL_error(L,"luAPL error %d: %s",errcode, errname.c_str());
 699  return 0;
 700}
 701
 702static A doassign(lua_State *L, E e) {
 703// Evaluate an A+ expression and assign the result to a new variable
 704  E e1=(E)(ma(4));
 705  e1->n=2;
 706  e1->f=op_assign;
 707  V v=(V)malloc(sizeof(struct _v));memset(v,0,sizeof(struct _v));
 708  e1->a[0]=MV(v);
 709  e1->a[1]=ME(e);
 710  doeval(L,e1,false);
 711  return (A)MV(v);
 712}
 713
 714static int assigninto(lua_State *L) {
 715// Update the value of a variable
 716	E e = parseargs(L);
 717	doeval(L,(E)e,false);
 718	return 0;
 719}
 720
 721int assign(lua_State *L) {
 722// Evaluate an expression and assign the result to a variable
 723	E e = parseargs(L);
 724	A res = NULL;
 725	if (QE(e)) {
 726		res = doassign(L,e);
 727	} else if (QV(e)) {
 728		 V v=(V)malloc(sizeof(struct _v));memset(v,0,sizeof(struct _v));
 729		 v->a = ic((A)XV(e)->a);
 730		 res = (A)MV(v);
 731	} else {
 732		V v=(V)malloc(sizeof(struct _v));memset(v,0,sizeof(struct _v));
 733		v->a = (I)e;
 734		res = (A)MV(v);
 735	}
 736	A* luares = (A*) lua_newuserdata(L, sizeof(A));
 737	luaL_getmetatable(L, "APLOBJ");
 738	lua_setmetatable(L, -2);
 739	(*luares) = res;
 740	return 1;
 741}
 742
 743static A getA(lua_State *L) {
 744// Pull an A+ object off the lua stack
 745	A a = *(A*)luaL_checkudata(L, 1, "APLOBJ");
 746	if(QV(a)) a = (A)XV(a)->a;
 747	return a;
 748}
 749
 750static int debug(lua_State *L) {
 751// Hit a breakpoint in the debugger
 752	return 0;
 753}
 754
 755static int sqrBrackets(lua_State *L) {
 756// Evaluate x[...] and return a value
 757	vector<Tok> toks;
 758	tokenizeArgs(L,toks,NoAObjGrouping);
 759	A a = getAObject(L,toks[0]); if(QV(a)) a = (A)ic((A)XV(a)->a);
 760	A x = getAObject(L,toks[1]);
 761	int n=2;
 762	if (a->t==Et) n = 1+a->n; 
 763    E e1=newExpr(op_brackets,n,(I)x,(I)a);
 764	if (a->t==Et) {
 765		for(int i=0;i<a->n;i++) {
 766			((I*)(e1->a))[i+1] = ic((A)(a->p)[i]);
 767		}
 768		dc(a);
 769	}
 770	A res = doeval(L,e1);
 771	A* luares = (A*) lua_newuserdata(L, sizeof(A));
 772	luaL_getmetatable(L, "APLOBJ");
 773	lua_setmetatable(L, -2);
 774	(*luares) = res;
 775	return 1;
 776}
 777
 778static int assign2SqrBrackets(lua_State *L) {
 779// Evaluate x[...] and return a value
 780	vector<Tok> toks;
 781	tokenizeArgs(L,toks,NoGrouping);
 782	A a = getAObject(L,toks[1]); 
 783	A x = getAObject(L,toks[2]); 
 784	A v = getAObject(L,toks[0]);
 785    E e1=newExpr(op_brackets,2,(I)x,(I)a);
 786	E e2=newExpr(op_assign,2,ME(e1),(I)v);
 787	A res = doeval(L,e2);
 788	A* luares = (A*) lua_newuserdata(L, sizeof(A));
 789	luaL_getmetatable(L, "APLOBJ");
 790	lua_setmetatable(L, -2);
 791	(*luares) = res;
 792	return 1;
 793}
 794
 795namespace AFn {
 796
 797// forward declarations
 798static bool pushValue(lua_State *L, A a);
 799
 800static int type2str(lua_State *L) {
 801// Return the type of the A object
 802	A a = getA(L);
 803	const char* typestr = NULL;
 804	switch(a->t) {
 805	  case It: typestr = "INT"; break;
 806	  case Ft: typestr = "FLOAT"; break;
 807	  case Ct: typestr = "CHAR"; break;
 808	  case Et: typestr = sym(a)?"SYMBOL":"NESTED"; break;
 809	  case Xt: typestr = "FUNCTION"; break;
 810	  default: typestr = "UNKNOWN"; break;
 811	}
 812	lua_pushstring(L,typestr);
 813	return 1;
 814}
 815
 816static bool pushNumberRecursive(lua_State *L, int rank, int& index, A a) {
 817	if (rank<=1) {
 818	  if (index>=a->n) return false;
 819	  if (a->t==It) {
 820  		  lua_pushinteger(L,((I*)a->p)[index]);
 821		} else {
 822		  lua_pushnumber(L,((F*)a->p)[index]);
 823	  }
 824	  index++;
 825	  return true;
 826	}
 827	lua_newtable(L);
 828	int size = a->d[a->r-rank+1];
 829	rank-=1;
 830	for(int i=0;i<size;i++) {
 831  	  bool dopush = pushNumberRecursive(L,rank,index,a);
 832	  if (dopush) lua_rawseti(L,-2,i+1);
 833	}
 834	return true;
 835}
 836
 837static bool pushNumber(lua_State *L, A a) {
 838    int n = a->n;
 839	if(n==0) return false;
 840	if(n==1) {
 841		if (a->t==It) {
 842  		  lua_pushinteger(L,*(I*)a->p);
 843		} else {
 844		  lua_pushnumber(L,*(F*)a->p);
 845		}
 846		return true;
 847	}
 848	int rank = a->r;
 849	int index = 0;
 850	lua_newtable(L);
 851	int size = (rank<=1) ? a->n : a->d[0];
 852	for(int i=0;i<size;i++) {
 853		bool dopush = pushNumberRecursive(L,rank,index,a);
 854		if (dopush) lua_rawseti(L,-2,i+1);
 855	}
 856	return true;
 857}
 858
 859static bool pushStringRecursive(lua_State *L, int rank, int& index, A a) {
 860	if (rank<=0) return false;
 861	if (rank==1) {
 862		int lim = a->d[a->r-2];
 863		int step = a->d[a->r-1];
 864		for(int i=0;i<lim;i++) {
 865			lua_pushlstring(L,(char*)a->p+index,step);
 866			index+=step;
 867			lua_rawseti(L,-2,i+1);
 868		}
 869		return false;
 870	}
 871
 872	lua_newtable(L);
 873	int size = a->d[a->r-rank];
 874	rank-=1;
 875	for(int i=0;i<size;i++) {
 876  	  bool dopush = pushStringRecursive(L,rank,index,a);
 877	  if (dopush) lua_rawseti(L,-2,i+1);
 878	}
 879	return true;
 880}
 881
 882static bool pushString(lua_State *L, A a) {
 883// return a string value to lua
 884	if (a->n==0) return false;
 885	if (a->r<=1) {
 886		lua_pushlstring(L,(char*)a->p,a->n);
 887		return true;
 888	}
 889	int rank = a->r;
 890	int index = 0;
 891	lua_newtable(L);
 892	for(int i=0;i<a->d[0];i++) {
 893	  bool dopush = pushStringRecursive(L,--rank,index,a);
 894	  if (dopush) lua_rawseti(L,-2,i+1);
 895	}
 896	return true;
 897}
 898
 899static bool pushNestedRecursive(lua_State *L, int rank, int& index, A a) {
 900	if (rank<=1) {
 901		if (index>=a->n) return false;
 902		return pushValue(L,((A*)a->p)[index++]);
 903	}
 904	lua_newtable(L);
 905	int size = a->d[a->r-rank+1];
 906	rank-=1;
 907	for(int i=0;i<size;i++) {
 908  	  bool dopush = pushNestedRecursive(L,rank,index,a);
 909	  if (dopush) lua_rawseti(L,-2,i+1);
 910	}
 911	return true;
 912}
 913
 914static bool pushNested(lua_State *L, A a) {
 915	int rank = a->r;
 916	int index = 0;
 917	if (a->n==0) return false;
 918	lua_newtable(L);
 919	int size = (rank<=1) ? a->n : a->d[0];
 920	for(int i=0;i<size;i++) {
 921		bool dopush = pushNestedRecursive(L,rank,index,a);
 922		if (dopush) lua_rawseti(L,-2,i+1);
 923	}
 924	return true;
 925}
 926
 927static bool pushSf(lua_State *L, A a) {
 928// loop over syms - push key / value
 929	lua_newtable(L);
 930	A syms = (A)a->p[0];
 931	A vals = (A)a->p[1];
 932	int n = syms->n;
 933	for(int i=0;i<n;i++) {
 934		S s = XS(syms->p[i]);
 935		lua_pushstring(L,s->n);
 936		bool dopush = pushValue(L,(A)vals->p[i]);
 937		assert(dopush);
 938        lua_rawset(L, -3);
 939	}
 940	return true;
 941}
 942
 943static bool pushValue(lua_State *L, A a) {
 944	if (QV(a)) a = (A)(XV(a)->a);
 945	switch(a->t) {
 946	  case It: if (a->n==0) break; return pushNumber(L,a); 
 947	  case Ft: if (a->n==0) break; return pushNumber(L,a); 
 948	  case Ct: if (a->n==0) break; return pushString(L,a);
 949	  case Et: if (a->n==0) break; if (ep_issf(a)) { return pushSf(L,a); } else { return pushNested(L,a); }
 950      case Xt: break;
 951	  default: break;
 952	}
 953	return false;
 954}
 955
 956static int value(lua_State *L) {
 957	A a = getA(L);
 958	bool dopush = pushValue(L,a);
 959	if (dopush) return 1;
 960	return 0;
 961}
 962
 963static void addnewlines(A ct, string& str, const string& prefix, int offset) {
 964// Convert an object to string - add newlines 
 965	I d[9];
 966	mv(d,ct->d,ct->r);
 967	int k=ct->r-1;
 968	while(--k) { d[k]*=d[k+1]; }
 969
 970	int an = ct->n;
 971	int step = ct->d[ct->r-1];
 972	int i = offset;
 973	if(an-i-step>0) {
 974	    for(k=ct->r;--k&&!((an-i-step)%d[k]);) { str.append("\n"); str.append(prefix); }
 975	}
 976}
 977
 978static string convert2str(A ct, const string& prefix) {
 979// Convert an aobject to string
 980	string str;
 981	int an = ct->n;
 982	int step = ct->d[ct->r-1];
 983	for (int i=0;i<an;i+=step) {
 984		str.append(((C*)(ct->p))+i,step);
 985		addnewlines(ct,str,prefix,i);
 986	}
 987	return str;
 988}
 989
 990static void nestedobj2string(A a, int& nestLevel, string& str) {
 991// Convert a nested A object to a string
 992  int n = a->n;
 993  const char* prefix = "< ";
 994  const char* spaces = "  ";
 995  for (int i=0; i<n; i++) {
 996	  A a1 = (A)(a->p[i]);
 997	  int localnest = nestLevel;
 998	  if(a1->t==Et && !sym(a1)) {
 999		  localnest++;
1000	      nestedobj2string(a1,localnest,str);
1001		  if(a->r>1) addnewlines(a,str,"",i);
1002	  } else {
1003		  A ct = (A)mth(a1);
1004		  if (i==0) {
1005  		    for(int jj=0;jj<nestLevel;jj++) str.append(prefix); 
1006		  } else {
1007			for(int jj=0;jj<nestLevel-1;jj++) str.append(spaces); 
1008			str.append(prefix);
1009		  }
1010		  if (ct->r>1) {
1011			string prefix2;
1012			for(int jj=0;jj<nestLevel;jj++) prefix2.append(spaces);
1013		    str.append(convert2str(ct,prefix2).c_str());
1014	      } else {
1015		    str.append((C*)ct->p,ct->n);
1016	      }
1017		  str.append("\n");
1018		  dc(ct);
1019	  }
1020  }
1021}
1022
1023static int collectgarbage(lua_State *L) {
1024// Decrement a ref count on the A+ obj
1025	checkmem();
1026	void * ud = lua_touserdata(L,1);
1027	A a = *(A*)ud;
1028	if (QA(a)) { 
1029		dc(a); 
1030	} else if (QV(a)) {
1031  	  V v = XV(*(V*)(ud));
1032	  if (v) {
1033  	    if(v->a) dc((A)v->a);
1034	    free(v);
1035	  }
1036	} else {
1037		luaL_error(L,"Error - freeing unknown var type");
1038	}
1039	checkmem();
1040	return 0;
1041}
1042
1043static int unaryminus(lua_State *L) {
1044// Evaluate fncode on the incoming args
1045	vector<Tok> toks;
1046	tokenizeArgs(L,toks,NoGrouping);
1047	Tok tmp = toks[1]; // Only first arg is valid
1048	toks.clear();
1049	toks.push_back(tmp);
1050	E e=(E)(ma(2+toks.size())); // 2+numArgs
1051    e->n=toks.size();
1052    e->f=op_umn;
1053	int size = toks.size();
1054	for(int i=0; i<size;i++) {
1055		A arg = getAObject(L,toks[i]);
1056		e->a[size-i-1]=(I)arg;
1057	}
1058	A res = doassign(L,(E)e);
1059	A* luares = (A*) lua_newuserdata(L, sizeof(A));
1060	luaL_getmetatable(L, "APLOBJ");
1061	lua_setmetatable(L, -2);
1062	(*luares) = res;
1063	return 1;
1064}
1065
1066static int inlineop(lua_State *L, long fncode) {
1067// Evaluate fncode on the incoming args
1068	vector<Tok> toks;
1069	tokenizeArgs(L,toks,NoGrouping);
1070	E e=(E)(ma(2+toks.size())); // 2+numArgs
1071    e->n=toks.size();
1072    e->f=fncode;
1073	int size = toks.size();
1074	for(int i=0; i<size;i++) {
1075		A arg = getAObject(L,toks[i]);
1076		e->a[size-i-1]=(I)arg;
1077	}
1078	A res = doassign(L,(E)e);
1079	A* luares = (A*) lua_newuserdata(L, sizeof(A));
1080	luaL_getmetatable(L, "APLOBJ");
1081	lua_setmetatable(L, -2);
1082	(*luares) = res;
1083	return 1;
1084}
1085
1086static int plus(lua_State *L) {	return inlineop(L,op_plus); }
1087static int minus(lua_State *L) { return inlineop(L,op_minus); }
1088static int multiply(lua_State *L) {	return inlineop(L,op_multiply); }
1089static int divide(lua_State *L) { return inlineop(L,op_divide); }
1090static int power(lua_State *L) { return inlineop(L,op_pow); }
1091static int lessthaneq(lua_State *L) { return inlineop(L,op_le); }
1092static int lessthan(lua_State *L) { return inlineop(L,op_lt); }
1093static int strand(lua_State *L) { return inlineop(L,op_strand); }
1094
1095static int equals(lua_State *L) {
1096// Return the value of the A+ operator "match" - either true or false
1097	vector<Tok> toks;
1098	tokenizeArgs(L,toks,NoGrouping);
1099	E e=(E)(ma(2+toks.size())); // 2+numArgs
1100    e->n=toks.size();
1101    e->f=op_match;
1102	int size = toks.size();
1103	for(int i=0; i<size;i++) {
1104		A arg = getAObject(L,toks[i]);
1105		e->a[size-i-1]=(I)arg;
1106	}
1107	A res = doeval(L,(E)e);
1108	lua_pushboolean(L, res->p[0]);
1109	dc(res);
1110	return 1;
1111}
1112
1113static int length(lua_State *L) {
1114// Count - returns the length of the array
1115	vector<Tok> toks;
1116	tokenizeArgs(L,toks,NoGrouping);
1117	E e=(E)(ma(2+1)); // 2+numArgs
1118    e->n=1;
1119    e->f=op_count;
1120	e->a[0] = (I)getAObject(L,toks[1]); // First token passed in is a Null (?)
1121	A res = doeval(L,(E)e);
1122	lua_pushinteger(L, res->p[0]);
1123	dc(res);
1124	return 1;
1125}
1126
1127static int symbol(lua_State *L) {
1128	vector<Tok> toks;
1129	tokenizeArgs(L,toks,NoGrouping);
1130	int size = toks.size();
1131	A z = gv(Et,size);
1132	if (size==1) z->r=0;
1133	for(int i=0;i<size;i++) {
1134		assert((toks[i].iType==Char) && toks[i].iStr.size()==1);
1135		z->p[size-i-1]=MS(si(toks[i].iStr[0].c_str()));
1136	}
1137	A* luares = (A*) lua_newuserdata(L, sizeof(A));
1138	luaL_getmetatable(L, "APLOBJ");
1139	lua_setmetatable(L, -2);
1140	(*luares) = z;
1141	return 1;
1142}
1143
1144static int newindex(lua_State *L) {
1145	if (lua_type(L,2) == LUA_TSTRING) {
1146		lua_pushnil(L);
1147		return 1; 
1148	}
1149	return assign2SqrBrackets(L);
1150}
1151
1152typedef A (*AFnPtr)(A);
1153
1154static int inlinefunc(lua_State *L, AFnPtr fn) {
1155	vector<Tok> toks;
1156	tokenizeArgs(L,toks,NoGrouping);
1157	Tok tuple;
1158	for(unsigned int i=0; i<toks.size(); i++) {
1159		if ((fn==ep_alsf) && (i%2!=0) && (toks[i].iType==Char) && (toks[i].iStr.size()==1)) {
1160		  A z = gv(Et,1);
1161	  	  z->p[0]=MS(si(toks[i].iStr[0].c_str()));
1162		  toks[i].iType = AObject;
1163		  toks[i].iA.push_back(z);
1164		}
1165		tuple.Append(getAObject(L,toks[i]));
1166	}
1167	A a = getAObject(L,tuple);
1168	if (QV(a)) a = (A)((V)XV(a))->a;
1169	A sf = fn(a);
1170	if (q!=0) {
1171		string errname((qs)? qs : "");
1172		int errcode = q;
1173		luaL_error(L,"luAPL error %d: %s",errcode, errname.c_str());
1174		return 0;
1175	}
1176	V v=(V)malloc(sizeof(struct _v));memset(v,0,sizeof(struct _v));
1177	v->a = (I)sf;
1178	I* luares = (I*) lua_newuserdata(L, sizeof(A));
1179	luaL_getmetatable(L, "APLOBJ");
1180	lua_setmetatable(L, -2);
1181	(*luares) = MV(v);
1182	return 1;
1183}
1184
1185static int alsf(lua_State *L) {	return inlinefunc(L,ep_alsf); }
1186static int flat(lua_State *L) {	return inlinefunc(L,ep_flat); }
1187static int sysexp(lua_State *L) { return inlinefunc(L,ep_exp); }
1188static int sysimp(lua_State *L) { return inlinefunc(L,ep_imp); }
1189
1190
1191static int ssr(lua_State *L) {
1192	vector<Tok> toks;
1193	tokenizeArgs(L,toks,NoGrouping);
1194	A s = getAObject(L,toks[2]);
1195	A t = getAObject(L,toks[1]);
1196	A r = getAObject(L,toks[0]);
1197	if (QV(s)) s = (A)((V)XV(s))->a;
1198	if (QV(t)) t = (A)((V)XV(t))->a;
1199	if (QV(r)) r = (A)((V)XV(r))->a;
1200	A sf = ep_ssr(s,t,r);
1201	if (q!=0) {
1202		string errname((qs)? qs : "");
1203		int errcode = q;
1204		luaL_error(L,"luAPL error %d: %s",errcode, errname.c_str());
1205		return 0;
1206	}
1207	V v=(V)malloc(sizeof(struct _v));memset(v,0,sizeof(struct _v));
1208	v->a = (I)sf;
1209	I* luares = (I*) lua_newuserdata(L, sizeof(A));
1210	luaL_getmetatable(L, "APLOBJ");
1211	lua_setmetatable(L, -2);
1212	(*luares) = MV(v);
1213	return 1;
1214}
1215
1216static int ss(lua_State *L) {
1217	vector<Tok> toks;
1218	tokenizeArgs(L,toks,NoGrouping);
1219	A s = getAObject(L,toks[1]);
1220	A t = getAObject(L,toks[0]);
1221	if (QV(s)) s = (A)((V)XV(s))->a;
1222	if (QV(t)) t = (A)((V)XV(t))->a;
1223	A sf = ep_ss(s,t);
1224	if (q!=0) {
1225		string errname((qs)? qs : "");
1226		int errcode = q;
1227		luaL_error(L,"luAPL error %d: %s",errcode, errname.c_str());
1228		return 0;
1229	}
1230	V v=(V)malloc(sizeof(struct _v));memset(v,0,sizeof(struct _v));
1231	v->a = (I)sf;
1232	I* luares = (I*) lua_newuserdata(L, sizeof(A));
1233	luaL_getmetatable(L, "APLOBJ");
1234	lua_setmetatable(L, -2);
1235	(*luares) = MV(v);
1236	return 1;
1237}
1238
1239static int issf(lua_State *L) {
1240	vector<Tok> toks;
1241	tokenizeArgs(L,toks,NoGrouping);
1242	A a = getAObject(L,toks[0]);
1243	if (QV(a)) a = (A)((V)XV(a))->a;
1244	I res = ep_issf(a);
1245	if (q!=0) {
1246		string errname((qs)? qs : "");
1247		int errcode = q;
1248		luaL_error(L,"luAPL error %d: %s",errcode, errname.c_str());
1249		return 0;
1250	}
1251	lua_pushinteger(L,res);
1252	return 1;
1253}
1254
1255int tostring(lua_State *L) {
1256// Convert an A object to a string
1257	A a = getA(L);
1258	A ct = NULL;
1259	if (a->t==Et && !sym(a)) {
1260	  int nestLevel = 1;
1261	  string str="";
1262	  AFn::nestedobj2string(a,nestLevel,str);
1263	  str.resize(str.size()-1); // remove trailing \n
1264	  lua_pushstring(L,str.c_str());
1265	} else {
1266  	  ct = (A)mth(a);
1267	  string str;
1268	  if (ct->r>1) {
1269		  str = AFn::convert2str(ct,"");
1270	  } else {
1271		  str.append((C*)ct->p,ct->n);
1272	  }
1273
1274	  lua_pushstring(L,str.c_str());
1275	  dc(ct);
1276	}
1277	return 1;
1278}
1279
1280static int index(lua_State *L) {
1281// Call a method or evaluate square brackets on an aobject eg: x[0]
1282	if (lua_type(L,2) == LUA_TSTRING) {
1283		const char *key;
1284		size_t      ksize;
1285		key = lua_tolstring(L,2,&ksize);
1286		if (strcmp(key,"value") == 0) {
1287			lua_pushcfunction(L,AFn::value);
1288			return 1;
1289		} 	
1290		if (strcmp(key,"type") == 0) {
1291			lua_pushcfunction(L,AFn::type2str);
1292			return 1;
1293		} 
1294		if (strcmp(key,"tostring") == 0) {
1295			lua_pushcfunction(L,AFn::tostring);
1296			return 1;
1297		} 
1298	}
1299	return sqrBrackets(L);
1300}
1301
1302} // namespace AFn
1303
1304extern "C"
1305const struct luaL_reg luapl [] = {
1306	{"export", AFn::sysexp},
1307	{"import", AFn::sysimp},
1308	{"assign", assign},
1309	{"debug", debug},
1310	{"alsf", AFn::alsf},
1311	{"assigninto", assigninto},
1312	{"flat", AFn::flat},
1313	{"issf", AFn::issf},
1314	{"strand", AFn::strand},
1315	{"symbol", AFn::symbol},
1316	{"ssr",AFn::ssr},
1317	{"ss",AFn::ss},
1318	{NULL, NULL}  /* sentinel */
1319};
1320
1321#ifdef _WIN32

1322#define EXPORT __declspec(dllexport)

1323#else

1324#define EXPORT

1325#endif

1326
1327extern "C"
1328void aplus_main(long argc, char** argv);
1329
1330#ifndef _WIN32

1331void checkmem() {
1332
1333}
1334#endif

1335
1336extern "C" 
1337	EXPORT int luaopen_luapl (lua_State *L) {
1338	const char* apldir = "./apl";
1339	aplus_main(1, (char**)&apldir);
1340	luaL_newmetatable(L, "APLOBJ");
1341      
1342	lua_pushstring(L, "__index");
1343    lua_pushcfunction(L, AFn::index);
1344    lua_settable(L, -3);
1345
1346	lua_pushstring(L, "__newindex");
1347    lua_pushcfunction(L, AFn::newindex);
1348    lua_settable(L, -3);
1349
1350	lua_pushstring(L, "__gc");
1351    lua_pushcfunction(L, AFn::collectgarbage);
1352    lua_settable(L, -3);
1353
1354	lua_pushstring(L, "__add");
1355    lua_pushcfunction(L, AFn::plus);
1356    lua_settable(L, -3);
1357
1358	lua_pushstring(L, "__sub");
1359    lua_pushcfunction(L, AFn::minus);
1360    lua_settable(L, -3);
1361
1362	lua_pushstring(L, "__mul");
1363    lua_pushcfunction(L, AFn::multiply);
1364    lua_settable(L, -3);
1365
1366	lua_pushstring(L, "__div");
1367    lua_pushcfunction(L, AFn::divide);
1368    lua_settable(L, -3);
1369
1370	lua_pushstring(L, "__pow");
1371	lua_pushcfunction(L, AFn::power);
1372    lua_settable(L, -3);
1373
1374	lua_pushstring(L, "__unm");
1375	lua_pushcfunction(L, AFn::unaryminus);
1376    lua_settable(L, -3);
1377
1378	/* - broken only work if both args are userdata and returns a boolean.
1379	lua_pushstring(L, "__lt");
1380	lua_pushcfunction(L, AFn::lessthan);
1381    lua_settable(L, -3);
1382
1383	lua_pushstring(L, "__le");
1384	lua_pushcfunction(L, AFn::lessthaneq);
1385    lua_settable(L, -3);
1386	*/
1387
1388	lua_pushstring(L, "__eq");
1389    lua_pushcfunction(L, AFn::equals);
1390    lua_settable(L, -3);
1391
1392	lua_pushstring(L, "__len");
1393    lua_pushcfunction(L, AFn::length);
1394    lua_settable(L, -3);
1395
1396	lua_pushstring(L, "__tostring");
1397    lua_pushcfunction(L, AFn::tostring);
1398    lua_settable(L, -3);
1399
1400	int i = 0;
1401	while (APL_OPTABLE[i].name != NULL)
1402		registerOperator(L,&APL_OPTABLE[i++]);
1403
1404	luaL_openlib(L, "luapl", luapl, 0);
1405	return 1;
1406}