'''http://luajit.org/%|%LuaJIT%|%''' is a remarkably fast [JIT] compiler that is source- and binary extension-compatible with [Lua] 5.1. 


** LuaJIT bindings with [Critcl] **

[dbohdan] 2017-06-04: This module lets you define procs in JIT-compiled Lua. With it you can write fast numerical or [binary data]-processing commands in a high-level, [garbage collection%|%garbage-collected] language instead of C. The bindings translate Lua tables to Tcl lists (when Lua procs return those), but not vice versa. To use the module you will need Tcl 8.5 or 8.6, LuaJIT 2.x (Lua 5.1-5.3 are also supported, but won't give you the same dramatic speed boost), https://en.wikipedia.org/wiki/Pkg-config%|%pkg-config%|% and [Critcl] 3.1.11 or later. Earlier versions of Critcl will not work.

Unlike [tcl-duktape], this extension does not manage multiple instances of the guest language per host interpreter (it was easier to prototype this way and based on my past experience I think [YAGNI]). If you need multiple LuaJIT instances you can create a separate Tcl interpreter for each.

======
# Tcl bindings for LuaJIT and Lua 5.1-5.3.
# This module requires a recent version of Critcl, pkg-config and a LuaJIT 2.x
# or a Lua 5.1-5.3 development package for your OS.
# Copyright (c) 2017 dbohdan.
# License: MIT.
package require critcl 3.1.11

if {![::critcl::compiling]} {
    error {critcl found no compiler}
}

namespace eval ::luajit {
    variable bindingsVersion 0.1.0
    # Set the variable ::luajit::luaPackage in your code (set or
    # ::luajit::luaHeaders and ::luajit::luaLib directly) before sourcing or
    # requiring this module to use a different version of Lua.
    if {![info exists luaPackage]} {
        # The default Lua package.

        # variable luaPackage lua5.1
        # variable luaPackage lua5.2
        # variable luaPackage lua5.3
        variable luaPackage luajit
    }
    if {![info exists luaHeaders]} {
        variable luaHeaders [exec pkg-config --cflags $luaPackage]
    }
    if {![info exists luaLib]} {
        variable luaLib [exec pkg-config --libs $luaPackage]
    }
}

critcl::cheaders $::luajit::luaHeaders
critcl::ccode {
    #include <lua.h>
    #include <lauxlib.h>
    #include <lualib.h>
    #define LUAJIT_CDATA ((lua_State *) cdata)
}

critcl::clibraries $::luajit::luaLib

critcl::cinit {
    lua_State *L = luaL_newstate();
    luaL_openlibs(L);
} {}

critcl::ccommand luajit::eval {cdata interp objc objv} {
    size_t len;
    int rc;
    const char *lua_res;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "code");
        return TCL_ERROR;
    }

    rc = luaL_loadstring(LUAJIT_CDATA, Tcl_GetStringFromObj(objv[1], NULL)) ||
         lua_pcall(LUAJIT_CDATA, 0, 1, 0);
    lua_res = lua_tolstring(LUAJIT_CDATA, -1, &len);
    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(lua_res, len));
    lua_pop(LUAJIT_CDATA, 1);

    if (rc == 0) {
        return TCL_OK;
    } else {
        return TCL_ERROR;
    }
} -clientdata L

