I'm attempting to write a program in Common Lisp that dynamically creates other lisp files. Common Lisp's print function seems very useful for this purpose. Unfortunately, the function outputs data on a single line. For example (just printing to standard output):
(print '(let ((a 1) (b 2) (c 3)) (+ a b c)))
>> (let ((a 1) (b 2) (c 3)) (+ a b c))
The generated lisp files need to be human readable and thus shouldn't minimize whitespace. It seems that the pprint function is the solution to my problem. Since pprint sets *pretty-print* to true, the function should print on multiple lines. In other words:
(pprint '(let ((a 1) (b 2) (c 3)) (+ a b c)))
>> (let ((a 1)
>> (b 2)
>> (c 3))
>> (+ a b c))
However, in Allegro CL, pprint seems to behave in an identical manner to print. Output is only on a single line. Is there a way to cause the function to print s-expressions in a "pretty" way? Are there any other globals that need to be set before the function prints correctly? Is there an alternative function/macro that I'm looking for? Thanks for the help!
The pretty printer is controlled by more than just *print-pretty*. E.g., look at the interaction with *print-right-margin* in SBCL (under SLIME):
CL-USER> (pprint '(let ((a 1) (b 2) (c 3)) (+ a b c)))
(LET ((A 1) (B 2) (C 3))
(+ A B C))
; No value
CL-USER> (let ((*print-right-margin* 10))
(pprint '(let ((a 1) (b 2) (c 3)) (+ a b c))))
(LET ((A
1)
(B
2)
(C
3))
(+ A B
C))
; No value
CL-USER> (let ((*print-right-margin* 20))
(pprint '(let ((a 1) (b 2) (c 3)) (+ a b c))))
(LET ((A 1)
(B 2)
(C 3))
(+ A B C))
; No value
You might be able to get satisfactory results just by setting that variable, but in general you'll want to have a look at 22.2 The Lisp Pretty Printer. Pretty printing functions have lots of places for optional newlines and the like, and where they get put depends on a number of things (like *print-right-margin* and *print-miser-width*). There are some examples of using the pretty printer to format Lisp source code in 22.2.2 Examples of using the Pretty Printer. There's too much to quote it all, but it shows how the following pretty printing code can produce all these outputs, depending on context:
(defun simple-pprint-defun (*standard-output* list)
(pprint-logical-block (*standard-output* list :prefix "(" :suffix ")")
(write (first list))
(write-char #\Space)
(pprint-newline :miser)
(pprint-indent :current 0)
(write (second list))
(write-char #\Space)
(pprint-newline :fill)
(write (third list))
(pprint-indent :block 1)
(write-char #\Space)
(pprint-newline :linear)
(write (fourth list))))
(DEFUN PROD (X Y)
(* X Y))
(DEFUN PROD
(X Y)
(* X Y))
(DEFUN
PROD
(X Y)
(* X Y))
;;; (DEFUN PROD
;;; (X Y)
;;; (* X Y))
Related
I am using a function from an external library returning a vector of four numbers and I want to access these values directly like it would be possible with destructuring-bind. See this pointless example:
(defun a-vector ()
(vector 1 2 3 4))
(defun a-list ()
(list 1 2 3 4))
(destructuring-bind (a b c d)
(a-list)
(format t "~D ~D ~D ~D~%" a b c d))
(destructuring-bind (a b c d)
(coerce (a-vector) 'list)
(format t "~D ~D ~D ~D~%" a b c d))
If I coerce the vector into a list it is possible and as performance isn't a problem here, it is maybe fine. But I was wondering if there is a more simple way?
You can bind variables to each cell as follows:
(defmacro with-aref ((&rest indices) array &body body)
(let ((a (gensym)))
`(let ((,a ,array))
(symbol-macrolet
,(loop
for n from 0
for i in indices
collect (list i `(aref ,a ,n)))
,#body))))
You would use it as follows:
(with-aref (w x y z) vec
(setf w (+ x y z)))
With a bit more work, you can also support indices and different categories of accessors. Let's say each binding is a triple (i n k) where i is an identifier, n a number (or nil) that represents the numerical index and k is either :place, :value or nil; :place binds the symbol with symbol-macrolet, :value just binds it with let.
First, let's help the user by providing shortcut notations:
x stands for (x nil nil)
(x o) either stands for (x o nil) or (x nil o), depending on whether option o is a number or a symbol (at macroexpansion time).
Besides, we may want to automatically ignore the nil identifier, the empty symbol || or symbols starting with an underscore (e.g. _, _var).
Here is the normalization function:
(defun normalize-index (index)
(flet ((ret (i n k)
(let ((ignored (or (null i)
(string= i "")
(char= #\_ (char (string i) 0)))))
(list (if ignored (gensym) i) n k ignored))))
(let ((index (alexandria:ensure-list index)))
(typecase index
(null (ret nil nil nil))
(cons (destructuring-bind (i &optional n (k nil kp)) index
(if kp
(ret i n k)
(etypecase n
(symbol (ret i nil n))
((integer 0) (ret i n nil))))))))))
We can apply this normalization to a list of indices, and keep track of ignored symbols:
(defun normalize (indices)
(loop
for i in indices
for norm = (normalize-index i)
for (index number kind ignore) = norm
collect norm into normalized
when ignore
collect index into ignored
finally (return (values normalized ignored))))
Then, we take care of nil numbers in normalized entries. We want the indices to increase from the last used index, or be given explicitly by the user:
(defun renumber (indices)
(loop
for (v n k) in indices
for next = nil then (1+ index)
for index = (or n next 0)
collect (list v index k)))
For example:
(renumber (normalize '(a b c)))
((A 0 NIL) (B 1 NIL) (C 2 NIL))
(renumber (normalize '((a 10) b c)))
((A 10 NIL) (B 11 NIL) (C 12 NIL))
(renumber (normalize '((a 10) (b 3) c)))
((A 10 NIL) (B 3 NIL) (C 4 NIL))
We do the same for the kind of variable we bind:
(defun rekind (indices)
(loop
for (v n k) in indices
for next = nil then kind
for kind = (or k next :place)
collect (list v n kind)))
For example:
(rekind (normalize '(a b c)))
((A NIL :PLACE) (B NIL :PLACE) (C NIL :PLACE))
(rekind (normalize '(a (b :value) c)))
((A NIL :PLACE) (B NIL :VALUE) (C NIL :VALUE))
Finally, all those steps are combined in parse-indices:
(defun parse-indices (indices)
(multiple-value-bind (normalized ignored) (normalize indices)
(values (rekind (renumber normalized))
ignored)))
Finally, the macro is as follows:
(defmacro with-aref ((&rest indices) array &body body)
(multiple-value-bind (normalized ignored) (parse-indices indices)
(labels ((ignored (b) (remove-if-not #'ignoredp (mapcar #'car b)))
(ignoredp (s) (member s ignored)))
(loop
with a = (gensym)
for (i n k) in normalized
for binding = `(,i (aref ,a ,n))
when (eq k :value) collect binding into values
when (eq k :place) collect binding into places
finally (return
`(let ((,a ,array))
(let ,values
(declare (ignore ,#(ignored values)))
(symbol-macrolet ,places
(declare (ignore ,#(ignored places)))
,#body))))))))
For example:
(let ((vec (vector 0 1 2 3 4 5 6 7 8 9 10)))
(prog1 vec
(with-aref ((a 2) (b :value) c _ _ d (e 0) (f 1)) vec
(setf a (list a b c d e f)))))
The above is macroexpanded as:
(LET ((VEC (VECTOR 0 1 2 3 4 5 6 7 8 9 10)))
(LET ((#:G1898 VEC))
(LET ((#:G1901 VEC))
(LET ((B (AREF #:G1901 3))
(C (AREF #:G1901 4))
(#:G1899 (AREF #:G1901 5))
(#:G1900 (AREF #:G1901 6))
(D (AREF #:G1901 7))
(E (AREF #:G1901 0))
(F (AREF #:G1901 1)))
(DECLARE (IGNORE #:G1899 #:G1900))
(SYMBOL-MACROLET ((A (AREF #:G1901 2)))
(DECLARE (IGNORE))
(LET* ((#:G19011902 #:G1901)
(#:NEW1 (LIST (AREF #:G1901 2) B C D E F)))
(FUNCALL #'(SETF AREF) #:NEW1 #:G19011902 2)))))
#:G1898))
It produces the following result
#(0 1 (2 3 4 7 0 1) 3 4 5 6 7 8 9 10)
coredump's answer is lovely. This is a variant of it which binds variables rather than accessors, and also lets you optionally specify indices. So
(with-vector-elements ((a 3) b) x
...)
will bind a to the result of (aref x 3) and b to the result of (aref x 4), for instance.
This is really only useful over coredump's answer if you're intending to (a) not write back to the vector and (b) use the bindings a lot, so you want to avoid a lot of possible arefs (which I don't think compilers can generally optimize away without some fairly strong assumptions).
(defmacro with-vector-elements ((&rest indices) vector &body forms)
(let ((canonical-indices
(loop with i = 0
for index in indices
collect (etypecase index
(symbol
(prog1
`(,index ,i)
(incf i)))
(cons
(destructuring-bind (var idx) index
(assert (and (symbolp var)
(typep idx '(and fixnum (integer 0))))
(var idx) "Invalid index spec")
(prog1
index
(setf i (1+ idx))))))))
(vname (gensym "V")))
`(let ((,vname ,vector))
(let ,(loop for (var index) in canonical-indices
collect `(,var (aref ,vname ,index)))
,#forms))))
There is also a package called metabang-bind - with nickname bind - in which the function bind can handle much more destructuring situations:
(ql:quickload :metabang-bind)
(in-package :metabang-bind)
(bind ((#(a b c) #(1 2 3)))
(list a b c))
;; => (1 2 3)
If not using in-package, you can call the function as bind:bind.
The function bind you can think of roughly as a destructuring-let* (similar idea to clojure's let, however not so clean in syntax but understandable because it has also to handle structs and classes and also values).
All the other use cases it can handle are described here.
I would like to ask you for help with the following:
When I apply a procedure number-of-elements on the list, I need to get a list of pairs, where on the first place in the pair is the element and on the second place (after the dot) there is a number of elements occurred in the list.
For example, when typing this:
(number-of-elements '((a b c) a (b c) c (a b b)))
I got this:
((a . 3) (b . 4) (c . 3))
So far I have a code working on regular list (a b a d).
(define number-of-elements
(lambda (lst)
(define exclude
(lambda (sznm key)
(foldr (lambda (ass result)
(if (equal? (car ass) key)
result
(cons ass result)))
'()
sznm)))
(foldr (lambda (key bag)
(cond ((assoc key bag)
=> (lambda (old)
(let ((new (cons key (+ (cdr old) 1))))
(cons new (exclude bag key)))))
(else (let ((new (cons key 1)))
(cons new bag)))))
'()
lst)))
But if I use it on:
(number-of-elements '((a b c) a (b c) c (a b b)))
I got this:
(((a b c) . 1) (a . 1) ((b c) . 1) (c . 1) ((a b b) . 1))
I know I need to use a deep recursion, but I do not know, how to implement it into the code I actually have.
You already did most of the work counting the elements - but see the different implementations of bagify for a simpler implementation. One straightforward solution for dealing with nested sublists would be to flatten the input list before counting the elements:
(number-of-elements
(flatten
'((a b c) a (b c) c (a b b))))
=> '((a . 3) (b . 4) (c . 3))
If your interpreter doesn't define flatten, it's easy to implement:
(define (flatten lst)
(if (not (list? lst))
(list lst)
(apply append (map flatten lst))))
This is the idiomatic way to think about solutions in Scheme: decompose the problem in parts, then use built-in procedures to solve each subpart, and finally combine them.
(let ((a 3))
(let ((a 4)
(b a))
(+ a b)))
The above code evaluates to 7 the logic being that b takes the value of outer a. According to my understanding, in lexical binding each use of 'let' creates a fresh location. So why is the variable b in the statement (b a) not using the value of a from (a 4)?
Because that's what LET is specified to do. Bindings are done in parallel.
CL-USER 60 > (let ((a 3))
(let ((a 4)
(b a))
(+ a b)))
7
The version where bindings are done in a sequential fashion is called LET*.
CL-USER 61 > (let ((a 3))
(let* ((a 4)
(b a))
(+ a b)))
8
See Special Operator LET, LET*.
(let ((a 4)
(b a))
(+ a b)) ; ==> 7
Is equivalent to writing:
((lambda (a b)
(+ a b))
4
a) ; ==> 7
Do you see from this version that it's logical that a and b are bound after the evaluation of 4 and a?
Now we have:
(let* ((a 4)
(b a))
(+ a b)) ; ==> 8
which is equivalent to:
(let ((a 4))
(let ((b a))
(+ a b))) ; ==> 8
Here the second let is in the body of the first. a is 4 when the expression for b is evaluated.
I am new to lisp, and here is my question:
I have a list that is something like
((a ((length 3) (size 5))) (b ((length 5) (size 7))))...
The above list is just a sample.
What I am trying to have is a function find that can work like a database query, for example
(find (and (gt length 4) (lt size 8)))
I this case, the above function should find b for me. Note that the conditional argument of this function can be expand with and or or ...
I did some research and know eval can somehow help me with this, but I am not sure how it works exactly.Can someone please show me an example or give me some hint on this?
Thank you
I would not use eval for this. But it would be relatively easy to do so.
You have a sequence of items:
((a ((length 3) (size 5)))
(b ((length 5) (size 7))))
You have a test description, like this:
(and (> length 4) (< size 8))
Now you want to see if
(my-equal '(and (> length 4) (< size 8)) '((length 5) (size 7))
is true.
So the task would be to write MY-EQUAL. Typically I would write it as a recursive function.
But if you want to do it with EVAL, it gets relatively easy:
You want to eval this form:
(let ((length 5) (size 7))
(and (> length 4) (< size 8)))
Now it should be easy to write MY-EQUAL.
You can use it then as
(find term sequence :test #'my-equal :key #'second)
Note, that evaluation of arbitrary code read from a stream is a security risk.
Bonus
We can use COMPILE instead of EVAL:
(defun lookup (v bindings)
(let ((result (assoc v bindings)))
(if result
(second result)
(error "variable ~a not known" v))))
(defparameter *query-operators* '(and or > < =))
(defun generate-query-code (q bindings)
(cond ((numberp q) q)
((symbolp q) `(lookup ',q ,bindings))
((consp q)
(destructuring-bind (op . args)
q
(if (member op *query-operators*)
`(,op ,#(mapcar (lambda (arg)
(generate-query-code arg bindings))
args))
(error "Unknown op ~a" op))))))
(defun compile-query (q)
(compile nil
(let* ((bindings (gensym "bindings"))
(code (generate-query-code q bindings)))
`(lambda (,bindings)
,code))))
(defun find-query (query descriptions)
(find-if (compile-query query)
descriptions
:key #'second))
Example:
CL-USER 39 > (find-query '(and (> length 4) (< size 8))
'((a ((length 3) (size 5)))
(b ((length 5) (size 7)))))
(B ((LENGTH 5) (SIZE 7)))
This blog post looks related to your problem: http://xach.livejournal.com/131456.html
(you have to expand it with a small mapping between length and size and actual values for each of your records, so the closure chain can be called on each of your records)
I have an implementation of BFS I got elsewhere and modified slightly, but I am having problems with its input.
It takes a graph, and will take it as '((a b c) (b c) (c d))
But my input I am giving it is a weighted graph... I know it's not useful for the BFS, but I use the weights farther down the line later. This input looks like
'(
(a (b 3) (c 1))
(b (a 3) (d 1))
(c (a 1) (d2) (e 2))
)
And so on.
My code:
(defun shortest-path (start end net)
(BFS end (list (list start)) net))
(defun BFS (end queue net)
(if (null queue)
nil
(expand-queue end (car queue) (cdr queue) net)))
(defun expand-queue (end path queue net)
(let ((node (car path)))
(if (eql node end)
(reverse path)
(BFS end
(append queue
(new-paths path node net))
net))))
(defun new-paths (path node net)
(mapcar #'(lambda (n)
(cons n path))
(cdr (assoc node net))))
I'm just not sure where I need to most likely modify it to accept the new style list, or make a help function to format it correctly?
You need to specify what the list that represents your graph means. Currently you have only given an example list.
When the graph has a syntax like:
graph = (node*)
node = (name nextnodename*)
name = SYMBOL
nextnodename = SYMBOL
Then a transformation function might be:
(defun convert-graph (graph)
(mapcar (lambda (node)
(destructuring-bind (name . nodes) node
(cons name (mapcar #'first nodes))))
graph))
or if you might need other extraction functions:
(defun convert-graph (graph &key (key #'first))
(mapcar (lambda (node)
(destructuring-bind (name . nodes) node
(cons name (mapcar key nodes))))
graph))
Example:
(convert-graph '((a (b 3) (c 1))
(b (a 3) (d 1))
(c (a 1) (d 2) (e 2)))
:key #'first)
((A B C) (B A D) (C A D E))
Now you might need to remove duplicate links. But this depends on the syntax and semantics of your graph description.