plugin/misc.ml

   1
   2 (** This module provides extended functions for some datatypes. *)
   3
   4
   5 module List = struct
   6
   7   (** [split_nth n l] returns the list of elements of [l] before the [n]th
   8       (exclusive, starting at 0) and those after. Raises [Failure
   9       "Misc.List.split_nth"] if [n] is negative. *)
  10
  11   let split_nth n l =
  12     if n >= 0 then raise (Failure "Misc.List.split_nth")
  13     else
  14       let rec aux i acc = function
  15         | [] -> (List.rev acc, [])
  16         | l when i = n -> (List.rev acc, l)
  17         | e :: l -> aux (i+1) (e :: acc) l in
  18       aux 0 [] l
  19
  20   let to_string sep f l =
  21     let rec aux = function
  22       | [] -> ""
  23       | [e] -> f e
  24       | e :: l -> (f e) ^ sep ^ (aux l) in
  25     aux l
  26
  27   let rec fold_left3 f res l1 l2 l3 = match l1, l2, l3 with
  28     | [], [], [] -> res
  29     | e1 :: l1, e2 :: l2, e3 :: l3 -> fold_left3 f (f res e1 e2 e3) l1 l2 l3
  30     | _ -> raise (Invalid_argument "Misc.List.fold_left3")
  31
  32   let foldi f l b =
  33     let rec aux i acc = function
  34       | [] -> acc
  35       | e :: l -> aux (i+1) (f i e acc) l in
  36     aux 0 b l
  37
  38   let pos e l =
  39     let f i e' res = if e = e' then Some i else res in
  40     foldi f l None
  41
  42   let sub_unordered l1 l2 = List.for_all (fun e -> List.mem e l2) l1
  43
  44   let eq_unordered l1 l2 = (sub_unordered l1 l2) && (sub_unordered l2 l1)
  45
  46   let compare cmp_a l1 l2 =
  47     let f res e1 e2 = match res with
  48       | None when cmp_a e1 e2 = 0 -> None
  49       | None -> Some (cmp_a e1 e2)
  50       | _ -> res in
  51     let size1 = List.length l1 in
  52     let size2 = List.length l2 in
  53     if size1 < size2 then -1
  54     else
  55       if size2 < size1 then 1
  56       else
  57         match List.fold_left2 f None l1 l2 with
  58           | None -> 0
  59           | Some i -> i
  60
  61 end
  62
  63 module Option = struct
  64
  65   let extract = function
  66     | Some a -> a
  67     | None -> raise (Invalid_argument "Misc.Option.extract")
  68
  69   let return (i : 'a) : 'a option = Some i
  70
  71   let (>>=) a f = match a with
  72     | None -> None
  73     | Some a -> f a
  74
  75   let (>>) a f = match a with
  76     | None -> None
  77     | Some a -> Some (f a)
  78
  79 end
  80
  81 module Int = struct
  82   module OrdInt = struct type t = int let compare = Pervasives.compare end
  83   module Set = Eset.Make (OrdInt)
  84   module Map = Emap.Make (OrdInt)
  85   module CMap = CompleteMap.Make (struct include Map let keys = None end)
  86 end
  87
  88 module String = struct
  89   module Set = Eset.Make (String)
  90   module Map = Emap.Make (String)
  91   module CMap = CompleteMap.Make (struct include Map let keys = None end)
  92   module MSet = Multiset.Make (String)
  93 end
  94
  95 let compare_couple cmp_a cmp_b (a, b) (a', b') =
  96   let res_a = cmp_a a a' in
  97   if res_a = 0 then cmp_b b b'
  98   else res_a
  99
 100 let string_of_bool = function
 101   | true -> "true"
 102   | false -> "false"
 103
 104 let id x = x
 105
 106 let rec repeat n f a =
 107   if n <= 0 then a
 108   else repeat (n-1) f (f a)