critcl::ccode {
    Tcl_Obj* table2tcl(ClientData cdata, Tcl_Interp *interp,
                       lua_State *L, int index) {
        Tcl_Obj* result = Tcl_NewListObj(0, NULL);
        lua_pushnil(L);
        index--;

        while (lua_next(L, index) != 0) {
            Tcl_Obj* kv[2];
            int i;
            for (i = 0; i < 2; i++) {
                int kv_index = -2 + i;
                if (lua_istable(L, kv_index)) {
                    kv[i] = table2tcl(cdata, interp, L, kv_index);
                    if (kv[i] == NULL) {
                        return NULL;
                    }
                } else {
                    /* Can't call lua_tolstring() unconditionally because it
                       changes the internal representation of the value. It
                       will throw off lua_next() if a value that was a number
                       becomes a string. */
                    if (lua_isnumber(LUAJIT_CDATA, kv_index)) {
                        kv[i] = Tcl_NewWideIntObj(
                            lua_tonumber(LUAJIT_CDATA, kv_index)
                        );
                    } else {
                        size_t lua_str_len;
                        const char* lua_str = lua_tolstring(LUAJIT_CDATA,
                                                            kv_index,
                                                            &lua_str_len);
                        kv[i] = Tcl_NewByteArrayObj(lua_str, lua_str_len);            
                    }
                }
                if (Tcl_ListObjAppendElement(interp, result, kv[i]) != TCL_OK) {
                    return NULL;
                }
            }
            lua_pop(L, 1);
        }
        return result;
    }
}

critcl::ccommand luajit::call {cdata interp objc objv} {
    int err;
    int i;
    int len;
    int level = lua_gettop(LUAJIT_CDATA);
    int nresults = -1;
    int listc;
    Tcl_Obj **listv;
    Tcl_Obj *results;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "funcpath ?arg ...?");
        return TCL_ERROR;
    }

    /* Traverse tables to find the function to call. */
    if (Tcl_ListObjGetElements(interp, objv[1], &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(
            interp,
            Tcl_NewStringObj("can't process function path list", -1)
        );
        return TCL_ERROR;
    }
    if (listc == 0) {
        Tcl_SetObjResult(
            interp,
            Tcl_NewStringObj("function path can't be empty", -1)
        );
        return TCL_ERROR;
    }
    lua_getglobal(LUAJIT_CDATA, Tcl_GetStringFromObj(listv[0], NULL));
    if (lua_isnil(LUAJIT_CDATA, -1)) {
        Tcl_SetObjResult(
            interp,
            Tcl_NewStringObj("global Lua variable not found", -1)
        );
        lua_pop(LUAJIT_CDATA, 1);
        return TCL_ERROR;
    }
    for (i = 1; i < listc; i++) {
        lua_getfield(LUAJIT_CDATA, -1, Tcl_GetStringFromObj(listv[i], NULL));
        lua_remove(LUAJIT_CDATA, -2);
    }
    if (lua_isnil(LUAJIT_CDATA, -1)) {
        Tcl_SetObjResult(
            interp,
            Tcl_NewStringObj("Lua function not found", -1)
        );
        lua_pop(LUAJIT_CDATA, 1);
        return TCL_ERROR;
    }

    /* Push the arguments. */
    for (i = 2; i < objc; i++) {
        char* arg = Tcl_GetByteArrayFromObj(objv[i], &len);
        lua_pushlstring(LUAJIT_CDATA, arg, len);
    }

    /* Call the function. */
    err = lua_pcall(LUAJIT_CDATA, objc - 2, LUA_MULTRET, 0);
    nresults = lua_gettop(LUAJIT_CDATA) - level;

    /* Process multiple return values. */
    results = Tcl_NewListObj(0, NULL);
    for (i = nresults - 1; i >= 0; i--) {
        Tcl_Obj *elem = NULL;
        int index = -1 - i;
        if (lua_istable(LUAJIT_CDATA, index)) {
            elem = table2tcl(cdata, interp, LUAJIT_CDATA, index);
            if (elem == NULL) {
                Tcl_SetObjResult(
                    interp,
                    Tcl_NewStringObj("can't convert Lua table to list", -1)
                );
                err = 1;
                break;
            }
        } else {
            size_t lua_str_len;
            const char* lua_str = lua_tolstring(LUAJIT_CDATA, index,
                                                &lua_str_len);
            elem = Tcl_NewByteArrayObj(lua_str, lua_str_len);
        }
        if (Tcl_ListObjAppendElement(interp, results, elem) != TCL_OK) {
            Tcl_SetObjResult(
                interp,
                Tcl_NewStringObj("can't create result list", -1)
            );
            err = 1;
            break;
        }
    }
    if (nresults == 1) {
        Tcl_Obj* result;
        Tcl_ListObjIndex(interp, results, 0, &result);
        Tcl_SetObjResult(interp, result);
    } else {
        Tcl_SetObjResult(interp, results);
    }

    lua_pop(LUAJIT_CDATA, nresults);

    if (err) {
        return TCL_ERROR;
    } else {
        return TCL_OK;
    }
} -clientdata L

