[486] | 1 | |
---|
[818] | 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 | |
---|
[740] | 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 | |
---|
[818] | 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 | |
---|
[740] | 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 | |
---|
[486] | 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 | |
---|
[740] | 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 = |
---|
[486] | 45 | let rec aux i res = function |
---|
| 46 | | [] -> res |
---|
[740] | 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) |
---|
[486] | 50 | |
---|
[740] | 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 | |
---|
[818] | 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 | |
---|
[486] | 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 | |
---|
[619] | 77 | let rec last = function |
---|
| 78 | | [] -> raise Not_found |
---|
| 79 | | [a] -> a |
---|
| 80 | | _ :: l -> last l |
---|
| 81 | |
---|
[486] | 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 | |
---|
[619] | 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 | |
---|
[486] | 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 |
---|