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