package stdune
Source file per_item.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 73module Make (Key : Map.Key) : Per_item_intf.S with type key = Key.t = struct module Map = Map.Make (Key) type key = Key.t type 'a t = { map : int Map.t ; values : 'a Array.Immutable.t } let to_dyn f { map; values } = let open Dyn in record [ "map", Map.to_dyn int map; "values", Array.Immutable.to_dyn f values ] ;; let equal f t { values; map } = Array.Immutable.equal f t.values values && Map.equal ~equal:Int.equal t.map map ;; let for_all x = { map = Map.empty; values = Array.Immutable.of_array [| x |] } let of_mapping l ~default = let values = Array.Immutable.of_list (default :: List.map l ~f:snd) in match List.mapi l ~f:(fun i (keys, _) -> List.map keys ~f:(fun key -> key, i + 1)) |> List.concat |> Map.of_list with | Ok map -> Ok { map; values } | Error (key, x, y) -> Error (key, Array.Immutable.get values x, Array.Immutable.get values y) ;; let get t key = let index = match Map.find t.map key with | None -> 0 | Some i -> i in Array.Immutable.get t.values index ;; let map t ~f = { t with values = Array.Immutable.map t.values ~f } let fold t ~init ~f = Array.Immutable.fold_right t.values ~init ~f let exists t ~f = Array.Immutable.exists t.values ~f let is_constant t = Array.Immutable.length t.values = 1 module Make_monad_traversals (M : sig include Monad.S val all : 'a t list -> 'a list t end) = struct let map { map; values } ~f = let open M.O in let l = Array.Immutable.to_list values in let+ new_values = List.map l ~f |> M.all in { map; values = Array.Immutable.of_list new_values } ;; let fold t ~init ~f = let open M.O in let rec loop i acc = if i = Array.Immutable.length t.values then M.return acc else let* acc = f (Array.Immutable.get t.values i) acc in loop (i + 1) acc in loop 0 init ;; end end