Add push-cfunction and register-fn for Lua→Carp callbacks

lua.carp

@@ -23,6 +23,22 @@
           (Lua.set-field %lua -2 (cstr %(Symbol.str field-name))))
         (luax--make-field-stmts lua (cdr field-specs))))))
 
+(defndynamic luax--to-c-ident [s]
+  (if (= (Dynamic.String.length s) 0)
+    ""
+    (let [ch (Dynamic.String.slice s 0 1)
+          rest (Dynamic.String.slice s 1 (Dynamic.String.length s))
+          repl (cond
+            (= ch "-") "_MINUS_"
+            (= ch ".") "_"
+            (= ch "?") "_QMARK_"
+            (= ch "!") "_BANG_"
+            ch)]
+      (Dynamic.String.concat [repl (luax--to-c-ident rest)]))))
+
+(defndynamic luax--fn-c-name [sym]
+  (Dynamic.String.concat ["luax_cfn_" (luax--to-c-ident (Symbol.str sym))]))
+
 (defmacro luax--def-maybe-get [suffix type-const getter article type-article]
   (let [fn-name (Symbol.concat ['maybe-get- suffix])
         doc-str (Dynamic.String.concat
@@ -368,7 +384,78 @@ global, `args` is a list of parameter names, and `body` is the Lua source.
                  (cdr args)))
              ") "
              body
-             " end"]))))
+             " end"])))
+
+  (doc prepare-cfunction "Declare a Carp function as pushable onto a Lua stack.
+Must be called at the top level, before any use of
+[`push-cfunction`](#push-cfunction) or [`register-fn`](#register-fn) with this
+function. The function must be a top-level `defn` with signature
+`(Fn [&Lua] Int)`.
+
+```
+(defn square [l]
+  (let [x (Lua.get-int l 1)]
+    (do (Lua.push-int l (* x x)) 1)))
+
+(Lua.prepare-cfunction square)
+```")
+  (defmacro prepare-cfunction [fn-sym]
+    (let [cfn (luax--fn-c-name fn-sym)
+          helper (Symbol.concat ['luax--push-cfn-- fn-sym])
+          the-type '(Fn [(Ref Lua)] ())]
+      `(do
+        (c-name %fn-sym %cfn)
+        (deftemplate %helper
+                     %the-type
+                     %(Dynamic.String.concat
+                       ["int " cfn "(lua_State*); void $NAME(lua_State* l)"])
+                     %(Dynamic.String.concat
+                       ["$DECL { lua_pushcfunction(l, " cfn "); }"])))))
+
+  (doc push-cfunction "Push a prepared Carp function onto the Lua stack as a
+C function. The function must have been declared with
+[`prepare-cfunction`](#prepare-cfunction) at the top level first.
+
+```
+(defn square [l]
+  (let [x (Lua.get-int l 1)]
+    (do (Lua.push-int l (* x x)) 1)))
+
+(Lua.prepare-cfunction square)
+
+(Lua.with-lua-do
+  (Lua.push-cfunction lua square)
+  (Lua.set-global lua (cstr \"square\")))
+```")
+  (defmacro push-cfunction [lua fn-sym]
+    (let [helper (Symbol.concat ['luax--push-cfn-- fn-sym])] `(%helper %lua)))
+
+  (doc register-fn "Register a Carp function as a Lua global, making it callable
+from Lua scripts. The function must have been declared with
+[`prepare-cfunction`](#prepare-cfunction) at the top level first. `name` is the
+Lua-side name (a symbol).
+
+The function must be a top-level `defn` with signature `(Fn [&Lua] Int)`:
+it receives arguments via the Lua stack (1-indexed from the bottom) and
+must return the number of results pushed.
+
+```
+(defn my-add [l]
+  (let [a (Lua.get-int l 1)
+        b (Lua.get-int l 2)]
+    (do (Lua.push-int l (+ a b)) 1)))
+
+(Lua.prepare-cfunction my-add)
+
+(Lua.with-lua-do
+  (Lua.libs lua)
+  (Lua.register-fn lua add my-add)
+  (ignore (Lua.do-string lua (cstr \"print(add(3, 4))\"))))
+```")
+  (defmacro register-fn [lua name fn-sym]
+    `(do
+      (Lua.push-cfunction %lua %fn-sym)
+      (Lua.set-global %lua (cstr %(Symbol.str name))))))
 
 (doc Lua "provides bindings for embedding Lua in Carp. It wraps the Lua C API
 directly, following its stack-based model: you push values onto a virtual stack,
@@ -417,8 +504,24 @@ setting fields with [`set-field`](#set-field), and optionally assigning the
 table to a global with [`set-global`](#set-global).
 
 The module also provides convenience macros: [`fun`](#fun) defines a Lua
-function from inline source, and [`val`](#val) evaluates a Lua expression into
-a global. For higher-level functions that handle type checking and error
+function from inline source, [`val`](#val) evaluates a Lua expression into
+a global, and [`register-fn`](#register-fn) registers a Carp function as a
+Lua global so that Lua scripts can call back into Carp:
+
+```
+(defn double-it [l]
+  (let [x (Lua.get-int l 1)]
+    (do (Lua.push-int l (* x 2)) 1)))
+
+(Lua.prepare-cfunction double-it)
+
+(Lua.with-lua-do
+  (Lua.libs lua)
+  (Lua.register-fn lua double double-it)
+  (ignore (Lua.do-string lua (cstr \"print(double(21))\"))))
+```
+
+For higher-level functions that handle type checking and error
 wrapping automatically, see [`Luax`](#Luax).")
 
 (doc Luax "provides a safe, higher-level interface over [`Lua`](#Lua). Where the

test/cfunction.carp

@@ -0,0 +1,144 @@
+(load "../lua.carp")
+(load "Test.carp")
+(use Test)
+
+(add-cflag "-I/opt/homebrew/include")
+(add-cflag "-L/opt/homebrew/lib")
+(Lua.setup "lua")
+
+; === callback functions ===
+
+(defn test-constant [l] (do (Lua.push-int l 42) 1))
+
+(defn test-add [l]
+  (let-do [a (Lua.get-int l 1)
+           b (Lua.get-int l 2)] (Lua.push-int l (+ a b)) 1))
+
+(defn test-negate [l]
+  (let-do [x (Lua.get-float l 1)] (Lua.push-float l (* -1f x)) 1))
+
+(defn test-greet [l]
+  (let-do [name (String.from-cstr-or (Lua.to-string l 1) @"world")]
+    (Lua.push-carp-str l &(fmt "hello %s" &name))
+    1))
+
+(defn test-multi-return [l]
+  (let-do [x (Lua.get-int l 1)]
+    (Lua.push-int l (+ x 1))
+    (Lua.push-int l (+ x 2))
+    2))
+
+; === prepare all callbacks at top level ===
+
+(Lua.prepare-cfunction test-constant)
+(Lua.prepare-cfunction test-add)
+(Lua.prepare-cfunction test-negate)
+(Lua.prepare-cfunction test-greet)
+(Lua.prepare-cfunction test-multi-return)
+
+(deftest test
+  ; === push-cfunction: basic push ===
+  (assert-equal test
+    Lua.TYPE_FUNCTION
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.push-cfunction lua test-constant)
+                     (Lua.type-of lua -1))
+    "push-cfunction pushes a function onto the stack")
+
+  ; === push-cfunction: callable from Carp ===
+  (assert-equal test
+    42
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.push-cfunction lua test-constant)
+                     (ignore (Lua.call lua 0 1 0))
+                     (Lua.get-int lua -1))
+    "push-cfunction: pushed function is callable via Lua.call")
+
+  ; === register-fn: zero-arg function ===
+  (assert-equal test
+    42
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.register-fn lua constant test-constant)
+                     (ignore (Lua.do-string lua (cstr "result = constant()")))
+                     (Lua.get-global lua (cstr "result"))
+                     (Lua.get-int lua -1))
+    "register-fn: zero-arg function callable from Lua")
+
+  ; === register-fn: two-arg integer addition ===
+  (assert-equal test
+    7
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.register-fn lua add test-add)
+                     (ignore (Lua.do-string lua (cstr "result = add(3, 4)")))
+                     (Lua.get-global lua (cstr "result"))
+                     (Lua.get-int lua -1))
+    "register-fn: two-arg int function callable from Lua")
+
+  ; === register-fn: float argument ===
+  (assert-equal test
+    -2.5f
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.register-fn lua negate test-negate)
+                     (ignore (Lua.do-string lua (cstr "result = negate(2.5)")))
+                     (Lua.get-global lua (cstr "result"))
+                     (Lua.get-float lua -1))
+    "register-fn: float function callable from Lua")
+
+  ; === register-fn: string argument and return ===
+  (assert-true test
+    (= @"hello Ada"
+       (Lua.with-lua-do (Lua.libs lua)
+                        (Lua.register-fn lua greet test-greet)
+                        (ignore
+                          (Lua.do-string lua (cstr "result = greet('Ada')")))
+                        (Lua.get-global lua (cstr "result"))
+                        (String.from-cstr-or (Lua.to-string lua -1) @"")))
+    "register-fn: string function callable from Lua")
+
+  ; === register-fn: multiple return values ===
+  (assert-equal test
+    13
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.register-fn lua inc2 test-multi-return)
+                     (ignore
+                       (Lua.do-string lua
+                                      (cstr "a, b = inc2(5); result = a + b")))
+                     (Lua.get-global lua (cstr "result"))
+                     (Lua.get-int lua -1))
+    "register-fn: multi-return function works from Lua")
+
+  ; === register-fn: callable via call-fn ===
+  (assert-true test
+    (= &(Result.Success 12)
+       &(Lua.with-lua-do (Lua.libs lua)
+                         (Lua.register-fn lua add test-add)
+                         (Luax.call-fn lua
+                                       add
+                                       Lua.get-int
+                                       (Lua.push-int 5)
+                                       (Lua.push-int 7))))
+    "register-fn: registered function works with Luax.call-fn")
+
+  ; === register-fn: composing Carp and Lua functions ===
+  (assert-equal test
+    20
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.register-fn lua add test-add)
+                     (ignore (Lua.fun lua double [x] "return add(x, x)"))
+                     (Lua.get-global lua (cstr "double"))
+                     (Lua.push-int lua 10)
+                     (ignore (Lua.call lua 1 1 0))
+                     (Lua.get-int lua -1))
+    "register-fn: Lua code can call registered Carp functions")
+
+  ; === register-fn: multiple registrations ===
+  (assert-equal test
+    49
+    (Lua.with-lua-do (Lua.libs lua)
+                     (Lua.register-fn lua add test-add)
+                     (Lua.register-fn lua constant test-constant)
+                     (ignore
+                       (Lua.do-string lua (cstr "result = add(constant(), 7)")))
+                     (Lua.get-global lua (cstr "result"))
+                     (Lua.get-int lua -1))
+    "register-fn: multiple functions can be registered and composed"))