proc ::luajit::safe-name {text} {
    string trim [regsub -all {[^[:alnum:]]+} $text _] _
}

proc ::luajit::ljproc {name arglist body} {
    set luaName [safe-name $name]
    set luaArgs {}
    set procBody "luajit::call $luaName"
    foreach arg $arglist {
        if {$arg eq {args}} {
            append procBody " {*}\$args"
            lappend luaArgs ...
        } else {
            append procBody " \$$arg"
            lappend luaArgs $arg
        }
    }
    ::luajit::eval "function ${luaName}([join $luaArgs ,])\n$body\nend"
    proc $name $arglist $procBody
}

proc ::luajit::assert-equal {actual args} {
    set matched 0
    foreach expected $args {
        if {$actual eq $expected} {
            set matched 1
            break
        }
    }
    if {!$matched} {
        if {[string length $actual] > 200} {
            set actual [string range $actual 0 199]...
        }
        error "expected \"[join $args {" or "}]\",\n\
               but got \"$actual\""
    }
}

proc ::luajit::dict-sort d {
    set res {}
    foreach key [lsort [dict keys $d]] {
        set value [dict get $d $key]
        if {[llength $key] % 2 == 0} {
            set key [dict-sort $key]
        }
        if {[llength $value] % 2 == 0} {
            set value [dict-sort $value]
        }
        lappend res $key $value
    }
    return $res
}

