I'm trying to use the CLISP FFI to call some Win32 functions.
I was able to make a call out and have that call a callback in Lisp, but now I can't figure out how to access the values passed to the callback.
One of the values is a pointer to a struct. I have the structure defined ok, I can print it and get a #<FOREIGN-VARIABLE #x00000000> or wrap it in foreign-address and get #<FOREIGN-ADDRESS #x00000000> (not the real value or addr in either), but when I try to deref it I get the following:
*** - FFI:DEREF is only allowed after FFI:FOREIGN-VALUE:
(FFI:DEREF (FFI:FOREIGN-ADDRESS PRECT*))
I've tried to wrap the foreign-address call in foreign-value, tried to use with-c-place, and other things, but nothing works. I either get nothing printed (in which case I assume there was an error during the call and it borked), or I get that error.
The only documentation I've been able to find is this dffi reference but it has scant examples and the documentation for those functions isn't clear.
Anyone have any pointers? (Pun!) Should I switch to CFFI/UFFI or SBCL even?
Update
I got it to print the struct out once after wrapping the pointer in foreign-value reloading it in the REPL (without exiting), then it seemed to error in the callback for subsequent reloads.
Edit
Still can't get it working; here's the code:
(defpackage "WIN32")
(in-package "WIN32")
(use-package "FFI")
; Listen for a WM_DISPLAYCHANGE message to get notifications of when
; a monitor (setting) is added/removed/changed
(def-c-type BOOL boolean)
(def-c-type CHAR char)
(def-c-type DWORD uint)
(def-c-type HANDLE c-pointer)
(def-c-type HDC HANDLE)
(def-c-type HMONITOR HANDLE)
(def-c-type HWND HANDLE)
(def-c-type LONG long)
(def-c-type LPARAM c-pointer)
(def-c-type LPCSTR c-string)
(def-c-type LPCTSTR LPCSTR) ; LPCWSTR
;(def-c-type LPCWSTR )
(def-c-type TCHAR CHAR) ; WCHAR
;(def-c-type WCHAR )
(defun symbol-to-keyword (sym)
(intern (symbol-name sym) :keyword))
(defun affix-to-symbol (prefix sym suffix)
(intern (concatenate 'string prefix (symbol-name sym) suffix)))
(defun car-symbol-to-keyword (pair)
(cons
(symbol-to-keyword (car pair))
(cdr pair)))
(defmacro def-struct-type (name &rest fields)
`(progn
(def-c-struct ,name ,#fields)
(def-c-type
,(affix-to-symbol "P" name "")
(c-pointer ,name))
(defconstant
,(affix-to-symbol "" name "-INSTANCE")
'(c-struct ,name ,#(mapcar #'car-symbol-to-keyword fields)))
))
;typedef struct _RECT {
; LONG left;
; LONG top;
; LONG right;
; LONG bottom;
;} RECT, *PRECT;
(def-struct-type RECT
(left LONG)
(top LONG)
(right LONG)
(bottom LONG))
;BOOL CALLBACK MonitorEnumProc(
; _In_ HMONITOR hMonitor,
; _In_ HDC hdcMonitor,
; _In_ LPRECT lprcMonitor,
; _In_ LPARAM dwData
;);
;BOOL EnumDisplayMonitors(
; _In_ HDC hdc,
; _In_ LPCRECT lprcClip,
; _In_ MONITORENUMPROC lpfnEnum,
; _In_ LPARAM dwData
;);
(def-call-out EnumDisplayMonitors
(:name "EnumDisplayMonitors")
(:library "User32.dll")
(:arguments
(hdc HDC)
(lprcClip PRECT)
(lpfnEnum
(c-function
(:arguments
(hMonitor HMONITOR)
(hdcMonitor HDC)
(lprcMonitor PRECT)
(dwData LPARAM))
(:return-type BOOL)
(:language :stdc-stdcall)))
(dwData LPARAM))
(:return-type BOOL)
(:language :stdc-stdcall))
(export 'EnumDisplayMonitors)
(defun callback (hmon hdc* prect* data)
(progn
(format t "~A ~A ~A ~A~%" hmon hdc* (foreign-address prect*) data)
t))
(EnumDisplayMonitors nil nil #'callback nil)
Use slot and c-var-object
See slot and c-var-object.
More examples
You can find more examples in
tests/ffi.tst
modules/bindings/glibc/tests.tst and modules/bindings/glibc/linux.lisp
modules/bindings/win32/tests.tst and modules/bindings/win32/win32.lisp
modules/dbus/tests.tst and modules/dbus/dbus.lisp
more ffi modules
Future
Indeed, these days sbcl is better maintained than clisp, so you might want to consider switching.
Related
I am learning Lisp and, just for practice/education, am trying to define a function that will
ask the user to enter a number until they enter an integer > 0 [copied from Paul Graham's Ansi Common Lisp]
print that number and subtract 1 from it, repeat until the number hits 0, then return.
I am trying to do this via passing 2 functions into a higher-order function - one to get the number from the user, and another recursive [just for fun] function that prints the number while counting it down to 0.
Right now my higher-order function is not working correctly [I've tested the first 2 and they work fine] and I cannot figure out why. I am using SBCL in SLIME. My code for the 3 functions looks like this:
(defun ask-number ()
(format t "Please enter a number. ")
(let ((val (read))) ; so val is a single-item list containing the symbol 'read'?
(cond ; no here read is a function call
((numberp val)
(cond
((< val 0) (ask-number))
(T val)))
(t (ask-number))))))
(defun count-down (n)
(cond
((eql n 0) n)
(t
(progn
(format t "Number is: ~A ~%" n)
(let ((n (- n 1)))
(count-down n))))))
(defun landslide (f1 f2)
(let (x (f1))
(progn
(format t "x is: ~A ~%" x)
(f2 x)))))
but calling slime-eval-defun in landslide yields:
; SLIME 2.27; in: DEFUN LANDSLIDE
; (F1)
;
; caught STYLE-WARNING:
; The variable F1 is defined but never used.
; (SB-INT:NAMED-LAMBDA LANDSLIDE
; (F1 F2)
; (BLOCK LANDSLIDE
; (LET (X (F1))
; (PROGN (FORMAT T "x is: ~A ~%" X) (F2 X)))))
;
; caught STYLE-WARNING:
; The variable F1 is defined but never used.
;
; caught STYLE-WARNING:
; The variable F2 is defined but never used.
; in: DEFUN LANDSLIDE
; (F2 X)
;
; caught STYLE-WARNING:
; undefined function: COMMON-LISP-USER::F2
;
; compilation unit finished
; Undefined function:
; F2
; caught 4 STYLE-WARNING conditions
I have tried several [what I consider] obvious modifications to the code, and they all fail with different warnings. Calling the function like (landslide (ask-number) (count-down)), ask-number prompts for user input as expected, but then SLIME fails with
invalid number of arguments: 0
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
I know I have to be missing something really obvious; can someone tell me what it is?
First: You are missing a set of parens in your let:
You have (let (x (f1)) ...) which binds 2 variables x and f1 to nil.
What you want is (let ((x (f1))) ...) which binds 1 variable x to the values of function call (f1)
Second: Common Lisp is a "lisp-2", so to call f2 you need to use funcall: (funcall f2 ...).
Finally: all your progns are unnecessary, and your code is hard to read because of broken indentation, you can use Emacs to fix it.
Before I reach an error in landslide, there are some notes about this code:
Your first function is hard to read- not just because of indentation, but because of nested cond.
You should always think about how to simplify condition branches- using and, or, and if you have only two branches of code, use if instead.
There are predicates plusp and minusp.
Also, don't forget to flush.
I'd rewrite this as:
(defun ask-number ()
(format t "Please enter a number. ")
(finish-output)
(let ((val (read)))
(if (and (numberp val)
(plusp val))
val
(ask-number))))
Second function, count-down.
(eql n 0) is zerop
cond here has only two branches, if can be better
cond has implicit progn, so don't use progn inside cond
let is unnecessary here, you can use 1- directly when you call count-down
Suggested edit:
(defun count-down (n)
(if (zerop n) n
(progn
(format t "Number is: ~A ~%" n)
(count-down (1- n)))))
Also, this function can be rewritten using loop and downto keyword, something like:
(defun count-down (n)
(loop for i from n downto 0
do (format t "Number is: ~A ~%" i)))
And finally, landslide. You have badly formed let here and as Common Lisp is Lisp-2, you have to use funcall. Note that let has also implicit progn, so you can remove your progn:
(defun landslide (f1 f2)
(let ((x (funcall f1)))
(format t "x is: ~A ~%" x)
(finish-output)
(funcall f2 x)))
Then you call it like this:
(landslide #'ask-number #'count-down)
This question is really about my lack of understanding of restarts.
In the encoder for cl-json there exists a tempting macro I would like to use
with-substitute-printed-representation-restart
But alas I do not quite understand how.
This
(cl-json::encode-json-plist (list :boo "boo" :foo "foo"))
returns
{"boo":"boo","foo":"foo"}
This
(cl-json::encode-json-plist (list :boo "boo" :foo (lambda (a b) (+ a b))))
signals an UNENCODABLE-VALUE-ERROR
I would like to restart from that point where cl-json finds the function and have it return
something of my choosing when it runs into that adding lambda I included in the list.
(defun my-func ()
(handler-bind ((cl-json::UNENCODABLE-VALUE-ERROR
#'(lambda (e) (invoke-restart 'return-default))))
(myencode (list :boo "boo" :foo (lambda (a b) (+ a b))))
)
)
(defun myencode (alist)
(restart-case
(cl-json::encode-json-plist-to-string alist)
(return-default () :report "Just return a default could not do this string" "barf")
)
)
returns "barf"
I want it to return
{"boo":"boo","foo":"barf"}
How do I use that macro do to this?
In other words I want the restart to happen where the error was thrown not where the error was caught. Can I do that?
I don't understand if the doc is wrong or if I am reading the code badly, but there should already be a restart available whenever an object cannot be encoded. If you redefined cl-json default method for encode-json as follows, then you have a restart.
(defmethod encode-json (anything &optional (stream *json-output*))
"If OBJECT is not handled by any specialized encoder signal an error
which the user can correct by choosing to encode the string which is
the printed representation of the OBJECT."
(with-substitute-printed-representation-restart (anything stream)
(unencodable-value-error anything 'encode-json)))
By the way you could redefine so that the restart accepts an argument, the string to print instead:
(defmethod encode-json (anything &optional (stream *json-output*))
"If OBJECT is not handled by any specialized encoder signal an error
which the user can correct by choosing to encode the string which is
the printed representation of the OBJECT."
(with-substitute-printed-representation-restart (anything stream)
(restart-case (unencodable-value-error anything 'encode-json)
(use-value (v)
:report "Use a different encoding"
(check-type v string)
(write v :stream stream :escape t)))))
For example:
CL-USER> (handler-bind
((json:unencodable-value-error
(lambda (err)
(declare (ignore err))
(invoke-restart 'use-value "UNKNOWN"))))
(json:encode-json
`(((foo . ,#'print) (bar . "baz")))))
[{"foo":"UNKNOWN","bar":"baz"}]
You may want to ask directly the author of the library
I'm trying to pass a symbol of a condition of a function to a macro, and see the result:
(defmacro macro-test-1 (form condition)
`(handler-case (funcall ,form)
(,condition (c)
(declare (ignore c))
(format t "~a" 'why?))))
(macro-test-1 #'(lambda () (error 'simple-type-error)) division-by-zero)
;; OK, I get the simple-type-error as expected.
(defun test-1 (condition)
(macro-test-1 #'(lambda () (error 'simple-type-error)) condition))
; in: DEFUN TEST-1
; (SB-INT:NAMED-LAMBDA TEST-1
; (CONDITION)
; (BLOCK TEST-1
; (MACRO-TEST-1 #'(LAMBDA () (ERROR 'SIMPLE-TYPE-ERROR)) CONDITION)))
;
; caught STYLE-WARNING:
; The variable CONDITION is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
TEST-1
;; what happened?
(test-1 'division-by-zero)
WHY?
NIL
;; what happened?
I'm pretty confused by what's going on, I've been trying to figure it out for a long time, I hope I'm missing something silly.
up 1
It is as I imagined, silly error, now I realized what I was trying to do, the macro will be expanded at compile time, and the argument I pass to the function at runtime, so the macro will not receive the condition argument correctly. So I see two possibilities of solving this, turning macro-test-1 into a function or turning test-1 into a macro.
Actually I tested here, changing to function still not working:
CL-USER> (defun macro-test-1 (form condition)
(handler-case (funcall form)
(condition (c)
(declare (ignore c))
(format t "~a" 'why?))))
; in: DEFUN MACRO-TEST-1
; (SB-INT:NAMED-LAMBDA MACRO-TEST-1
; (FORM CONDITION)
; (BLOCK MACRO-TEST-1
; (HANDLER-CASE (FUNCALL FORM)
; (CONDITION (C) (DECLARE #) (FORMAT T "~a" 'WHY?)))))
;
; caught STYLE-WARNING:
; The variable CONDITION is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
WARNING: redefining COMMON-LISP-USER::MACRO-TEST-1 in DEFUN
CL-USER> (macro-test-1 #'(lambda () (error 'simple-type-error)) 'division-by-zero)
WHY?
NIL
However when you redefine macro-test-1 as a macro, and redefine test-1 as a macro:
CL-USER> (defmacro test-1 (condition)
`(macro-test-1 #'(lambda () (error 'simple-type-error)) ,condition))
TEST-1
CL-USER> (test-1 division-by-zero)
; Evaluation aborted on #<SIMPLE-TYPE-ERROR {1001BB8FF3}>.
I'm still not sure why the function does not work, the evaluation rule is not to evaluate all arguments and then pass to the body of the function the evaluated arguments? Because it does not work?
up 2
I understand that the handler-case does not work because you need to know the errors at compile time, and passing condition as a runtime function argument would not be able to know the compile-time error, so it does not work. And I stress this single reason, and not because macros occur has compile time, by a question I noted below which led me to this whole mess, and made me believe it is possible to pass condition by a function. I can do this:
(defmacro macro-test-1 (fn value)
`(funcall ,fn ,value 1))
(macro-test-1 #'= 1)
;; => T it is OK
(defun test-1 (fn value)
(macro-test-1 fn value))
(test-1 #'= 1)
;; => why it is OK?
The above code works, even though I pass the arguments to the function at runtime, why does it work? if the macro is expanded at compile time, why is it working when I call test-1? or are macros not always expanded at compile time? What am I missing here?
up 3
I decided to go deeper, and tried:
(defmacro macro-test-1 (fn value)
`(,fn ,value 1))
(macro-test-1 = 1)
;; => T it is OK
(defun test-1 (fn value)
(macro-test-1 fn value))
; in: DEFUN TEST-1
; (SB-INT:NAMED-LAMBDA TEST-1
; (FN VALUE)
; (BLOCK TEST-1 (MACRO-TEST-1 FN VALUE)))
;
; caught STYLE-WARNING:
; The variable FN is defined but never used.
; in: DEFUN TEST-1
; (MACRO-TEST-1 FN VALUE)
; ==>
; (FN VALUE 1)
;
; caught STYLE-WARNING:
; undefined function: FN
;
; compilation unit finished
; Undefined function:
; FN
; caught 2 STYLE-WARNING conditions
WARNING: redefining COMMON-LISP-USER::TEST-1 in DEFUN
TEST-1
Yes I know that if I try as shown below, it will not exit as expected:
(test-1 '= 1)
; Evaluation aborted on #<UNDEFINED-FUNCTION FN {1004575323}>. ;
But I wanted to find a way to make it work, so I tried, until I could, by resetting macro-test-1 to:
(defmacro macro-test-1 (fn value)
`(eval (,fn ,value 1)))
WARNING: redefining COMMON-LISP-USER::MACRO-TEST-1 in DEFMACRO
MACRO-TEST-1
(defun test-1 (fn value)
(macro-test-1 fn value))
WARNING: redefining COMMON-LISP-USER::TEST-1 in DEFUN
TEST-1
(test-1 '= 1)
T
Of course this would only work in handler-case or case, if I redefined its macros, which I believe should not be a good practice, nor do I need it, but I like to go where it does not, well, then, I learn erring.
Macros are code transformation. Thus the expansion can happen as early as when you evaluate a defun. eg.
(defun test-1 (condition)
(macro-test-1 #'(lambda () (error 'simple-type-error)) condition))
;; becomes this
(defun test-1 (condition)
(handler-case (funcall #'(lambda nil (error 'simple-type-error)))
(condition (c)
(declare (ignore c)) (format t "~a" 'why?)))
Now just lets say you want to have handler-case check for simple-type-error. You'll write it like this:
(handler-case expression
(simple-type-error ()
(format t "~a" 'why?)))
not
(handler-case expression
('simple-type-error ()
(format t "~a" 'why?)))
Eg. handler-case is syntax and that place is can not have a variable be evaluated to some error, but must be a type specifier and that is probably handled compile time by the system. This is the reason you get that condition is never used since your handler-case checks for a type called condition, not what you sent as the condition argument.
Making test-1 a macro actually passes division-by-zero as the symbol to macro-test-1 and the result is this:
(handler-case (funcall #'(lambda nil (error 'simple-type-error)))
(division-by-zero (c)
(declare (ignore c))
(format t "~a" 'why?)))
This also means the errors need to be known compile time since you cannot have a macro be passed values in variables. That is why it works so the second you want some user to input what error to act on you cannot do it with your solution.
EDIT
In up2 you ask why this works:
(defun test-1 (fn value)
(macro-test-1 fn value))
So we'll just find out what actually gets saved:
(macroexpand-1 '(macro-test-1 fn value))
; ==> (funcall fn value)
; ==> t
Thus your function becomes this:
(defun test-1 (fn value)
(funcall fn value))
handler-case was syntax that didn't take variables or expression at the place you wanted and thats why that didn't work, but it will of course work for all functions, including funcall, since it evaluates all it's arguments.
To show you a different example of what does not work is case:
(defun check-something (what result default-value value)
(case value
(what result)
(otherwise default-value)))
case is a macro so what actually happens. We can do macroexpand-1 on it to see:
(macroexpand-1
'(case value
(what result)
(otherwise default-value))
)
; ==> (let ((tmp value))
; (cond ((eql tmp 'what) result)
; (t default-value)))
; ==> t
The macro expects the case values to be literals and thus quotes them so that they never get evaluated. The resulting function you clearly see what is never used, just as condition wasn't:
(defun check-something (what result default-value value)
(let ((tmp value))
(cond ((eql tmp 'what) result)
(t default-value))))
Macros are to abstract on syntax. You need to be able to write the code without the macro and rather see that this is a pattern that repeats and than add an abstraction that rewrites from your simplified version to the full version. If it cannot be done to begin with it cannot be rewritten as a macro.
Same for functions. The whole reason why we have macros is to control evaluation. A good example of something that cannot be written as a fucntion is if:
(defun my-if (predicate consequence alternative)
(cond (predicate consequence)
(t alternative)))
(my-if t 'true 'false) ; ==> true
(my-if nil 'true 'false) ; ==> false
But since functions always evaluates their arguments you cannot do this:
(defun factorial (n)
(my-if (<= n 1)
1
(* n (factorial (1- n)))))
This will never halt since being a function all 3 arguments are always evalaued and (* n (factorial (1- n)))) is done even when n is negative and it will have endless recursion. Using a macro instead would replace the my-if with the resulting cond and both cond and if does not evaluate all their arguments rather than short circuits on the one that matches truthy predicate.
You may use macroexpand-1 to check if you code indeed is correct. You should be able to replace the input with the ourput. Is you use macroexpand applies the expansion until it will not expand anymore. Eg. cond will also be expanded to nested if's.
EDIT 2
From up3:
(defun test-1 (fn value)
(macro-test-1 fn value))
This is the same problem. The macro function gets fn and value as bindings and the result is:
(defun test-1 (fn value)
(fn value))
This might have worked in Scheme, but in Common Lisp symbols in operator prosition is different from other positions. Thus when CL tries to find the function fn it never look any close to the variable fn. The only way to solve this is by using funcall and then you actually don't need a macro at all:
(defun with-1 (fn value)
(funcall fn value 1))
(with-1 #'+ 10) ; ==> 11
Notice the #' prefix. That is short for (function ...) so it's really (function +). function is a special form that takes the argument symbol and gets the value from the function namespace.
With eval you can do a lot of stuff, but it comes with a price. It will not be optimized and perhaps even just interpreted and it might gove you compile time errors at runtime as well as open for security risks. A good example was a online interactive ruby that just did eval and it worked well until someone evaluated code that deleted all the system files. eval is considered harmful and even evil. In my professional career I have seen eval being used 3 times on purpose. (2 times in PHP, one in requirejs). One of those times I challenged the writer that there might be a better way to do it. Of course both handler-case and case will work with eval since the evaluated code would have the correct format, but you'll loose the lexical scoping. eg.
(let ((x 10))
(eval '(+ x 1)));
; *** EVAL: variable X has no value
You might be smart and do this:
(let ((x 10))
(eval `(+ ,x 1))) ; ==> 11
but what if it was a list or something else not self evaluating?
(let ((x '(a b)))
(eval `(cons '1 ,x)))
; *** undefined function: a
Thus eval has its chalenges as well. Keep away for other purposes than education ones.
I want to write some special reader macros:
[hello "world"] ; <=> (funcall #'|hello| "world")
{hello "my" ("world")} ; <=> (apply #'|hello| "my" ("world"))
Can this be implemented? And how would you do it?
Yes, the term you are wanting is readtable (Common Lisp HyperSpec chapter 23 and Common Lisp HyperSpec chapter 2 talk about the relevant concepts).
You'll need to first define a function that can read the data you are interested in, then return it in the form you want it.
(defun read-case-preserve-funcall-or-apply (stream char)
(let ((preserved-readtable-case (readtable-case *readtable*)))
(setf (readtable-case *readtable* :preserve))
(let ((tmp (read-delimited-list (if (char= char #\[) #\] #\}) stream t)))
(let ((fun (car tmp))
(args (cdr tmp)))
(cond ((char= char #\[) `(funcall (function ,fun) ,#args))
((char= char #\{) `(apply (function ,fun) ,#args)))))))
After that, you need to hook it up to the readtable and copy some syntax-markers from ( and ) to your new delimiters.
I wrote a new version of "zap-to-char".It just highlights the region instead of kill it.I think this would be more flexible,because we can choose to kill,or copy,or just go to this char.
Here is the snippet:
(defun new-zap-to-char (arg char)
(interactive "p\ncZap to char: ")
(push-mark)
(setq mark-active t)
(defun iter-zap ()
(if (< arg 0)
(search-forward (char-to-string char) nil nil -1)
(search-forward (char-to-string char) nil nil 1))
(if (char-equal char (setq c (read-char)))
(iter-zap)
(>>>>here is the "push-back-to-input" function"<<<<))
(iter-zap))
As you see, I need a function to push the result of 'read-char' back to input,when you type input except for the "char". But I don't know if Emacs offered one. So I need your help.
I hope I've made this clear.
You can try unread-command-events.
For example:
(push ?a unread-command-events)