Newbie question in Common Lisp:
How to make my procedure to return distinct procedural object with its own local binding each time call? Currently, I use let to create the local state, but two function calls are sharing the same local state. Here is the code,
(defun make-acc ()
(let ((balance 100))
(defun withdraw (amount)
(setf balance (- balance amount))
(print balance))
(defun deposit (amount)
(setf balance (+ balance amount))
(print balance))
(lambda (m)
(cond ((equal m 'withdraw)
(lambda (x) (withdraw x)))
((equal m 'deposit)
(lambda (x) (deposit x)))))))
;; test
(setf peter-acc (make-acc))
(setf paul-acc (make-acc))
(funcall (funcall peter-acc 'withdraw) 10)
;; Give 90
(funcall (funcall paul-acc 'withdraw) 10)
;; Expect 90 but give 80
Should I do it in another way? Is my way of writing wrong? Can someone pls help me to clear this doubt? Thanks in advance.
Note that, even after the defun-is-global problem is dealt with, you need far less machinery than you have to do something like this. For instance:
(defun make-account (balance)
(lambda (op amount)
(ecase op
((withdraw)
(decf balance amount))
((deposit)
(incf balance amount)))))
(defun account-operation (account op &rest args-to-op)
(apply account op args-to-op))
Then
> (setf joe-acct (make-account 10))
#<Closure 1 subfunction of make-account 4060010B54>
> (setf mary-acct (make-account 100))
#<Closure 1 subfunction of make-account 4060010C94>
> (account-operation joe-acct 'withdraw 10)
0
> (account-operation mary-acct 'deposit 10)
110
Obviously account-operation is just a convenience.
Maybe you want object orientation?
(defclass account ()
((balance :initarg :balance
:initform 100
:accessor balance)))
(defmethod withdraw ((acc account) amount)
(decf (balance acc) amount))
(defmethod deposit ((acc account) amount)
(incf (balance acc) amount))
Usage:
(defparameter alice-account (make-instance 'account))
(withdraw alice-account 25) ;; => 75
(balance alice-account) ;; => 75
We can create accounts with another balance:
(defparameter bob-account (make-instance 'account :balance 90))
For more, I suggest the Cookbook: https://lispcookbook.github.io/cl-cookbook/clos.html
A general rule is that defun should be used only when defining a function at top level. To define local functions the two special operators flet and labels can be used (manual).
For instance:
(defun make-acc ()
(let ((balance 100))
(flet ((withdraw (amount)
(setf balance (- balance amount))
(print balance))
(deposit (amount)
(setf balance (+ balance amount))
(print balance)))
(lambda (m)
(cond ((equal m 'withdraw)
(lambda (x) (withdraw x)))
((equal m 'deposit)
(lambda (x) (deposit x))))))))
labels is like flet, but it is used when there are recursive definitions.
Then you don't need to return functions inside the function returned by make-acc, but in it you can simply execute the required operation:
(defun make-acc ()
(let ((balance 100))
(flet ((withdraw (amount)
(setf balance (- balance amount))
(print balance))
(deposit (amount)
(setf balance (+ balance amount))
(print balance)))
(lambda (m x)
(cond ((equal m 'withdraw)
(withdraw x))
((equal m 'deposit)
(deposit x)))))))
The call will be more simple and will return the expected value:
CL-USER> (setf paul-acc (make-acc))
#<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL MAKE-ACC) #x3020021640AF>
CL-USER> (funcall paul-acc 'withdraw 10)
90
90
CL-USER> (funcall paul-acc 'withdraw 10)
80
80
Finally, if you want you can also return two different functions to perform deposit and withdrawal on the account:
(defun make-acc (initial-amount)
(let ((balance initial-amount))
(flet ((withdraw (amount)
(setf balance (- balance amount))
(print balance))
(deposit (amount)
(setf balance (+ balance amount))
(print balance)))
(values #'withdraw #'deposit))))
using this for instance as:
(multiple-value-bind (paul-withdraw paul-deposit)
(make-acc 100)
(funcall paul-withdraw 10)
(funcall paul-withdraw 10))
The only serious problem here is defun that in common lisp is not used to define local functions.
You could for example use lambdas for those operations, especially as you want to return lambdas...
(defun make-acc ()
(let* ((balance 100)
(withdraw (lambda (amount)
(setf balance (- balance amount))
(print balance)))
(deposit (lambda (amount)
(setf balance (+ balance amount))
(print balance))))
(lambda (m)
(cond
((equal m 'withdraw) withdraw)
((equal m 'deposit) deposit)))))
Note that I used let* instead of let because you need to be able to see balance in the two following bindings.
Related
I was thinking about a cond with a twist
(let ((a 0))
(let* ((result nil))
(tagbody
(let ((b1 (+ 0 a)))
(when (eq b1 1)
(print "1")
(setf result b1)
(go finish)))
(let ((b2 (+ 0 a)))
(when (eq b2 2)
(print "2")
(setf result b2)
(go finish)))
(when T
(print "else")
(setf result a))
(format t "=== ~A~%" a)
finish)
result))
where when test-form is wrapped in let. On one hand this seems to fit into a problem I am working on, but also seems overcomplicated. Can it be simplified with a macro? What would be the best way to simplify it if I had lots of test-forms?
Part of the problem in trying to do it that way is restricting the let blocks to only one test-form and its body.
But I wonder if I am going down the wrong path. Playing with an imaginary variant of when-let suggests there is no benefit of going down this path.
Trying cond
The version using cond appears to be more compact.
(let ((a 3))
(let* ((b1 (+ 0 a))
(b2 (+ 0 a)))
(cond
((eq b1 1)
(print "1")
b1)
((eq b2 2)
(print "2")
b2)
(T (print "else")
a))))
All boils down to the variables defined in the let* which in real life example would be used to avoid calculating the same value twice and improve readability. What should I do?
I'd prefer to think more in terms of blocks and returning values from them, instead working with goto and variables. If one really needs separate let-bound variables and their own scope:
(prog ((a 0))
(let ((b1 (+ 0 a)))
(when (eql b1 1)
(print "1")
(return b1)))
(let ((b2 (+ 0 a)))
(when (eql b2 2)
(print "2")
(return b2)))
(return
(progn
(print "else")
(return a))))
Somebody did now. I wanted it to be compatible with cond which raises a trouble: if you want the binding clauses to be like
(cond/binding
...
((var expr) <use var>)
...)
But you want to allow just general test clauses, then a function with one argument is ambiguous: should
(cond/binding
...
((car x) ...)
...)
call car or bind car? To make this work then you need to bind a useless variable in that case:
(cond/binding
...
((useless (car x)) <useless not used here>)
...)
And that means you either need to insert ignore or ignorable declarations all over the place, or live with compiler warnings.
So, well, I decided it would be better to go the other way: you have to say when you want to bind a variable. And you do that by a clause like:
(cond/binding
...
((bind var expr) <var is bound here>)
...)
And note that bind is magic in the syntax (so this means you can't call a function called bind, but that's OK as I already use bind as a keyword in other macros.
The macro also tries hard (well, hard given I basically just typed it in and it's had no testing) to actually behave like cond: returning multiple values, for instance.
So this:
(cond/binding
((f x y z) t)
((bind x 3) (print x) (values x t))
(t (values nil nil))
(1))
expands to
(block #:cond/binding
(when (f x y z)
(return-from #:cond/binding (progn t)))
(let ((x 3))
(when x
(return-from #:cond/binding
(progn (print x) (values x t)))))
(when t
(return-from #:cond/binding (progn (values nil nil))))
(let ((r 1))
(when r
(return-from #:cond/binding r))))
(where all the blocks are the same block).
So, here:
(defmacro cond/binding (&body clauses)
;; Like COND but it can bind variables. All clauses are (should be)
;; like COND, except that a clause of the form ((bind var <expr>)
;; ...) will bind a variable. Note that bind has to be literally
;; the symbol BIND: it's magic in the syntax.
(let ((bn (make-symbol "COND/BINDING")))
`(block ,bn
,#(mapcar
(lambda (clause)
(unless (consp clause)
(error "bad clause ~S" clause))
(case (length clause)
(1
`(let ((r ,(car clause)))
(when r (return-from ,bn r))))
(otherwise
(destructuring-bind (test/binding &body forms) clause
(typecase test/binding
(cons
(case (car test/binding)
((bind)
(unless (and (= (length test/binding) 3)
(symbolp (second test/binding)))
(error "bad binding clause ~S" test/binding))
(destructuring-bind (var expr) (rest test/binding)
`(let ((,var ,expr))
(when ,var
(return-from ,bn
(progn ,#forms))))))
(otherwise
`(when ,test/binding
(return-from ,bn
(progn ,#forms))))))
(t
`(when ,test/binding
(return-from ,bn
(progn ,#forms)))))))))
clauses))))
Caveat emptor.
If I understand you problem correctly, then you can use or and rely on the fact that when is evaluated to nil if the condition is not true, e.g.,
(defun example (a)
(or
(let ((b1 (+ 0 a)))
(when (eql b1 1)
(print "1")
b1))
(let ((b2 (+ 0 a)))
(when (eql b2 2)
(print "2")
b2))
(progn
(print "else")
a)))
Using macrolet is the best solution so far. That allows me to bypass the limitations of when-let and not all bindins in the let form have to evaluate to true.
(let ((a 3))
(let ((result nil))
(macrolet ((ret-go (res)
`(progn
(setf result ,res)
(go finish))))
(tagbody
(let ((b1 (+ 0 a)))
(when (eq b1 1)
(print "1")
(ret-go b1)))
(let ((b2 (+ 0 a)))
(when (eq b2 2)
(print "2")
(ret-go b2)))
(when T
(print "else")
(setf result a))
(format t "=== ~A~%" a)
finish)
result)))
I'm new to lisp, and have been trying to learn Common Lisp by diving in and writing some code. I've read plenty of documentation on the subject, but it's taking a while to really sink in.
I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty. The code is at the end of the post, to avoid cluttering the actual question.
Here is an example of usage:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
And an example of output:
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
Now, the existing code works. Unfortunately, the (? ...) macro is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?
I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
Output:
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.
Also, I'll be wanting to handle exceptions in the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.
I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?
Can anyone help me out here, please?
A complete code listing follows:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro while (condition &body body)
`(loop while ,condition do (progn ,#body)))
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
(defun starts-with-p (str1 str2)
"Determine whether `str1` starts with `str2`"
(let ((p (search str2 str1)))
(and p (= 0 p))))
(defmacro pop-first-char (string)
`(with-gensyms (c)
(if (> (length ,string) 0)
(progn
(setf c (schar ,string 0))
(if (> (length ,string) 1)
(setf ,string (subseq ,string 1))
(setf ,string ""))))
c))
(defmacro pop-chars (string count)
`(with-gensyms (result)
(setf result ())
(dotimes (index ,count)
(push (pop-first-char ,string) result))
result))
(defun format-ansi-codes (text)
(let ((result ()))
(while (> (length text) 0)
(cond
((starts-with-p text "\\e")
(push (code-char #o33) result)
(pop-chars text 2)
)
((starts-with-p text "\\r")
(push (code-char 13) result)
(pop-chars text 2)
)
(t (push (pop-first-char text) result))
))
(setf result (nreverse result))
(coerce result 'string)))
(defun kv-lookup (values key)
"Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
(setf key (if (typep key 'cons) (nth 1 key) key))
(while values
(let ((k (pop values)) (v (pop values)))
(setf k (if (typep k 'cons) (nth 1 k) k))
(if (eql (symbol-name key) (symbol-name k))
(return v)))))
(defun make-ansi-escape (ansi-name)
(let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
:red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
:cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
:bg-dark-grey "\\e[100m"
:bold "\\e[1m" :underline "\\e[4m"
:start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
(format-ansi-codes (kv-lookup ansi-codes ansi-name))
))
(defun format-ansi-escaped-arg (out-stream arg)
(cond
((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
((typep arg 'string) (format out-stream arg))
(t (format out-stream "~a" arg))
))
(defun format-ansi-escaped (out-stream &rest args)
(while args
(let ((arg (pop args)))
(if (typep arg 'list)
(let ((first-arg (eval (first arg))))
(format out-stream first-arg (second arg))
)
(format-ansi-escaped-arg out-stream arg)
))
))
(defmacro while-pop ((var sequence &optional result-form) &rest forms)
(with-gensyms (seq)
`(let (,var)
(progn
(do () ((not ,sequence))
(setf ,var (pop ,sequence))
(progn ,#forms))
,result-form))))
(defun report-start (form)
(format t "( ) '~a'~%" form))
(defun report-result (result form)
(format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
result)
(defmacro ? (name &body body-forms)
"Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
(with-gensyms (result indent indent-string)
(if (not body-forms)
:empty
(progn
(setf result () indent 0 indent-string " ")
(cond
((typep (first body-forms) 'integer)
(setf indent (pop body-forms))))
`(progn
(format t "~v#{~A~:*~}" ,indent ,indent-string)
(format-ansi-escaped t "[" :white ,name :normal "]~%")
(with-gensyms (test-results)
(setf test-results ())
,(while-pop (body-form body-forms `(progn ,#(nreverse result)))
(cond
( (EQL (first body-form) '?)
(push `(progn
(setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,#(nthcdr 2 body-form))))
(format t "~%")
test-results
) result)
)
(t
(push `(progn
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(report-start ',body-form)
(with-gensyms (result label)
(setf result ,body-form)
(format-ansi-escaped t :move-up :start-of-line :clear-line)
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(push (report-result result ',body-form) test-results)
test-results
)) result))))))))))
(defun ?? (&rest results)
"Run any number of tests, and print a summary afterward"
(setf results (flatten results))
(format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
(if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
:yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
:brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
:normal "~%"))
For my part, the ? macro is rather technical and it's hard to follow the logic behind the formatting functions. So instead of tracking errors I'd like to suggest my own attempt, perhaps it'll be of use.
I think that actually your ?? doesn't want to evaluate anything, but rather to treat its body as individual tests or sections. If the body includes a list starting with ?, this list represents a section; other elements are test forms optionally followed by descriptions. So in my implementation ?? will be a macro, and ? will be just a symbol.
I start with wishful thinking. I suppose I can create individual tests using a function make-test-item and test sections using a function make-test-section (their implementation is unimportant for now), that I can display them using an auxiliary function display-test and compute results using the function results, which returns two values: the total number of tests and the number of passed ones. Then I'd like the code
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
to expand into something like
(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
Here a list of tests is created; then we traverse it printing each test (0 denotes the zero level of indentation and t is as in format) and keeping track of the results, finally displaying the total results. I don't think explicit eval is needed here.
It may not be the most exquisite piece of code ever, but it seems manageable. I supply missing definitions below, they are rather trivial (and can be improved) and have nothing to do with macros.
Now we pass on to the macros. Consider both pieces of code as data, then we want a list processing function which would turn the first one into the second. A few auxiliary functions would come in handy.
The major task is to parse the body of ?? and generate the list of test to go inside the let.
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,#items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
Here parse-test essentially absorbs the syntax of ??. Each iteration consumes one or two forms and collects corresponding make-... forms. The functions can be easily tested in REPL (and, of course, I did test them while writing).
Now the macro becomes quite simple:
(defmacro ?? (&body body)
`(let ((tests (list ,#(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
It captures a few symbols, both in the variable name space and in the function one (the expansion may contain make-test-item and make-test-section). A clean solution with gensyms would be cumbersome, so I'd suggest just moving all the definitions in a separate package and exporting only ?? and ?.
For completeness, here is an implementation of the test API. Actually, it's what I started coding with and proceeded until I made sure the big let-form works; then I passed on to the macro part. This implementation is fairly sloppy; in particular, it doesn't support terminal colours and display-test can't even output a section into a string.
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
All the code is licenced under WTFPL.
Use accumulative recursion to write a function called update-balance that consumes a list of transactions, lot, a starting balance at the beginning of the month (considered day 0), start-bal, and a non-‐negative number representing a minimum balance, min-bal. The function produces the balance of a bank account after completing all of the transactions in lot.
Having a problem with use of accumulative recursion
(define (trans-val t start-bal min-bal)
(cond
[(symbol=? (trans-action t) 'withdraw)
(cond
[(>= (- start-bal (trans-amt t)) min-bal)
(- start-bal (trans-amt t))]
[else (- start-bal (+ 1 (trans-amt t)))])]
[else
(cond
[(>= (+ start-bal (trans-amt t)) min-bal)
(+ start-bal (trans-amt t))]
[else (+ start-bal (- (trans-amt t) 1))])]))
Maybe something like this?
(define (update-balance lot start-bal min-bal)
(if (null? lot)
; no more transactions to process -> return start-bal
start-bal
; take next transaction (t), calculate new balance
(let* ((t (car lot))
(new-bal ((if (eq? (trans-action t) 'withdraw) - +)
start-bal
(trans-amt t))))
; if new balance >= minimum balance, use that, otherwise retain previous balance
; in any case, tail-recursively call update-balance to process the next transaction
(update-balance (cdr lot)
(if (>= new-bal min-bal) new-bal start-bal)
min-bal))))
Testing:
> (update-balance (list (trans 'deposit 100) (trans 'withdraw 80)) 0 0)
20
> (update-balance (list (trans 'deposit 10) (trans 'withdraw 80)) 0 0)
10
The function "greaterthan", (< NUM1 NUM2), allows only for returning t/nil for comparing 2 values.
I would like to test (var1 > var2 < var3 < var4), is there any way to do that using only one function in lisp? If not, what is the best procedure?
The best procedure is not to bother: (and (< var2 var1) (< var2 var3) (< var3 var4)) is not harder to read that your ..>..<..<.. chain.
It makes sense to test for the ascending order:
(require 'cl)
(defun cl-< (&rest args)
(every '< args (cdr args))
These days I don't hesitate to (require 'cl) anymore, but if you do,
here is another variant:
(defun cl-< (arg &rest more-args)
(or (null more-args)
(and (< arg (first more-args))
(apply #'cl-< more-args))))
The following is a macro implementation for variadic <
(defmacro << (x y &rest args)
(if args
(if (or (symbolp y)
(numberp y))
`(and (< ,x ,y) (<< ,y ,#args))
(let ((ys (make-symbol "y")))
`(let (,ys)
(and (< ,x (setq ,ys ,y))
(<< ,ys ,#args)))))
`(< ,x ,y)))
for simple cases just expands to (and ...) chains
(<< x y z) ==> (and (< x y) (< y z))
where the expression is not a number and not a symbol expands to a more complex form to avoid multiple evaluations in presence of side effects
(<< (f x) (g y) (h z)) ==> (let ((gy)) (and (< (f x) (setq gy (g y)))
(< gy (h z))))
for example
(setq foo (list))
nil
(defun call (x) (push x foo) x)
call
(<< (call 1) (call 2) (call 5) (call 4) (call 0))
nil
foo
(4 5 2 1)
every function has been called once, except for 0 that didn't need to be called because of short circuiting (I'm not 100% sure if short circuiting is a really good idea or not... #'< in Common Lisp is a regular function with all arguments all evaluated exactly once in left-to-right order without short circuiting).
(defun << (arg1 arg2 arg3 arg4)
(when (and (< arg1 arg2) (< arg2 arg3) (< arg3 arg4)))
)
(<< 1 2 3 4)
Probably possible to extend with any amount of arguments, but such a general form would seem useful.
(defmacro << (&rest args)
(let ((first (car args))
(min (gensym))
(max (gensym))
(forms '(t)) iterator)
(setq args (reverse (cdr args))
iterator args)
`(let ((,min ,first) ,max)
,(or
(while iterator
(push `(setq ,min ,max) forms)
(push `(< ,min ,max) forms)
(push `(setq ,max ,(car iterator)) forms)
(setq iterator (cdr iterator))) `(and ,#forms)))))
(macroexpand '(<< 10 20 30 (+ 30 3) (* 10 4)))
(let ((G99730 10) G99731)
(and (setq G99731 20)
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 30)
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 (+ 30 3))
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 (* 10 4))
(< G99730 G99731)
(setq G99730 G99731) t))
This is the idea similar to 6502's, but it may create less code, in a less trivial situation, but it will create more code in a trivial situation.
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!")))