proc ::luajit::test {} {
    if [catch {luajit::eval {
        print("using " .. jit.version)
    }}] {
        luajit::eval {
            print("using " .. _VERSION)
        }
    }

    assert-equal [luajit::call {string find} abcdef cd] {3 4}

    catch {luajit::call {} abcdef cd} err
    assert-equal $err {function path can't be empty}

    catch {luajit::call {nope bogus} foo} err
    assert-equal $err {global Lua variable not found}

    catch {luajit::call {math bogus} foo} err
    assert-equal $err {Lua function not found}


    luajit::ljproc add {a b} {
        return a + b
    }
    assert-equal [luajit::call add 5 7] 12 12.0
    assert-equal [add 5 7] 12 12.0

    luajit::ljproc divmul {a b} {
        return math.floor(a / b), a % b, a, b
    }
    assert-equal [luajit::call divmul 7 3] {2 1 7 3} {2 1.0 7 3}
    assert-equal [divmul 7 3] {2 1 7 3} {2 1.0 7 3}

    luajit::ljproc varargs {a b c args} {
        return a, b, c, {...}
    }
    assert-equal [luajit::call varargs foo bar baz a b c] \
                 {foo bar baz {1 a 2 b 3 c}}
    assert-equal [varargs foo bar baz a b c] {foo bar baz {1 a 2 b 3 c}}

    catch {luajit::ljproc foo {} {blah}} err
    assert-equal $err \
                 {[string "function foo()..."]:3: '=' expected near 'end'} \
                 {[string "function foo()..."]:3: syntax error near 'end'}

    luajit::ljproc bar {} {return nope['bogus']}
    catch bar err
    assert-equal $err \
                 {[string "function bar()..."]:2: attempt to index global\
                  'nope' (a nil value)} \
                 {[string "function bar()..."]:2: attempt to index a nil value\
                  (global 'nope')}

    luajit::ljproc table-1 {} {
        return 1, {a = 1, b = 2, c = 3}, 3, 4, 5
    }
    set res [table-1]
    lset res 1 [luajit::dict-sort [lindex $res 1]]
    assert-equal $res {1 {a 1 b 2 c 3} 3 4 5}
    unset res

    luajit::ljproc table-2 {} {
        return {}
    }
    assert-equal [table-2] {}

    luajit::ljproc table-3 {} {
        return {2, 3, 4}
    }
    assert-equal [luajit::dict-sort [table-3]] {1 2 2 3 3 4}

    luajit::ljproc nested-table-1 {} {
        return {a = 1, b = 2, c = {3, 4, 5}, d = {e = 6, f = 7}}
    }
    assert-equal [luajit::dict-sort [nested-table-1]] \
                 {a 1 b 2 c {1 3 2 4 3 5} d {e 6 f 7}}

    luajit::ljproc nested-table-2 {} {
        local t1 = {a = 1, b = 2}
        local t2 = {hello = {-3, -2, -1}}
        t2[t1] = {0, 1, 2}
        return t2
    }
    assert-equal [luajit::dict-sort [nested-table-2]] \
                 {{a 1 b 2} {1 0 2 1 3 2} hello {1 -3 2 -2 3 -1}}


    # Benchmark.
    set s {}
    set refValue 0
    for {set i 0} {$i < 1024*1014} {incr i} {
        incr refValue [expr {$i % 256}]
        append s [format %c [expr {$i % 256}]]
    }
    proc char-sum-1 data {
        set sum 0
        set len [string length $data]
        for {set i 0} {$i < $len} {incr i} {
            binary scan $data "@$i cu" byte
            incr sum $byte
        }
        return $sum
    }
    proc char-sum-2 data {
        set sum 0
        foreach c [split $data {}] {
            scan $c %c byte
            incr sum $byte
        }
        return $sum
    }
    luajit::ljproc lj-sum data {
        local sum = 0
        for i = 1, #data do
            sum = sum + data:byte(i, i)
        end
        return sum
    }
    assert-equal [char-sum-1 $s] $refValue
    assert-equal [char-sum-2 $s] $refValue
    assert-equal [lj-sum $s] $refValue
    puts [time {char-sum-1 $s} 5]
    puts [time {char-sum-2 $s} 5]
    puts [time {lj-sum $s} 5]
    puts [time {::luajit::call lj_sum $s} 5]
}

# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    ::luajit::test
}
======


** Creating a Tcl interpreter in LuaJIT **

[dbohdan] 2016-09-17: LuaJIT comes stock with a really nice http://luajit.org/ext_ffi.html%|%FFI library%|%. The code below is a translation of [PYK]'s example from the [Ffidl] page that shows how to create a Tcl interpreter in LuaJIT.

======
#! /usr/bin/env luajit

ffi = require("ffi")
-- The following line is for openSUSE Tumbleweed. If you run a different OS
-- you should probably replace it with something like
-- local tcl = ffi.load("tcl8.6")
local tcl = ffi.load("/usr/lib64/libtcl8.6.so")
ffi.cdef[[
typedef struct Tcl_Interp Tcl_Interp;
typedef struct Tcl_Obj Tcl_Obj;
typedef struct Tcl_DString {
    char *string;
    int length;
    int spaceAvl;
    char staticSpace[200];
} Tcl_DString;

Tcl_Obj *        Tcl_NewStringObj(const char *bytes, int length);
Tcl_Interp *     Tcl_CreateInterp(void);
char *           Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
int              Tcl_InterpDeleted(Tcl_Interp *interp);
char *           Tcl_GetString(Tcl_Obj *objPtr);
int              Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags);
]]

local interp = tcl.Tcl_CreateInterp()
local script = tcl.Tcl_NewStringObj("puts [pwd]", -1)
tcl.Tcl_EvalObjEx(interp, script, 0)

local pwd = ffi.new("Tcl_DString")
tcl.Tcl_GetCwd(interp, pwd)
print(ffi.string(pwd.string))
======

** Discussion **

<<categories>>Critcl | Foreign Interfaces | Language