chickadee » tree-walkers

Rationale

This module provides routines, to access and traverse trees, i.e. nested pseudo-lists, as well as some list routines. They all help writing pattern matching and procedural macros.

In particular, there is a replacement of car, cdr and consorts by one operator, walk, of integer arguments, or, to be more precise, by +1 and -1: (walk -1) is car, (walk 1) cdr, (walk) is identity. These operaters can (and will) be composed, so, for example, (walk -1 1 1) is (o (walk -1) (walk 1) (walk 1)), in other words caddr.

The more arguments you give to walk, the deeper you can dig into a tree. If you like, you can interprete the arguments of walk as a path for traversing the tree. For compatibility with the c*r routines, you interprete the arguments of walk from right to left. It might be more convenient, to do it left to right; walk* does this.

Other routines, which walk a tree, are provided as well. In particular, we provide a routine, tree->pathes, which maps a tree to a flat list of pairs, containing the tree's items and the corresponding pathes to access that items. This list can be used, to destructure similarly shaped trees.

This way, we can use one tree as a pattern and take its pathes to destructure another tree, i.e. another nested pseudolist. You gess it: This will make pattern matching and writing procedural macros easy.

Some routines, which might be helpfull in macro-writing or tree-analysing, are provided as well, for example map*, filter* and friends.

API

values->list

(values->list vals)syntax

transforms values, vals, into a list

list->values

list->values lstprocedure

transforms a list, lst, into a values

list-values

list-values proc #!rest argsprocedure

transforms the resulting values of calling proc with args into a list. Used in tests most of the time

always

always xprprocedure

returns a procedure of arbitrary many arguments, which always returns the value of xpr, whatever it's arguments are given

filter

filter ok? lstprocedure

splits a list into two sublists, one that pass the ok? test and one that doesn't

filter*

filter* ok? treeprocedure

filters a tree according to the predicate ok? respecting the tree structure

filter-pairs

filter-pairs ok? pairsprocedure

splits a list of pairs into two sublists, one that pass the ok? test on the cars and one that doesn't

at

at nprocedure

at n lstprocedure

the second takes the nth item of the list lst, the first is a curried version of the second.

take

take nprocedure

take n lstprocedure

the second takes the first n items of the list lst, the first is a curried version of the second.

drop

drop nprocedure

drop n lstprocedure

the second drops the first n items of the list lst, the first is a curried version of the second.

split-at

split-at n plsprocedure

splitting a pseudo-list in two sublists, head and tail, the sublist head excluding the nth item and the pseudolist tail starting with nth item.

split-when

split-when ok? lstprocedure

splitting a list in two sublists, head and tail, the sublist head before the first item passing the ok? test, the sublist tail starting at that item.

take-while

take-while ok?procedure

take-while ok? lstprocedure

the second takes the first items of the list lst, which pass the ok? test; the first is a curried version of the second.

drop-while

drop-while ok?procedure

drop-while ok? lstprocedure

the second drops the first items of the list lst, which pass the ok? test; the first is a curried version of the second.

every?

every? ok?procedure

every? ok? xsprocedure

checks, if every item of the list xs passes the ok? test. The first is the curried version of the second call.

all?

all? op?procedure

returns a predicate, which tests, if all items of it's only argument, a list, are pairweise passed by the binary predicate op?)

some?

some? ok?procedure

some? ok? xsprocedure

checks, if some item of the list xs passes the ok? test. The first is the curried version of the second call.

none?

none? ok?procedure

none? ok? xsprocedure

checks, if no item of the list xs passes the ok? test. The first is the curried version of the second call.

pseudo-list?

pseudo-list? xprprocedure

checks, if xpr evaluates to a pair, which is not a list, or to an atom which is not null.

pseudo-length

pseudo-length plsprocedure

returns the length of a pseudo-list or list

pseudo-head

pseudo-head plsprocedure

returns the head of a pseudo-list, i.e. the list stripped-of the sentinel. In case of a list, the list itself is returned.

pseudo-tail

pseudo-tail plsprocedure

returns the sentinel of a pseudo-list, i.e. null in the case of lists

pseudo-list-of?

pseudo-list-of? ok?procedure

returns a procedure, which checks, if its only argument is a pseudo-list, whose items pass the ok? test. A pseudo-list is not a list, except ok? is null? or atom?

indexes

indexes xsprocedure

returns the indexes of the list xs.

tree-of?

tree-of? ok?procedure

returns a procedure, which checks, if its only argument is a tree, whose items pass the ok? test.

iterate

iterate fn kprocedure

iterate fn k argprocedure

The second applies the function fn successively k times to the argument arg. The first is a curried version of the second.

