Source file `listContext.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
open Result

type 'a t = 'a list
let empty = []

let is_empty = function
  | [] -> true
  | _ -> false

let push elt ctx = elt :: ctx

let size = List.length

type 'a focused_list = 'a t * 'a list

type direction = Right | Left
type error = Move_failure of direction
type 'a move_result = ('a focused_list, error) result

let rec forward ?(step=1) =
  function
  | f_l when step = 0 -> Ok f_l
  | ctx, h :: tl when step > 0 -> forward ~step:(step - 1) ((h :: ctx), tl)
  | _, [] when step > 0 -> Error (Move_failure Right)
  (* n is negative *)
  | h :: ctx, l -> forward ~step:(step + 1) (ctx, h :: l)
  | [], _ -> Error (Move_failure Left)

let right f_l = forward ~step:1 f_l

let left f_l = forward ~step:(-1) f_l

let rec zip_up ctx l =
  match ctx, l with
  | [], _ -> l
  | elt::c, _ -> zip_up c (elt :: l)

let fold focused_list f acc =
  let rec fold_aux (c, l) acc =
    let new_acc = f (c, l) acc in
    match l with
    | [] -> new_acc
    | elt :: tl -> fold_aux (elt::c, tl) new_acc in
  fold_aux focused_list acc

let full_left (ctx, l) =
  [], zip_up ctx l

let forward_insert elt (c, l) = (c, elt :: l)
let backward_insert elt (c, l) = (elt :: c, l)

let nth_context n l =
  let rec nth_context_aux n ctx = function
    | [] -> Error (Move_failure Right)
    | elt :: tl ->
      if n = 1 then
        Ok ((ctx, tl), elt)
      else
        nth_context_aux (n-1) (elt :: ctx) tl in
  nth_context_aux n [] l