This question is related to the Chapter 6 code of Conrad Barski's Book, Land of Lisp.
The code is the following
(defun tweak-text (lst caps lit)
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eq item #\space) (cons item (tweak-text rest caps lit)))
((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
((eq item #\") (tweak-text rest caps (not lit)))
(lit (cons item (tweak-text rest nil lit)))
((or caps lit) (cons (char-upcase item) (tweak-text rest nil lit)))
(t (cons (char-downcase item) (tweak-text rest nil nil)))))))
Now look at the (lit ..) part and the stuff below it .. ((or caps nil) ..), so my question is the following
if lit is ever true, it will be will be evaluated in the former expression stated
if it is not true, the latter expression will always evaluate to (or caps false) => (or caps false) which is pretty much useless?
So shouldn't the latter expression simply be (caps (cons (char ...)) ?
This book has been read by thousands so I must be wrong about something and I'm not John Bell.
Yes, the simpler expression is equivalent. It is mentioned in the page 97 errata http://landoflisp.com/errata.html
One of the problems is the use of recursion, which limits the length of lists the function is able to process.
(defun tweak-text (list &aux (caps t) (lit nil))
(mapcon (lambda (c)
(case c
(#\space (list c))
((#\! #\? #\.)
(setf caps t)
(list c))
(#\"
(setf lit (not lit))
())
(otherwise
(cond (lit (setf caps nil) (list c))
(caps (setf caps nil) (list (char-upcase c)))
(t (setf caps nil lit nil)
(list (char-downcase c)))))))
list))
Related
(defun leftorright (element tree)
(cond ((null (car tree))
(setf tree
(cons element (cons (cons NIL NIL) (cons NIL NIL)))))
((>= element (car tree))
(if (null (caddr tree))
(setf (cddr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cddr tree))))
((< element (car tree))
(if (null (caaddr tree))
(setf (cadr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cadr tree))))))
(setf tree (cons NIL NIL))
(print tree)
(leftorright 8 tree)
(leftorright 3 tree)
(leftorright 6 tree)
(leftorright 4 tree)
(leftorright 7 tree)
(print tree)
(defun leftorright (element tree)
(cond ((null (car tree))
(setf tree
(cons element (cons (cons NIL NIL) (cons NIL NIL)))))
((>= element (car tree))
(if (null (caddr tree))
(setf (cddr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cddr tree))))
((< element (car tree))
(if (null (caaddr tree))
(setf (cadr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cadr tree))))))
So looking at
(setf tree (cons NIL NIL))
(print tree)
You think of the tree structure as something with 2 slots - a left and a right one. leftorright is actually an inser function which takes an element and fits the element into either left or right slot of a tree.
(null (car tree)) considers the case that the tree is empty.
In that case you want to set tree
(cons element (cons (cons NIL NIL) (cons NIL NIL))).
Let's take 'element as value for element just to see the returned structure:
(ELEMENT (NIL) NIL)
Here is already some problem. Why not (element nil nil)? OR: (element (nil) (nil))?
In the next cond clauses, you distinguish between the cases that element is >= (car tree) (the current value?) and < than (car tree).
Then, in the next step you distinguish the case that the first subtree (caddr tree) is null - thus empty. In that case you again build (element (nil) nil). But you assign it to some subparts of tree.
(caddr tree) or (cadr tree). If they are not empty you delegate to leftorright to handle those subtreeparts.
So as many commentators point our, your (setf tree ...) expressions are problematic - because they are mutating tree -
obviously you come from some non-lisp language (which we lispers call blubb language) and try to think in the blubb way - meaning imperatively.
The lisp-way for such tree functions is always to recursively construct a tree and return the entire tree.
Recursion means to break down the cases into the very primitive and simple cases - and just to think-through one step.
So what is the most primitive case of tree? - If we assume that it is actually a list - probably of the length 3 (current-value left right).
The most primitive tree is the empty tree. (null tree).
So we start with
(defun insert (element tree)
(cond ((null tree) (cons element (cons nil (cons nil nil))))
...))
However, cons cons cons is not as nice as once a list. So let's do:
(defun insert (element tree)
(cond ((null tree) (list element nil nil))
...))
And we use list for constructing a tree.
If the tree is not empty, it contains 3 slots - the first for the element (current-value) and the seconds and third slots are for sub-trees (either an empty-tree - '() - or another 3-slot-list - a real tree.
For the next element which gets inserted to any non-empty tree - the criterion is the current value. Any element >= than the current value gets inserted as a tree into the right slot. Otherwise/else/< into the left slot.
(defun insert (element tree)
(cond ((null tree)
(list element
nil
nil))
((>= element (car tree))
(list (car tree) (cadr tree) (insert element (caddr tree))))
(t
(list (car tree) (insert element (cadr tree)) (caddr tree)))))
and that is actually what you wanted.
Let's use it:
(defparameter *tree* nil) ;; generate an empty tree
Now let's insert - but now we assign the result anew to *tree* using setf.
(setf *tree* (insert 8 *tree*))
(setf *tree* (insert 3 *tree*))
(setf *tree* (insert 6 *tree*))
(setf *tree* (insert 4 *tree*))
(setf *tree* (insert 7 *tree*))
;; let's see how now *tree* looks like:
*tree*
;; => (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)
Let's improve the function
We are lazy, we don't want to write so often setf and we want to give in order the numbers to be inserted.
First, we change the order of the arguments:
(defun insert (tree element)
(cond ((null tree)
(list element
nil
nil))
((>= element (car tree))
(list (car tree) (cadr tree) (insert (caddr tree) element)))
(t
(list (car tree) (insert (cadr tree) element) (caddr tree)))))
And then, we make this function variadic - means it can take as many arguments as we want (namely the sequence of the elements):
(defun insert* (tree &rest elements)
(let ((tree tree))
(loop for e in elements
do (setf tree (insert tree e))
finally (return tree))))
Now we can do:
(insert* '() 8 3 6 4 7)
;;=> (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)
The nice thing is, we used a local (let ((tree tree)) ...)
and we loop over the elements and do (setf tree ...) meaning we mutate the local tree only. So the global variable given for tree is unaffected.
Unless we setf the new result to the global tree's variable.
Like this:
(defparameter *tree* '())
(setf *tree* (insert* *tree* 8 3 6 4 7))
*tree*
;;=> (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)
setf is necessary to change the *tree* value.
Look:
(defparameter *tree* '())
(insert* *tree* 8 3 6 4 7)
*tree*
;;=> NIL ;; original *tree* value is not altered by `insert*` function!
Destructive insert!
I also tried a destructive insert!.
However, perhaps things could be improved. I am open for suggestions.
(defun %insert! (tree element &optional (acc '()))
"Generate setf expression for `insert!` macro!"
(cond ((null tree)
(nreverse (cons (list element nil nil) acc)))
((>= element (car tree))
(%insert! (third tree) element (cons 'third acc)))
(t
(%insert! (second tree) element (cons 'second acc)))))
(defun butlast-last (l &optional (acc '()))
(cond ((or (null l) (null (cdr l))) (values (nreverse acc) (car l)))
(t (butlast-last (cdr l) (cons (car l) acc)))))
(defun %insert!-to-setf (%insert!-expression tree)
(multiple-value-bind (seq expr) (butlast-last %insert!-expression)
(append (cons 'setf (list (reduce (lambda (res e) (cons e (list res))) seq :initial-value tree)))
(list (cons 'quote (list expr))))))
(defmacro insert! (tree element)
(eval `(%insert!-to-setf (%insert! ,tree ,element) ',tree)))
The usage of eval in the macro already signals something is very bad in this code.
See the last section of this answer to see how a better insert! and insert*! can be written!
Destructive insert! and insert*! as pure functions
Finally, I figured out how to do destructive insert! and insert*! as pure functions.
(defun insert! (tree element)
(let ((e (list element nil nil)))
(cond ((null tree)
(setf tree e))
(t
(labels ((%insert! (itree)
(cond ((>= element (first itree))
(if (null (third itree))
(setf (third itree) e)
(%insert! (third itree))))
(t
(if (null (second itree))
(setf (second itree) e)
(%insert! (second itree)))))))
(%insert! tree))))
tree))
(defun insert*! (tree &rest elements)
(loop for e in elements
do (setf tree (insert! tree e))
finally (return tree)))
(defparameter *t* '())
(setf *t* (insert! *t* 3))
(setf *t* (insert! *t* 8))
(setf *t* (insert! *t* 7))
(setf *t* (insert! *t* 5))
(insert*! '() 3 8 7 5)
And finally make out of them imperative macros
Imperative in that way that they are mutating the tree argument.
And you don't need to assign the results to a new value.
I think these macros are what you actually wanted to program!
BUT destructive insert! and insert*! as pure functions is more lispier than the macros which are following now.
(defun %insert! (tree element)
(let ((e (list element nil nil)))
(cond ((null tree)
(setf tree e))
(t
(labels ((%%insert! (itree)
(cond ((>= element (first itree))
(if (null (third itree))
(setf (third itree) e)
(%%insert! (third itree))))
(t
(if (null (second itree))
(setf (second itree) e)
(%%insert! (second itree)))))))
(%%insert! tree))))
tree))
(defun %insert*! (tree &rest elements)
(loop for e in elements
do (setf tree (%insert! tree e))
finally (return tree)))
(defmacro insert! (tree element)
`(setf ,tree (%insert! ,tree ,element)))
(defmacro insert*! (tree &rest elements)
`(setf ,tree (%insert*! ,tree ,#elements)))
(defparameter *t* '())
(insert! *t* 3)
(insert! *t* 8)
(insert! *t* 7)
(insert! *t* 5)
(defparameter *t* '())
(insert*! *t* 3 8 7 5)
I'm trying to make a code in lisp to count occurrences of atoms in a list in lisp.
The problem is the code works for all atoms except the atom (), which appears as NIL.
Example in the code:
(defun flatten (list_)
(cond ((atom list_) (list list_))
((null list_) NIL)
(t (append (flatten (car list_)) (flatten (cdr list_))) )
)
)
(defun toUniqueList (list_ out)
(cond ((null list_) NIL)
((not (member (car list_) out)) (append (list (car list_)) (toUniqueList (cdr list_) (append (list (car list_)) out)) ))
(t (toUniqueList (cdr list_) out))
)
)
(defun countOccurences (list_ x)
(cond ((null list_) 0)
((eql (car list_) x) (+ (countOccurences (cdr list_) x) 1))
(t (countOccurences (cdr list_) x))
)
)
(defun countOccurencesAll (list_)
(setq flatList (flatten list_))
(setq parsed (toUniqueList flatList '()))
(setq result '())
(dolist (x parsed)
(setq result (append result (list (list x (countOccurences flatList x)) ))))
result
)
(write (countOccurencesAll '(x y z 4.6 (a x) () (5 z x) ())))
; ((X 3) (Y 1) (Z 2) (4.6 1) (A 1) (NIL 5) (5 1))
Any idea in how to show () rather than NIL?
The expressions nil, 'nil, (), and '() all gets evaluated to nil which is displayed as nil unless it is the cdr of a pair in which it will just close the list. eg. '(() . ()) gets evaluated to (NIL . NIL) and it is displayed as (NIL). There is nothing you can do about that.
So the question is then, because ((a) (()) (c)) is really ((a . nil) . ((nil . nil) . ((c . nil) . nil))) should it count nil/() 5 times or ignore when nil in the cdr of a pair and just count it as one?
BTW using setq in countOccurencesAll on undefined bindings means your code is in the mercy of the implementation. The hyperspec does not define how it should be handled and SBCL makes warnings about how it interprets the code and other might just choose an interpretation. A better approach would be to use let to define the bindings. Using a hash and iterate over the list once would make an O(n) solution.
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.
so I have a program:
(defun add (L)
(cond((endp L) nil)
(t(cons(1+(first L)))(add(rest L)))))
that will add 1 to each member of the list. I want to check if the list is all numbers and return nil if not, and don't know how to go about doing that within the defun.
I thought of doing
(defun add (L)
(cond((endp L) nil)
((not(numberp(first L))) nil)
(t(cons(1+(first L)))(add(rest L)))))
but that will still return the beginning of the list if the non number is in the middle. How would I pre check and return nil at the beginning?
You can wrap it in a condition-case
(defun add (L)
(condition-case nil
(mapcar '1+ L)
(error nil)))
Another possibility is to use iteration:
(defun add (l)
(loop for x in l
if (numberp x)
collect (1+ x)
else do (return-from add nil)))
The function is immediately exited with nil on the first non numeric element.
You would not implement iteration using recursion, since Lisp already provides iteration constructs. Example: MAPCAR.
Common Lisp also provides control flow constructs like RETURN-FROM, where you return from a block. A function defined by DEFUN has a block with its name and BLOCK can also create a named block explicitly. Examples for both:
CL-USER 62 > (block mapping
(mapcar (lambda (item)
(if (numberp item)
(1+ item)
(return-from mapping nil)))
'(1 2 3 nil 5 6)))
NIL
CL-USER 63 > (block mapping
(mapcar (lambda (item)
(if (numberp item)
(1+ item)
(return-from mapping nil)))
'(1 2 3 4 5 6)))
(2 3 4 5 6 7)
As function:
CL-USER 64 > (defun increment-list (list)
(mapcar (lambda (item)
(if (numberp item)
(1+ item)
(return-from increment-list nil)))
list))
INCREMENT-LIST
CL-USER 65 > (increment-list '(1 2 3 4 5 6))
(2 3 4 5 6 7)
CL-USER 66 > (increment-list '(1 2 3 nil 5 6))
NIL
I'd say that an idiomatic way, in Common Lisp, of checking that all elements in a list are numbers would be (every #'numberp the-list), so I would probably write this as:
(defun add-1 (list)
(when (every #'numberp list)
(mapcar #'1+ list)))
It would be possible to use (if ...) or (and ...), but in this case I would argue that (when ...) makes for the clearest code.
The difficulty is that propagating nil results in the nil at the end of the list causing everything to be nil. One solution is to check that add returns nil but (rest xs) is not nil. However, IMO it is more straightforward to just iterate over the list twice, checking for numbers the first time and then doing the addition on the second iteration.
Try this:
(defun add (xs)
(cond ((endp xs) nil)
((not (numberp (car xs))) nil)
(t (let ((r (add (rest xs))))
(cond ((and (not r) (rest xs)) nil)
(t (cons (1+ (first xs)) r)))))))
Barring mistakes on my end, this results in:
(add '()) => nil
(add '(1 2)) => '(2 3)
(add '(x y)) => nil
(add '(1 2 y)) => nil
EDIT: Without let. This results in 2^(n+1)-1 calls to add for a list of length n.
(defun add (xs)
(cond ((endp xs) nil)
((not (numberp (car xs))) nil)
(t (cond ((and (not (add (rest xs))) (rest xs)) nil)
(t (cons (1+ (first xs)) (add (rest xs)))))))))
The program should reformat the string like below.
Example: (game-print '(THIS IS A SENTENCE。 WHAT ABOUT THIS？ PROBABLY.))
This is a sentence. What about ths? Probably.
But something is wrong( Lisp nesting exceeds `max-lisp-eval-depth) and i don't know why. This piece of code is actually from the book "Land of lisp" in page 97. The original code is written in common lisp. I want to rewrite it in elisp. The last two argument in tweak-text means captain and literal.
(defun tweak-text (lst caps lit)
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eql item ?\ ) (cons item (tweak-text rest caps lit)))
((member item '(?\! ?\? ?\.)) (cons item (tweak-text rest t lit)))
((eql item ?\") (tweak-text rest caps (not lit)))
(lit (cons item (tweak-text rest nil lit)))
(caps (cons (upcase item) (tweak-text rest nil lit)))
(t (cons (downcase item) (tweak-text rest nil nil)))))))
(defun game-print (lst)
(print (coerce (tweak-text (coerce (prin1-to-string lst) 'list) t nil) 'string)))
(game-print '(not only does this sentence have a "comma," it also mentions the "iPad."))
The orignal code written in common lisp.
(defun tweak-text (lst caps lit)
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
((eql item #\") (tweak-text rest caps (not lit)))
(lit (cons item (tweak-text rest nil lit)))
(caps (cons (char-upcase item) (tweak-text rest nil lit)))
(t (cons (char-downcase item) (tweak-text rest nil nil)))))))
(defun game-print (lst)
(princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string lst)) 'list) t nil) 'string))
(fresh-line))
In both cases, you have non-terminal recursions, so you're using
O(length(lst)) stack space. Obviously, systems may limit the stack
space you can use, and you do indeed reach this limit in emacs. (Now
then in emacs, you can increase the limit by changing
max-lisp-eval-depth, but this won't solve the fundamental problem).
The solution is to use iteration instead of recursion.
But first, write in emacs:
(defun character (x)
"common-lisp: return the character designated by X."
(etypecase x
(integer x)
(string (aref x 0))
(symbol (aref (symbol-name x) 0))))
(defun string-trim (character-bag string-designator)
"common-lisp: returns a substring of string, with all characters in \
character-bag stripped off the beginning and end."
(unless (sequencep character-bag)
(signal 'type-error "expected a sequence for `character-bag'."))
(let* ((string (string* string-designator))
(margin (format "[%s]*" (regexp-quote
(if (stringp character-bag)
character-bag
(map 'string 'identity character-bag)))))
(trimer (format "\\`%s\\(\\(.\\|\n\\)*?\\)%s\\'" margin margin)))
(replace-regexp-in-string trimer "\\1" string)))
(require 'cl)
so that you can write a single function for both CL and elisp:
(defun tweak-text (list caps lit)
(let ((result '()))
(dolist (item list (nreverse result))
(cond ((find item " !?.") (push item result))
((eql item (character "\"")) (setf lit (not lit)))
(lit (push item result)
(setf caps nil))
(caps (push (char-upcase item) result)
(setf caps nil))
(t (push (char-downcase item) result)
(setf caps nil
lit nil))))))
(defun game-print (list)
(princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string list)) 'list)
t nil)
'string))
(terpri))
Then:
(game-print '(not only does this sentence have a "comma," it also mentions the "iPad."))
in emacs:
prints: Not only does this sentence have a comma, it also mentions the iPad.
returns: t
in Common Lisp:
prints: Not only does this sentence have a comma, it also mentions the iPad.
returns: nil
Now, in general there's little point of using lists to process strings, both emacs lisp and Common Lisp have powerful primitives to deal with sequences and strings directly.
Note that elisp (sadly) does not optimise for tail-recursion, so that turns out to be a very inefficient way to write this function.
You are indeed hitting the 'max-lisp-eval-depth' limit when recursing in tweak-text. I don't see anything wrong with the way the code is(I didn't check if its doing what you intend it to do).
You can configure/raise the 'max-lisp-eval-depth' limit. The documentation for that variable states that you can raise it as long as you are confident that you are not going to trip into running out of stack space. The limit is conservatively set to 541 on my machine. Raising it to 600 got the function definition above to work on the input you gave as example.
As Pascal Bourguignon already mentioned it, using strings w/o coercing them to lists and back would be a better approach, below is my take at it. Note that it is slightly different in that literal strings are verified for punctuation, and if they appear to have punctuation such as would cause it otherwise to have the next letter upper-cased, then it would be upper cased too. I'm not sure this is a disadvantage, this is why I didn't take care of this difference.
(defun tweak-text (source)
(let ((i 0) (separator "") (cap t) current)
(with-output-to-string
(dolist (i source)
(setq current
(concat separator
(etypecase i
(string i)
(symbol (downcase (symbol-name i)))))
separator " ")
(let (current-char)
(dotimes (j (length current))
(setq current-char (aref current j))
(cond
((position current-char " \t\n\r"))
(cap (setq cap nil
current-char (upcase current-char)))
((position current-char ".?!")
(setq cap t)))
(princ (char-to-string current-char))))))))
(tweak-text '(not only does this sentence have a "comma," it also mentions the "iPad."))
"Not only does this sentence have a comma, it also mentions the iPad."
I think you should write something like this:
(defun tweak-text-wrapper (&rest args)
(let ((max-lisp-eval-depth 9001)) ; as much as you want
(apply tweak-text args)))