// $Id: lua.cmod 16 2004-10-14 09:52:41Z kaos $

#include "global.h"
#include "svalue.h"
#include "module.h"
#include "interpret.h"
#include "pike_error.h"
#include "pike_types.h"

/* All your includes here */
#include 
#include 
#include 

/* Global variables
 */

/* Definitions
 */

#define LUAMOD_VERSION  "0.3"
#define LUAMOD_AUTHOR   "Andreas Stenius "

#define MAX_TYPENAME  8

//#define DEBUG_LUA

#ifdef DEBUG_LUA
#define LUADBG_PRINTF(X) printf X
#else
#define LUADBG_PRINTF(X)
#endif

/*! @module Public
 */

/*! @module Lang
 */

/*! @module Lua
 */

/*! @class State
 */

PIKECLASS State 
{
  CVAR lua_State * L;

  INIT
  {
    // create new lua state
    THIS->L = lua_open();

    if( !THIS->L )
      Pike_error( "Failed to initialize new Lua state\n" );
  }

  EXIT
  {
    if( THIS->L )
      lua_close( THIS->L );
  }

  // all pike functions registered in lua is called through this function
  int __lua_call_pike_fun( lua_State * L )
  {
    // number of arguments passed
    int i, n = lua_gettop( L );

    // get pike function to call (from upvalue)
    struct svalue * pike_fun = lua_touserdata( L, lua_upvalueindex( 1 ) );
    if( ! pike_fun || pike_fun->type != PIKE_T_FUNCTION )
    {
      Pike_error( "Invalid function upvalue\n" );
      return 0;
    }

    // push lua args onto pike stack
    for( i = 1; i <= n; i++ )
    {
      switch( lua_type( L, i ) )
      {
        case LUA_TNUMBER: push_float( lua_tonumber( L, i ) ); break;
        case LUA_TBOOLEAN: push_int( lua_toboolean( L, i ) ); break;
        case LUA_TSTRING: push_text( lua_tostring( L, i ) ); break;
        default:
          Pike_error( "Can't pass `%s' to pike function (not implemented)\n", lua_typename( L, lua_type( L, i ) ) );
          return 0;
      }
    }

    // call pike function
    apply_svalue( pike_fun, n );

    // push pike return value onto lua stack
    switch( Pike_sp[ -1 ].type )
    {
      case PIKE_T_STRING: lua_pushstring( L, STR0(Pike_sp[-1].u.string) ); break;
      case PIKE_T_FLOAT: lua_pushnumber( L, Pike_sp[-1].u.float_number ); break;
      case PIKE_T_INT: lua_pushnumber( L, Pike_sp[-1].u.integer ); break;

      default: // unhandled pike type
        return 0;
    }

    return 1;
  }

  /*! @decl void register( string name, function fun, void|int table )
   *!
   *! Registers the pike function @[fun] with lua, as @[name] in the table at stack
   *! index @[table], or the global scope (LUA_GLOBALSINDEX) if omited.
  */
  PIKEFUN void register( string name, function fun, void|int table )
  {
    struct svalue * pike_fun;
    LUADBG_PRINTF( ( "Lua: register function \"%s\" in table at index %d\n", STR0(name), table ? table->u.integer : LUA_GLOBALSINDEX ) );

    // pike function name in lua
    lua_pushstring( THIS->L, STR0(name) );

    // create new userdata for pike function to be called
    pike_fun = lua_newuserdata( THIS->L, sizeof( struct svalue ) );
    if( ! pike_fun )
      Pike_fatal( "Lua: failed to allocate userdata\n" );

    // keep ref to pike func in userdata
    // FIXME: add __gc metamethod function to userdata to call sub_ref on pike fun
    * pike_fun = * fun; add_ref( pike_fun->u.dummy );

    // push function with one upvalue (the pike fun)
    lua_pushcclosure( THIS->L, __lua_call_pike_fun, 1 );

    // store function in lua table
    if( table )
      lua_settable( THIS->L, table->u.integer );
    else
      lua_settable( THIS->L, LUA_GLOBALSINDEX );

    pop_n_elems( args );
  }

/*
** luaopen mapping
*/

  /*! @decl int open_base()
   *!
   *! Open base libarary.
  */
  PIKEFUN int open_base()
  {
    LUADBG_PRINTF( ( "Lua: open base\n" ) );
    RETURN luaopen_base( THIS->L );
  }

  /*! @decl int open_table()
   *!
   *! Open table library.
  */
  PIKEFUN int open_table()
  {
    LUADBG_PRINTF( ( "Lua: open table\n" ) );
    RETURN luaopen_table( THIS->L );
  }

  /*! @decl int open_io()
   *!
   *! Open io library.
  */
  PIKEFUN int open_io()
  {
    LUADBG_PRINTF( ( "Lua: open io\n" ) );
    RETURN luaopen_io( THIS->L );
  }

  /*! @decl int open_string()
   *!
   *! Open string library.
  */
  PIKEFUN int open_string()
  {
    LUADBG_PRINTF( ( "Lua: open string\n" ) );
    RETURN luaopen_string( THIS->L );
  }

  /*! @decl int open_math()
   *!
   *! Open math library.
  */
  PIKEFUN int open_math()
  {
    LUADBG_PRINTF( ( "Lua: open math\n" ) );
    RETURN luaopen_math( THIS->L );
  }

  /*! @decl int open_debug()
   *!
   *! Open debug library.
  */
  PIKEFUN int open_debug()
  {
    LUADBG_PRINTF( ( "Lua: open debug\n" ) );
    RETURN luaopen_debug( THIS->L );
  }


/*
** basic stack manipulation
*/

  /*! @decl int gettop()
   *!
   *! Because indices start at 1, the result of gettop is equal to the number of elements in the stack (and so 0 means an empty stack).
   */
  PIKEFUN int gettop()
  {
    RETURN lua_gettop( THIS->L );
  }

  /*! @decl void settop( int index )
   *!
   *! Accepts any acceptable index, or 0, and sets the stack top to that index. If the new top is larger than the old one, 
   *! then the new elements are filled with nil. If index is 0, then all stack elements are removed.
   */
  PIKEFUN void settop( int idx )
  {
    pop_n_elems( args );
    LUADBG_PRINTF( ( "Lua: settop( %d )\n", idx ) );
    lua_settop( THIS->L, idx );
  }

  /*! @decl void pushvalue( int index )
   *!
   *! Pushes onto the stack a copy of the element at the given index.
   */
  PIKEFUN void pushvalue( int idx )
  {
    pop_n_elems( args );
    LUADBG_PRINTF( ( "Lua: pushvalue( %d )\n", idx ) );
    lua_pushvalue( THIS->L, idx );
  }

  /*! @decl void remove( int index )
   *!
   *! Removes the element at the given position, shifting down the elements above that position to fill the gap.
   */
  PIKEFUN void remove( int idx )
  {
    pop_n_elems( args );
    LUADBG_PRINTF( ( "Lua: remove( %d )\n", idx ) );
    lua_remove( THIS->L, idx );
  }

  /*! @decl void insert( int index )
   *!
   *! Moves the top element into the given position, shifting up the elements above that position to open space.
   */
  PIKEFUN void insert( int idx )
  {
    pop_n_elems( args );
    LUADBG_PRINTF( ( "Lua: insert( %d )\n", idx ) );
    lua_insert( THIS->L, idx );
  }

  /*! @decl void replace( int index )
   *!
   *! Moves the top element into the given position, without shifting any element (therefore replacing the value at the given position).
   */
  PIKEFUN void replace( int idx )
  {
    pop_n_elems( args );
    LUADBG_PRINTF( ( "Lua: replace( %d )\n", idx ) );
    lua_replace( THIS->L, idx );
  }

  /*! @decl int checkstack( int size )
   *!
   *! Grows the stack size to top + extra elements; it returns false if it cannot grow the stack to that size. 
   *! This function never shrinks the stack; if the stack is already larger than the new size, it is left unchanged.
   *!
   *! NOTE: When you interact with Lua API, you are responsible for controlling stack overflow.
   *!
   *! Whenever Lua calls C, it ensures that at least LUA_MINSTACK stack positions are available. 
   *! LUA_MINSTACK is defined in lua.h as 20, so that usually you do not have to worry about stack space unless your code 
   *! has loops pushing elements onto the stack.
   *!
   *! Most query functions accept as indices any value inside the available stack space, that is, indices up to the maximum 
   *! stack size you have set through lua_checkstack. Such indices are called acceptable indices. More formally, we define 
   *! an acceptable index as follows:
   *! (index < 0 && abs(index) <= top) || (index > 0 && index <= stackspace)
   *!
   *! Note that 0 is never an acceptable index.
   *!
   *! Unless otherwise noted, any function that accepts valid indices can also be called with pseudo-indices, which represent some Lua values that are accessible to the C code but are not in the stack. Pseudo-indices are used to access the global environment, the registry, and the upvalues of a C function (see 3.17). 
   */
  PIKEFUN int checkstack( int sz )
  {
    LUADBG_PRINTF( ( "Lua: checkstack( %d )\n", sz ) );
    RETURN lua_checkstack( THIS->L, sz );
  }


/*
** access functions (stack -> C)
*/
  
  /*! @decl int isnumber( int index )
   *!
   *! Return 1 if the object is compatible with the given type, and 0 otherwise.
   */
  PIKEFUN int isnumber( int idx )
  {
    RETURN lua_isnumber( THIS->L, idx );
  }

  /*! @decl int isstring( int index )
   *!
   *! Return 1 if the object is compatible with the given type, and 0 otherwise.
   */
  PIKEFUN int isstring( int idx )
  {
    RETURN lua_isstring( THIS->L, idx );
  }

  /*! @decl int iscfunction( int index )
   *!
   *! Return 1 if the object is compatible with the given type, and 0 otherwise.
   */
  PIKEFUN int iscfunction( int idx )
  {
    RETURN lua_iscfunction( THIS->L, idx );
  }

  /*! @decl int isuserdata( int index )
   *!
   *! Return 1 if the object is compatible with the given type, and 0 otherwise.
   */
  PIKEFUN int isuserdata( int idx )
  {
    RETURN lua_isuserdata( THIS->L, idx );
  }

  /*! @decl int type( int index )
   *!
   *! Returns the type of a value in the stack, or LUA_TNONE for a non-valid index (that is, if that stack position is "empty").
   */
  PIKEFUN int type( int idx )
  {
    RETURN lua_type( THIS->L, idx );
  }

  /*! @decl string typename( int type )
   *!
   *! Translates a lua type to a string.
   */
  PIKEFUN string typename( int tp )
  {
    pop_n_elems( args );
    if( tp > MAX_TYPENAME )
      Pike_error( "type out of range (%d)\n", tp );

    push_text( lua_typename( THIS->L, tp ) );
  }

  /*! @decl int equal( int index1, int index2 )
   *!
   *!
   */
  PIKEFUN int equal( int idx1, int idx2 )
  {
    RETURN lua_equal( THIS->L, idx1, idx2 );
  }

  /*! @decl int rawequal( int index1, int index2 )
   *!
   *!
   */
  PIKEFUN int rawequal( int idx1, int idx2 )
  {
    RETURN lua_rawequal( THIS->L, idx1, idx2 );
  }

  /*! @decl int lessthan( int index1, int index2 )
   *!
   *!
   */
  PIKEFUN int lessthan( int idx1, int idx2 )
  {
    RETURN lua_lessthan( THIS->L, idx1, idx2 );
  }

  /*! @decl float tonumber( int index )
   *!
   *!
   *! FIXME: make sure lua_Number and pike float's are the same size (lua_Number defaults to double).
   *! configure pike with: --with-double-precision to make pike float's double.
   */
  PIKEFUN float tonumber( int idx )
  {
    RETURN lua_tonumber( THIS->L, idx );
  }

  /*! @decl int toboolean( int index )
   *!
   *!
   */
  PIKEFUN int toboolean( int idx )
  {
    RETURN lua_toboolean( THIS->L, idx );
  }

  /*! @decl string tostring( int index )
   *!
   *!
   */
  PIKEFUN string tostring( int idx )
  {
    const char *str;
    LUADBG_PRINTF( ( "Lua: tostring( %d )\n", idx ) );
    pop_n_elems( args );

    str = lua_tostring( THIS->L, idx );
    if( str )
      push_text( str );
    else
      push_constant_text( "" );
  }

  /*! @decl int strlen( int index )
   *!
   *!
   */
  PIKEFUN int strlen( int idx )
  {
    RETURN lua_strlen( THIS->L, idx );
  }
/*
  PIKEFUN lua_CFunction tocfunction( int idx )
  {
    RETURN lua_tocfunction( THIS->L, idx );
  }

  PIKEFUN void * touserdata( int idx )
  {
    RETURN lua_touserdata( THIS->L, idx );
  }

  PIKEFUN int ( int idx )
  {
    RETURN lua_( THIS->L, idx );
  }*/


/*
** push functions (C -> stack)
*/

  /*! @decl void pushnil()
   *!
   *!
   */
  PIKEFUN void pushnil()
  {
    pop_n_elems( args );
    lua_pushnil( THIS->L );
  }

  /*! @decl void pushnumber( float n )
   *! @decl void pushnumber( int n )
   *!
   */
  PIKEFUN void pushnumber( int|float n )
  {
    lua_Number N;
    if( n->type == PIKE_T_INT )
      N = n->u.integer;
    else if( n->type == PIKE_T_FLOAT )
      N = n->u.float_number;
    else
      Pike_error( "Bad argument 1 to pushnumber(), (expecting int|float, got %s)\n", get_name_of_type( n->type ) );

    LUADBG_PRINTF( ( "Lua: pushnumber( %f )\n", N ) );
    pop_n_elems( args );
    lua_pushnumber( THIS->L, N );
  }

  /*! @decl void pushlstring( string s, int length )
   *!
   *!
   */
  PIKEFUN void pushlstring( string s, int l )
  {
    LUADBG_PRINTF( ( "Lua: pushlstring( \"%s\", %d )\n", STR0(s), l ) );
    pop_n_elems( args );
    lua_pushlstring( THIS->L, STR0(s), l );
  }

  /*! @decl void pushstring( string s )
   *!
   *!
   */
  PIKEFUN void pushstring( string s )
  {
    LUADBG_PRINTF( ( "Lua: pushstring( \"%s\" )\n", STR0(s) ) );
    pop_n_elems( args );
    lua_pushstring( THIS->L, STR0(s) );
  }

  /*! @decl void pushboolean( int(0..1) bool )
   *!
   *!
   */
  PIKEFUN void pushboolean( int(0..1) b )
  {
    LUADBG_PRINTF( ( "Lua: pushboolean( %d )\n", b ) );
    pop_n_elems( args );
    lua_pushboolean( THIS->L, b );
  }


/*
** get functions (Lua -> stack)
*/

  /*! @decl void gettable( int index )
   *!
   *!
   */
  PIKEFUN void gettable( int idx )
  {
    LUADBG_PRINTF( ( "Lua: gettable( %d )\n", idx ) );
    pop_n_elems( args );
    lua_gettable( THIS->L, idx );
  }

  /*! @decl void rawget( int index )
   *!
   *!
   */
  PIKEFUN void rawget( int idx )
  {
    LUADBG_PRINTF( ( "Lua: rawget( %d )\n", idx ) );
    pop_n_elems( args );
    lua_rawget( THIS->L, idx );
  }

  /*! @decl void rawgeti( int index, int n )
   *!
   *!
   */
  PIKEFUN void rawgeti( int idx, int n )
  {
    LUADBG_PRINTF( ( "Lua: rawgeti( %d, %d )\n", idx, n ) );
    pop_n_elems( args );
    lua_rawgeti( THIS->L, idx, n );
  }

  /*! @decl void newtable()
   *!
   *!
   */
  PIKEFUN void newtable()
  {
    pop_n_elems( args );
    lua_newtable( THIS->L );
  }

  /*! @decl int getmetatable( int index )
   *!
   *!
   */
  PIKEFUN int getmetatable( int objindex )
  {
    pop_n_elems( args );
    lua_getmetatable( THIS->L, objindex );
  }

  /*! @decl void getfenv( int index )
   *!
   *!
   */
  PIKEFUN void getfenv( int idx )
  {
    pop_n_elems( args );
    lua_getfenv( THIS->L, idx );
  }


/*
** set functions (stack -> Lua)
*/

  /*! @decl void settable( int index )
   *!
   *!
   */
  PIKEFUN void settable( int idx )
  {
    LUADBG_PRINTF( ( "Lua: settable( %d )\n", idx ) );
    pop_n_elems( args );
    lua_settable( THIS->L, idx );
  }

  /*! @decl void rawset( int index )
   *!
   *!
   */
  PIKEFUN void rawset( int idx )
  {
    LUADBG_PRINTF( ( "Lua: rawset( %d )\n", idx ) );
    pop_n_elems( args );
    lua_rawset( THIS->L, idx );
  }

  /*! @decl void rawseti( int index, int n )
   *!
   *!
   */
  PIKEFUN void rawseti( int idx, int n )
  {
    LUADBG_PRINTF( ( "Lua: rawseti( %d )\n", idx, n ) );
    pop_n_elems( args );
    lua_rawseti( THIS->L, idx, n );
  }

  /*! @decl void setmetatable( int index )
   *!
   *!
   */
  PIKEFUN void setmetatable( int objindex )
  {
    pop_n_elems( args );
    lua_setmetatable( THIS->L, objindex );
  }

  /*! @decl void setfenc( int index )
   *!
   *!
   */
  PIKEFUN void setfenv( int idx )
  {
    pop_n_elems( args );
    lua_setfenv( THIS->L, idx );
  }


/*
** `load' and `call' functions (load and run Lua code)
*/

  /*! @decl void call( int nargs, int nresults )
   *!
   *!
   */
  PIKEFUN void call( int nargs, int nresults )
  {
    pop_n_elems( args );
    lua_call( THIS->L, nargs, nresults );
  }

  /*! @decl int pcall( int nargs, int nresults, int errfunc )
   *!
   *!
   */
  PIKEFUN int pcall( int nargs, int nresults, int errfunc )
  {
    RETURN lua_pcall( THIS->L, nargs, nresults, errfunc );
  }


/*
** coroutine functions
*/

  /*! @decl int yield( int nresults )
   *!
   *!
   */
  PIKEFUN int yield( int nresults )
  {
    RETURN lua_yield( THIS->L, nresults );
  }

  /*! @decl int resume( int nargs )
   *!
   *!
   */
  PIKEFUN int resume( int nargs )
  {
    RETURN lua_resume( THIS->L, nargs );
  }


/*
** garbage-collection functions
*/

  /*! @decl int getgcthreshold()
   *!
   *!
   */
  PIKEFUN int getgcthreshold()
  {
    RETURN lua_getgcthreshold( THIS->L );
  }

  /*! @decl int getgccount()
   *!
   *!
   */
  PIKEFUN int getgccount()
  {
    RETURN lua_getgccount( THIS->L );
  }

  /*! @decl void setgcthreshold( int new_threshold )
   *!
   *!
   */
  PIKEFUN void setgcthreshold( int newthreshold )
  {
    pop_n_elems( args );
    lua_setgcthreshold( THIS->L, newthreshold );
  }


/*
** miscellaneous functions
*/

  /*! @decl string version()
   *!
   *!
   */
  PIKEFUN string version()
  {
    pop_n_elems( args );
    push_constant_text( lua_version() );
  }

  /*! @decl int error()
   *!
   *!
   */
  PIKEFUN int error()
  {
    RETURN lua_error( THIS->L );
  }

  /*! @decl int next( int index )
   *!
   *!
   */
  PIKEFUN int next( int idx )
  {
    RETURN lua_next( THIS->L, idx );
  }

  /*! @decl void concat( int n )
   *!
   *!
   */
  PIKEFUN void concat( int n )
  {
    pop_n_elems( args );
    lua_concat( THIS->L, n );
  }


/*
** Aux lib functions
*/

  /*! @decl int loadfile( string filename )
   *!
   *!
   */
  PIKEFUN int loadfile( string filename )
  {
    LUADBG_PRINTF( ( "Lua: loadfile( %s )\n", STR0(filename) ) );
    RETURN luaL_loadfile( THIS->L, STR0(filename) );
  }

  /*! @decl int loadbuffer( string buff, int size, string name )
   *!
   *!
   */
  PIKEFUN int loadbuffer( string buff, int sz, string name )
  {
    LUADBG_PRINTF( ( "Lua: loadbuffer( \"%s\", %d, %s )\n", STR0(buff), sz, STR0(name) ) );
    RETURN luaL_loadbuffer( THIS->L, STR0(buff), sz, STR0(name) );
  }

  /*! @decl int dofile( string filename )
   *!
   *!
   */
  PIKEFUN int dofile( string filename )
  {
    LUADBG_PRINTF( ( "Lua: dofile( %s )\n", STR0(filename) ) );
    RETURN lua_dofile( THIS->L, STR0(filename) );
  }
  
  /*! @decl int dostring( string s )
   *!
   *!
   */
  PIKEFUN int dostring( string str )
  {
    LUADBG_PRINTF( ( "Lua: dostring( \"%s\" )\n", STR0(str) ) );
    RETURN lua_dostring( THIS->L, STR0(str) );
  }

  /*! @decl int dobuffer( string buff, int size, string name )
   *!
   *!
   */
  PIKEFUN int dobuffer( string buff, int sz, string name )
  {
    LUADBG_PRINTF( ( "Lua: dobuffer( \"%s\", %d, %s )\n", STR0(buff), sz, STR0(name) ) );
    RETURN lua_dobuffer( THIS->L, STR0(buff), sz, STR0(name) );
  }
}


