src/utilities/miscPottier.ml

   1
   2 let rec map3 f al bl cl =
   3   let f' ((a, b), c) = f a b c in
   4   List.map f' (List.combine (List.combine al bl) cl)
   5
   6 let rec max_list = function
   7   | [] -> raise (Invalid_argument "MiscPottier.max_list")
   8   | [a] -> a
   9   | a :: l -> max a (max_list l)
  10
  11 let rec reduce l1 l2 = match l1, l2 with
  12   | [], _ -> (([], []), ([], l2))
  13   | _, [] -> (([], l1), ([], []))
  14   | a :: l1, b :: l2 ->
  15     let ((common1, rest1), (common2, rest2)) = reduce l1 l2 in
  16     ((a :: common1, rest1), (b :: common2, rest2))
  17
  18 let pow a b =
  19   if b < 0 then raise (Invalid_argument "MiscPottier.pow2")
  20   else
  21     let rec aux = function
  22       | 0 -> 1
  23       | i -> a * aux (i-1) in
  24     aux b
  25
  26 let rec make a n =
  27   if n = 0 then []
  28   else a :: (make a (n-1))
  29
  30 let index_of x =
  31   let rec aux i = function
  32     | [] -> raise Not_found
  33     | y :: l -> if y = x then i else aux (i+1) l
  34   in
  35   aux 0
  36
  37 let rec remove_n_first n =
  38   let rec aux i = function
  39   | [] -> []
  40   | l when i = n -> l
  41   | _ :: l -> aux (i+1) l in
  42   aux 0
  43
  44 let foldi_from_until n m f a l =
  45   let rec aux i res = function
  46     | [] -> res
  47     | _ when i >= m -> res
  48     | e :: l -> aux (i+1) (f i res e) l in
  49   aux 0 a (remove_n_first n l)
  50
  51 let foldi_from n f a l = foldi_from_until n (List.length l) f a l
  52
  53 let foldi_until m f a l = foldi_from_until 0 m f a l
  54
  55 let foldi f a l = foldi_from_until 0 (List.length l) f a l
  56
  57 let pos e l =
  58   let f i res e' = if e' = e then Some i else res in
  59   match foldi f None l with
  60     | None -> raise Not_found
  61     | Some i -> i
  62
  63 let iteri f l =
  64   let rec aux i = function
  65     | [] -> ()
  66     | e :: l -> f i e ; aux (i+1) l
  67   in
  68   aux 0 l
  69
  70 let mapi f l =
  71   let rec aux i = function
  72     | [] -> []
  73     | e :: l -> (f i e) :: (aux (i+1) l)
  74   in
  75   aux 0 l
  76
  77 let rec last = function
  78   | [] -> raise Not_found
  79   | [a] -> a
  80   | _ :: l -> last l
  81
  82 (* [split a i] splits the list a in two lists: one with the elements
  83    up until the [i]th (exclusive) and one with the rest. *)
  84
  85 let rec split l i =
  86   if i = 0 then ([], l)
  87   else
  88     let (l1, l2) = split (List.tl l) (i-1) in
  89     ((List.hd l) :: l1, l2)
  90
  91 (* [split_last l] returns the list [l] without its last element and its last
  92    element. Raises Invalid_argument "MiscPottier.split_last" if the list is
  93    empty. *)
  94
  95 let split_last l = match split l ((List.length l) - 1) with
  96   | l', last :: _ -> (l', last)
  97   | _ -> raise (Invalid_argument "MiscPottier.split_last")
  98
  99 let rec update_list_assoc a b = function
 100   | [] -> []
 101   | (a', b') :: l ->
 102       if a' = a then (a, b) :: l else (a', b') :: (update_list_assoc a b l)
 103
 104 (* Pasted from Pottier's PP compiler *)
 105
 106 let rec combine xs1 xs2 =
 107   match xs1, xs2 with
 108   | [], _
 109   | _, [] ->
 110       []
 111   | x1 :: xs1, x2 :: xs2 ->
 112       (x1, x2) :: combine xs1 xs2
 113
 114 let rec subtract xs1 xs2 =
 115   match xs1, xs2 with
 116   | [], _ ->
 117       []
 118   | _, [] ->
 119       xs1
 120   | _ :: xs1, _ :: xs2 ->
 121       subtract xs1 xs2
 122
 123 let mirror l =
 124   List.map (fun (x, y) -> (y, x)) l
 125
 126 let length l =
 127   Int32.of_int (List.length l)
 128
 129 let rec prefix k l =
 130   match k, l with
 131   | 0, _
 132   | _, [] ->
 133       []
 134   | _, x :: xs ->
 135       x :: prefix (k - 1) xs
 136
 137 let memoize f =
 138   let table = Hashtbl.create 131 in
 139   fun key ->
 140     try
 141       Hashtbl.find table key
 142     with Not_found ->
 143       let data = f key in
 144       Hashtbl.add table key data;
 145       data
 146
 147 let filter_map filter map =
 148   let rec aux = function
 149     | [] -> []
 150     | e :: l -> (if filter e then [map e] else []) @ (aux l)
 151   in
 152   aux
 153
 154 let string_of_list sep f =
 155   let rec aux = function
 156     | [] -> ""
 157     | [e] -> f e
 158     | e :: l -> (f e) ^ sep ^ (aux l)
 159   in
 160   aux