extra/lua/lua.factor

   1 ! Copyright (C) 2010 Erik Charlebois.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.accessors alien.c-types
   4 alien.libraries alien.syntax classes.struct combinators
   5 io.encodings.ascii kernel math system ;
   6 IN: lua
   7
   8 << "liblua5.1" {
   9     { [ os windows? ] [ "lua5.1.dll" ] }
  10     { [ os macosx? ] [ "liblua5.1.dylib"  ] }
  11     { [ os unix? ] [ "liblua5.1.so" ] }
  12 } cond cdecl add-library >>
  13
  14 LIBRARY: liblua5.1
  15
  16 ! luaconf.h
  17 TYPEDEF: double LUA_NUMBER
  18 TYPEDEF: ptrdiff_t LUA_INTEGER
  19
  20 CONSTANT: LUA_IDSIZE 60
  21
  22 ! This is normally the BUFSIZ value of the given platform.
  23 : LUAL_BUFFERSIZE ( -- x )
  24     {
  25         { [ os windows? ] [ 512 ] }
  26         { [ os macosx? ] [ 1024 ] }
  27         { [ os unix? ] [ 8192 ] }
  28     } cond ;
  29
  30 ! lua.h
  31 CONSTANT: LUA_SIGNATURE B{ 27 76 117 97 }
  32 CONSTANT: LUA_MULTRET -1
  33
  34 CONSTANT: LUA_REGISTRYINDEX -10000
  35 CONSTANT: LUA_ENVIRONINDEX  -10001
  36 CONSTANT: LUA_GLOBALSINDEX  -10002
  37
  38 : lua_upvalueindex ( i -- i ) [ LUA_GLOBALSINDEX ] dip - ; inline
  39
  40 CONSTANT: LUA_YIELD     1
  41 CONSTANT: LUA_ERRRUN    2
  42 CONSTANT: LUA_ERRSYNTAX 3
  43 CONSTANT: LUA_ERRMEM    4
  44 CONSTANT: LUA_ERRERR    5
  45
  46 C-TYPE: lua_State
  47
  48 CALLBACK: int lua_CFunction ( lua_State* L )
  49 CALLBACK: char* lua_Reader ( lua_State* L, void* ud, size_t* sz )
  50 CALLBACK: int lua_Writer ( lua_State* L, void* p, size_t sz, void* ud )
  51 CALLBACK: void* lua_Alloc ( void* ud, void* ptr, size_t osize, size_t nsize )
  52
  53 CONSTANT: LUA_TNONE           -1
  54 CONSTANT: LUA_TNIL            0
  55 CONSTANT: LUA_TBOOLEAN        1
  56 CONSTANT: LUA_TLIGHTUSERDATA  2
  57 CONSTANT: LUA_TNUMBER         3
  58 CONSTANT: LUA_TSTRING         4
  59 CONSTANT: LUA_TTABLE          5
  60 CONSTANT: LUA_TFUNCTION       6
  61 CONSTANT: LUA_TUSERDATA       7
  62 CONSTANT: LUA_TTHREAD         8
  63
  64 CONSTANT: LUA_MINSTACK 20
  65
  66 TYPEDEF: LUA_NUMBER lua_Number
  67 TYPEDEF: LUA_INTEGER lua_Integer
  68
  69 FUNCTION: lua_State* lua_newstate ( lua_Alloc f, void* ud )
  70 FUNCTION: void lua_close ( lua_State* L )
  71 FUNCTION: lua_State* lua_newthread ( lua_State* L )
  72
  73 FUNCTION: lua_CFunction lua_atpanic ( lua_State* L, lua_CFunction panicf )
  74
  75 FUNCTION: int lua_gettop ( lua_State* L )
  76 FUNCTION: void lua_settop ( lua_State* L, int idx )
  77 FUNCTION: void lua_pushvalue ( lua_State* L, int idx )
  78 FUNCTION: void lua_remove ( lua_State* L, int idx )
  79 FUNCTION: void lua_insert ( lua_State* L, int idx )
  80 FUNCTION: void lua_replace ( lua_State* L, int idx )
  81 FUNCTION: int lua_checkstack ( lua_State* L, int sz )
  82
  83 FUNCTION: void lua_xmove ( lua_State* from, lua_State* to, int n )
  84
  85 FUNCTION: int lua_isnumber ( lua_State* L, int idx )
  86 FUNCTION: int lua_isstring ( lua_State* L, int idx )
  87 FUNCTION: int lua_iscfunction ( lua_State* L, int idx )
  88 FUNCTION: int lua_isuserdata ( lua_State* L, int idx )
  89 FUNCTION: int lua_type ( lua_State* L, int idx )
  90 FUNCTION: c-string[ascii] lua_typename ( lua_State* L, int tp )
  91
  92 FUNCTION: int lua_equal ( lua_State* L, int idx1, int idx2 )
  93 FUNCTION: int lua_rawequal ( lua_State* L, int idx1, int idx2 )
  94 FUNCTION: int lua_lessthan ( lua_State* L, int idx1, int idx2 )
  95
  96 FUNCTION: lua_Number lua_tonumber ( lua_State* L, int idx )
  97 FUNCTION: lua_Integer lua_tointeger ( lua_State* L, int idx )
  98 FUNCTION: int lua_toboolean ( lua_State* L, int idx )
  99 FUNCTION: c-string[ascii] lua_tolstring ( lua_State* L, int idx, size_t* len )
 100 FUNCTION: size_t lua_objlen ( lua_State* L, int idx )
 101 FUNCTION: lua_CFunction lua_tocfunction ( lua_State* L, int idx )
 102 FUNCTION: void* lua_touserdata ( lua_State* L, int idx )
 103 FUNCTION: lua_State* lua_tothread ( lua_State* L, int idx )
 104 FUNCTION: void* lua_topointer ( lua_State* L, int idx )
 105
 106 FUNCTION: void lua_pushnil ( lua_State* L )
 107 FUNCTION: void lua_pushnumber ( lua_State* L, lua_Number n )
 108 FUNCTION: void lua_pushinteger ( lua_State* L, lua_Integer n )
 109 FUNCTION: void lua_pushlstring ( lua_State* L, char* s, size_t l )
 110 FUNCTION: void lua_pushstring ( lua_State* L, c-string[ascii] s )
 111 ! FUNCTION: c-string[ascii] lua_pushvfstring ( lua_State* L, c-string[ascii] fmt, va_list argp )
 112 ! FUNCTION: c-string[ascii] lua_pushfstring ( lua_State* L, c-string[ascii] fmt, ... )
 113 FUNCTION: void lua_pushcclosure ( lua_State* L, lua_CFunction fn, int n )
 114 FUNCTION: void lua_pushboolean ( lua_State* L, int b )
 115 FUNCTION: void lua_pushlightuserdata ( lua_State* L, void* p )
 116 FUNCTION: int lua_pushthread ( lua_State* L )
 117
 118 FUNCTION: void lua_gettable ( lua_State* L, int idx )
 119 FUNCTION: void lua_getfield ( lua_State* L, int idx, c-string[ascii] k )
 120 FUNCTION: void lua_rawget ( lua_State* L, int idx )
 121 FUNCTION: void lua_rawgeti ( lua_State* L, int idx, int n )
 122 FUNCTION: void lua_createtable ( lua_State* L, int narr, int nrec )
 123 FUNCTION: void* lua_newuserdata ( lua_State* L, size_t sz )
 124 FUNCTION: int lua_getmetatable ( lua_State* L, int objindex )
 125 FUNCTION: void lua_getfenv ( lua_State* L, int idx )
 126
 127 FUNCTION: void lua_settable ( lua_State* L, int idx )
 128 FUNCTION: void lua_setfield ( lua_State* L, int idx, c-string[ascii] k )
 129 FUNCTION: void lua_rawset ( lua_State* L, int idx )
 130 FUNCTION: void lua_rawseti ( lua_State* L, int idx, int n )
 131 FUNCTION: int lua_setmetatable ( lua_State* L, int objindex )
 132 FUNCTION: int lua_setfenv ( lua_State* L, int idx )
 133
 134 FUNCTION: void lua_call ( lua_State* L, int nargs, int nresults )
 135 FUNCTION: int lua_pcall ( lua_State* L, int nargs, int nresults, int errfunc )
 136 FUNCTION: int lua_cpcall ( lua_State* L, lua_CFunction func, void* ud )
 137 FUNCTION: int lua_load ( lua_State* L, lua_Reader reader, void* dt, c-string[ascii] chunkname )
 138
 139 FUNCTION: int lua_dump ( lua_State* L, lua_Writer writer, void* data )
 140
 141 FUNCTION: int lua_yield ( lua_State* L, int nresults )
 142 FUNCTION: int lua_resume ( lua_State* L, int narg )
 143 FUNCTION: int lua_status ( lua_State* L )
 144
 145 CONSTANT: LUA_GCSTOP          0
 146 CONSTANT: LUA_GCRESTART       1
 147 CONSTANT: LUA_GCCOLLECT       2
 148 CONSTANT: LUA_GCCOUNT         3
 149 CONSTANT: LUA_GCCOUNTB        4
 150 CONSTANT: LUA_GCSTEP          5
 151 CONSTANT: LUA_GCSETPAUSE      6
 152 CONSTANT: LUA_GCSETSTEPMUL    7
 153
 154 FUNCTION: int lua_gc ( lua_State* L, int what, int data )
 155
 156 FUNCTION: int lua_error ( lua_State* L )
 157 FUNCTION: int lua_next ( lua_State* L, int idx )
 158 FUNCTION: void lua_concat ( lua_State* L, int n )
 159 FUNCTION: lua_Alloc lua_getallocf ( lua_State* L, void* *ud )
 160 FUNCTION: void lua_setallocf ( lua_State* L, lua_Alloc f, void* ud )
 161
 162 TYPEDEF: lua_Reader lua_Chunkreader
 163 TYPEDEF: lua_Writer lua_Chunkwriter
 164
 165 FUNCTION: void lua_setlevel ( lua_State* from, lua_State* to )
 166
 167 CONSTANT: LUA_HOOKCALL    0
 168 CONSTANT: LUA_HOOKRET     1
 169 CONSTANT: LUA_HOOKLINE    2
 170 CONSTANT: LUA_HOOKCOUNT   3
 171 CONSTANT: LUA_HOOKTAILRET 4
 172
 173 : LUA_MASKCALL ( n -- n ) LUA_HOOKCALL shift ; inline
 174 : LUA_MASKRET ( n -- n ) LUA_HOOKRET shift ; inline
 175 : LUA_MASKLINE ( n -- n ) LUA_HOOKLINE shift ; inline
 176 : LUA_MASKCOUNT ( n -- n ) LUA_HOOKCOUNT shift ; inline
 177
 178 C-TYPE: lua_Debug
 179 CALLBACK: void lua_Hook ( lua_State* L, lua_Debug* ar )
 180
 181 FUNCTION: int lua_getstack ( lua_State* L, int level, lua_Debug* ar )
 182 FUNCTION: int lua_getinfo ( lua_State* L, c-string[ascii] what, lua_Debug* ar )
 183 FUNCTION: c-string[ascii] lua_getlocal ( lua_State* L, lua_Debug* ar, int n )
 184 FUNCTION: c-string[ascii] lua_setlocal ( lua_State* L, lua_Debug* ar, int n )
 185 FUNCTION: c-string[ascii] lua_getupvalue ( lua_State* L, int funcindex, int n )
 186 FUNCTION: c-string[ascii] lua_setupvalue ( lua_State* L, int funcindex, int n )
 187
 188 FUNCTION: int lua_sethook ( lua_State* L, lua_Hook func, int mask, int count )
 189 FUNCTION: lua_Hook lua_gethook ( lua_State* L )
 190 FUNCTION: int lua_gethookmask ( lua_State* L )
 191 FUNCTION: int lua_gethookcount ( lua_State* L )
 192
 193 STRUCT: lua_Debug
 194     { event           int              }
 195     { name            char*            }
 196     { namewhat        char*            }
 197     { what            char*            }
 198     { source          char*            }
 199     { currentline     int              }
 200     { nups            int              }
 201     { linedefined     int              }
 202     { lastlinedefined int              }
 203     { short_src       char[LUA_IDSIZE] }
 204     { i_ci            int              } ;
 205
 206 ! lauxlib.h
 207
 208 : luaL_getn ( L i -- int ) lua_objlen ; inline
 209 : luaL_setn ( L i j -- ) 3drop ; inline
 210
 211 : LUA_ERRFILE ( -- x ) LUA_ERRERR 1 + ;
 212
 213 STRUCT: luaL_Reg
 214     { name char*         }
 215     { func lua_CFunction } ;
 216
 217 FUNCTION: void luaI_openlib ( lua_State* L, c-string[ascii] libname, luaL_Reg* l, int nup )
 218 FUNCTION: void luaL_register ( lua_State* L, c-string[ascii] libname, luaL_Reg* l )
 219 FUNCTION: int luaL_getmetafield ( lua_State* L, int obj, c-string[ascii] e )
 220 FUNCTION: int luaL_callmeta ( lua_State* L, int obj, c-string[ascii] e )
 221 FUNCTION: int luaL_typerror ( lua_State* L, int narg, c-string[ascii] tname )
 222 FUNCTION: int luaL_argerror ( lua_State* L, int numarg, c-string[ascii] extramsg )
 223 FUNCTION: c-string[ascii] luaL_checklstring ( lua_State* L, int numArg, size_t* l )
 224 FUNCTION: c-string[ascii] luaL_optlstring ( lua_State* L, int numArg, c-string[ascii] def, size_t* l )
 225 FUNCTION: lua_Number luaL_checknumber ( lua_State* L, int numArg )
 226 FUNCTION: lua_Number luaL_optnumber ( lua_State* L, int nArg, lua_Number def )
 227
 228 FUNCTION: lua_Integer luaL_checkinteger ( lua_State* L, int numArg )
 229 FUNCTION: lua_Integer luaL_optinteger ( lua_State* L, int nArg, lua_Integer def )
 230
 231 FUNCTION: void luaL_checkstack ( lua_State* L, int sz, c-string[ascii] msg )
 232 FUNCTION: void luaL_checktype ( lua_State* L, int narg, int t )
 233 FUNCTION: void luaL_checkany ( lua_State* L, int narg )
 234
 235 FUNCTION: int luaL_newmetatable ( lua_State* L, c-string[ascii] tname )
 236 FUNCTION: void* luaL_checkudata ( lua_State* L, int ud, c-string[ascii] tname )
 237
 238 FUNCTION: void luaL_where ( lua_State* L, int lvl )
 239 ! FUNCTION: int luaL_error ( lua_State* L, c-string[ascii] fmt,  ... ) ;
 240 FUNCTION: int luaL_checkoption ( lua_State* L, int narg, c-string[ascii] def, c-string[ascii] lst )
 241
 242 FUNCTION: int luaL_ref ( lua_State* L, int t )
 243 FUNCTION: void luaL_unref ( lua_State* L, int t, int ref )
 244
 245 FUNCTION: int luaL_loadfile ( lua_State* L, c-string[ascii] filename )
 246 FUNCTION: int luaL_loadbuffer ( lua_State* L, c-string[ascii] buff, size_t sz, c-string[ascii] name )
 247 FUNCTION: int luaL_loadstring ( lua_State* L, c-string[ascii] s )
 248
 249 FUNCTION: lua_State* luaL_newstate ( )
 250 FUNCTION: c-string[ascii] luaL_gsub ( lua_State* L, c-string[ascii] s, c-string[ascii] p, c-string[ascii] r )
 251 FUNCTION: c-string[ascii] luaL_findtable ( lua_State* L, int idx, c-string[ascii] fname, int szhint )
 252
 253 : lua_pop ( L n -- ) neg 1 - lua_settop ; inline
 254 : lua_newtable ( L -- ) 0 0 lua_createtable ; inline
 255 : lua_pushcfunction ( L f -- ) 0 lua_pushcclosure ; inline
 256 : lua_setglobal ( L s -- ) [ LUA_GLOBALSINDEX ] dip lua_setfield ; inline
 257 : lua_register ( L n f -- ) pick swap lua_pushcfunction lua_setglobal ; inline
 258 : lua_strlen ( L i -- size_t ) lua_objlen ; inline
 259 : lua_isfunction ( L n -- ? ) lua_type LUA_TFUNCTION = ; inline
 260 : lua_istable ( L n -- ? ) lua_type LUA_TTABLE = ; inline
 261 : lua_islightuserdata ( L n -- ? ) lua_type LUA_TLIGHTUSERDATA = ; inline
 262 : lua_isnil ( L n -- ? ) lua_type LUA_TNIL = ; inline
 263 : lua_isboolean ( L n -- ? ) lua_type LUA_TBOOLEAN = ; inline
 264 : lua_isthread ( L n -- ? ) lua_type LUA_TTHREAD = ; inline
 265 : lua_isnone ( L n -- ? ) lua_type LUA_TNONE = ; inline
 266 : lua_isnoneornil ( L n -- ? ) lua_type 0 <= ; inline
 267 : lua_getglobal ( L s -- ) [ LUA_GLOBALSINDEX ] dip lua_getfield ; inline
 268 : lua_tostring ( L i -- string ) f lua_tolstring ; inline
 269 : lua_open ( -- lua_State* ) luaL_newstate ; inline
 270 : lua_getregistry ( L -- ) LUA_REGISTRYINDEX lua_pushvalue ; inline
 271 : lua_getgccount ( L -- int ) LUA_GCCOUNT 0 lua_gc ; inline
 272
 273 : luaL_argcheck ( L cond numarg extramsg -- int ) rot 0 = [ luaL_argerror ] [ 3drop 1 ] if ; inline
 274 : luaL_checkstring ( L n -- string ) f luaL_checklstring ; inline
 275 : luaL_optstring ( L n d -- string ) f luaL_optlstring ; inline
 276 : luaL_checkint ( L n -- int ) luaL_checkinteger ; inline
 277 : luaL_optint ( L  n d -- int ) luaL_optinteger ; inline
 278 : luaL_checklong ( L n -- long ) luaL_checkinteger ; inline
 279 : luaL_optlong ( L n d -- long ) luaL_optinteger ; inline
 280
 281 : luaL_typename ( L i -- string ) dupd lua_type lua_typename ; inline
 282 : luaL_dofile ( L fn -- int )
 283     dupd luaL_loadfile 0 = [
 284         0 LUA_MULTRET 0 lua_pcall
 285     ] [ drop 1 ] if ; inline
 286 : luaL_dostring ( L s -- int )
 287     dupd luaL_loadstring 0 = [
 288         0 LUA_MULTRET 0 lua_pcall
 289     ] [ drop 1 ] if ; inline
 290
 291 : luaL_getmetatable ( L n -- ) [ LUA_REGISTRYINDEX ] dip lua_getfield ; inline
 292
 293 STRUCT: luaL_Buffer
 294     { p      char*                 }
 295     { lvl    int                   }
 296     { L      lua_State*            }
 297     { buffer char[LUAL_BUFFERSIZE] } ;
 298
 299 FUNCTION: void luaL_buffinit ( lua_State* L, luaL_Buffer* B )
 300 FUNCTION: char* luaL_prepbuffer ( luaL_Buffer* B )
 301 FUNCTION: void luaL_addlstring ( luaL_Buffer* B, char* s, size_t l )
 302 FUNCTION: void luaL_addstring ( luaL_Buffer* B, char* s )
 303 FUNCTION: void luaL_addvalue ( luaL_Buffer* B )
 304 FUNCTION: void luaL_pushresult ( luaL_Buffer* B )
 305
 306 :: luaL_addchar ( B c -- )
 307     B p>> alien-address
 308     LUAL_BUFFERSIZE B buffer>> <displaced-alien> alien-address
 309     >= [ B luaL_prepbuffer drop ] when
 310     c B p>> 0 set-alien-signed-1
 311     B [ 1 swap <displaced-alien> ] change-p drop ; inline
 312
 313 : luaL_putchar ( B c -- ) luaL_addchar ; inline
 314 : luaL_addsize ( B n -- ) [ swap <displaced-alien> ] curry change-p drop ; inline