diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index da7aecc..e80ea71 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -39,6 +39,8 @@ jobs: set -euo pipefail carp -x test/lua.carp carp -x test/midlevel.carp + carp -x test/cfunction.carp + carp -x test/metatable.carp - name: Install angler run: | diff --git a/lua.carp b/lua.carp index 18a8650..ad9d44a 100644 --- a/lua.carp +++ b/lua.carp @@ -221,6 +221,10 @@ Use [`Luax.do-in`](#do-in) for a version that returns `Result`.") (register TYPE_TABLE Int "LUA_TTABLE") (doc TYPE_FUNCTION "Type constant for function values.") (register TYPE_FUNCTION Int "LUA_TFUNCTION") + (doc TYPE_USERDATA "Type constant for full userdata values.") + (register TYPE_USERDATA Int "LUA_TUSERDATA") + (doc TYPE_LIGHTUSERDATA "Type constant for light userdata values.") + (register TYPE_LIGHTUSERDATA Int "LUA_TLIGHTUSERDATA") (doc type-of "Return the type constant of the value at `index`. Compare against `TYPE_NIL`, `TYPE_NUMBER`, etc.") @@ -250,6 +254,75 @@ the table at `index`. Returns a type constant.") with [`push-nil`](#push-nil) as the initial key.") (register next (Fn [&Lua Int] Int) "lua_next") + ; === Raw table access === + + (doc raw-get + "Like [`get-table`](#get-table) but bypasses metamethods. Pops the +key from the stack and pushes the value. Returns the type of the result.") + (register raw-get (Fn [&Lua Int] Int) "lua_rawget") + (doc raw-set + "Like [`set-table`](#set-table) but bypasses metamethods. Pops both +the key and the value from the stack.") + (register raw-set (Fn [&Lua Int] ()) "lua_rawset") + (doc raw-geti + "Push `t[n]` onto the stack without invoking metamethods, where `t` +is the table at `index`. Returns the type of the result.") + (register raw-geti (Fn [&Lua Int Int] Int) "lua_rawgeti") + (doc raw-seti "Pop the top value and set it as `t[n]` without invoking +metamethods, where `t` is the table at `index`.") + (register raw-seti (Fn [&Lua Int Int] ()) "lua_rawseti") + (doc raw-len "Return the raw length of the value at `index` (table, string, or +full userdata) without invoking the `__len` metamethod.") + (deftemplate raw-len + (Fn [&Lua Int] Int) + "int $NAME(lua_State* l, int i)" + "$DECL { return (int) lua_rawlen(l, i); }") + + ; === Metatable operations === + + (doc get-metatable "Push the metatable of the value at `index` onto the stack. +Returns `true` if the value has a metatable, `false` otherwise (and nothing is +pushed).") + (register get-metatable (Fn [&Lua Int] Bool) "lua_getmetatable") + (doc set-metatable "Pop the table from the top of the stack and set it as the +metatable for the value at `index`.") + (deftemplate set-metatable + (Fn [&Lua Int] ()) + "void $NAME(lua_State* l, int i)" + "$DECL { lua_setmetatable(l, i); }") + (doc new-metatable + "Create or look up a named metatable in the Lua registry and +push it onto the stack. Returns `true` if a new table was created, `false` if +the name already existed. Either way the metatable is on top of the stack +afterward.") + (register new-metatable (Fn [&Lua (Ptr CChar)] Bool) "luaL_newmetatable") + (doc set-named-metatable + "Set the metatable of the value on top of the stack to +the metatable associated with `name` in the registry. The value remains on the +stack.") + (register set-named-metatable (Fn [&Lua (Ptr CChar)] ()) "luaL_setmetatable") + + ; === Userdata === + + (doc new-userdata "Allocate `size` bytes as a full userdata, push it onto the +stack, and return a pointer to the allocated block. The userdata is +garbage-collected by Lua. Use [`set-metatable`](#set-metatable) or +[`set-named-metatable`](#set-named-metatable) to attach a metatable.") + (deftemplate new-userdata + (Fn [&Lua Int] (Ptr ())) + "void* $NAME(lua_State* l, int sz)" + "$DECL { return lua_newuserdata(l, (size_t) sz); }") + (doc check-userdata "Return a pointer to the userdata at `index` if it has the +metatable `name` from the registry. Raises a Lua error otherwise (catchable with +[`call`](#call)).") + (register check-userdata + (Fn [&Lua Int (Ptr CChar)] (Ptr ())) + "luaL_checkudata") + (doc test-userdata + "Like [`check-userdata`](#check-userdata) but returns a null +pointer instead of raising a Lua error when the check fails.") + (register test-userdata (Fn [&Lua Int (Ptr CChar)] (Ptr ())) "luaL_testudata") + (doc do-file "Load and execute a Lua file. Returns a status code. Use [`eval-file`](#eval-file) for a version that returns `Result`.") (deftemplate do-file @@ -501,7 +574,18 @@ replaces the function and arguments on the stack. Tables are built by creating an empty table with [`create-table`](#create-table), setting fields with [`set-field`](#set-field), and optionally assigning the -table to a global with [`set-global`](#set-global). +table to a global with [`set-global`](#set-global). Raw table access +([`raw-get`](#raw-get), [`raw-set`](#raw-set), [`raw-geti`](#raw-geti), +[`raw-seti`](#raw-seti)) bypasses metamethods for direct table manipulation. + +Metatables enable object-oriented patterns and operator overloading. Use +[`new-metatable`](#new-metatable) to create a named metatable in the registry, +[`set-metatable`](#set-metatable) to attach it to a table or userdata, and +[`get-metatable`](#get-metatable) to retrieve it. + +Full userdata ([`new-userdata`](#new-userdata)) allocates GC-managed memory on +the Lua side, useful for exposing Carp-created objects to Lua scripts with +metatables for method dispatch. The module also provides convenience macros: [`fun`](#fun) defines a Lua function from inline source, [`val`](#val) evaluates a Lua expression into @@ -622,6 +706,15 @@ and assigns it to a global in one expression: "a Carp `String`" "a string") + (doc maybe-get-userdata "Read the value at `index` as a userdata pointer, +returning `Nothing` if it is not a full or light userdata. Leaves the stack +unchanged.") + (defn maybe-get-userdata [lua index] + (let [t (Lua.type-of lua index)] + (if (or (= t Lua.TYPE_USERDATA) (= t Lua.TYPE_LIGHTUSERDATA)) + (Maybe.Just (Lua.get-user-data lua index)) + (Maybe.Nothing)))) + ; === set-*-global family === (luax--def-set-global int Lua.push-int) (luax--def-set-global float Lua.push-float) diff --git a/test/metatable.carp b/test/metatable.carp new file mode 100644 index 0000000..bb13fed --- /dev/null +++ b/test/metatable.carp @@ -0,0 +1,192 @@ +(load "../lua.carp") +(load "Test.carp") +(use Test) + +(add-cflag "-I/opt/homebrew/include") +(add-cflag "-L/opt/homebrew/lib") +(Lua.setup "lua") + +(deftest test + ; === raw-get / raw-set === + (assert-equal test + 42 + (Lua.with-lua-do (Lua.create-table lua 0 1) + (Lua.push-int lua 1) + (Lua.push-int lua 42) + (Lua.raw-set lua -3) + (Lua.push-int lua 1) + (ignore (Lua.raw-get lua -2)) + (Lua.get-int lua -1)) + "raw-set and raw-get with integer key") + (assert-equal test + 99 + (Lua.with-lua-do (Lua.create-table lua 0 1) + (ignore (Lua.push-string lua (cstr "key"))) + (Lua.push-int lua 99) + (Lua.raw-set lua -3) + (ignore (Lua.push-string lua (cstr "key"))) + (ignore (Lua.raw-get lua -2)) + (Lua.get-int lua -1)) + "raw-set and raw-get with string key") + + ; === raw-geti / raw-seti === + (assert-equal test + 100 + (Lua.with-lua-do (Lua.create-table lua 3 0) + (Lua.push-int lua 100) + (Lua.raw-seti lua -2 1) + (Lua.push-int lua 200) + (Lua.raw-seti lua -2 2) + (ignore (Lua.raw-geti lua -1 1)) + (Lua.get-int lua -1)) + "raw-seti and raw-geti with integer index") + (assert-equal test + 200 + (Lua.with-lua-do (Lua.create-table lua 3 0) + (Lua.push-int lua 100) + (Lua.raw-seti lua -2 1) + (Lua.push-int lua 200) + (Lua.raw-seti lua -2 2) + (ignore (Lua.raw-geti lua -1 2)) + (Lua.get-int lua -1)) + "raw-geti retrieves the second element") + + ; === raw-len === + (assert-equal test + 3 + (Lua.with-lua-do (Lua.libs lua) + (ignore (Lua.do-string lua (cstr "t = {10, 20, 30}"))) + (Lua.get-global lua (cstr "t")) + (Lua.raw-len lua -1)) + "raw-len returns sequence length") + (assert-equal test + 0 + (Lua.with-lua-do (Lua.create-table lua 0 0) (Lua.raw-len lua -1)) + "raw-len returns 0 for empty table") + + ; === get-metatable / set-metatable === + (assert-false test + (Lua.with-lua-do (Lua.create-table lua 0 0) (Lua.get-metatable lua -1)) + "get-metatable returns false when no metatable is set") + (assert-true test + (Lua.with-lua-do (Lua.create-table lua 0 0) + (Lua.create-table lua 0 0) + (Lua.set-metatable lua -2) + (Lua.get-metatable lua -1)) + "get-metatable returns true after set-metatable") + + ; === new-metatable === + (assert-true test + (Lua.with-lua-do (Lua.new-metatable lua (cstr "TestType"))) + "new-metatable returns true for a new name") + (assert-false test + (Lua.with-lua-do + (ignore (Lua.new-metatable lua (cstr "TestType"))) + (Lua.pop lua 1) + (Lua.new-metatable lua (cstr "TestType"))) + "new-metatable returns false for an existing name") + (assert-equal test + Lua.TYPE_TABLE + (Lua.with-lua-do + (ignore (Lua.new-metatable lua (cstr "TestType"))) + (Lua.type-of lua -1)) + "new-metatable pushes a table onto the stack") + + ; === set-named-metatable === + (assert-true test + (Lua.with-lua-do + (ignore (Lua.new-metatable lua (cstr "MyMT"))) + (Lua.pop lua 1) + (Lua.create-table lua 0 0) + (Lua.set-named-metatable lua (cstr "MyMT")) + (Lua.get-metatable lua -1)) + "set-named-metatable attaches registry metatable") + + ; === metatable with __index for method dispatch === + (assert-equal test + 10 + (Lua.with-lua-do (Lua.libs lua) + (ignore + (Lua.do-string lua + (cstr + "MT = {}; MT.__index = MT; function MT.getx(self) return self.x end"))) + (Lua.create-table lua 0 1) + (Lua.push-int lua 10) + (Lua.set-field lua -2 (cstr "x")) + (Lua.get-global lua (cstr "MT")) + (Lua.set-metatable lua -2) + (Lua.set-global lua (cstr "obj")) + (ignore (Lua.do-string lua (cstr "result = obj:getx()"))) + (Lua.get-global lua (cstr "result")) + (Lua.get-int lua -1)) + "metatable __index enables method dispatch from Carp-created table") + + ; === raw access bypasses metamethods === + (assert-equal test + Lua.TYPE_NIL + (Lua.with-lua-do (Lua.libs lua) + (ignore + (Lua.do-string lua + (cstr + "mt = {__index = function(t,k) return 999 end}"))) + (Lua.create-table lua 0 0) + (Lua.get-global lua (cstr "mt")) + (Lua.set-metatable lua -2) + (ignore (Lua.push-string lua (cstr "missing"))) + (Lua.raw-get lua -2)) + "raw-get bypasses __index metamethod") + + ; === new-userdata === + (assert-equal test + Lua.TYPE_USERDATA + (Lua.with-lua-do (ignore (Lua.new-userdata lua 8)) (Lua.type-of lua -1)) + "new-userdata pushes a userdata value") + (assert-false test + (Lua.with-lua-do (ignore (Lua.new-userdata lua 8)) + (null? (Lua.get-user-data lua -1))) + "new-userdata returns a non-null pointer") + + ; === new-userdata with metatable === + (assert-true test + (Lua.with-lua-do + (ignore (Lua.new-metatable lua (cstr "Point"))) + (Lua.pop lua 1) + (ignore (Lua.new-userdata lua 8)) + (Lua.set-named-metatable lua (cstr "Point")) + (Lua.get-metatable lua -1)) + "userdata can have a metatable attached via set-named-metatable") + + ; === test-userdata === + (assert-false test + (Lua.with-lua-do + (ignore (Lua.new-metatable lua (cstr "Vec"))) + (Lua.pop lua 1) + (ignore (Lua.new-userdata lua 8)) + (Lua.set-named-metatable lua (cstr "Vec")) + (null? (Lua.test-userdata lua -1 (cstr "Vec")))) + "test-userdata returns non-null for matching metatable") + (assert-true test + (Lua.with-lua-do + (ignore (Lua.new-metatable lua (cstr "Vec"))) + (Lua.pop lua 1) + (ignore (Lua.new-userdata lua 8)) + (Lua.set-named-metatable lua (cstr "Vec")) + (null? (Lua.test-userdata lua -1 (cstr "Other")))) + "test-userdata returns null for non-matching metatable") + + ; === TYPE_USERDATA / TYPE_LIGHTUSERDATA === + (assert-equal test + Lua.TYPE_USERDATA + (Lua.with-lua-do (ignore (Lua.new-userdata lua 4)) (Lua.type-of lua -1)) + "TYPE_USERDATA matches full userdata") + + ; === maybe-get-userdata === + (assert-true test + (Maybe.just? + &(Lua.with-lua-do (ignore (Lua.new-userdata lua 8)) + (Luax.maybe-get-userdata lua -1))) + "maybe-get-userdata returns Just for full userdata") + (assert-true test + (Maybe.nothing? + &(Lua.with-lua-do (Lua.push-int lua 42) (Luax.maybe-get-userdata lua -1))) + "maybe-get-userdata returns Nothing for non-userdata"))