Source file focused_list.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
module Focused_list = struct
  type 'a t =
    | List_zip of ('a list * 'a * 'a list)
        (** This type aims to implement a zipper for lists. The context is
      the first parameter. It represents the list of the elements {e
      in reverse order} that has been traversed to reach the focused
      element (the second parameter). The last element is the
      remaining elements of the list. *)

  exception Empty_list
  exception End_of_list

  let init = function [] -> raise Empty_list | h :: tl -> List_zip ([], h, tl)

  let rec forward ?(step=1) f_l =
    match step,f_l with
    | n, _ when n = 0 -> f_l
    | n, List_zip (c, f, h :: tl) when n > 0 -> forward ~step:(step - 1) (List_zip (f :: c, h, tl))
    | n, List_zip (_, _, []) when n > 0 -> raise End_of_list
    | _, List_zip (h:: c, f, tl) -> forward ~step:(step + 1) (List_zip (c, h, f :: tl))
    | _, List_zip ([], _, _) -> raise End_of_list

  let backward = function
    | List_zip (h :: tl, f, r) -> List_zip (tl, h, f :: r)
    | List_zip ([], _, _) -> raise End_of_list

  let rec fold f acc = function
    | List_zip ((_, _, []) as focus) -> f acc focus
    | List_zip ((_, _, _) as focus) as lst -> fold f (f acc focus) (forward lst)

  let rec fold_forward ?(include_focus = true) f acc = function
    | List_zip (_, focus, []) -> if include_focus then f acc focus else acc
    | List_zip (_, focus, _) as lst ->
        if include_focus then
          fold_forward ~include_focus f (f acc focus) (forward lst)
        else fold_forward ~include_focus:true f acc (forward lst)

  let focus (List_zip (_, a, _)) = a

  let zip (List_zip (c, a, l)) =
    List.fold_left
      (fun acc elt -> elt::acc)
      (a :: l)
      c
end