package top-closure

  1. Overview
  2. Docs

Source file top_closure.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
include S

module Make (Keys : Keys) (Monad : Monad) = struct
  open Monad.O

  let top_closure ~key ~deps elements =
    let rec loop res visited elt ~temporarily_marked =
      let key = key elt in
      if Keys.mem temporarily_marked key
      then Monad.return (Error [ elt ])
      else if not (Keys.mem visited key)
      then (
        let visited = Keys.add visited key in
        let temporarily_marked = Keys.add temporarily_marked key in
        deps elt
        >>= iter_elts res visited ~temporarily_marked
        >>| function
        | Error l -> Error (elt :: l)
        | Ok (res, visited) ->
          let res = elt :: res in
          Ok (res, visited))
      else Monad.return (Ok (res, visited))
    and iter_elts res visited elts ~temporarily_marked =
      match elts with
      | [] -> Monad.return (Ok (res, visited))
      | elt :: elts ->
        loop res visited elt ~temporarily_marked
        >>= (function
         | Error _ as result -> Monad.return result
         | Ok (res, visited) -> iter_elts res visited elts ~temporarily_marked)
    in
    iter_elts [] Keys.empty elements ~temporarily_marked:Keys.empty
    >>| function
    | Ok (res, _visited) -> Ok (List.rev res)
    | Error elts -> Error elts
  ;;
end
[@@inline always]