map*

map* fn tree #!rest treesprocedure

maps a function, fn, over a list of trees

when-map*

when-map* ok? fn treeprocedure

map fn recursively over tree, but only on those expressions, which pass the ok? test

map**

map** fn pat #!rest treesprocedure

returns two values, mapping recursively pat and trees with fn.

flatten*

flatten* pairsprocedure

transforms a nested list of pairs into a flat list of pairs

zip2

zip2 xlsprocedure

transforms a list of pairs into a pair of lists

unzip*

unzip* treesprocedure

transforms a list of equally shaped nested pseudo-lists into a nested list of lists or atoms

walk

walk #!rest ksprocedure

creates a procedure, which accesses a tree along the nonzero exact integers ks from right to left, where 1 represents cdr, -1 car.

walk*

walk* #!rest ksprocedure

the same as walk, but the ks are accessed from left to right

memp

memp ok? lstprocedure

returns the sublist of lst, whose first item passes the ok? test, or #f if no item passes it.

dups-remove

dups-remove =? lstprocedure

removes duplicates from the list lst, compared by the binary function =?

and?

and? #!rest xprsprocedure

procedure version of and, so that apply is usable

sublist

sublist lst fromprocedure

sublist lst from uptoprocedure

returns the sublist of a list, lst, starting from indox from included up to index upto excluded. If the argument upto is missing, the length of lst is used instead.

tree->pathes

tree->pathes patprocedure

transforms a nested pseudo-list, pat, breadth-first into a flat list of pairs consisting of the nested pseudo-list's items and the pathes to reach these items

pathes

pathes item treeprocedure

returns a list of pathes, where each path is a list of integers, which, when fed to walk, would return the item in the tree.

same-shape?

same-shape? tree1 tree2procedure

checks, if both trees have the same shape, i.e. have items in the same position.

pseudo->accessors

pseudo->accessors patprocedure

pseudo->accessors pat walkerprocedure

transforms a flat pseudo-list, pat, into a flat list of triples consisting of the pseudo-list's atoms, the procedures to reach these atoms and the expressions describing these procedures. If walker is not given, 'walk is assumed.

tree->accessors

tree->accessors patprocedure

tree->accessors pat walkerprocedure

transforms a flat pseudo-list, pat, into a flat list of triples consisting of the pseudo-list's atoms, the procedures to reach these atoms and the expressions describing these procedures. If walker is not given, 'walk is assumed.

apply-accessors

apply-accessors pat treeprocedure

apply-accessors pat tree map?procedure

applies or maps, if map? is true, all accessors to a tree.

all-match?

all-match? treeprocedure

tree xssprocedure

Returns a procedure, which tests, if all accessors match its only argument xss. Shows the item, the corresponding path and the argument of the first failing accessor.

tree-walkers

tree-walkersprocedure

tree-walkers symprocedure

with sym: documentation of exported symbol without sym: list of exported symbols

Examples

(import tree-walkers)

