I have a list of strings that I need to format using emacs lisp. This was the only way I could think of going about it:
(setq slist '("is there" "any" "way" "directed iteration"))
(format "%s _%s_ %s to do %S in elisp?"
(elt slist 0)
(elt slist 1)
(elt slist 2)
(elt slist 3)
(elt slist 4))
Giving me what I want.
is there _any_ way to do "directed iteration" in elisp?
There must be a more elegant way, but after much thought, I'm not seeing it. I'm very new to emacs lisp and I might be missing something obvious.
Use apply:
(apply 'format "%s _%s_ %s to do %S in elisp?" slist)
The apply function takes a function (or symbol) as its first argument, then a number of individual arguments, finishing with a list of arguments.
I've decided to make it into a standalone project by adding some more features, fixing some bugs and adding more bugs! yey :)
You can find the project here: http://code.google.com/p/formatting-el/source/browse/trunk/formatting.el
Not sure how much buggy this is, but at the first sight it seems to work:
(defun directive-end (c)
(member c "csdoxXeg%"))
(defun pp-if-nil (spec)
(position ?\% spec))
(defun pp-list (spec args)
(let ((pos 0) (last 0) (fstring "% ") current seen-^)
(catch 't
(while t
(setq pos (1+ (or (position ?% spec :start pos) -1))
current (aref spec pos))
(unless (and seen-^ (char-equal current ?\}) (null args))
(princ (substring spec last (1- pos))))
(setq last pos pos (1+ pos))
(cond
((char-equal current ?^)
(incf last)
(setq seen-^ t))
((char-equal current ?\{)
(setq pos (+ pos (pp-list (substring spec pos) (car args)))
args (cdr args)
last pos
seen-^ nil ))
((char-equal current ?\})
(if args (setq pos 0 last 0)
(throw 't nil)))
((char-equal current ?%)
(setq seen-^ nil last (1+ last))
(write-char ?%))
(t (unless args (error "Not enough argumens for list iteration"))
(setf (aref fstring 1) current)
(princ (format fstring (car args)))
(setq args (cdr args)
seen-^ nil
last
(or (position-if #'directive-end spec :start pos)
pos)))))) pos))
(defun cl-format (spec &rest args)
(with-output-to-string
(let ((pos 0) (last 0) (fstring "% ") current)
(catch 't
(while t
(setq pos (1+ (or (position ?\% spec :start pos) -1))
current (aref spec pos))
(when (= pos 0) (throw 't nil))
(princ (substring spec last (1- pos)))
(setq last pos pos (1+ pos))
(cond
((char-equal current ?^)
(unless args
(setq last (pp-if-nil spec)
pos last)))
((char-equal current ?\{)
(setq pos (+ pos (pp-list (substring spec pos) (car args)))
args (cdr args)
last pos))
((char-equal current ?\})
(error "Unmatched list iteration termination directive"))
((char-equal current ?%)
(write-char ?%)
(incf last))
(t (unless args (error "Not enough argumens"))
(setf (aref fstring 1) current)
(princ (format fstring (car args)))
(setq args (cdr args)
last
(or (position-if #'directive-end spec :start pos)
pos))))
(incf pos))))))
(cl-format "begin: %{%s = %d%^,%}; %% %c %% %{%{%s -> %d%^.%},%}"
'(a 1 b 2 c 3) ?\X '((a 2 b 4 c 6) (a 1 b 3 c 5)))
"begin: a = 1,b = 2,c = 3; % X % a -> 2.b -> 4.c -> 6,a -> 1.b -> 3.c -> 5,"
This tries to replicate some (very simplistic) Common Lisp-like printing behaviour of the ~{ ... ~} directives.
Related
With these emac lisp definitions given to me I need to get the correct results for (defun operand (n ast)). Currently, the first child works like it's supposed to but for the second child (operand (- n 1) (cadr ast)) gives the second child as (INT_LITERAL pos) and not the rest of the child ((INT_LITERAL pos) (77)). Not sure where to go from here. As you can see I've done some guess and testing to fix my solution but nothing has worked yet. From my understanding when my results are nil that means that frame has no parent frame but I'm not sure why it does not print out the whole operand.
(defun store (offset value alist)
"Insert the value for this offset, replacing the previous value (if any)."
(cond
((null alist) (list (cons offset value))) ; ((offset . value))
((eq offset (caar alist)) (cons (cons offset value) (cdr alist)))
(t (cons (car alist)
(store offset value (cdr alist))))
)
)
(defun lookup (offset alist)
"Return the value associated with this offset, or raise an error."
(cond
((null alist) (user-error "UNINITIALISED %s" offset) (exit))
((eq (caar alist) offset) (cdar alist))
(t (lookup offset (cdr alist)))
)
)
;;(setq a (store 1 19 (store 0 17 ())))
;; a
;; (setq a (store 2 20 a))
;; (setq a (store 1 29 a))
;; (lookup 3 ())
;; (lookup 3 a)
;;(lookup 1 a)
;;; Accessors for the various fields in an AST node
(defun position (ast)
"The position stored in an AST node"
(cadar ast)
)
(defun kind (ast)
(caar ast)
)
(defun operand (n ast)
;; Your code goes here.
(if (eq n 0)
(caadr ast) ;;first child
(operand (- n 1)(cadr ast)) ;;second child
)
)
;;(operand (- n 1)(cadr (cadr ast))) gives 77 (#o115, #x4d, ?M)
;;(operand (- n 1)(cadr ast)) gives (INT_LITERAL pos)
;;(operand (- n 1) (cadr (cddr ast))) gives nil
;;(operand (- n 1) (cdr (cadr ast))) gives nil
;; (operand (- n 1)(caddr ast)) gives nil
;;(operand (- n 1)(car ast)) gives wrong type argument listp, pos
;;(operand (- n 1)(cdr ast)) gives nil
;;cadadr, cadr, cadddr, cdadr, caddr, car, cdr
;; (setq ast '((PLUS pos) (( (VARIABLE pos) (b 1) ) ((INT_LITERAL pos) (77) ) ) ))
;; (kind ast) = PLUS
;; (position ast) = pos
;; (operand 0 at) = ((VARIABLE pos)(b 1))
;; (kind (operand 0 ast))= VARIABLE
;; (operand 1 ast)= supposed to equal ((INT_LITERAL pos) (77))
;; (kind (operand 1 ast)) = supposed to equal INT_LITERAL
Your question is not easy to follow -- I'm confident that you could pare all that code down to something far more minimal for these purposes.
At present you're calling operand recursively, but the ast data does not have the nested structure required by that recursion, and so things quickly break down.
I think you just want this?
(defun operand (n ast)
(nth n (cadr ast)))
I'm writing a macro to generate codes used by another macro in Common Lisp. But I'm new at this and have difficulty in constructing a macro that takes in a list (bar1 bar2 ... barn) and produces the following codes by a loop.
`(foo
,#bar1
,#bar2
...
,#barn)
I wonder whether this can be achieved not involving implement-dependent words such as SB-IMPL::UNQUOTE-SPLICE in sbcl.
Maybe I didn't give a clear description about my problem. In fact I want to write a macro gen-case such that
(gen-case
(simple-array simple-vector)
('(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0))
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
objname body)
produces something like
`(case (car (type-of ,objname))
(simple-array
,#(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector
,#(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))
In general cases, the lists taken in by gen-case may contain more than two items.
I have tried
``(case (car (type-of ,,objname))
,',#(#|Some codes that produce target codes|#))
but the target codes are inserted to the quote block and thus throw an exception in the macro who calls the macro gen-case. Moreover, I have no way to insert ,# to the target codes as a straightforward insertion will cause a "comma not inside a backquote" exception.
The codes generated are part of another macro
(defmacro DSI-Layer ((obj-name tag-name) &body body)
"Data Structure Independent Layer."
(let ((temp))
(defun code-gen (c)
(if (atom c) c
(if (eq (car c) tag-name)
(let ((args (cadr c)) (codes (code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code temp))
(cons (code-gen (car c)) (code-gen (cdr c))))))
`(case (car (type-of ,obj-name))
(simple-array
,#(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector
,#(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))))
and I've set up a read-macro
(defvar *arg* (make-symbol "ARG"))
(set-macro-character #\$
#'(lambda (stream char)
(declare (ignore char))
(list *arg* (read stream t nil t))))
The intention of DSI-Layer is to add a piece of code to determine the type of input parameters. For example, the codes
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(DSI-Layer (G next-vertex)
(do nil ((null queue) nil)
(setf v (pop queue)) (push v vl)
(next-vertex (i v visited G n)
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))
vl))
will be converted to
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(case (car (type-of G))
(simple-array
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dotimes (i n)
(when (and (= (aref G v i) 1) (zerop (aref visited i)))
(setf queue (nconc queue (list i)))
(incf (aref visited i))))))
(simple-vector
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dolist (i (aref G v))
(when (zerop (aref visited i))
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))))))
Now I just wonder that whether the DSI-Layer can be generated from another macro gen-case by passing the type names and corresponding code templates to it or not.
By the way, I don't think the specific meaning of generated codes matters in my problem. They are just treated as data.
Don't be tempted to use internal details of backquote. If you have the lists you want to append in distinct variables, simply append them:
`(foo
,#(append b1 b2 ... bn))
If you have a list of them in some single variable (for instance if they've come from an &rest or &body argument) then do something like
`(foo
,#(loop for b in bs
appending b))
I see your problem - you need it not for a function call
but for a macro-call with case.
One cannot use dynamically macros - in a safe way.
One has to use eval but it is not safe for scoping.
#tfb as well as me answered in this question for type-case
lengthily.
previous answer (wrong for this case)
No need for a macro.
`(foo
,#bar1
,#bar2
...
,#barn)
with evaluation of its result
by pure functions would be:
(apply foo (loop for bar in '(bar1 bar2 ... barn)
nconc bar))
nconc or nconcing instead of collect fuses lists together and is very useful in loop. - Ah I see my previous answerer used append btw appending - nconc nconcing however is the "destructive" form of "append". Since the local variable bar is destructed here which we don't need outside of the loop form, using the "destructive" form is safe here - and comes with a performance advantage (less elements are copied than when using append). That is why I wired my brain always to use nconc instead of append inside a loop.
Of course, if you want to get the code construct, one could do
`(foo ,#(loop for bar in list-of-lists
nconc bar))
Try it out:
`(foo ,#(loop for bar in '((1 2 3) (a b c) (:a :b :c)) nconc bar))
;; => (FOO 1 2 3 A B C :A :B :C)
The answers of all of you inspired me, and I came up with a solution to my problem. The macro
(defmacro Layer-Generator (obj-name tag-name callback body)
(let ((temp (gensym)) (code-gen (gensym)))
`(let ((,temp))
(defun ,code-gen (c)
(if (atom c) c
(if (eq (car c) ,tag-name)
(let ((args (cadr c)) (codes (,code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code ,temp))
(cons (,code-gen (car c)) (,code-gen (cdr c))))))
(list 'case `(car (type-of ,,obj-name))
,#(let ((codes nil))
(dolist (item callback)
(push
`(cons ',(car item)
(progn
(setf ,temp ,(cadr item))
(,code-gen ,body)))
codes))
(nreverse codes))))))
produces codes which are not the same as DSI-Layer but produce codes coincident with what the latter produces. Because the codes
`(case (car (type-of ,obj-name))
(tag1
,#(#|codes1|#))
(tag2
,#(#|codes2|#))
...)
are equivalent to
(list 'case `(car (type-of ,obj-name))
(cons 'tag1 (#|codes1|#))
(cons 'tag2 (#|codes2|#))
...)
And now we can use a loop to generate it just as what the Layer-Generator does.
I write a macro that accepts a list of lambdas to be called and generates a function. The lambdas are always evaluated in defun argument list, but not in defmacro. How can I avoid call to eval inside defmacro?
This code works:
(defmacro defactor (name &rest fns)
(let ((actors (gensym)))
`(let (;(,actors ',fns)
(,actors (loop for actor in ',fns
collect (eval actor)))) ; This eval I want to avoid
(mapcar #'(lambda (x) (format t "Actor (type ~a): [~a]~&" (type-of x) x)) ,actors)
(defun ,name (in out &optional (pos 0))
(assert (stringp in))
(assert (streamp out))
(assert (or (plusp pos) (zerop pos)))
(loop for actor in ,actors
when (funcall actor in out pos)
return it)))))
;; Not-so-relevant use of defactor macros
(defactor invert-case
#'(lambda (str out pos)
(let ((ch (char str pos)))
(when (upper-case-p ch)
(format out "~a" (char-downcase ch))
(1+ pos))))
#'(lambda (str out pos)
(let ((ch (char str pos)))
(when (lower-case-p ch)
(format out "~a" (char-upcase ch))
(1+ pos)))))
This code evaluates as expected to:
Actor (type FUNCTION): [#<FUNCTION (LAMBDA (STR OUT POS)) {100400221B}>]
Actor (type FUNCTION): [#<FUNCTION (LAMBDA (STR OUT POS)) {100400246B}>]
INVERT-CASE
And its usage is:
;; Complete example
(defun process-line (str &rest actors)
(assert (stringp str))
(with-output-to-string (out)
(loop for pos = 0 then (if success success (1+ pos))
for len = (length str)
for success = (loop for actor in actors
for ln = len
for result = (if (< pos len)
(funcall actor str out pos)
nil)
when result return it)
while (< pos len)
unless success do (format out "~a" (char str pos)))))
(process-line "InVeRt CaSe" #'invert-case) ; evaluates to "iNvErT cAsE" as expected
Without eval, the defactor above evaluates to:
Actor (type CONS): [#'(LAMBDA (STR OUT POS)
(LET ((CH (CHAR STR POS)))
(WHEN (UPPER-CASE-P CH)
(FORMAT OUT ~a (CHAR-DOWNCASE CH))
(1+ POS))))]
Actor (type CONS): [#'(LAMBDA (STR OUT POS)
(LET ((CH (CHAR STR POS)))
(WHEN (LOWER-CASE-P CH)
(FORMAT OUT ~a (CHAR-UPCASE CH))
(1+ POS))))]
and all the rest obviously doesn't work.
If I transform defmacro into defun, it doesn't need eval:
(defun defactor (name &rest fns)
(defun name (in out &optional (pos 0))
(assert (stringp in))
(assert (streamp out))
(assert (or (plusp pos) (zerop pos)))
(loop for actor in fns
when (funcall actor in out pos)
return it)))
However, it always defines the function name instead of the passed function name argument (which should be quoted).
Is it possible to write defactor with the possibility to pass the function name unlike defun version, and without eval in macro version of it?
You're making things more complex than necessary with the first loop... just collect the parameters instead
(defmacro defactor (name &rest fns)
(let ((actors (gensym)))
`(let ((,actors (list ,#fns)))
(mapcar #'(lambda (x) (format t "Actor (type ~a): [~a]~&" (type-of x) x)) ,actors)
(defun ,name (in out &optional (pos 0))
(assert (stringp in))
(assert (streamp out))
(assert (or (plusp pos) (zerop pos)))
(loop for actor in ,actors
when (funcall actor in out pos)
return it)))))
This mostly doesn’t need to be a macro as-is. You can mostly use a helper function:
(defun make-actor (&rest funs)
(lambda (in out &optional (pos 0)
(loop for actor in funs
when (funcall actor in out pos) return it)))
And write a simple macro:
(defmacro defactor (name &rest funs)
`(let ((f (make-actor ,#funs)))
(defun ,name (in out &optional (pos 0)) (funcall f in out pos))))
However this doesn’t gain much in terms of expressivity (you practically call the macro like a function) or efficiency (the compiler has to be quite clever to work out how to improve the code by inclining a bunch of complicated things).
Here is another way one might implement something like this:
(defmacro defactor (name (in out pos) &rest actors)
(let ((inv (gensym "IN"))
(outv (gensym "OUT"))
(posv (gensym "POS")))
`(defun ,name (,inv ,outv &optional (,posv 0))
;; TODO: (declare (type ...) ...)
(or ,#(loop for form in actors
collect `(let ((,in ,inv) (,out ,outv) (,pos ,posv)) ,form)))))
And then use it like:
(defactor invert-case (in out pos)
(let ((ch (char str pos)))
(when (upper-case-p ch)
(format out "~a" (char-downcase ch))
(1+ pos)))
(let ((ch (char str pos)))
(when (lower-case-p ch)
(format out "~a" (char-upcase ch))
(1+ pos))))
In elisp, how can I get a destructuring bind for regex matches?
For example,
;; what is the equivalent of this with destructuring?
(with-temp-buffer
(save-excursion (insert "a b"))
(re-search-forward "\\(a\\) \\(b\\)")
(cons (match-string 1)
(match-string 2)))
;; trying to do something like the following
(with-temp-buffer
(save-excursion (insert "a b"))
(cl-destructuring-bind (a b) (re-search-forward "\\(a\\) \\(b\\)")
(cons a b)))
I was thinking I would have to write a macro to expand matches if there isn't another way.
Here is one way: you first extend pcase to accept a new re-match pattern, with a definition such as:
(pcase-defmacro re-match (re)
"Matches a string if that string matches RE.
RE should be a regular expression (a string).
It can use the special syntax \\(?VAR: to bind a sub-match
to variable VAR. All other subgroups will be treated as shy.
Multiple uses of this macro in a single `pcase' are not optimized
together, so don't expect lex-like performance. But in order for
such optimization to be possible in some distant future, back-references
are not supported."
(let ((start 0)
(last 0)
(new-re '())
(vars '())
(gn 0))
(while (string-match "\\\\(\\(?:\\?\\([-[:alnum:]]*\\):\\)?" re start)
(setq start (match-end 0))
(let ((beg (match-beginning 0))
(name (match-string 1 re)))
;; Skip false positives, either backslash-escaped or within [...].
(when (subregexp-context-p re start last)
(cond
((null name)
(push (concat (substring re last beg) "\\(?:") new-re))
((string-match "\\`[0-9]" name)
(error "Variable can't start with a digit: %S" name))
(t
(let* ((var (intern name))
(id (cdr (assq var vars))))
(unless id
(setq gn (1+ gn))
(setq id gn)
(push (cons var gn) vars))
(push (concat (substring re last beg) (format "\\(?%d:" id))
new-re))))
(setq last start))))
(push (substring re last) new-re)
(setq new-re (mapconcat #'identity (nreverse new-re) ""))
`(and (pred stringp)
(app (lambda (s)
(save-match-data
(when (string-match ,new-re s)
(vector ,#(mapcar (lambda (x) `(match-string ,(cdr x) s))
vars)))))
(,'\` [,#(mapcar (lambda (x) (list '\, (car x))) vars)])))))
and once that is done, you can use it as follows:
(pcase X
((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)")
(cons var val)))
or
(pcase-let
(((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)") X))
(cons var val))
This has not been heavily tested, and as mentioned in the docstring it doesn't work as efficiently as it (c|sh)ould when matching a string against various regexps at the same time. Also you only get the matched substrings, not their position. And finally, it applies the regexp search to a string, whereas in manny/most cases regexps searches are used in a buffer. But you may still find it useful.
I'm playing around in CL, making a One-Dimensional version of Battleship before I try to tackle a full Two-Dimensional version, and I've hit a hangup. To check if the boat is there, I've represented it with zeroes, and when a spot is hit, I replace it with an asterisk, so I can check the list with numberp. However, when I run (new-game), it immediately finishes, which tells me that I'm not entering the zeroes correctly so that they are recognized as numbers. What am I doing wrong? I know it must be a rookie mistake.
;;;; Suez-Canal.lisp
;;;;
;;;; A simple, 1-Dimensional version of Battleship
;;;; The computer places a boat randomly, and you must sink it.
(setf *random-state* (make-random-state t))
(defparameter *boat-length* 3)
(defparameter *canal-length* 10)
(defparameter *shots-fired* 0)
(defun new-game ()
(init-canal *canal-length*)
(place-boat)
(game-loop)
(format t "It took you ~a shots to sink the boat." *shots-fired*))
(defun init-canal (len)
(defparameter *canal* (make-list len)))
(defun place-boat ()
(let ((pos (random-spot)))
(setf (nth pos *canal*) 'O)
(setf (nth (+ pos 1) *canal*) 'O)
(setf (nth (+ pos 2) *canal*) 'O)))
(defun random-spot ()
(let ((x (random 7)))
x))
(defun game-loop ()
(loop until (notany #'numberp *canal*)
do (progn
(prompt-for-guess)
(check-guess (read-guess))
(incf *shots-fired*))))
(defun prompt-for-guess ()
(format t "~&Enter in a number between 1 and 10 to fire a shot.~&"))
(defun read-guess ()
(parse-integer (read-line *query-io*) :junk-allowed t))
(defun check-guess (guess)
(if (and (<= guess 9)
(>= guess 0))
(fire-shot guess)
(progn
(format t "~&Invalid selection~&")
(check-guess (read-guess)))))
(defun fire-shot (pos)
(if (= (nth (- pos 1) *canal*) 0)
(progn
(setf (nth (- pos 1) *canal*) #\*)
(print "Hit!"))
(print "Miss!")))
You are not entering zeroes at all, but rather the letter 'O'.
Other notes:
Do not use DEFPARAMETER inside DEFUN. Define the variable at top level, and inside the initialization function just SETF it.
Do not use lists for random access. Use arrays.
Numerical comparison operators will signal an error when given a non-numeric value. Use EQL for general comparisons.
Here is a corrected version:
(setf *random-state* (make-random-state t))
(defparameter *boat-length* 3)
(defparameter *canal-length* 10)
(defparameter *shots-fired* 0)
;;; you need to declare *canal* at toplevel.
(defparameter *canal* nil)
(defun new-game ()
(init-canal *canal-length*)
(place-boat)
(game-loop)
(format t "It took you ~a shots to sink the boat." *shots-fired*))
;;; just set the the variable.
(defun init-canal (length)
(setq *canal* (make-list length)))
;;; you need to set those positions to 0 and not to O
(defun place-boat ()
(let ((pos (random-spot)))
(setf (nth pos *canal*) 0)
(setf (nth (+ pos 1) *canal*) 0)
(setf (nth (+ pos 2) *canal*) 0)))
;;; no need for a LET
(defun random-spot ()
(random 7))
;;; no need for progn
;;; you could also replace UNTIL NOTANY with WHILE SOME
(defun game-loop ()
(loop until (notany #'numberp *canal*)
do
(prompt-for-guess)
(check-guess (read-guess))
(incf *shots-fired*)))
(defun prompt-for-guess ()
(format t "~&Enter in a number between 1 and 10 to fire a shot.~&"))
(defun read-guess ()
(parse-integer (read-line *query-io*) :junk-allowed t))
;;; <= can take more than two arguments
;;; typically this recursive version might be replaced with a LOOP
(defun check-guess (guess)
(if (<= 0 guess 9)
(fire-shot guess)
(progn
(format t "~&Invalid selection~&")
(check-guess (read-guess)))))
;;; use EQL, = only compares numbers
(defun fire-shot (pos)
(if (eql (nth (- pos 1) *canal*) 0)
(progn
(setf (nth (- pos 1) *canal*) #\*)
(print "Hit!"))
(print "Miss!")))