source: Deliverables/D2.2/8051/src/utilities/miscPottier.ml

Last change on this file was 1585, checked in by tranquil, 8 years ago

fighting with a bug of the translation from RTL to ERTL

File size: 4.5 KB
Line 
1
2let 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
6let 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"
11
12let 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
18let rec max_list = function
19  | [] -> raise (Invalid_argument "MiscPottier.max_list")
20  | [a] -> a
21  | a :: l -> max a (max_list l)
22
23let 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
30let 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
38let rec make a n =
39  if n <= 0 then []
40  else a :: (make a (n-1))
41
42let 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
48let 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
55let 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
62let foldi_from_until n m f a l =
63  let rec aux i res = function
64    | [] -> res
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)
68
69let foldi_from n f a l = foldi_from_until n (List.length l) f a l
70
71let foldi_until m f a l = foldi_from_until 0 m f a l
72
73let foldi f a l = foldi_from_until 0 (List.length l) f a l
74
75let 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
81let 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
88let 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
95let rec last = function
96  | [] -> raise Not_found
97  | [a] -> a
98  | _ :: l -> last l
99
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
103let 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
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
113let split_last l = match split l ((List.length l) - 1) with
114  | l', last :: _ -> (l', last)
115  | _ -> raise (Invalid_argument "MiscPottier.split_last")
116
117let 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
124let rec combine xs1 xs2 =
125  match xs1, xs2 with
126  | [], _
127  | _, [] ->
128      []
129  | x1 :: xs1, x2 :: xs2 ->
130      (x1, x2) :: combine xs1 xs2
131
132let rec subtract xs1 xs2 =
133  match xs1, xs2 with
134  | [], _ ->
135      []
136  | _, [] ->
137      xs1
138  | _ :: xs1, _ :: xs2 ->
139      subtract xs1 xs2
140
141let mirror l =
142  List.map (fun (x, y) -> (y, x)) l
143
144let length l =
145  Int32.of_int (List.length l)
146
147let rec prefix k l =
148  match k, l with
149  | 0, _
150  | _, [] ->
151      []
152  | _, x :: xs ->
153      x :: prefix (k - 1) xs
154
155let 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
165let 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
172let 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
179
180
181let 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
191let 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)
Note: See TracBrowser for help on using the repository browser.