Source file arrayTraversal.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
70
71
72
module type Evaluator_TYPE = sig
  type state
  type cell

  val cell_compare : cell -> cell -> int
  val update : state -> cell -> state option
end

module Make (E : Evaluator_TYPE) = struct
  type row = E.cell list
  type array = row list
  type return = Return of (E.state * (E.state * row * array) list) | Stop

  let rec visit_row state row arr resume =
    match row with
    | [] -> continue resume
    | elt :: remaining -> (
        match E.update state elt with
        | Some new_state ->
            visit_array new_state arr ((state, remaining, arr) :: resume)
        | None -> visit_row state remaining arr resume)

  and visit_array state arr resume =
    match arr with
    | [] -> Return (state, resume)
    | row :: remaining -> visit_row state row remaining resume

  and continue resumption =
    match resumption with
    | [] -> Stop
    | (state, row, arr) :: resume -> visit_row state row arr resume

  let rec all_results_aux f acc state array resume =
    match visit_array state array resume with
    | Return (res, (current_state, r, arr) :: resume) ->
        all_results_aux f (f acc res) current_state (r :: arr) resume
    | Return (res, []) -> f acc res
    | Stop -> acc

  let collect_results f acc init array = all_results_aux f acc init array []
end

module type Evaluator_TYPE2 = sig
  type state
  type cell

  module CellSet : Set.S with type elt = cell

  val update : state -> cell -> state option
end

module Make2 (E : Evaluator_TYPE2) = struct
  exception Failed

  type row = E.CellSet.t
  type array = row list

  let rec fold_on_array f acc state = function
    | [] -> f acc state
    | row :: remaining ->
        if E.CellSet.is_empty row then raise Failed
        else
          E.CellSet.fold
            (fun elt l_acc ->
              match E.update state elt with
              | Some new_state -> fold_on_array f l_acc new_state remaining
              | None -> l_acc)
            row acc

  let collect_results f acc init array =
    try fold_on_array f acc init array with Failed -> acc
end