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.
Related
My Setup
I develop common lisp with emacs + slime. My machine is a mac pro M1. And, I use the kitty terminal emulator.
The Situation
When I run my app (see code at the end) in the repl, it works fine.
When I create and run the executable, it's as if the order of the program is different.
For example, I have 5 questions which asks for user input...
(defpackage custom-sender
;; import the exactly the symbols I need from a package
(:import-from :cl-json :encode-json-to-string)
(:use :cl)
(:export :main))
(in-package custom-sender)
(defun main()
(asking-questions))
(defun asking-questions ()
(let ((firstname (prompt-read "What is the firstname of the contact?"))
(email (prompt-read "What is their email?"))
(job (prompt-read "What is the job?"))
(first-line (prompt-read "what is the first line of their address?"))
(sending-account (prompt-read "Which email account do you want to send from? (e2, e3 etc)")))
(status-update "some text ~a" email);; <-- this function is executed BEFORE the "sending-account" question is asked
... ) ;;<-- end of let block
)
(defun status-update (message value)
(format *query-io* (concatenate 'string message "~C~C") value #\linefeed #\linefeed)
(force-output *query-io*))
(defun prompt-read (question)
(format *query-io* "~a: " question)
(read-line *query-io*)
(force-output *query-io*))
The Problem
When running the executable, there are two issues:
The first function (status-update...) is executed before the final prompt read. In the terminal, the question comes up but immediately exits. So I cannot enter anything.
Also... (status-update...) gets the value of email which is NIL. Even though I entered a value inside the terminal.
This entire process runs perfectly in the repl.
Note - I am building the executable with the ASD MAKE process.
(defun prompt-read (question)
(format *query-io* "~a: " question)
(read-line *query-io*)
(force-output *query-io*))
change it to something like this:
(defun prompt-read (question)
(format *query-io* "~a: " question)
(force-output *query-io*)
(read-line *query-io*)
(force-output *query-io*))
Otherwise the prompt may not be visible when the function is waiting for input..., due to a buffering output stream.
Streams may or may not buffer output. For portable programs you'd need to add operations to clear or force output.
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.
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).
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))
I have some function with loop, each iteration it reads input, on "0" it calls function "exit-and-save", in that function it saves some database and after that I need it to exit the program? What is the command for that? If I use return-from... it just returns from function, if I use return - error, if I use quit, it disconnects from slime. I'm new in common lisp...
(loop for i from 0 to 10
do (progn (format t "~&cycle ~d" i)
(when (> i 5)
(return nil))))
First of all I cannot verify that slime disconnects using (quit), at least not using sbcl at Ubuntu.
CL-USER> (quit)
; Evaluation aborted on NIL.
CL-USER>
"still able to input here"
But if you got some freakish version of slime you could take advantage of the condition system:
(define-condition end-program-condition (simple-error) ())
(defun some-func ()
(error 'end-program-condition))
(defun main-function ()
(handler-case (some-func)
(end-program-condition () "THE END")))
CL-USER> (main-function)
"THE END"
CL-USER> "still can input here"
"still can input here"
It depends on your common lisp implementation, but if using sbcl for example, you could call sb-ext:exit.
Source: http://www.sbcl.org/manual/#Exit