Add metatable, raw table access, and userdata support

.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: |

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)

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"))