A while back <http://tinyurl.com/2qswco>, I was playing with writing
some code to allow me to do with lisp the kind of thing I had previously
done with Don Libe's Expect <http://expect.nist.gov/>; i.e. telnet to a
remote system and issue commands programmatically at the shell of the
remote system. I got it <homepage.mac.com/dkick1/> working sufficiently
for my rather limited needs, and so I haven't thought about it too much
lately. I do still want to go back and write a simple streams version
at some point, though. I would appreciate any feedback about any of the
code (in "telnet-stream-2007-05-15.tgz") but, more specifically, the
recent thread "new to the condition system" <http://tinyurl.com/2kuvy8>
jogged my memory about the following code I had written. The question
it raised for me was whether or not what I did was idiomatic CL or if it
was the kind of thing for which most people would use throw/catch instead.
(define-condition mismatch-during-wait-for (simple-condition) ())
(defmethod wait-for* ((what list) (where generic-telnet-stream)
&key echo-fn recv-char-fn)
(assert (eq (car what) :sequence))
(let ((peek nil))
(labels ((%recv-char ()
(cond (peek (prog1 peek (setq peek nil)))
(t (let ((char (recv-char where)))
(prog1 char
(when recv-char-fn
(funcall recv-char-fn char))
(when echo-fn
(funcall echo-fn char)))))))
(%string (expected)
(loop with i = 0
for c = (%recv-char)
if (eql c (schar expected i)) do (incf i)
else do (signal 'mismatch-during-wait-for)
while (< i (length expected))))
(%digits ()
(unless (digit-char-p (%recv-char))
(signal 'mismatch-during-wait-for))
(loop for c = (%recv-char)
while (digit-char-p c)
finally (progn
(assert (null peek))
(setq peek c))))
(%lemma (list)
(handler-case
(loop for element in list do
(cond ((typep element 'string)
(%string element))
((eq element :digits) (%digits))
(t (error "Unknown type of element: ~S."
element)))
finally (return t))
(mismatch-during-wait-for () nil))))
(loop until (%lemma (cdr what))))))
Damien Kick <·····@earthlink.net> writes:
> The question it raised for me was whether or not what I did was
> idiomatic CL or if it was the kind of thing for which most people
> would use throw/catch instead.
ISTM that conditions are for providing documentable, inter-module
interfaces for dealing with unusual circumstances, and then they're
mainly useful when the condition is signalled in an environment with
some useful restarts (otherwise a handler can't do much beyond report
the error and unwind). For intra-module calls to an unexported
routine that establishes no restarts and whose callers all handle the
condition without re-signalling, signalling a condition strikes me as
slightly misleading for the person reading the code, since you're not
actually offering the user an opportunity to handle the condition.
However, in the code below, it doesn't take much work to determine
that the user won't have the chance to handle the condition, so even
if signalling a condition is unidiomatic, it's sort of academic.
> (define-condition mismatch-during-wait-for (simple-condition) ())
>
> (defmethod wait-for* ((what list) (where generic-telnet-stream)
> &key echo-fn recv-char-fn)
> (assert (eq (car what) :sequence))
> (let ((peek nil))
> (labels ((%recv-char ()
> (cond (peek (prog1 peek (setq peek nil)))
> (t (let ((char (recv-char where)))
> (prog1 char
> (when recv-char-fn
> (funcall recv-char-fn char))
> (when echo-fn
> (funcall echo-fn char)))))))
> (%string (expected)
> (loop with i = 0
> for c = (%recv-char)
> if (eql c (schar expected i)) do (incf i)
> else do (signal 'mismatch-during-wait-for)
> while (< i (length expected))))
> (%digits ()
> (unless (digit-char-p (%recv-char))
> (signal 'mismatch-during-wait-for))
> (loop for c = (%recv-char)
> while (digit-char-p c)
> finally (progn
> (assert (null peek))
> (setq peek c))))
> (%lemma (list)
> (handler-case
> (loop for element in list do
> (cond ((typep element 'string)
> (%string element))
> ((eq element :digits) (%digits))
> (t (error "Unknown type of element: ~S."
> element)))
> finally (return t))
> (mismatch-during-wait-for () nil))))
> (loop until (%lemma (cdr what))))))