I often have a truth-list like the following '(nil nil nil t nil t nil nil nil) and I would like to call (reduce #'or truth-list)
However, this does not work and I found that or is a macro. Is there a quick and easy way I can get this to work like a function? What I have been doing is passing: (lambda (p q) (or p q)) as my function, but since I have come across this so many times, I bet there is a better way.
Thanks for all the help!
Not really. You actually need the function. Just define a BINARY-OR function. If you use it often, then just add it to your code.
Alternatives:
(some #'identity '(nil nil nil t nil t nil nil nil))
or
(loop for i in '(nil nil nil t nil t nil nil nil) thereis i)
Bonus: both above forms will stop at the first true value. The reduce variant won't.
Related
I found that it is very difficult to align column if the row contains value which is a NIL
I try specified column width, however, in the output, NIL seems always has different width than other unicode characters so that always won't align properly. Is there a method to achieve better alignment? (yes I would prefer empty list to print out as NIL)
Thanks.
(progn
(format t "~?" "~5#a ~5#a ~5#a ~5#a ~5#a~%" '(蘋果 () 桔子 () 西瓜))
(format t "~?" "~5#a ~5#a ~5#a ~5#a ~5#a~%" '(() 茄子 () 菠菜 () 苦瓜)))
OUTPUT (Column not aligned even column width has already been specified
蘋果 NIL 桔子 NIL 西瓜
NIL 茄子 NIL 菠菜 NIL
Would be expecting OUTPUT aligned like below (with NIL occupy the same width as specified) :
蘋果 NIL 桔子 NIL 西瓜
NIL 茄子 NIL 菠菜 NIL
I observed that the string formatting of () to NIL takes 3 characters, where the others take 2, so I tried changing the () padding to ~6#a. It turns out it works better:
(length (format nil "~a" nil))
3
(progn
(format t "~?" "~5#a ~6#a ~5#a ~6#a ~5#a~%" '(蘋果 () 桔子 () 西瓜))
(format t "~?" "~6#a ~5#a ~6#a ~5#a ~6#a~%" '(() 茄子 () 菠菜 () 苦瓜)))
蘋果 NIL 桔子 NIL 西瓜
NIL 茄子 NIL 菠菜 NIL
The width of latin and non-latin characters are different (see last column specifically), but the columns look aligned now.
So, you have to pre-calculate the padding for each entry.
You can use the ~v directive to insert a variable inside a directive .
(let ((padding 30))
(format nil "~va" padding "foo"))
;; "foo "
(source: Cookbook)
I am trying to implement a queue as a doubly linked list. However, the enqueue function goes into infinite recursion when I try to enqueue a second node, I can't seem to figure out what's causing it.
(defstruct node
value
(next nil)
(previous nil))
(defstruct (queue (:print-function print-queue))
(first nil)
(last nil))
(defun print-queue (queue s d)
(do ((node (queue-first queue) (node-next node)))
((null node) (format s "~%"))
(format s "~A " (node-value node))))
(defun enqueue (data queue)
(let ((node (make-node :value data)))
(if (null (queue-first queue))
(setf (queue-first queue) node (queue-last queue) node)
(setf (node-previous node) (queue-last queue)
(node-next (queue-last queue)) node
(queue-last queue) node))))
EDIT: Problematic test case
(setf queue (make-queue))
(enqueue 3 queue)
(enqueue 4 queue) ; this call never terminates and blows up the stack
The last statement on CLISP causes a
* - Program stack overflow. RESET
on SBCL it just goes into an infinite loop and I have to exit SBCL
Well, you still haven't really looked at the error. ;-)
If you use SBCL:
0] backtrace
...
11898: (SB-KERNEL::%DEFAULT-STRUCTURE-PRETTY-PRINT #1=#S(NODE :VALUE 4 :NEXT NIL :PREVIOUS #S(NODE :VALUE 3 :NEXT #1# :PREVIOUS NIL)) #<SYNONYM-STREAM :SYMBOL SB-SYS:*STDOUT* {10001ACA23}>)
11899: ((LABELS SB-IMPL::HANDLE-IT :IN SB-KERNEL:OUTPUT-OBJECT) #<SYNONYM-STREAM :SYMBOL SB-SYS:*STDOUT* {10001ACA23}>)
11900: (PRIN1 #1=#S(NODE :VALUE 4 :NEXT NIL :PREVIOUS #S(NODE :VALUE 3 :NEXT #1# :PREVIOUS NIL)) NIL)
11901: (SB-IMPL::REPL-FUN NIL)
11902: ((LAMBDA NIL :IN SB-IMPL::TOPLEVEL-REPL))
11903: (SB-IMPL::%WITH-REBOUND-IO-SYNTAX #<CLOSURE (LAMBDA NIL :IN SB-IMPL::TOPLEVEL-REPL) {1002ACB00B}>)
11904: (SB-IMPL::TOPLEVEL-REPL NIL)
11905: (SB-IMPL::TOPLEVEL-INIT)
11906: ((FLET #:WITHOUT-INTERRUPTS-BODY-58 :IN SAVE-LISP-AND-DIE))
11907: ((LABELS SB-IMPL::RESTART-LISP :IN SAVE-LISP-AND-DIE))
It's not your function which causes this.
As you can see the error happens in printing the result. You see in the backtrace that the function PRIN1 is used to print a node structure. Your function already returned a result, which now needs to be printed in the REPL.
Your function returns a circular data structure and Lisp tries to print it. Then it goes into an infinite loop.
You need to tell Lisp, that it should deal with circular data structures in the printer.
Use
(setf *print-circle* t)
and try again.
A bit style guide:
generally use CLOS classes instead of structures
provide a custom printer for each structure, especially those with circularities
return meaningful results from functions
I am curious how
(write
(make-instance 'simple-error
:format-control "A:~a ~% B:~a~%"
:format-arguments `("A" "B"))
:stream nil)
works, as I tried to implement it myself to gain experience in basic lisp funcionality but soon had to realize, that I am not able to. As the intuitive way of implementation:
(defmethod my-write ((simple-error err))
(FORMAT nil (if (simple-condition-format-control err)
(simple-condition-format-control err)
"")
(simple-condition-format-arguments err)))
obviously cannot work, as (simple-condition-format-arguments err) returns the list of arguments and therefore, in the example above, "B:~a" does not have a corresponding parameter to print.
So how would I actually implement this method?
You can use apply for this. It takes the function passed as its first argument and applies it to arguments constructed from its other arguments. For example, (apply #'f 1 2) calls (f 1 2), (apply #'f 1 '(2 3)) calls (f 1 2 3) and so on. It's perfectly suited for this situation.
SBCL has a function almost identical to yours:
(defun simple-condition-printer (condition stream)
(let ((control (simple-condition-format-control condition)))
(if control
(apply #'format stream
control
(simple-condition-format-arguments condition))
(error "No format-control for ~S" condition))))
As mentioned by Samuel, you need to use APPLY.
Also note that NIL for the stream in WRITE does something else than in FORMAT. With FORMAT the stream argument NIL causes the output to be returned as a string. With man other output functions, like WRITE, it means standard output.
[solved]
I have something similar with these four functions: base, init, func and some. The func is recursive and calls itself: in the "stop case" it would call some and return its value, then it should return control back to "init", wherefrom it is invoked; the latter being once called from base.
base
-> init
-> func
-> init
-> func
-> some
|
_________+
|
v
; should continue from here (in `func`)
[not anymore]
Instead, after the first call to some, the control is yielded directly to base, skipping what I would expect to be the intermediate (init,func) pair call(s).
I actually tried several simpler cases using block, return and recursion (e.g., "mutual tail-recursive factorial"), and all worked well. I mention that func uses a test helper function that catch a throw (but I tried even an example with (catch 'test (throw 'test 0)), and it was ok); just so whatever could my real program have something causing the issue.
This is elisp: each defun commences with block, and all functions use return, as in the following.
[I switched from using "defun/block" to "defun*"]
(defmacro 4+ (number)
"Add 4 to NUMBER, where NUMBER is a number."
(list 'setq number (list '1+ (list '1+ (list '1+ (list '1+ number))))))
(defmacro 4- (number)
"Subtract 4 from NUMBER, where NUMBER is a number."
(list 'setq number (list '1- (list '1- (list '1- (list '1- number))))))
(defun mesg (s &optional o)
"Use ATAB to tabulate message S at 4-multiple column; next/prev tab if O=1/0."
(when (null o) (setq o 0))
(case o (0 (4- atab)) (1 nil))
(message (concat "%" (format "%d" (+ atab (length s))) "s") s)
(case o (0 nil) (1 (4+ atab))))
(defun* base ()
(let (pack)
(setq atab 0)
(mesg "base->" 1)
(setq pack (init))
(mesg "<-base")))
(defun* init ()
(mesg "init->" 1)
(return-from init (progn (setq temp (func)) (mesg "<-init") temp)))
(defun* func (&optional pack)
(mesg "func->" 1)
(when (not (null pack)) (return-from func (progn (mesg "<+func") pack)))
(when (< 0 (mod (random) 2)); stop case
(return-from func (progn (setq temp (some)) (mesg "<-func") temp)))
(setq pack (init))
(case (mod (random) 2)
(0 (return-from func (progn (mesg "<0func") pack)))
(1 (return-from func (progn (setq temp (func pack)) (mesg "<1func") temp))) ; use tail-recursion instead of `while'
(t (error "foo bar"))))
(defun* some ()
(mesg "some->" 1)
(return-from some (progn (mesg "<-some") (list 2 3 4))))
(base)
The pack variable is my value-list as data structure. I also use func to reiterate itself (in tail-recursive call) with a special accumulating-parameter so that I avoid "imperative" while.
So instead of what I would expect (each > is paired by <)
base->
init->
func->
init->
func->
some->
<-some
<-func
<-init
func-> ; tail-recursion
<+func
<1func
<-init
<-base
my program behaves as follows.
base
-> init
-> func
-> init
-> func
-> some
|
__________________________+
|
v
; control yielded here (to `base`)
[not anymore]
Why is the control yielded too soon back to the start of the program, and not continue in the first call to func, after return from the second call via init?
Appreciate any help,
Sebastian
Looking at your code, it is not clear to me what's the extent of the block in func. If the block includes the whole func definition, then yes, the control reaches func when returning, but the block is skipped completely, hence the function completely, and comes back all the way up where it was called (eventually base). May be that the case?
If that's so, you have to put the code that you want to execute after a return after the block.
EDIT: Looking again at your code, I think you're not using the return as it should be used. For instance in init you have
(block nil
...
(return (func ...)))
This return "cancels" the block, and takes the same effect as not having the block at all, unless some function called in "..." does have a return without a block. So the return here cancels the possible return points of func.
Thanks both for your answer: inserting into my program those messages I tried as with the code I added for explanations revealed there are no defun* problems with elisp, but some things I mistook in design.
Here's the thing: I don't "get" setf-expanders and would like to learn how they work.
I need to learn how they work because I've got a problem which seems like a typical example for why you should learn setf-expanders, the problem is as follows:
(defparameter some-array (make-array 10))
(defun arr-index (index-string)
(aref some-array (parse-integer index-string))
(setf (arr-index "2") 7) ;; Error: undefined function (setf arr-index)
How do I write a proper setf-expander for ARR-INDEX?
(defun (setf arr-index) (new-value index-string)
(setf (aref some-array (parse-integer index-string))
new-value))
In Common Lisp a function name can not only be a symbol, but also a list of two symbols with SETF as the first symbol. See above. DEFUN thus can define SETF functions. The name of the function is (setf arr-index).
A setf function can be used in a place form: CLHS: Other compound forms as places.
The new value is the first argument then.
CL-USER 15 > some-array
#(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
CL-USER 16 > (setf (arr-index "2") 7)
7
CL-USER 17 > some-array
#(NIL NIL 7 NIL NIL NIL NIL NIL NIL NIL)
Rainer's answer is spot on. Before ANSI Common Lisp, it was necessary to use defsetf to define an expander for simple places that could be set with a simple function call. setf functions like (setf arr-index) came into the language with CLOS and simplify a lot of things. In particular, setf functions can be generic.