should ccl allow ffi callbacks to be defined within closures

Madhu <[email protected]> Wed, 22 May 2024 12:18:40 +0530 (IST)
Newsgroups gmane.lisp.openmcl.devel
Message-ID <[email protected]>
----Next_Part(Wed_May_22_12_18_40_2024_054)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

I came across a use of cffi callbacks which defines the callback
within a function. In CCL the following

```
(defun barf ()
  (ccl:defcallback CMPSTRINGP (:address p1 :address p2 :signed-int)
      (ccl:external-call "strcmp" :address p1 :address p2 :signed-int)))
(barf)

=>
Condition of type TYPE-ERROR:

The value (:INTERNAL CMPSTRINGP BARF) is not of the expected type
 (AND SYMBOL (NOT (SATISFIES CONSTANTP)))
```

Is there any reason to disallow callbacks defined by defcallbacks from
being closures which capture their environment?

I am attaching a patch which continues to use the name specified by
DEFCALLBACK even if the defining function is a closure.

I'd very much appreciate it if other developers could review it and
give feedback.



----Next_Part(Wed_May_22_12_18_40_2024_054)--
Content-Type: Text/X-Patch; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="0001-allow-ffi-callbacks-to-be-defined-within-closures.patch"

From d6241c160cc42979da2629862f97c350615850a9 Mon Sep 17 00:00:00 2001
From: Madhu <[email protected]>
Date: Sun, 12 May 2024 22:01:08 +0530
Subject: [PATCH] allow ffi callbacks to be defined within closures.

* level-1/l1-callbacks.lisp: (define-callback-function): If the
function-name is an internal-function of the form (:internal name) use
the internal name instead.

After this patch, defcallbacks can be defined within internal
functions. e.g. the following will work, instead of erroring out on
the name.

```
(defun barf ()
  (ccl:defcallback CMPSTRINGP (:address p1 :address p2 :signed-int)
      (ccl:external-call "strcmp" :address p1 :address p2 :signed-int)))
(barf)
```
---
 level-1/l1-callbacks.lisp | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/level-1/l1-callbacks.lisp b/level-1/l1-callbacks.lisp
index 3f88041..f147f71 100644
--- a/level-1/l1-callbacks.lisp
+++ b/level-1/l1-callbacks.lisp
@@ -25,7 +25,10 @@ (defstatic *callback-lock* (make-lock))
 (defun define-callback-function (lisp-function  &optional doc-string (without-interrupts t) info &aux name trampoline)
   (unless (functionp lisp-function)
     (setq lisp-function (require-type lisp-function 'function)))
-  (unless (and (symbolp (setq name (function-name lisp-function)))
+  (if (and (consp (setq name (function-name lisp-function)))
+	   (eql (car name) :internal))
+      (setq name (second name)))
+  (unless (and (symbolp name)
                ;;Might as well err out now before do any _Newptr's...
                (not (constant-symbol-p name)))
     (report-bad-arg name '(and symbol (not (satisfies constantp)))))
-- 
2.39.2.101.g768bb238c4


----Next_Part(Wed_May_22_12_18_40_2024_054)----