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. *)

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

  let rec forward ?(step=1) f_l =
    match step, f_l with
    | n, _ when n = 0 -> Some 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 -> None
    | _, List_zip (h :: c, f, tl) -> forward ~step:(step + 1) (List_zip (c, h, f :: tl))
    | _, List_zip ([], _, _) -> None

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

  let rec fold f acc = function
    | List_zip ((_, _, _) as focus) as lst -> 
      let f_val = f acc focus in
      match (forward lst) with
      | None -> f_val
      | Some fl -> fold f f_val fl

  let rec fold_forward ?(include_focus = true) f acc = function
    | List_zip (_, focus, _) as lst ->
      let f_val = if include_focus then f acc focus else acc in
        match (forward lst) with
        | None -> f_val
        | Some fl -> fold_forward ~include_focus:true f f_val fl

  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