((iterate cdr 2) '(1 2 3))
;-> (quote (3))

((walk -2 1 -1 1) '(a (b (c)) d))
;-> (quote c)

((walk 3) '(a (b (c)) d))
;-> (quote ())

((walk -4) '((((x)))))
;-> (quote x)

((walk -1 1 -1 1) '(a (b x) c))
;-> (quote x)

((walk -1 1 -1 1) '(a (b x) c y))
;-> (quote x)

((walk -1 1 1 1) '(a (b x) c y))
;-> (quote y)

(tree->pathes '(a b . c))
;-> (quote ((a (-1)) (b (-1 1)) (c (1 1))))

(tree->pathes '(a b c))
;-> (quote ((a (-1)) (b (-1 1)) (c (-1 1 1)) (() (1 1 1))))

(tree->pathes '(a (b c) d))
;-> (quote ((a (-1)) (d (-1 1 1)) (() (1 1 1)) (b (-1 -1 1)) (c (-1 1 -1 1)) (() (1 1 -1 1))))

(tree->pathes '(a (b (c)) d))
;-> (quote ((a (-1)) (d (-1 1 1)) (() (1 1 1)) (b (-1 -1 1)) (() (1 1 -1 1)) (c (-1 -1 1 -1 1)) (() (1 -1 1 -1 1))))

(tree->pathes '(a (b . c) . d))
;-> (quote ((a (-1)) (d (1 1)) (b (-1 -1 1)) (c (1 -1 1))))

(pathes 'a '(((((a))))))
;-> (quote ((-1 -1 -1 -1 -1)))

(pathes 'c '(a (b . c) d))
;-> (quote ((1 -1 1)))

(pathes '() '(a (b (c)) d))
;-> (quote ((1 1 1) (1 1 -1 1) (1 -1 1 -1 1)))

(pathes 'c '(a (b (c)) d))
;-> (quote ((-1 -1 1 -1 1)))

(pathes 'a '(a a))
;-> (quote ((-1) (-1 1)))

(pathes 'a 'a)
;-> (quote (()))

(map (lambda (triple) `(,(car triple) ,(caddr triple)))
     (tree->accessors '(a (b . c) d) 'walk))
;-> (quote ((a (walk -1)) (d (walk -1 1 1)) (() (walk 1 1 1)) (b (walk -1 -1 1)) (c (walk 1 -1 1))))

(let ((pat '(a (b . c) . d)))
  (map (lambda (proc) (proc pat)) (map cadr (tree->accessors pat))))
;-> (quote (a d b c))

(let ((pat '(a (b c) d)))
  (map (lambda (proc) (proc pat)) (map cadr (tree->accessors pat))))
;-> (quote (a d () b c ()))

(let ((pat '(a (b (c . d)) (e . f))))
  (map (lambda (proc) (proc pat)) (map cadr (tree->accessors pat))))
;-> (quote (a () b () c d e f))

((pseudo-list-of? atom?) '(a b c))
;-> #t

((pseudo-list-of? symbol?) '(a b c))
;-> #f

((pseudo-list-of? symbol?) '(a b . c))
;-> #t

((pseudo-list-of? atom?) '())
;-> #t

((pseudo-list-of? symbol?) 'a)
;-> #t

((tree-of? symbol?) '(a (b . c) . d))
;-> #t

((tree-of? symbol?) '(a (b . c) d))
;-> #f

((tree-of? (disjoin symbol? null?)) '(a (b . c) d))
;-> #t

((all-match? '(a (b . c) . d)) '(a (b . c) . d))
;-> #t

((all-match? '(a (b . c) . d)) '(1 (2 3) 4))
;-> #t

((all-match? '(a (b c) d)) '(1 (2 3) 4))
;-> #t

((all-match? '(a (#f c) d)) '(1 (2 3) 4))
;-> #t

((all-match? '(a (#f c) d)) '(1 (#f 3) 4))
;-> #t

((all-match? '(a b)) '(1))
;-> #f

(same-shape? '(a (b (c) d) e) '(1 (2 (3) 4) 5))
;-> #t

(same-shape? '(a (b (c) d) e) '(1 (2 (3 0) 4) 5))
;-> #f

(and? (eqv? 'a 'a) (eqv? 1 1) (equal? "foo" "foo"))
;-> #t

(and? (eqv? 'a 'a) (equal? "foo" "bar") (eqv? 1 1))
;-> #f

(none? odd? '(0 2))
;-> #t

(none? odd? '(0 1 2 3))
;-> #f

(some? odd? '(0 2))
;-> #f

(some? odd? '(1 2))
;-> #t

(every? odd? '(1 3))
;-> #t

(every? odd? '(0 1 2 3))
;-> #f

((all? same-shape?) '((1 2) (10 20) (100 200)))
;-> #t

((all? same-shape?) '((1 2) (10 20) (100 200)))
;-> #t

((all? same-shape?) '((1 2) (10 . 20) (100 200)))
;-> #f

(map* add1 0)
;-> 1

(map* add1 '(0 (1 2)))
;-> (quote (1 (2 3)))

(map* add1 '(0 (1 . 2)))
;-> (quote (1 (2 . 3)))

(when-map* (list-of? atom?) list->vector '((1) (2)))
;-> (quote (#(1) #(2)))

(when-map* (list-of? atom?) list->vector '((1) ((2) (3))))
;-> (quote (#(1) (#(2) #(3))))

(when-map* (list-of? atom?) list->vector '((1) ((2) 0 (3))))
;-> (quote (#(1) (#(2) 0 #(3))))

(when-map* (conjoin integer? even?) add1 '(0 (1 2 (3))))
;-> (quote (1 (1 3 (3))))

(list-values map** list '(a b) '(1 2))
;-> (quote (((a) (b)) ((1) (2))))

(list-values map** list '(a (b c) d) '(1 (2 (3 4)) #(5 6)))
;-> (quote (((a) ((b) (c)) (d)) ((1) ((2) ((3) (4))) (#(5 6)))))

(list-values map** list '(a b) '(1 2) '(10 20))
;-> (quote (((a) (b)) ((1 10) (2 20))))

(list-values map** list '(a (b c) d) '(1 (2 (3)) 4) '(10 (20 (30)) 40))
;-> (quote (((a) ((b) (c)) (d)) ((1 10) ((2 20) ((3 30))) (4 40))))

(values->list (filter odd? '(0 1 2 3)))
;-> (quote ((1 3) (0 2)))

(list-values filter odd? '(0 1 2 3))
;-> (quote ((1 3) (0 2)))

(values->list (filter-pairs odd? '((0 a) (1 b) (2 c) (3 d))))
;-> (quote (((1 b) (3 d)) ((0 a) (2 c))))

(list-values filter-pairs odd? '((0 a) (1 b) (2 c) (3 d)))
;-> (quote (((1 b) (3 d)) ((0 a) (2 c))))

(filter* odd? '(0 1 2 3))
;-> (quote (1 3))

(filter* odd? '(0 (1 2 3)))
;-> (quote ((1 3)))

(filter* odd? '(0 1 (2 3 (4 5) 6 7) 8 9))
;-> (quote (1 (3 (5) 7) 9))

(filter* odd? '(0 (2 (4) 6) 8))
;-> (quote ((())))

(filter* odd? '(1 (3 (5) 7) 9))
;-> (quote (1 (3 (5) 7) 9))

(values->list (list->values '(1 2 3)))
;-> (quote (1 2 3))

(values->list (list->values (values->list (values 1 2 3))))
;-> (quote (1 2 3))

(values->list (split-at 2 '(0 1 2 3)))
;-> (quote ((0 1) (2 3)))

(list-values split-at 2 '(0 1 2 3))
;-> (quote ((0 1) (2 3)))

(drop 2 '(0 1 2 3))
;-> (quote (2 3))

(take 2 '(0 1 2 3))
;-> (quote (0 1))

(values->list (split-when odd? '(0 1 2 3)))
;-> (quote ((0) (1 2 3)))

(list-values split-when odd? '(0 1 2 3))
;-> (quote ((0) (1 2 3)))

(take-while odd? '(1 3 2 4))
;-> (quote (1 3))

(drop-while odd? '(1 3 2 4))
;-> (quote (2 4))

(memp integer? '(a b c))
;-> #f

(memp integer? '(a b 1 c))
;-> (quote (1 c))

(sublist '(0 1 2 3 4) 1 3)
;-> (quote (1 2))

(sublist '(0 1 2 3 4) 4)
;-> (quote (4))

(indexes '(a b c d))
;-> (quote (0 1 2 3))

(unzip* '(1 2 3))
;-> (quote (1 2 3))

(unzip* '((1 2) (1 2) (1 2)))
;-> (quote ((1 1 1) (2 2 2)))

(unzip* '((1 . 2) (1 . 2) (1 . 2)))
;-> (quote ((1 1 1) 2 2 2))

(unzip* '((1 (2 3)) (1 (2 3)) (1 (2 3))))
;-> (quote ((1 1 1) ((2 2 2) (3 3 3))))

(unzip* '((0 (1 . 2)) (0 (1 . 2)) (0 (1 . 2))))
;-> (quote ((0 0 0) ((1 1 1) 2 2 2)))

(unzip* '((0 (1 2)) (0 (1 2)) (0 (1 2))))
;-> (quote ((0 0 0) ((1 1 1) (2 2 2))))

(unzip* '((0 (1 2) . 3) (0 (1 2) . 3) (0 (1 2) . 3)))
;-> (quote ((0 0 0) ((1 1 1) (2 2 2)) 3 3 3))

(unzip* '((0 (1 . 2) . 3) (0 (1 . 2) . 3) (0 (1 . 2) . 3)))
;-> (quote ((0 0 0) ((1 1 1) 2 2 2) 3 3 3))

(flatten* (map* list '(a b (c d)) '(1 2 (#(3 30) #(4 40)))))
;-> (quote ((a 1) (b 2) (c #(3 30)) (d #(4 40))))

(flatten* '((a 1) ((b 2)) (((c 3)))))
;-> (quote ((a 1) (b 2) (c 3)))

(pseudo-head '(1 2 . 3))
;-> (quote (1 2))

(pseudo-tail '(1 2 . 3))
;-> 3

(pseudo-head '())
;-> (quote ())

(pseudo-tail '())
;-> (quote ())

(pseudo-head 3)
;-> (quote ())

(pseudo-tail 3)
;-> 3

(pseudo-length '(0 1 . 2))
;-> 2

Requirements

None

Last update

Mar 27, 2024

Author

Juergen Lorenz

License

Copyright (c) 2022-2024 , Juergen Lorenz, ju (at) jugilo (dot) de All rights reserved.

Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Version history

2.0

added a lot of routines based on walk

1.0

initial check in