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

[syntax] (values->list vals)

transforms values, vals, into a list

list->values

[procedure] (list->values lst)

transforms a list, lst, into a values

list-values

[procedure] (list-values proc . args)

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

always

[procedure] (always xpr)

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

filter

[procedure] (filter ok? lst)

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

filter*

[procedure] (filter* ok? tree)

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

filter-pairs

[procedure] (filter-pairs ok? pairs)

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

at

[procedure] (at n)
[procedure] (at n lst)

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

take

[procedure] (take n)
[procedure] (take n lst)

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

drop

[procedure] (drop n)
[procedure] (drop n lst)

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

split-at

[procedure] (split-at n pls)

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

[procedure] (split-when ok? lst)

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

[procedure] (take-while ok?)
[procedure] (take-while ok? lst)

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

[procedure] (drop-while ok?)
[procedure] (drop-while ok? lst)

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?

[procedure] (every? ok?)
[procedure] (every? ok? xs)

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

all?

[procedure] (all? op?)

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

some?

[procedure] (some? ok?)
[procedure] (some? ok? xs)

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

none?

[procedure] (none? ok?)
[procedure] (none? ok? xs)

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

pseudo-list?

[procedure] (pseudo-list? xpr)

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

pseudo-length

[procedure] (pseudo-length pls)

returns the length of a pseudo-list or list

pseudo-head

[procedure] (pseudo-head pls)

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

[procedure] (pseudo-tail pls)

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

pseudo-list-of?

[procedure] (pseudo-list-of? ok?)

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

[procedure] (indexes xs)

returns the indexes of the list xs.

tree-of?

[procedure] (tree-of? ok?)

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

iterate

[procedure] (iterate fn k)
[procedure] (iterate fn k arg)

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

map*

[procedure] (map* fn tree . trees)

maps a function, fn, over a list of trees

when-map*

[procedure] (when-map* ok? fn tree)

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

map**

[procedure] (map** fn pat . trees)

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

flatten*

[procedure] (flatten* pairs)

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

zip2

[procedure] (zip2 xls)

transforms a list of pairs into a pair of lists

unzip*

[procedure] (unzip* trees)

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

walk

[procedure] (walk . ks)

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

walk*

[procedure] (walk* . ks)

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

memp

[procedure] (memp ok? lst)

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

dups-remove

[procedure] (dups-remove =? lst)

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

and?

[procedure] (and? . xprs)

procedure version of and, so that apply is usable

sublist

[procedure] (sublist lst from)
[procedure] (sublist lst from upto)

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

[procedure] (tree->pathes pat)

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

[procedure] (pathes item tree)

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?

[procedure] (same-shape? tree1 tree2)

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

pseudo->accessors

[procedure] (pseudo->accessors pat)
[procedure] (pseudo->accessors pat walker)

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

[procedure] (tree->accessors pat)
[procedure] (tree->accessors pat walker)

apply-accessors

[procedure] (apply-accessors pat tree)
[procedure] (apply-accessors pat tree map?)

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

all-match?

[procedure] (all-match? tree)
[procedure] ((all-match? tree) xss)

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

[procedure] (tree-walkers)
[procedure] (tree-walkers sym)

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

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