Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Re: How to destructure list to places?
72 views
Skip to first unread message
WJ
Mar 19, 2012, 8:45:44 PM3/19/12
to
Matthew Danish wrote:
> (destructuring-bind (a b (c d)) (list 1 2 (list 3 4))
> (list b c d a))
Clojure:
(let [[a b [c d]] (list 1 2 (list 3 4))]
(list b c d a))
==> (2 3 4 1)
> (destructuring-bind (a b (c d)) (list 1 2 (list 3 4))
> (list b c d a))
Clojure:
(let [[a b [c d]] (list 1 2 (list 3 4))]
(list b c d a))
==> (2 3 4 1)
WJ
May 10, 2012, 11:53:12 PM5/10/12
to
(match-let ([`(,a ,b (,c ,d)) '(1 2 (3 4))]) (list b c d a))
=> '(2 3 4 1)
(match-let ([(list a b (list c d)) '(1 2 (3 4))]) (list b c d a))
=> '(2 3 4 1)
(match-let ([(list (? odd? odds) ... more ...) '(3 5 7 8 9)])
(list odds more))
=> '((3 5 7) (8 9))
WJ
May 10, 2012, 11:59:56 PM5/10/12
to
'((1 2 3) (4 5))
Norbert_Paul
May 11, 2012, 3:33:22 AM5/11/12
to
I once did it for fun to have sort of a "poor man's struct".
Here
(destructuring-bind tree . body)
is equivalent to
(with-cons-places (tree) . body)
.
In other words: (tree) is a forest which consists of one tree.
----%<-------------------------------------------------------%<----
(defmacro with-cons-places (forest &body body)
"Locally defines accessors via flet to the leafs of each car/cdr tree defined in the
specified forest - a list of lists. Each list in the specified forest defines one tree.
So it is possible to define a hierarchy of accessors to non-leaf-nodes.
Each non-nil symbol acc which occurs in one tree lst denotes an accessor acc
such that
(eq (acc lst) 'acc) is true.
Keyword symbols will be ignored. So if one specifies ((a b) . :ignore) as a tree
only the accessors a (with #'a = #'caar and #(setf a) = #'(setf caar))
and b (with #'b = #'cadar and #'(setf b) = #'(setf cadar)) will be defined.
Examples:
(with-cons-places ((search-key . attached-value))
(let ((data '((:a-key . :a-value)
(:another-key . :another-value)
(:some-key . :old-value))))
(setf (attached-value (find :some-key data :key #'search-key))
:new-value )
(attached-value (find :some-key data :key #'search-key))))
==>
:new-value
(with-cons-places (( row-col . attached-value)
((row col) . :dont-ignore)) ; will be ignored anyway
(let ((matrix '( ((1 1) . :a11) ((1 2) . :a12) ((1 3) . :a13)
((2 2) . :a22)
((3 1) . :a31) ((3 3) . :a33))))
(flet ((row-n (mat n) (remove n mat
:key #'row
:test (complement #'eql)))
(col-m (mat m) (remove m mat
:key #'col
:test (complement #'eql))))
(col-m matrix 2))))
==>
(((1 2) . :A12) ((2 2) . :A22))
(with-cons-places ((() () () () () () () () () () eleventh twelvth thirteenth))
(eleventh '(1 2 3 4 5 6 7 8 9 10 12)))
==> 12
(let ((lst (list 1 2 3 4 5 6 7 8 9 10 12)))
(with-cons-places ((() () () () () () () () () () eleventh twelvth thirteenth))
(setf (eleventh lst) 11)
lst ))
==> (1 2 3 4 5 6 7 8 9 10 11)
"
(labels ((cons-places (tree &optional (result ()))
(cond ((null tree) ())
((keywordp tree) ()) ; ignore keywords
((symbolp tree) (list (cons tree ; well, actually, its leaf.
(reverse result))))
((atom tree) ()) ; this is an error.
(T
(append
(cons-places (car tree) (cons 'car result))
(cons-places (cdr tree) (cons 'cdr result))))))
;; concatenates sequences (cxr cyr czr) into czyxr or fourth, ..., tenth
;; note the inversion in order from (.x. .y. .z.) to .zyx.
(pack-cons-place (lst &aux (pos 0))
(cond ((null lst) nil)
((null (cdr lst)) lst)
((null (cddr lst))
(cond ((equal lst '(car car)) '(caar))
((equal lst '(cdr car)) '(cadr))
((equal lst '(car cdr)) '(cdar))
((equal lst '(cdr cdr)) '(cddr))
(T lst))) ; be safe
((null (cdddr lst))
(cond ((equal lst '(car car car)) '(caaar))
((equal lst '(car cdr car)) '(cadar))
((equal lst '(car car cdr)) '(cdaar))
((equal lst '(car cdr cdr)) '(cddar))
((equal lst '(cdr car car)) '(caadr))
((equal lst '(cdr cdr car)) '(caddr))
((equal lst '(cdr car cdr)) '(cdadr))
((equal lst '(cdr cdr cdr)) '(cdddr))
( T lst))) ; be safe
((null (cddddr lst))
(cond ((equal lst '(car car car car)) '(caaaar))
((equal lst '(car car cdr car)) '(cadaar))
((equal lst '(car car car cdr)) '(cdaaar))
((equal lst '(car car cdr cdr)) '(cddaar))
((equal lst '(car cdr car car)) '(caadar))
((equal lst '(car cdr cdr car)) '(caddar))
((equal lst '(car cdr car cdr)) '(cdadar))
((equal lst '(car cdr cdr cdr)) '(cdddar))
((equal lst '(cdr car car car)) '(caaadr))
((equal lst '(cdr car cdr car)) '(cadadr))
((equal lst '(cdr car car cdr)) '(cdaadr))
((equal lst '(cdr car cdr cdr)) '(cddadr))
((equal lst '(cdr cdr car car)) '(caaddr))
((equal lst '(cdr cdr cdr car)) '(cadddr))
((equal lst '(cdr cdr car cdr)) '(cdaddr))
((equal lst '(cdr cdr cdr cdr)) '(cddddr))
( T lst))) ; be safe
;; first to tenth are applicable.
;; Note: first to fourth are already handled by the previous cases:
;; car, cadr, caddr, or cadddr.
((< (setf pos (position 'car lst)) ; relies on the fact, that only car and cdr exists in lst
9)
(cons (nth pos '(first second third fourth fifth sixth seventh eighth ninth tenth))
(pack-cons-place (nthcdr pos (cdr lst)))))
;; split up the sequence into subsequences of length at most 4.
(T (append (pack-cons-place (list (car lst) (cadr lst) (caddr lst) (cadddr lst)))
(pack-cons-place (cddddr lst)))))))
(let* ((accessors (mapcan #'cons-places forest))
(names (mapcar #'car accessors))
(functions (mapcan #'(lambda (name-acc)
(let ((name (car name-acc))
(accessor
(pack-cons-place
(cdr name-acc)))
(result 'X))
(dolist (acc accessor)
(setf result `(,acc ,result)))
`((,name (X) ,result) ; the reader
((setf ,name) (Y X) (setf ,result Y))))) ; the writer
accessors)))
`(flet ,functions
(declare (ignorable ,@(mapcan #'(lambda (name)
`((function ,name) (function (setf ,name))))
names)))
. ,body))))
----%<-------------------------------------------------------%<----
Norbert
Here
(destructuring-bind tree . body)
is equivalent to
(with-cons-places (tree) . body)
.
In other words: (tree) is a forest which consists of one tree.
----%<-------------------------------------------------------%<----
(defmacro with-cons-places (forest &body body)
"Locally defines accessors via flet to the leafs of each car/cdr tree defined in the
specified forest - a list of lists. Each list in the specified forest defines one tree.
So it is possible to define a hierarchy of accessors to non-leaf-nodes.
Each non-nil symbol acc which occurs in one tree lst denotes an accessor acc
such that
(eq (acc lst) 'acc) is true.
Keyword symbols will be ignored. So if one specifies ((a b) . :ignore) as a tree
only the accessors a (with #'a = #'caar and #(setf a) = #'(setf caar))
and b (with #'b = #'cadar and #'(setf b) = #'(setf cadar)) will be defined.
Examples:
(with-cons-places ((search-key . attached-value))
(let ((data '((:a-key . :a-value)
(:another-key . :another-value)
(:some-key . :old-value))))
(setf (attached-value (find :some-key data :key #'search-key))
:new-value )
(attached-value (find :some-key data :key #'search-key))))
==>
:new-value
(with-cons-places (( row-col . attached-value)
((row col) . :dont-ignore)) ; will be ignored anyway
(let ((matrix '( ((1 1) . :a11) ((1 2) . :a12) ((1 3) . :a13)
((2 2) . :a22)
((3 1) . :a31) ((3 3) . :a33))))
(flet ((row-n (mat n) (remove n mat
:key #'row
:test (complement #'eql)))
(col-m (mat m) (remove m mat
:key #'col
:test (complement #'eql))))
(col-m matrix 2))))
==>
(((1 2) . :A12) ((2 2) . :A22))
(with-cons-places ((() () () () () () () () () () eleventh twelvth thirteenth))
(eleventh '(1 2 3 4 5 6 7 8 9 10 12)))
==> 12
(let ((lst (list 1 2 3 4 5 6 7 8 9 10 12)))
(with-cons-places ((() () () () () () () () () () eleventh twelvth thirteenth))
(setf (eleventh lst) 11)
lst ))
==> (1 2 3 4 5 6 7 8 9 10 11)
"
(labels ((cons-places (tree &optional (result ()))
(cond ((null tree) ())
((keywordp tree) ()) ; ignore keywords
((symbolp tree) (list (cons tree ; well, actually, its leaf.
(reverse result))))
((atom tree) ()) ; this is an error.
(T
(append
(cons-places (car tree) (cons 'car result))
(cons-places (cdr tree) (cons 'cdr result))))))
;; concatenates sequences (cxr cyr czr) into czyxr or fourth, ..., tenth
;; note the inversion in order from (.x. .y. .z.) to .zyx.
(pack-cons-place (lst &aux (pos 0))
(cond ((null lst) nil)
((null (cdr lst)) lst)
((null (cddr lst))
(cond ((equal lst '(car car)) '(caar))
((equal lst '(cdr car)) '(cadr))
((equal lst '(car cdr)) '(cdar))
((equal lst '(cdr cdr)) '(cddr))
(T lst))) ; be safe
((null (cdddr lst))
(cond ((equal lst '(car car car)) '(caaar))
((equal lst '(car cdr car)) '(cadar))
((equal lst '(car car cdr)) '(cdaar))
((equal lst '(car cdr cdr)) '(cddar))
((equal lst '(cdr car car)) '(caadr))
((equal lst '(cdr cdr car)) '(caddr))
((equal lst '(cdr car cdr)) '(cdadr))
((equal lst '(cdr cdr cdr)) '(cdddr))
( T lst))) ; be safe
((null (cddddr lst))
(cond ((equal lst '(car car car car)) '(caaaar))
((equal lst '(car car cdr car)) '(cadaar))
((equal lst '(car car car cdr)) '(cdaaar))
((equal lst '(car car cdr cdr)) '(cddaar))
((equal lst '(car cdr car car)) '(caadar))
((equal lst '(car cdr cdr car)) '(caddar))
((equal lst '(car cdr car cdr)) '(cdadar))
((equal lst '(car cdr cdr cdr)) '(cdddar))
((equal lst '(cdr car car car)) '(caaadr))
((equal lst '(cdr car cdr car)) '(cadadr))
((equal lst '(cdr car car cdr)) '(cdaadr))
((equal lst '(cdr car cdr cdr)) '(cddadr))
((equal lst '(cdr cdr car car)) '(caaddr))
((equal lst '(cdr cdr cdr car)) '(cadddr))
((equal lst '(cdr cdr car cdr)) '(cdaddr))
((equal lst '(cdr cdr cdr cdr)) '(cddddr))
( T lst))) ; be safe
;; first to tenth are applicable.
;; Note: first to fourth are already handled by the previous cases:
;; car, cadr, caddr, or cadddr.
((< (setf pos (position 'car lst)) ; relies on the fact, that only car and cdr exists in lst
9)
(cons (nth pos '(first second third fourth fifth sixth seventh eighth ninth tenth))
(pack-cons-place (nthcdr pos (cdr lst)))))
;; split up the sequence into subsequences of length at most 4.
(T (append (pack-cons-place (list (car lst) (cadr lst) (caddr lst) (cadddr lst)))
(pack-cons-place (cddddr lst)))))))
(let* ((accessors (mapcan #'cons-places forest))
(names (mapcar #'car accessors))
(functions (mapcan #'(lambda (name-acc)
(let ((name (car name-acc))
(accessor
(pack-cons-place
(cdr name-acc)))
(result 'X))
(dolist (acc accessor)
(setf result `(,acc ,result)))
`((,name (X) ,result) ; the reader
((setf ,name) (Y X) (setf ,result Y))))) ; the writer
accessors)))
`(flet ,functions
(declare (ignorable ,@(mapcan #'(lambda (name)
`((function ,name) (function (setf ,name))))
names)))
. ,body))))
----%<-------------------------------------------------------%<----
Norbert
Tim Bradshaw
May 11, 2012, 3:47:09 AM5/11/12
to
On 2012-05-11 03:53:12 +0000, WJ said:
> ([`(,a ,b (,c ,d)) '(1 2 (3 4))])
Oh man, more of this shit. Two kinds of brackets, two kinds of quotes
> ([`(,a ,b (,c ,d)) '(1 2 (3 4))])
neither of which matches, and commas in front of things? Yuck.
Espen Vestre
May 11, 2012, 3:57:28 AM5/11/12
to
Tim Bradshaw <t...@tfeb.org> writes:
> Oh man, more of this shit. Two kinds of brackets, two kinds of quotes
> neither of which matches, and commas in front of things? Yuck.
Can't you just put him in your kill file? He has the honor of being the
> Oh man, more of this shit. Two kinds of brackets, two kinds of quotes
> neither of which matches, and commas in front of things? Yuck.
only person in my kill file, so I just see the noise when you and others
keep commenting it.
--
(espen)
Tim Bradshaw
May 11, 2012, 6:09:20 AM5/11/12
to
On 2012-05-11 07:57:28 +0000, Espen Vestre said:
> Can't you just put him in your kill file? He has the honor of being the
> only person in my kill file, so I just see the noise when you and others
> keep commenting it.
No! Baiting him is the sole purpose of my existence. It took me a long
> Can't you just put him in your kill file? He has the honor of being the
> only person in my kill file, so I just see the noise when you and others
> keep commenting it.
time to realise this: I assumed my purpose was to lounge on the lawn in
the smaller rose garden, occasionally calling for another whisky and
soda[*], but no, I now realise it is to bait WJ. I have my newsreader
set up so his articles flash red, sound bells and cause immediate
termination of all other applications on my computing appliance, and
the butler has instructions to wake me at any time, day or night, if he
posts. He has so far proved unwilling to do so, but I will have words.
I'm afraid your only solution is to put me in your kill file. I'd
suggest everyone do that, in fact.
--t
[*] In the summer, obviously: in the winter I am to be found in the
library, or sometimes on my yacht, which I have kept in a sunnier part
of the world.
Espen Vestre
May 11, 2012, 6:32:17 AM5/11/12
to
LOL :-)
> I'm afraid your only solution is to put me in your kill file. I'd
> suggest everyone do that, in fact.
I'm sorry Dave^WTim, I can't do that after reading this!
--
(espen)
> I'm afraid your only solution is to put me in your kill file. I'd
> suggest everyone do that, in fact.
--
(espen)
Tim Bradshaw
May 11, 2012, 6:44:55 AM5/11/12
to
On 2012-05-11 10:32:17 +0000, Espen Vestre said:
> I'm sorry Dave^WTim, I can't do that after reading this!
It's OK, I'll send a man round to do it.
> I'm sorry Dave^WTim, I can't do that after reading this!
WJ
Dec 20, 2014, 1:14:38 PM12/20/14
to
WJ wrote:
> Matthew Danish wrote:
>
> > (destructuring-bind (a b (c d)) (list 1 2 (list 3 4))
> > (list b c d a))
Gauche Scheme:
> Matthew Danish wrote:
>
> > (destructuring-bind (a b (c d)) (list 1 2 (list 3 4))
> > (list b c d a))
(use util.match)
(match-let1 (a (b (c (d ...)))) '(2 (3 (4 (5 6 7 8 9))))
(list d c b a))
===>
((5 6 7 8 9) 4 3 2)
WJ
Dec 16, 2015, 3:11:03 PM12/16/15
to
Why this is marked as abuse? It has been marked as abuse.
Report not abuse
WJ wrote:
> WJ wrote:
>
> > Matthew Danish wrote:
> >
> > > (destructuring-bind (a b (c d)) (list 1 2 (list 3 4))
> > > (list b c d a))
MatzLisp (Ruby):
> WJ wrote:
>
> > Matthew Danish wrote:
> >
> > > (destructuring-bind (a b (c d)) (list 1 2 (list 3 4))
> > > (list b c d a))
a,b,(c,d) = [1,2,[3,4]] ; [b,c,d,a]
==>[2, 3, 4, 1]
--
Africans gang-rape and clitorectomize Finnish girl; government arrests Finn
whom they accuse of complaining:
conservative-headlines.com/2009/03/another-european-awaits-extradition-for-hate-speech
0 new messages