blob: 65cea2110b42e175d2fae8b7b7c24f600c16c535 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
;;; Commentary:
;; Zipper data structure. Could be moved to (hnh util), but would then need to
;; be at least slightly more thorough.
;;; Code:
(define-module (c zipper)
:use-module (srfi srfi-88)
:use-module (hnh util object)
:export (list-zipper
list-zipper?
left focused right
zip-left
zip-right
zip-find-right
list->zipper
zipper->list
rezip))
(define-type (list-zipper)
(left type: list?)
focused
(right type: list?))
;; Move zipper one step to the left
(define (zip-left zipper)
(if (null? (left zipper))
zipper
(list-zipper left: (cdr (left zipper))
right: (cons (focused zipper) (right zipper))
focused: (car (left zipper)))))
;; Move zipper one step to the right
(define (zip-right zipper)
(if (null? (right zipper))
zipper
(list-zipper left: (cons (focused zipper) (left zipper))
right: (cdr (right zipper))
focused: (car (right zipper)))))
;; find first element matching predicate, going right
(define (zip-find-right predicate zipper)
(cond ((null? (right zipper)) zipper)
((predicate (focused zipper)) zipper)
(else (zip-find-right predicate (zip-right zipper)))))
(define (list->zipper list)
(list-zipper left: '()
focused: (car list)
right: (cdr list)))
(define (rezip zipper)
(if (null? (left zipper))
zipper
(rezip (zip-left zipper))))
(define (zipper->list zipper)
(let ((z (rezip zipper)))
(cons (focused z)
(right z))))
|
