So-net無料ブログ作成
検索選択

Tcl から Lua を呼ぶバインディング [Tcl]

できた。

#include <stdio.h>
#include <assert.h>
#include <stdlib.h>
#include "tcl.h"
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"

#define LUA_ENTER(L)    int __stacksize = lua_gettop(L)
#define LUA_RETURN(L,X) assert(__stacksize == lua_gettop(L));return X

static lua_State* L = NULL;

static int luaHandleProc(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[])
{
  int length;
  int error;
  char* luacode;
  LUA_ENTER(L);

  if(objc != 2){
    Tcl_WrongNumArgs(interp, 1, objv, "luacode");
    LUA_RETURN(L, TCL_ERROR);
  }

  luacode = Tcl_GetStringFromObj(objv[1], &length);
  error = luaL_loadbuffer(L, luacode, length,"tclua") || lua_pcall(L, 0, 0, 0);
  if (error) {
    Tcl_SetObjResult(interp, Tcl_NewStringObj(lua_tostring(L, -1), -1));
    LUA_RETURN(L, TCL_ERROR);
  }

  Tcl_SetObjResult(interp, Tcl_NewStringObj("", -1));
  LUA_RETURN(L, TCL_OK);
}

static int callHandleProc(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[])
{
  char* funname;
  int i;
  int argsbegin = 1;
  int resultc = 1;
  char** resultv = NULL;
  int stacksize = lua_gettop(L);
  LUA_ENTER(L);

  if(objc < 2){
    Tcl_WrongNumArgs(interp, 1, objv, "funName ?-result varName...? ?arg...?");
    LUA_RETURN(L, TCL_ERROR);
  }

  if (strcmp(Tcl_GetString(objv[argsbegin]), "-result") == 0) {
    Tcl_SplitList(interp, Tcl_GetString(objv[argsbegin + 1]), &resultc, &resultv);
    argsbegin += 2;
  }

  /* push function name */
  if (strchr(Tcl_GetString(objv[argsbegin]), '.') == NULL) {
    /* if it's a global function, just push it */
    funname = Tcl_GetString(objv[argsbegin]);
    lua_getglobal(L, funname);
  } else {
    /* if the function is contained in a module(=table) ... */
    int argc = 0;
    char** argv = NULL;
    int i;
    size_t length = strlen(Tcl_GetString(objv[argsbegin]));
    char* buf = malloc(length+256);

    sprintf(buf, "split %s .", Tcl_GetString(objv[argsbegin]));
    Tcl_Eval(interp, buf);
    Tcl_SplitList(interp, Tcl_GetStringResult(interp), &argc, &argv);

    lua_getglobal(L, argv[0]);
    for (i = 1; i < argc; i++) {
      if (!lua_istable(L, -1)) {
        lua_pop(L, 1);
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "attempt to index a non-table value: ", argv[i-1], NULL);
        LUA_RETURN(L, TCL_ERROR);
      }
      lua_getfield(L, -1, argv[i]);
      lua_remove(L, -2); /* remove the indexee table from the stack */
    }
    free(buf);
  }
  argsbegin++;

  /* push arguments */
  for (i = argsbegin; i < objc; i++) {
    char* arg;
    size_t length;
    arg = Tcl_GetStringFromObj(objv[i], &length);
    lua_pushlstring(L, arg, length);
  }

  /* call the function */
  if (lua_pcall(L, i - argsbegin, resultc, 0)) {
    Tcl_SetObjResult(interp, Tcl_NewStringObj(lua_tostring(L, -1), -1));
    lua_pop(L, 1);
    LUA_RETURN(L, TCL_ERROR);
  }

  if (resultv == NULL) {
    size_t length;
    const char* result = lua_tolstring(L, -1, &length);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    lua_pop(L, 1);
    LUA_RETURN(L, TCL_OK);
  } else {
    int i;
    for (i = resultc -1 ; i >= 0; i--) {
      size_t length;
      const char* result = lua_tolstring(L, -1, &length);
      Tcl_SetVar(interp, resultv[i], result, 0);
      lua_pop(L, 1);
    }
    Tcl_Free((char *)resultv);
    LUA_RETURN(L, TCL_OK);
  }
}

DLLEXPORT int Tclua_Init(Tcl_Interp* interp){
  L = luaL_newstate();
  luaL_openlibs(L);
  Tcl_InitStubs(interp, "8.1", 0);
  Tcl_CreateObjCommand(interp, "::lua::lua", luaHandleProc, NULL, NULL);
  Tcl_CreateObjCommand(interp, "::lua::call", callHandleProc, NULL, NULL);
  if (Tcl_Eval(interp, "namespace eval lua { namespace export * }") == TCL_ERROR) return TCL_ERROR;
  return Tcl_PkgProvide(interp, "lua", "1.00");
}

これを使うと以下のように Tcl と Lua を融合したコードが書ける。

package require lua
namespace import ::lua::*

lua {
  -- lua code begin
  function f(x)
    return x*2
  end

  -- function with multiple results
  function g(x)
    return x^2,x^3
  end

  x = {}
  x.y = {}
  x.y.f = f
}

puts "f(12)=[call f 12]"
call -result {r s} g 12
puts "g(12)=$r, $s"
puts "math.sin(1)=[call math.sin 1]"
puts "x.y.f(13)=[call x.y.f 13]"

実行結果。

f(12)=24
g(12)=144, 1728
math.sin(1)=0.8414709848079
x.y.f(13)=26

次の目標は Tcl と Lua の変数を行き来しやすくすることだな。


nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この記事のトラックバックURL:
※言及リンクのないトラックバックは受信されません。

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。

×

この広告は1年以上新しい記事の更新がないブログに表示されております。