/*
** Module stuff
*/

PIKE_MODULE_INIT
{
  INIT;

  // module & lua info
  add_string_constant( "__version", LUAMOD_VERSION, 0 );
  add_string_constant( "__author", LUAMOD_AUTHOR, 0 );
  add_string_constant( "LUA_VERSION", LUA_VERSION, 0 );
  add_string_constant( "LUA_COPYRIGHT", LUA_COPYRIGHT, 0 );

/*
** pseudo-indices
*/
  ADD_INT_CONSTANT( "LUA_MULTRET", LUA_MULTRET, 0 );
  ADD_INT_CONSTANT( "LUA_REGISTRYINDEX", LUA_REGISTRYINDEX, 0 );
  ADD_INT_CONSTANT( "LUA_GLOBALSINDEX", LUA_GLOBALSINDEX, 0 );

/* error codes for `lua_load' and `lua_pcall' */
  ADD_INT_CONSTANT( "LUA_ERRRUN", LUA_ERRRUN, 0 );
  ADD_INT_CONSTANT( "LUA_ERRFILE", LUA_ERRFILE, 0 );
  ADD_INT_CONSTANT( "LUA_ERRSYNTAX", LUA_ERRSYNTAX, 0 );
  ADD_INT_CONSTANT( "LUA_ERRMEM", LUA_ERRMEM, 0 );
  ADD_INT_CONSTANT( "LUA_ERRERR", LUA_ERRERR, 0 );

/*
** basic types
*/
  ADD_INT_CONSTANT( "LUA_TNONE", LUA_TNONE, 0 );
  ADD_INT_CONSTANT( "LUA_TNIL", LUA_TNIL, 0 );
  ADD_INT_CONSTANT( "LUA_TBOOLEAN", LUA_TBOOLEAN, 0 );
  ADD_INT_CONSTANT( "LUA_TLIGHTUSERDATA", LUA_TLIGHTUSERDATA, 0 );
  ADD_INT_CONSTANT( "LUA_TNUMBER", LUA_TNUMBER, 0 );
  ADD_INT_CONSTANT( "LUA_TSTRING", LUA_TSTRING, 0 );
  ADD_INT_CONSTANT( "LUA_TTABLE", LUA_TTABLE, 0 );
  ADD_INT_CONSTANT( "LUA_TFUNCTION", LUA_TFUNCTION, 0 );
  ADD_INT_CONSTANT( "LUA_TUSERDATA", LUA_TUSERDATA, 0 );
  ADD_INT_CONSTANT( "LUA_TTHREAD", LUA_TTHREAD, 0 );

/* minimum Lua stack available to a C function */
  ADD_INT_CONSTANT( "LUA_MINSTACK", LUA_MINSTACK, 0 );

}

PIKE_MODULE_EXIT
{
  EXIT;
}

/*! @endclass State
 */

/*! @endmodule Lua
 */

/*! @endmodule Lang
 */

/*! @endmodule Public
 */