Macros and defprotocol with Clojurescript - macros

I'm using petrol for a clojurescript application, and I've found a lot of boilerplate is necessary when extending protocols with messages.
So I decided to write a macro! Now, if only it worked :/
(ns my.macros)
(defmacro state-message [msg-type app-key]
`(extend-protocol
Message
~msg-type
(process-message [msg app]
(let [state (app-key app)]
(->>
(merge state msg)
(assoc app app-key))))))
The code above is approximately what I'd like to write, but I'm having some trouble getting the quoting right. Rather than doing what I intended, it's giving me a compiler error Invalid local name: ohds.macros/msg when I try to use it like (state-message m/ChangeUsername :user)
Macroexpand gives me this, and it looks right:
(clojure.core/extend-protocol
ohds.server/Message
m/ChangeUsername
(ohds.server/process-message [ohds.server.msg ohds.server/app]
(clojure.core/let [ohds.server/state (ohds.server/app-key ohds.server/app)]
(clojure.core/->>
(clojure.core/merge ohds.server/state ohds.server.msg)
(clojure.core/assoc ohds.server/app ohds.server/app-key)))))
I suspect the problem with with msg but I'm not sure how to proceed.

You need to use gensyms for introducing new local bindings in your macro.
The following should work:
(defmacro state-message [msg-type app-key]
`(extend-protocol
Message
~msg-type
(~'process-message [msg# app#]
(let [state# (~app-key app#)]
(->>
(merge state# msg#)
(assoc app# ~app-key))))))

Related

Can a macro be used to make c[...]r combinations with any arbitrary number of car and cdr calls, such as cadaddr?

I recently discovered that all of my implementations of Scheme throw an error when I try to use (cadaddr (list 1 3 (list 5 7) 9)). Apparently, by default Scheme does not allow any car and cdr combinations in the single-function form that use more than four abbreviated car and cdrcalls. I originally blamed this on Scheme's minimalism, but then I discovered that Common Lisp also shares this defect.
Can this be solved with a macro? Can we write a macro that allows an arbitrary amount of a and d in its c[...]r calls and returns the expected result, while also having the Common Lisp-like compatibility with macros like setf? If not, why not? And if so, has a reason ever been given for this is not a default feature in any lisp that I've seen?
Such a macro is described in Let Over Lambda for common lisp. You must wrap your code with (with-cxrs ...) to bring them all into scope, but it walks your code to see which combinators you need. I wrote a Clojure port of it years ago for fun, though of course nobody (including me) has ever wanted to use it for real. You could port it to Scheme if you liked.
(defn cxr-impl [name]
(when-let [op (second (re-matches #"c([ad]+)r" name))]
`(comp ~#(map {\a `first \d `rest} op))))
(defmacro with-cxrs [& body]
(let [symbols (remove coll? (tree-seq coll? seq body))]
`(let [~#(for [sym symbols
:let [impl (cxr-impl (name sym))]
:when impl
thing [sym impl]]
thing)]
~#body)))
user> (macroexpand-1 '(with-cxrs (inc (caadaaddadr x))))
(let [caadaaddadr (comp first first rest first first rest rest first rest)]
(inc (caadaaddadr x)))
https://groups.google.com/g/clojure/c/CanBrJPJ4aI/m/S7wMNqmj_Q0J
As noted in the mailing list thread, there are some bugs you'd have to work out if you wanted to use this for real.

How do I prevent slime from starting sldb on certain errors?

When serving large files from Clack/Hunchentoot with Slime connected, I sometimes see error messages like SB-IMPL::SIMPLE-STREAM-PERROR "Couldn't write to ~s"... Those are caused by the browser prematurely dropping connections (which is totally OK). The problem is that each time it happens, SLDB pops up. Which is annoying.
Is there a way I can inhibit certain errors in SLDB such as the above? I still would like to see them in an error log, but definitely not in SLDB.
You can subclass PROCESS-CONNECTION for your acceptor and do your own error handling for this error.
Let's start by defining a custom acceptor:
(defclass no-error-acceptor (hunchentoot:acceptor)
())
Then we can create a wrapper around PROCESS-CONNECTION that inhibits printing of a message for this specific error:
(defmethod hunchentoot:process-connection ((acceptor no-error-acceptor) (socket t))
(handler-case
(call-next-method)
(sb-impl::simple-stream-perror (condition)
;; Perhaps log the error here?
nil)))
Make sure you actually start the server using this acceptor in order for it to be used.
UPDATED
Since your system uses Hunchentoot, you could set the global variable HUNCHENTOOT:*CATCH-ERRORS-P* to T. This should guarantee that the all the conditions arising in code managed by Hunchentoot are catched by Hanchentoot itself and not passed to the debugger.
To disable the debugger in any Common Lisp implementation (both inside a shell REPL as well as the Slime REPL inside Emacs) you could use the predefined global variable *debugger-hook*, by assigning to it a two argument function. The function will receive the condition and the current value of *debugger-hook* when it is called, and can handle the condition or return normally, and in this case the debugger is invoked. For instance, you could simply print the condition:
* (defun my-debug(condition hook)
(declare (ignore hook))
(print condition)
(abort))
DEBUG-IGNORE
* (setf *debugger-hook* #'my-debug)
#<FUNCTION MY-DEBUG>
This second method however cannot work when using Hunchentoot together with Slime, due to the way the two packages interact with respect to the debugging strategies.
In this case one could adopt the solution found by Mike Ivanov, that redefines the swank-debugger-hook function before starting Swank:
(in-package swank)
(setq swank-debugger-hook-orig #'swank-debugger-hook)
(defun swank-debugger-hook (condition hook)
(etypecase condition
(sb-int:simple-stream-error
(progn
(princ "*** Stream error" *error-output*)
(abort)))
(t (funcall swank-debugger-hook-orig condition hook))))
(in-package cl-user)
(swank:create-server :port 4008 :dont-close t)

Understanding package loading

(solved, see the comments)
Recently I've been working on an API that has to interface with an already existing service. Everything seems to be working quite well, and my project is just starting to get large enough that I would see some benefit from throwing things into a package. As this is my first "real" project in CL, I think I'm not fully understanding the packaging/loading mechanisms going on here.
My basic problem is that I have a bunch of code that uses macros to generate functions/classes, interns them into my package, and then exports certain functions/accessors that people will eventually use to interact with the API. If I load the files individually like so:
(load "~/src/lisp/cl-bitcoin/bitcoin.lisp")
(load "~/src/lisp/cl-bitcoin/classes.lisp")
(load "~/src/lisp/cl-bitcoin/functions.lisp")
Everything works well. The functions declared by my macros are interned and exported correctly and I'm able to call them to interact with the API. However, if I attempt to do the following:
(ql:quickload :btc)
Quicklisp tells me that everything was loaded properly - and it seems that most of the loading process happened as I expected since all of my dependencies are loaded and available for use. The problem is that everything related to my package is not available. This includes functions that are exported directly from my package.lisp file. For reference, here are my .asd and package files:
package.lisp
(defpackage #:btc
(:use #:cl)
(:export #:set-connection-parameters
#:reset-rpc-id
#:with-connection-parameters
#:btc-base-err
#:btc-base-id))
btc.asd
(asdf:defsystem #:btc
:serial t
:depends-on (#:drakma
#:flexi-streams
#:cl-json)
:components ((:file "package")
(:file "bitcoin")
(:file "classes")
(:file "functions")))
I feel like I'm missing something fairly obvious here - I've been looking into eval-when and other related loading functions but haven't been able to figure this out. Can someone explain to me what's going on here?
Thanks for your help.
Edit: Here's what my REPL looks like:
; SLIME 2011-02-04
CL-USER> (ql:quickload :btc)
To load "btc":
Load 1 ASDF system:
btc
; Loading "btc"
..
(:BTC)
CL-USER> (btc:help "getinfo")
Invoking restart: Return to SLIME's top level.
; Evaluation aborted on #<SIMPLE-ERROR #x30200175DF0D>.
CL-USER> ; Reader error: No external symbol named "HELP" in package #<Package "BTC"> .
; No value
CL-USER> (load "/Users/jordan/src/lisp/cl-bitcoin/bitcoin.lisp")
#P"/Users/jordan/src/lisp/cl-bitcoin/bitcoin.lisp"
CL-USER> (load "/Users/jordan/src/lisp/cl-bitcoin/classes.lisp")
#P"/Users/jordan/src/lisp/cl-bitcoin/classes.lisp"
CL-USER> (load "/Users/jordan/src/lisp/cl-bitcoin/functions.lisp")
#P"/Users/jordan/src/lisp/cl-bitcoin/functions.lisp"
CL-USER> (btc:help "getinfo")
#<BTC::BTC-SINGLE #x3020017DBDDD>
CL-USER>
And the code to generate functions:
;;;; package information
(in-package #:btc)
;;; externally visible functions - this class contains the public api for
;;; cl-bitcoin as well as the function building framework that we need to
;;; easily handle the multiple return types that are possible from the
;;; bitcoind server methods
;; function building framework - resolving function return types into
;; specific btc objects (as defined in classes.lisp)
(defun create-btc-obj (fn result err id)
(case fn
((:getbalance :help) (make-btc-single result err id))
(otherwise (error "Unable to parse function ~S to a btc object" fn))))
(defmacro defbtcfun (name &rest args)
(let ((g (gensym)) (result (gensym)) (err (gensym)) (id (gensym)))
`(progn
(defun ,name ,args
(let ((,g (intern (string ',name) :keyword)))
(multiple-value-bind (,result ,err ,id) (get-bitcoind-result ,g ,#args)
(create-btc-obj ,g ,result ,err ,id))))
(export ',name 'btc))))
;; function definitions (each of these functions should have a corresponding case in
;; create-btc-obj above, otherwise a condition will be signaled
(defbtcfun help method)
(defbtcfun getbalance account minconf)
Jordan Kaye posted this as a comment, but never turned it into an answer:
It turns out that this was just an incorrect configuration issue in
asdf by me.. I accidentally set up the project in an incorrect
directory. When loading the project, quickload was actually loading an
entirely separate .asd file than the one that I was expecting. So,
when I loaded the (correct) files manually, the code worked as
expected - quickload was loading the wrong files. Thanks a lot for
your help, it led me to figure out the cause!

Unix signal handling in (common) lisp

I've done a bit of research on this subject and am turning up blanks. There seem to be implementation-dependent ways of doing Unix signal handling in Common Lisp, but is there a package that gives a cross-implementation way of doing signal handling?
I would mainly like to listen for SIGINT and do a graceful shutdown in my app. I'm using Clozure CL 1.7 on linux...like mentioned, it would be great for a package for this, but if I have to resort to implementation-specific code, that's fine.
I'm also not completely married to using SIGINT (although it's ideal). I can use another signal if needed.
If this is going to be messy, does anyone have any other suggestions for gracefully shutting down a lisp app from outside the app? One idea I had is to create a file the app monitors for, and if it detects the file, it shuts down...kind of hacky, though.
Thanks!
Although out of ignorance I was originally skeptical of Daimrod's comment (first comment under the question) about using CFFI, I looked around a bit more and found http://clozure.com/pipermail/openmcl-devel/2010-July/011675.html. I adapted it to use CFFI and have confirmed this works on SBCL/CCL/clisp (probably others) on linux pretty damn well:
(defmacro set-signal-handler (signo &body body)
(let ((handler (gensym "HANDLER")))
`(progn
(cffi:defcallback ,handler :void ((signo :int))
(declare (ignore signo))
,#body)
(cffi:foreign-funcall "signal" :int ,signo :pointer (cffi:callback ,handler)))))
(set-signal-handler 2
(format t "Quitting lol!!!11~%")
;; fictional function that lets the app know to quit cleanly (don't quit from callback)
(signal-app-to-quit))
Note that from what I understand, whatever is in the body of the callback must be short and sweet! No lengthy processing. In the linked article, the macro actually creates a separate thread just for handling the signal, which is overkill for my purposes, since I'm just setting a global variable from nil to t and returning.
Anyway, hopefully this is helpful to others!
I can't find a general library for signal handling either. However, Slime implements "create a custom SIGINT handler" for most Lisp implementations. By looking at the CCL case of that code, I found ccl:*break-hook*. ccl:*break-hook* is not in the documentation, but the commit it was introduced in is located here.
This trivial example code works on my system (CCL 1.8, linux x86):
(setf ccl:*break-hook*
(lambda (cond hook)
(declare (ignore cond hook))
(format t "Cleaning up ...")
(ccl:quit)))
After this code is entered into a non-Slime REPL, sending SIGINT will cause the program to print "Cleaning up ..." and exit.
This is a late answer, but for anybody else searching for this, have a look at trivial-signal, available on Quicklisp. This is based on CFFI.
Example
(signal-handler-bind ((:int (lambda (signo)
(declare (ignorable signo))
...handler...)))
...body...)
If you use SBCL, you cannot change the signal mask without causing SBCL to crash. Ask nyef about his tips on how to fix SBCL...
So there is trivial-signal as mentioned. Here's how I catch a C-c in my code:
(handler-case
(my-app-main-function)
;; AFAIK trivial-signal is supposed to handle the implementation differences.
(#+sbcl sb-sys:interactive-interrupt
#+ccl ccl:interrupt-signal-condition
#+clisp system::simple-interrupt-condition
#+ecl ext:interactive-interrupt
#+allegro excl:interrupt-signal
() (progn
(format *error-output* "Aborting.~&")
(exit)))
(error (c) (format t "Woops, an unknown error occured:~&~a~&" c)))

Clojure riddle: eval, macros and namespaces

In clojure, macros give a tremendous power to the programmer. eval also is very powerful. There exist some subtle differences between the two. I hope that this riddle will shine some light on this topic.
(ns hello)
(defmacro my-eval [x] `~(read-string x))
(defn hello[] "Hello")
(defn run-stuff []
(println (hello))
(println (my-eval "(hello)"))
(println (eval (read-string "(hello)"))))
(ns main)
(try (hello/run-stuff)
(catch Exception e (println e)))
Over the 3 statements inside run-stuff body, which one causes an exception and why the other ones don't?
I have formulated the following riddle following the investigation of this beautiful question Clojure - (read-string String calling function. Thanks to #Matthias Benkard for the clarifications
(println (hello)) and (println (my-eval "(hello)")) are completely identical statements -- the only difference is that one will confuse your editor more. my-eval is NOT comparable to the real eval. The difference is that the argument to my-eval needs to be a string at compile time -- the following errors out because the symbol x can't be cast to a string.
(def x "(hello)")
(my-eval x)
This makes my-eval utterly pointless - you can "eval" a literal string or you can remove the quotes and the my-eval and have equally functional code (that your editor will understand).
Real eval, on the other hand, tries to compile code at run time. Here, it fails because it is being run from the main namespace, not the hello namespace, as #Matthias Benkard pointed out.