This repository has been archived by the owner on Apr 12, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
zipper.ml
69 lines (57 loc) · 1.72 KB
/
zipper.ml
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
61
62
63
64
65
66
67
68
69
open Core.Std
type 'a t = {
prev : 'a list ;
next : 'a list ;
}
let empty = { prev = [] ; next = [] }
let singleton curr = { prev = [] ; next = [ curr ] }
let set_current { prev ; next } value =
match next with
| [] -> invalid_arg "Zipper.set_current"
| _curr :: rest -> { prev ; next = value :: rest }
let current { prev ; next } =
match next with
| [] -> invalid_arg "Zipper.current"
| curr :: _ -> curr
let insert { prev ; next } x pos =
match pos with
| `before -> { prev ; next = x :: next }
| `after ->
match next with
| [] -> { prev ; next = [ x ] }
| curr :: rest -> { prev = curr :: prev ; next = x :: rest }
let delete ({ prev ; next } as t) pos =
match pos with
| `before ->
begin match prev, next with
| _, [] -> t
| [], x :: next -> { prev = [] ; next }
| new_curr :: prev, _curr :: nexts ->
{ prev ; next = new_curr :: nexts }
end
| `after ->
begin match next with
| [] -> t
| x :: xs -> { prev ; next = xs }
end
let forward ({ prev ; next } as t) =
match next with
| [] | [ _ ]-> t
| x :: xs -> { prev = x :: prev ; next = xs }
let backward { prev ; next } =
match prev with
| [] -> { prev ; next }
| x :: xs -> { prev = xs ; next = x :: next }
let drop_tail ({ prev ; next } as t) =
match next with
| [] | [ _ ] -> t
| x :: xs -> { prev ; next = [ x ] }
let to_list { prev ; next } = List.rev_append prev next
let fold { prev ; next } ~init ~f =
match next with
| [] -> init (* no current element -> zipper is empty *)
| curr :: nexts ->
let acc = List.fold (List.rev prev) ~init ~f:(f false) in
let acc = f true acc curr in
List.fold nexts ~init:acc ~f:(f false)
let iter t ~f = fold t ~init:() ~f:(fun b acc -> f b)