I am trying a simple echo server in common lisp (I use clisp). I've tried the example in http://rosettacode.org/wiki/Echo_server#Common_Lisp
The CLISP version (without usocket) works fine.
When I try the usocket version (with clisp) I get the following error:
* - The condition
CDR: :INPUT is not a list
occurred.
Thank you in advance for your replies,
Dimitris
I'm not sure of the answer, but I think this can be tracked down to wait-for-input and wait-for-input-internal. The function wait-for-input has the following definition (abbreviated):
(defun wait-for-input (socket-or-sockets &key timeout ready-only)
"Waits for one or more streams to become ready for reading from
the socket. When `timeout' (a non-negative real number) is
specified, wait `timeout' seconds, or wait indefinitely when
it isn't specified. A `timeout' value of 0 (zero) means polling. …"
(unless (wait-list-p socket-or-sockets)
(let ((wl (make-wait-list (if (listp socket-or-sockets)
socket-or-sockets (list socket-or-sockets)))))
(multiple-value-bind
(socks to)
(wait-for-input wl :timeout timeout :ready-only ready-only)
(return-from wait-for-input
(values (if ready-only socks socket-or-sockets) to)))))
(let* ((start (get-internal-real-time))
(sockets-ready 0))
(dolist (x (wait-list-waiters socket-or-sockets))
(when (setf (state x)
#+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN
#-(and win32 (or sbcl ecl))
(if (and (stream-usocket-p x)
(listen (socket-stream x)))
:read
nil))
(incf sockets-ready)))
;; the internal routine is responsibe for
;; making sure the wait doesn't block on socket-streams of
;; which theready- socket isn't ready, but there's space left in the
;; buffer
(wait-for-input-internal socket-or-sockets
:timeout (if (zerop sockets-ready) timeout 0))
(let ((to-result (when timeout
(let ((elapsed (/ (- (get-internal-real-time) start)
internal-time-units-per-second)))
(when (< elapsed timeout)
(- timeout elapsed))))))
(values (if ready-only
(remove-if #'null (wait-list-waiters socket-or-sockets) :key #'state)
socket-or-sockets)
to-result))))
Note that the last section calls wait-for-input-internal with
(wait-for-input-internal socket-or-sockets
:timeout (if (zerop sockets-ready) timeout 0))
Now, the name socket-or-sockets implies that its value may be a single socket or a list of sockets. However, let's take a look at the definition of wait-for-input-internal for CLISP (it's defined in the backend/<implementation>.lisp):
(defmethod wait-for-input-internal (wait-list &key timeout)
(with-mapped-conditions ()
(multiple-value-bind
(secs musecs)
(split-timeout (or timeout 1))
(dolist (x (wait-list-%wait wait-list))
(setf (cdr x) :INPUT))
(let* ((request-list (wait-list-%wait wait-list))
(status-list (if timeout
(socket:socket-status request-list secs musecs)
(socket:socket-status request-list)))
(sockets (wait-list-waiters wait-list)))
(do* ((x (pop sockets) (pop sockets))
(y (cdr (pop status-list)) (cdr (pop status-list))))
((null x))
(when (member y '(T :INPUT))
(setf (state x) :READ)))
wait-list))))
There are two uses of :INPUT there. It appears that each element of the wait-list is supposed to be a cons whose cdr contains some sort of state. Perhaps wait-for-input is getting called with a single socket (after all, the argument name is socket-or-sockets, and when wait-for-input-internal is called, it's expecting a list. That could lead to the latter getting (<something> . :INPUT) when expecting ((<something . :INPUT)). I'm not sure, though. In any case, though, the error is coming from somewhere around here.
Related
Section §2.1.3 at page 90 explains, with a very clear example, that first class functions in a language make functions themselves and data be the same thing looked at from different perspectives, or, to cite the book:
the ability to manipulate procedures as objects automatically provides the ability to represent compound data.
At page 266, exercise 3.22 from Section §3.3.2, proposes the following
Instead of representing a queue as a pair of pointers, we can build a queue as a procedure with local state. The local state will consist of pointers to the beginning and the end of an ordinary list. Thus, the make-queue procedure will have the form
(define (make-queue)
(let ((front-ptr ...)
(rear-ptr ...))
<definitions of internal procedures>
(define (dispatch m) ...)
dispatch))
Complete the definition of make-queue and provide implementations of the queue operations using this representation.
I easily came up with the following (I've used names the-list and last-pair instead of front-ptr and rear-ptr because I found it clearer, in this case):
(define (make-queue)
(let ((the-list '())
(last-pair '()))
(define (dispatch m)
(cond ((eq? m 'empty) (null? the-list))
((eq? m 'front) (if (null? the-list)
(error "can't take front of empty list")
(car the-list)))
((eq? m 'ins) (lambda (e)
(if (null? the-list)
(begin (set! the-list (list e))
(set! last-pair the-list))
(begin (set-cdr! last-pair (list e))
(set! last-pair (cdr last-pair))))
the-list))
((eq? m 'del) (begin
(if (null? the-list)
(error "can't delete from emtpy list")
(set! the-list (if (pair? the-list) (cdr the-list) '())))
the-list))
((eq? m 'disp) (display the-list)) ; added this for convenience
(else "error")))
dispatch))
(define (empty-queue? q) (q 'empty))
(define (front-queue q) (q 'front))
(define (insert-queue! q e) ((q 'ins) e))
(define (delete-queue! q) (q 'del))
(define (display-queue q) (q 'disp))
which seems to work pretty fairly well…
… except for one crucial point!
At the beginning of §3.3.2 the two desired mutators (that are part of the queue interface) are defined like this (my emphasis):
(insert-queue! <queue> <item>)
inserts the item at the rear of the queue and returns the modified queue as its value.
(delete-queue! <queue>)
removes the item at the front of the queue and returns the modified queue as its value, signaling an error if the queue is empty before the deletion.
My solution doesn't abide by those parts of the definition, because both insert-queue! and delete-queue! are returning the-list, which is the bare list, an implementation detail of the queue interface. Indeed, my solution doesn't support things like these
(define q (make-queue)) ; ok
(insert-queue! (insert-queue! q 3) 4) ; doesn't work
(delete-queue! (delete-queue! q)) ; doesn't work
whereas I think it should.
I guess that the solution should see delete-queue! and insert-queue! return a mutated version of the dispatch function.
How do I do that?
No need for that. Simply define
(define (insert-queue! q e)
((q 'ins) e)
q)
(define (delete-queue! q)
(q 'del)
q)
The design is not clean though, as in, these queues are not persistent. The new version and the old share the same underlying buffer (list). There is no old version preserved anymore, just the current version.
So we don't return a new, modified queue; we return the same queue which has been mutated. Conceptually, that is. On a little bit lower level, we return the same dispatch procedure which is a part of the same closure which holds the same internal binding for the internal buffer, which has been mutated.
By the way, using the head sentinel trick, were you start with e.g. (list 1) instead of '(), usually leads to much simplified, clearer code.
From SBCL's documentation, we can learn:
Invokes the signal facility on a condition formed from DATUM and
ARGUMENTS. If the condition is not handled, NIL is returned.
It does not elaborate on what signal returns in case of a handled condition.
So, I assumed (guessed), that the handler can somehow determine the return value of the signal function:
(defun countdown (&optional
(start-value 10)
(fail-value 1))
(loop
repeat start-value
for i from 0
collecting
(if (= i fail-value)
(signal "fail-value (~D) hit!" i)
i)))
(defun countdown-progress-indicator-style (&optional
(start-value 10)
(fail-value 1))
(handler-bind
((simple-condition (lambda (c)
(format t "fail (~A)~%" c)
fail-value))) ;; <--- I hoped the return value of the handler is returned by signal!
(countdown start-value fail-value)))
But: even if handled, signal returns nil.
(countdown-progress-indicator-style)
fail (fail-value (1) hit!)
(0 NIL 2 3 4 5 6 7 8 9)
Hence, my question, if there is a function or mechanism I missed, which allows the handler to influence signal's return value.
I think the CLHS explains it nicely: in order to handle a condition, you need to transfer control. This can be all kinds of things, but the usual way is to invoke a restart.
(defun countdown (&optional
(start-value 10)
(fail-value 1))
(loop repeat start-value
for i from 0
collecting
(restart-case
(if (= i fail-value)
(signal "fail-value (~D) hit!" i)
i)
(use-fail-value (fv)
fv))))
(defun countdown-progress-indicator-style (&optional
(start-value 10)
(fail-value 1))
(handler-bind
((simple-condition (lambda (c)
(format t "Handling simple condition~%")
(apply #'format t
(simple-condition-format-control c)
(simple-condition-format-arguments c))
(invoke-restart 'use-fail-value
(first (simple-condition-format-arguments c))))))
(countdown start-value fail-value)))
This somewhat abuses simple-conditions arguments; you should probably make your own condition, which takes the value explicitly.
Another way to put it is that you made a nice discovery. You can signal an exceptional situation, have it processed by handler-bind, and carry on execution (or choose not to by using restarts).
With handler-case, you can exit early with a return value.
(handler-case (countdown 3)
(simple-condition ()
(print :exiting-now!)))
;;=>
:EXITING-NOW!
:EXITING-NOW!
If a condition is signaled for which there is an appropriate error-clause during the execution of expression and if there is no intervening handler for a condition of that type, then control is transferred to the body of the relevant error-clause.
http://clhs.lisp.se/Body/m_hand_1.htm#handler-case
I'm trying to understand dynamical and lexical bindings of a variable.
I was browsing SO and some links, when I encountered a problem on this one :
https://www.emacswiki.org/emacs/DynamicBindingVsLexicalBinding#toc2
I ran this code :
(let ((a 1))
(let ((f (lambda () (print a))))
(let ((a 2))
(funcall f))))
With expected result : 1 (and a warning which says that the second a variable is unused, which is normal).
Next, I tried :
(defvar a 99)
And reran the first code. Result is 2, like the tutorial says. Then, to experiment further, I tried to remove the dynamically binding variable a, to get again 1.
I tried to (makunbound 'a) or even (setq a 55) (I tried this by default, I think global lexical binding depends on implementation if I understand correctly...). makunbound seems to remove the symbol, but the "dynamically binding state" seems to be saved anyway. The result is still 2.
How can I reset Common Lisp to the previous state (before I dynamically bind the a variable) ? Restart SLIME do the trick, but I would rather have a way to do it programatically...
Thank you for your answer.
There is no portable way to revert the
special
proclaimation.
(CLISP offers
notspecial).
However, you can use unintern
to some extent: it will make new code treat your symbol as not
special because it is now a different symbol:
(defun test-a ()
(let ((a 1))
(let ((f (lambda () (print a))))
(let ((a 2))
(funcall f)))))
(test-a)
==> 1
(defvar a)
(test-a)
==> 2
now, let us try to "revert" defvar:
(unintern 'a)
(test-a)
==> 2
oops! Let us see:
(fdefinition 'test-a)
#<FUNCTION TEST-A NIL (DECLARE (SYSTEM::IN-DEFUN TEST-A))
(BLOCK TEST-A
(LET ((#:A 1)) (LET ((F (LAMBDA NIL (PRINT #:A)))) (LET ((#:A 2)) (FUNCALL F)))))>
you see, test-a is still using the old symbol a which is now uninterned (so printed as #:A). To get back, you need to re-eval the defun above and then you get
(test-a)
==> 1
again!
What is this self reference for?
Could it be written in any other way?
Is there any advantage?
(defmacro sublet (bindings% &rest body)
(let ((bindings (let-binding-transform
bindings%)))
(setq bindings
(mapcar
(lambda (x)
(cons (gensym (symbol-name (car x))) x))
bindings))
`(let (,#(mapcar #'list
(mapcar #'car bindings)
(mapcar #'caddr bindings)))
,#(tree-leaves
body
#1=(member x bindings :key #'cadr)
(caar #1#)))))
It's just a way of reusing structure somewhere else. In the macro you have:
(tree-leaves body
#1=(member x bindings :key #'cadr)
(caar #1#))
Which is just a fancy way of writing:
(tree-leaves body
(member x bindings :key #'cadr)
(caar (member x bindings :key #'cadr)))
On the positive side if you correct a bug in the member form you'll fix it both places, but it's runs the same code twice so if member was expensive this wouldn't be the wise way to do it. However it is a macro, thus run at compile time, and member is fairly fast on mall lists (small == millions of elements or below) so I guess it won't matter if you read the references just as good as any other CL code. An alternative and perhaps more readable for other kind of lispers would be:
(let ((found (member x bindings :key #'cadr)))
(tree-leaves body found (caar found)))
I've put together the following rudimentary stopwatch in Racket (just learning now, the final aim is a pomodoro-timer).
#lang racket
(define start-time 0)
(define end-times '())
(define (start);; stores start-time
(set! start-time (current-seconds)))
(define (lap);; stores "laps" in list
(set! end-times (cons (current-seconds) end-times)))
(define (stop);; stores final time, displays lap-times in h, m, s and resets end-times
(begin
(set! end-times (cons (current-seconds) end-times))
(display
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
(set! end-times '())
))
While this does exactly what it should, I was wondering how I could avoid mutable state. If I follow HTDP, this is the kind of situation where mutable state is warranted, but after browsing Wadler's "Monads for Functional Programming", I'm still curious about how I could do without set!.
I know that to make it functional, I should add arguments to my functions. For instance, start would become
(define (start [now (current-seconds)])
now)
and a similar approach could work with lap and stop.
Still, while I know that after adding additional arguments to restore functionality, I should also pass arguments rather than storing values in variables, I don't see how in this case I can leverage this to avoid set! as well.
Update: Since all three answers below are highly valuable (thanks!), I didn't mark any of them as the unique correct one. Below is the minimal solution to my initial question. It is a combination of the loop-proposal of #Metaxal, with the example-usage of #Greg Hendershott.
#lang racket
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([t0 (current-seconds)] [times '()])
(match (read-line)
["quit" (reverse
(map (lambda (x)
(let ((the-date (seconds->date x)))
(list
(sub1(date-hour the-date))
(date-minute the-date)
(date-second the-date)))) times))]
["lap" (loop t0 (cons (- (current-seconds) t0) times))]
[_ (loop t0 times)])))
What will likely happen in the following of your program is that you will have a loop.
Then this loop can be a function that takes as input the whole current state, and when you want to update its state, just call the loop again with the new state (you may also call the loop again with the same exact state of course).
Simplified example:
(define (loop [t0 (current-seconds)] [times '()])
;; ... do things here, possibly depending on user input ...
;; then loop with a new state:
(cond [<some-start-condition> (loop (current-seconds) '())]
[<some-lap-condition> (loop t0 (cons (- (current-seconds) t0) times))]
[<some-stop-condition> times])) ; stop, no loop, return value
This certainly changes the approach to your design though.
It's harder to use this approach when designing GUI programs, because the event loop often prevents you from (or makes it difficult) passing values from one event to the next.
However, in Racket, there is (the pedagogical, but still very good) big-bang that is made just for that.
In this case using set! is justified and hard to avoid, because we must "remember" state between invocations of the procedures. What we can do is improving the encapsulation of state, by hiding the variables that change inside a procedure and using a message dispatcher for accessing the procedures that refer to the mutable state. This is very similar to what we do with object-oriented programming, but only lambdas are required to implement it!
(define (make-timer)
; the "attributes" of the object
(let ([start-time 0]
[end-times '()])
; the "methods" of the object
(define (start)
(set! start-time (current-seconds)))
(define (lap)
(set! end-times (append end-times (list (current-seconds)))))
(define (stop)
(lap)
(display
(map (lambda (an-end)
(let ((the-date (seconds->date (- an-end start-time))))
(list
(sub1 (date-hour the-date))
(date-minute the-date)
(date-second the-date))))
end-times))
(set! end-times '()))
; return a dispatch procedure
(lambda (msg)
(case msg
((start) (start)) ; call the start procedure defined above
((lap) (lap)) ; call the lap procedure defined above
((stop) (stop)) ; call the stop procedure defined above
(else (error "unknown message:" msg))))))
I took the liberty of modifying some of your procedures to make them a bit simpler. Here's how we would use the timer object we just created:
(define timer (make-timer))
(timer 'start)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'stop)
=> ((18 0 1) (18 0 2) (18 0 3) (18 0 4))
This technique is called "message passing", learn more about it in the wonderful SICP book.
For a simple example like this, I would probably do what #Metaxal
suggested.
However another approach is that you could explicitly define the state
as a struct:
(struct state (start-time end-times))
Then change the start, lap, and stop to be functions on state:
;; start : -> state
;; stores start-time
(define (start)
(state (current-seconds) '()))
;; lap : state -> state
;; stores "laps" in list
(define (lap st)
(match-define (state start-time end-times) st)
(state start-time
(cons (current-seconds) end-times)))
;; stop : state -> list
;; stores final time, displays lap-times in h, m, s
(define (stop st)
(match-define (state start-time end-times*) st)
(define end-times (cons (current-seconds) end-times*))
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
As in #Metaxal's answer, your "main loop" needs to handle the state and "thread" it through the functions as appropriate:
Example usage:
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([st (start)])
(match (read-line)
["quit" (stop st)]
["lap" (loop (lap st))]
[_ (loop st)])))
Whereas #Óscar López's answer shows a style of OOP as explained in SICP.
A nice thing about Racket (and Scheme) is that you can choose whatever approach on the spectrum you think best fits the problem at hand, and your taste -- simple imperative, OOP imperative, pure functional.