The following code works but i have to load swank no matter whether i need it or not.
(ql:quickload :swank)
(defun swank ()
(swank:create-server :port 4005 :donot-close t))
If i move "(ql:quickload :swank)" into function swank, then CL will not find package swank.
Sincerely!
Remember that reading is a separate phase in CL. First a form is read, then it is executed. When the reader read the DEFUN form, it didn't recognize the SWANK:CREATE-SERVER symbol because, at that point, QL:QUICKLOAD had not been executed yet. The solution is to use INTERN.
(defun swank ()
(ql:quickload :swank)
(funcall (intern (string '#:create-server) :swank) :port 4005 :dont-close t))
Related
Sounds deceptively easy. This doesn't work:
~/.sbclrc
(load #P"~/in-package.lisp")
~/in-package.lisp
(in-package 'stored-package)
The package change only applies to the file in-package.lisp itself.
Try different approach: store just the name.
(defmacro recall-package (&optional (filename #p"~/lisp-package.lisp"))
"IN-PACKAGE the contents of the FILENAME"
(let ((p (car (uiop:read-file-lines filename))))
`(in-package ,p)))
This works, but only from ~/.sbclrc. Files which it LOADs expand the macro within their own context, and so it doesn't work.
SBCL reads it's .sbclrc like this:
(restart-case
(flet ((process-init-file (kind specified-pathname default-function)
(awhen (or specified-pathname (funcall default-function))
(with-open-file (stream (if specified-pathname
(parse-native-namestring it)
(pathname it))
:if-does-not-exist nil)
(cond (stream
(sb-fasl::call-with-load-bindings
(lambda (stream kind) (load-as-source stream :context kind))
stream kind stream))
(specified-pathname
(cerror "Ignore missing init file"
"The specified ~A file ~A was not found."
kind specified-pathname)))))))
(unless no-sysinit
(process-init-file "sysinit" sysinit *sysinit-pathname-function*))
(unless no-userinit
(process-init-file "userinit" userinit *userinit-pathname-function*))
Using these fancy sb-fasl::call-with-load-bindings and sb-int:load-as-source yields similar results to the above.
You can't do this with load, because
load binds *readtable* and *package* to the values they held before loading the file.
Function load
This means that any changes made to the values of these variables within a file being loaded are local to the file. That's almost always a good thing. In particular it means that there is no way at all (or no portable way: if you had access to the guts of the dynamic binding mechanism of the implementation this might not be true) that any changes made to the current package (ie the dynamic value of *package*) can ever propagate up through calls to load.
If all you want to do is set the package based on some name in a file, then this is relatively easy, with something like the below:
(defpackage :empty-package
(:use))
(defun set-package-from-file (f)
(let ((pn
(with-standard-io-syntax
;; EP just in case the file does somehow manage to smash
;; *package*)
(let* ((ep (find-package :empty-package))
(*package* ep)
(*read-eval* nil))
(unwind-protect
(with-open-file (in f)
(string (read in)))
;; Clean up EP to avoid leakage
(do-symbols (s ep)
(unintern s ep)))))))
(let ((p (find-package pn)))
(unless p (error "no package ~A" pn))
(setf *package* p))))
This is probably both overly-protective and thus will contain some horrible unexpected bug which I should have thought about (I know it's not safe against interning symbols in other packages). However the idea is that the file contains a single string-designator which should be the package name.
If you had time on your hands you could fairly easily write a version of load which would not rebind *package* &c, and which would work for source files. I think you can't portably write one which would work for FASL files.
Here's one reason why the behaviour the language specifies is the right behaviour: it makes compilation a lot easier. Consider a file which contains:
(in-package ...)
(defun foo (...) ...)
(load ...)
(defun bar (...)
(foo ...)
...)
If *package* could propagate up through load then compiling this file would be, at best, interesting.
I'm using HT-SIMPLE-AJAX to provide a simple JSON structure over AJAX. It works beautifully if the function defined by defun-ajaxis compiled after the lisp image and the server is started.
If I load the lisp program (with ccl --load) with the function defined, I get this error:
Error: Unbound variable: *AJAX-PROCESSOR*
While executing: #, in process listener(1).
Type :GO to continue, :POP to abort, :R for a list of available restarts.
If continued: Skip loading "/home/hunchentoot/quicklisp/local-projects/gac-man/run.lisp"
Type :? for other options.
The function is as follows:
(defun-ajax machine-info (serial) (*ajax-processor*)
(let* ((serialn (remove #\" serial)))
(concatenate 'string
"Lots of boring stuff" "here")))
The ajax processor is created in another function, called at the start of the program:
(defun start ()
(setup)
(connect-to-database)
(defvar *web-server* (start (make-instance 'hunchentoot:easy-acceptor :port 8080
:document-root #p"~/www/")))
(defvar *ajax-processor*
(make-instance 'ajax-processor :server-uri "/ajax"))
(print "Starting web server...")
(setf *show-lisp-errors-p* t
*show-lisp-backtraces-p* t)
(define-easy-handler (docroot :uri "/") () (docroot)
....
....
(setq *dispatch-table* (list 'dispatch-easy-handlers
(create-ajax-dispatcher *ajax-processor*)))))
And yet if I start everything and then compile in the function through slime later, it works just fine. Why is this error occurring?
I'm using Clozure Common Lisp on 64-bit Linux.
It seems that your defun-ajax form is loaded before the start function has run. That is not surprising. Usually, all code is loaded, and only then the entry point is called.
You should always be very suspicious of defvar, defun, defparameter etc. forms appearing in a function body. They don't belong there. Put them as toplevel forms, so they are loaded as part of the program. Most of the things defined during the run of the start function shown should really be toplevel forms.
I'm relatively new to Common Lisp (SBCL) and Hunchentoot (using Quicklisp). Can someone tell me how I can get this to work? I'm trying to wrap an Hunchentoot server and some paths in a function as a unit. When I run this, only Hunchentoot's index page is available, the paths /a and /b aren't.
(defun app0 (port)
(let ((*dispatch-table* nil) (server (make-instance 'hunchentoot:acceptor :port port)))
(push (hunchentoot:create-prefix-dispatcher "/a" (lambda () "a")) *dispatch-table*)
(push (hunchentoot:create-prefix-dispatcher "/b" (lambda () "b")) *dispatch-table*)
(hunchentoot:start server) server))
There are multiple problems, as far as I can see. First, request handling via *dispatch-table* requires, that the acceptor is of type easy-acceptor, i.e., you will have to
(make-instance 'easy-acceptor ...)
The documentation has the details.
The second problem is, that you rebind the *dispatch-table* during the set-up code, and push new values into this binding. Since the binding is reverted after the let is finished (and since hunchentoot:start works asynchronously), your entries in the *dispatch-table* are effectively lost, when the server is running. Try
(push (hunchentoot:create-prefix-dispatcher "/a" (lambda () "a")) *dispatch-table*)
(push (hunchentoot:create-prefix-dispatcher "/b" (lambda () "b")) *dispatch-table*)
at the top-level (or do something like that in a dedicated set-up function). If you don't like the global *dispatch-table* approach, you can also create a subclass of acceptor, and override acceptor-dispatch-request (and thus, implement any kind of dispatch you like).
Just as a side-note: you do not prefix *dispatch-table*, while you prefix virtually any other symbol from hunchentoot's package. Is this just a copy/paste mistake, or is this also the case in your actual code? If you do not :use the hunchentoot package in wherever package your code happens to live, then you'd also have to qualify the dispatch table as hunchentoot:*dispatch-table*.
Edit (to address the question in the comment section) There is an example in the hunchentoot documentation, which seems to do exactly what you want to do:
(defclass vhost (tbnl:acceptor)
((dispatch-table
:initform '()
:accessor dispatch-table
:documentation "List of dispatch functions"))
(:default-initargs
:address "127.0.0.1"))
(defmethod tbnl:acceptor-dispatch-request ((vhost vhost) request)
(mapc (lambda (dispatcher)
(let ((handler (funcall dispatcher request)))
(when handler
(return-from tbnl:acceptor-dispatch-request (funcall handler)))))
(dispatch-table vhost))
(call-next-method))
(defvar vhost1 (make-instance 'vhost :port 50001))
(defvar vhost2 (make-instance 'vhost :port 50002))
(push
(tbnl:create-prefix-dispatcher "/foo" 'foo1)
(dispatch-table vhost1))
(push
(tbnl:create-prefix-dispatcher "/foo" 'foo2)
(dispatch-table vhost2))
(defun foo1 () "Hello")
(defun foo2 () "Goodbye")
(tbnl:start vhost1)
(tbnl:start vhost2)
(comments present in the documentation removed for brevity). The tbnl is a predefined nickname for package hunchentoot. You can use both interchangeably, though I would recommend, that you pick one and stick to it. Mixing both might generate confusion.
My goal is a function which can call itself again indefinitely upon
encountering an error.
I am describing different approaches I tried based on the Common Lisp HyperSpec and would appreciate if someone could reveal the secrets of why
they act as they do.
I'm using SBCL 1.3.8 with enabled tail call optimization and verified that it is working properly on a simple tail recursive function.
unwind-protect
With the first approach I tried, m0 gets called twice. Once as a result of the original call and once as part of the cleanup form in the unwind-protect.
After encountering the error in the second body, it does not execute the cleanup form properly.
I would have expected for the function to call itself over and over again, and to run into a stack overflow or for SBCL to be able to recognize the call as a tail call and to optimize it.
(defun m0 ()
(unwind-protect
(progn
(write-line "body")
(error "error"))
(write-line "cleanup")
(m0)))
(m0)
Intrigued by the result, I investigated whether it was an occurrence with nested unwind-protects in general, and it seems to be. The following program displays the same behavior:
(unwind-protect
(progn
(write-line "body 0")
(error "error 0"))
(unwind-protect
(progn
(write-line "body 1")
(error "error 1"))
(write-line "body 2")
(error "error 2"))))
Is this behavior related to the extent of the exit of the inner unwind-protect?
Is there a way to get it to work and especially a way which supports tail call elimination?
Why can the unwind-protects not be nested arbitrarily?
handler-case
The second approach I tried runs into a stack overflow. This is not as surprising as the result of the first approach, but without knowing the inner details of the condition system, I would have expected the function to be tail recursive and therefore I would have expected for SBCL to optimize the tail call.
(define-condition m-error () nil)
(defun m1 ()
(handler-case
(progn (write-line "body")
(error 'm-error))
(m-error ()
(progn (write-line "cleanup")
(m1)))))
(m1)
Is there a way in which the function could be slightly modified to ensure that tail call elimination will occur?
handler-bind
Throws an error due to reaching the maximum-error-depth defined for the runtime environment.
I would have expected this to perform roughly equal to the handler-case solution. The stack is not unwound before executing the cleanup forms in this case due to the different behavior of handler-case and handler-bind, but I still would have expected for the call to m to be recognized as a tail call and to be optimized in the grand scheme of things.
(defun m2 ()
(handler-bind
((m-error #'(lambda (c)
(progn (write-line "cleanup")
(m2)))))
(write-line "body")
(error 'm-error)))
(m2)
The question related to m1 applies here, too.
I would like to know why these cases do not work as I expected them to work, based on the documentation. The people in #lisp on freenode were also puzzled by this behavior.
And if there is no way in which these examples can be fixed, then I would appreciate a pointer to some construct with which this behavior could be implemented, without returning control to a higher level.
Firstly, there is no guarantee that this is possible at all: CL the language is not specified to be tail-recursive at all, and thus it is entirely up to implementations both as to whether they optimise tail calls and, when they do, what is in tail position with respect to what.
Secondly, your first, unwind-protect implementation probably does not do what you think it does, and neither does your third. In the case of the third implementation your handler fails to handle the error which essentially means that there is no hope of the code being tail-recursive, since the handler must remain on the stack until it either returns normally or handles the error, neither of which it does.
The handler-bind implementation
As I think handler-bind is not widely understood, here is a version of your third implementation which might stand a chance of being tail-recursive: the handler does handle the error, and then the code it jumps to recurses.
(define-condition m-error ()
())
(defun m4 ()
(let* ((errored nil)
(result
(block escape
(handler-bind ((m-error
#'(lambda (c)
(declare (ignorable c))
(setf errored t)
(return-from escape nil))))
(error 'm-error)))))
(if (not errored)
result
(m4))))
However, in neither of the implementations to which I have immediate access (LW and CCL) will this easily compile as a tail call to m4 (both implementations do optimise tail calls).
I also tried a more horrible but explicit version of this solution:
(defun m5 ()
(tagbody
(return-from m5
(handler-bind ((m-error
#'(lambda (c)
(declare (ignorable c))
(go recurse))))
(error 'm-error)))
recurse
(m5)))
And I can't get either implication to compile the recursive call to m5 as a tail call. Probably to understand why they won't would require looking at the assembler.
The unwind-protect implementation
It's not clear to me that this can work. In particular, remember that
unwind-protect evaluates protected-form and guarantees that cleanup-forms are executed before unwind-protect exits, whether it terminates normally or is aborted by a control transfer of some kind.
(From the CLHS.)
So any code which looks like
(defun m6 ()
(unwind-protect
...any form...
(m6)))
is going to call itself recursively whatever happens. In particular it will almost certainly do so when you exit the debugger after any error in ...any form..., will certainly do so if there is no error in ...any form..., so long as it terminates, and it may very well try to call itself when you exit the Lisp implementation itself. Indeed this function may make it reasonably hard to regain control: it is not at all obvious that it terminates or that it is easily possible to force it to do so, even by interrupting evaluation.
Something like the following gives you more chance of escape:
(defun m7 ()
(let ((errored nil))
(unwind-protect
(handler-case
(error 'm-error)
(m-error ()
(setf errored t)))
(when errored
(m7)))))
A deeply horrid implementation
Real Programmers (who are correctly known as REAL PROGRAMMERS) would of course write the following version, which avoids having to worry about all this hipster 'tail recursion' nonsense:
(defun m8 ()
(tagbody
loop
(return-from m8
(handler-bind ((m-error
#'(lambda (c)
(declare (ignorable c))
(go loop))))
(error 'm-error)))))
(except they would write it in UPPERCASE).
I am calling my common-lisp program via a shellscript which calls sbcl with the necessary parameters and I have to guarantee that anyhow the actual program finishes the call will end clean with some/none output.
My current solution looks like this:
sbcl --eval "(unwind-protect
(handler-case
(progn
(declaim #+sbcl(sb-ext:muffle-conditions style-warning))
(let ((*standard-output* (make-broadcast-stream)))
(ql:quickload \"module\"))
(eval (read-from-string \"(package:start)\"))) ;this starts the program
(error (err)
(FORMAT t \"Something went really wrong:~a~%\" err)
(sb-ext:exit)))
(sb-ext:exit))"
But in the following two szenarios it wont work:
sbcl --eval "(unwind-protect
(handler-case
(progn
(define-condition bad () ())
(error 'bad))
(error (err)
(FORMAT t \"Something went really wrong:~a~%\" err)
(sb-ext:exit)))
(sb-ext:exit))"
sbcl --eval "(unwind-protect
(handler-case
(progn
(labels ((rek () (rek)))
(rek)))
(error (err)
(FORMAT t \"Something went really wrong:~a~%\" err)
(sb-ext:exit)))
(sb-ext:exit))"
I am now wondering if there is another solution which will catch ANY possible outcome of a called program and will ensure that the sbcl call will exit clean?
For the first scenario a general catch which does not specify what to catch, would probably do the deal. The second scenario has to be able to cope with bugs/errors which would result in the low-level-debuger being called.
The --non-interactive switch will ensure that SBCL never enters the debugger or the REPL. It's similar to passing --disable-debugger and using --eval "(sb-ext:quit)". You can also customize sb-ext:*invoke-debugger-hook* if you don't want it to print a backtrace in the event of an error.