Merge branch 'master' of https://scm.cri.ensmp.fr/git/Faustine
[Faustine.git] / interpretor / signal.ml
1 (**
2 Module: Signal
3 Description: signal definition and operations.
4 @author WANG Haisheng
5 Created: 03/06/2013 Modified: 03/06/2013
6 *)
7
8 open Types;;
9 open Basic;;
10 open Value;;
11
12 exception Signal_operation of string;;
13
14 let delay_memory_length = 10000;;
15
16 class rate : int -> int -> rate_type =
17 fun (num_init : int) ->
18 fun (denom_init : int) ->
19 let rec pgcd : int -> int -> int =
20 fun i1 -> fun i2 ->
21 let r = i1 mod i2 in
22 if r = 0 then i2 else pgcd i2 r in
23 let num_positive =
24 if num_init >= 0 then num_init
25 else (-num_init) in
26 let denom_positive =
27 if denom_init > 0 then denom_init
28 else if denom_init < 0 then -denom_init
29 else raise (Signal_operation "sample rate denominater = 0.") in
30 let factor = pgcd num_positive denom_positive in
31 let num_corrected = num_init / factor in
32 let denom_corrected = denom_init / factor in
33 object (self)
34 val _num = num_corrected
35 val _denom = denom_corrected
36 method num = _num
37 method denom = _denom
38 method to_int =
39 self#num / self#denom
40 method to_float =
41 (float_of_int self#num) /. (float_of_int self#denom)
42 method to_string =
43 (string_of_int self#num) ^ "/" ^ (string_of_int self#denom)
44 method equal : rate_type -> bool =
45 fun (r : rate_type) -> (self#num = r#num) && (self#denom = r#denom)
46 method mul : int -> rate_type =
47 fun (i : int) -> new rate (self#num * i) self#denom
48 method div : int -> rate_type =
49 fun (i : int) -> new rate self#num (self#denom * i)
50 end
51
52
53 class signal : rate_type -> (time -> value_type) -> signal_type =
54 fun (freq_init : rate_type) ->
55 fun (func_init : time -> value_type) ->
56 object (self)
57 val mutable signal_func = func_init
58 val mutable memory_length = 0
59 method frequency = freq_init
60 method at = signal_func
61
62 method private check_freq : signal_type list -> rate_type =
63 fun (sl : signal_type list) ->
64 let check : rate_type -> signal_type -> rate_type =
65 fun (f : rate_type) ->
66 fun (s : signal_type) ->
67 if f#equal s#frequency || s#frequency#num = 0 then f
68 else if f#num = 0 then s#frequency
69 else raise (Signal_operation "frequency not matched.") in
70 List.fold_left check self#frequency sl
71
72 method add_memory : int -> unit =
73 fun (length : int) ->
74 assert (length >= 0);
75 if memory_length >= length then ()
76 else
77 let memory = Hashtbl.create length in
78 let func : time -> value =
79 fun (t : time) ->
80 try Hashtbl.find memory t
81 with Not_found ->
82 let result = func_init t in
83 let () = Hashtbl.replace memory t result in
84 let () =
85 if (t - length) >= 0 then
86 Hashtbl.remove memory (t - length)
87 else () in
88 result in
89 memory_length <- length;
90 signal_func <- func
91
92 method private delay_by : int -> time -> value =
93 fun i -> fun t ->
94 if (t - i) >= 0 then
95 self#at (t - i)
96 else if t >= 0 && (t - i) < 0 then
97 (self#at 0)#zero
98 else raise (Signal_operation "Delay time < 0.")
99
100 method private prim1 :
101 (time -> value_type) -> signal_type =
102 fun (func : time -> value_type) ->
103 let freq = self#frequency in
104 new signal freq func
105
106 method private prim2 :
107 (time -> value_type -> value_type) -> signal_type -> signal_type =
108 fun (func_binary : time -> value_type -> value_type) ->
109 fun (s : signal_type) ->
110 let freq = self#check_freq [s] in
111 let func = fun t -> (func_binary t) (s#at t) in
112 new signal freq func
113
114 method neg = self#prim1 (fun t -> (self#at t)#neg)
115 method floor = self#prim1 (fun t -> (self#at t)#floor)
116 method ceil = self#prim1 (fun t -> (self#at t)#ceil)
117 method rint = self#prim1 (fun t -> (self#at t)#rint)
118 method sin = self#prim1 (fun t -> (self#at t)#sin)
119 method asin = self#prim1 (fun t -> (self#at t)#asin)
120 method cos = self#prim1 (fun t -> (self#at t)#cos)
121 method acos = self#prim1 (fun t -> (self#at t)#acos)
122 method tan = self#prim1 (fun t -> (self#at t)#tan)
123 method atan = self#prim1 (fun t -> (self#at t)#atan)
124 method exp = self#prim1 (fun t -> (self#at t)#exp)
125 method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
126 method ln = self#prim1 (fun t -> (self#at t)#ln)
127 method lg = self#prim1 (fun t -> (self#at t)#lg)
128 method int = self#prim1 (fun t -> (self#at t)#int)
129 method float = self#prim1 (fun t -> (self#at t)#float)
130 method abs = self#prim1 (fun t -> (self#at t)#abs)
131
132 method add = self#prim2 (fun t -> (self#at t)#add)
133 method sub = self#prim2 (fun t -> (self#at t)#sub)
134 method mul = self#prim2 (fun t -> (self#at t)#mul)
135 method div = self#prim2 (fun t -> (self#at t)#div)
136 method power = self#prim2 (fun t -> (self#at t)#power)
137 method _and = self#prim2 (fun t -> (self#at t)#_and)
138 method _or = self#prim2 (fun t -> (self#at t)#_or)
139 method _xor = self#prim2 (fun t -> (self#at t)#_xor)
140 method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
141 method _mod = self#prim2 (fun t -> (self#at t)#_mod)
142 method fmod = self#prim2 (fun t -> (self#at t)#fmod)
143 method remainder = self#prim2 (fun t -> (self#at t)#remainder)
144 method gt = self#prim2 (fun t -> (self#at t)#gt)
145 method lt = self#prim2 (fun t -> (self#at t)#lt)
146 method geq = self#prim2 (fun t -> (self#at t)#geq)
147 method leq = self#prim2 (fun t -> (self#at t)#leq)
148 method eq = self#prim2 (fun t -> (self#at t)#eq)
149 method neq = self#prim2 (fun t -> (self#at t)#neq)
150 method max = self#prim2 (fun t -> (self#at t)#max)
151 method min = self#prim2 (fun t -> (self#at t)#min)
152 method shl = self#prim2 (fun t -> (self#at t)#shl)
153 method shr = self#prim2 (fun t -> (self#at t)#shr)
154
155 method delay : signal_type -> signal_type =
156 fun (s : signal_type) ->
157 let freq = self#check_freq [s] in
158 let () = self#add_memory delay_memory_length in
159 let func : time -> value_type =
160 fun (t : time) ->
161 let i = (s#at t)#to_int in
162 self#delay_by i t in
163 new signal freq func
164
165 method mem : signal_type =
166 let freq = self#frequency in
167 let () = self#add_memory 1 in
168 let func = fun (t : time) -> self#delay_by 1 t in
169 new signal freq func
170
171 method rdtable : signal_type -> signal_type -> signal_type =
172 fun (s_size : signal_type) ->
173 fun (s_index : signal_type) ->
174 let freq = self#check_freq [s_index] in
175 let () = self#add_memory ((s_size#at 0)#to_int) in
176 let func : time -> value_type = fun t ->
177 self#at ((s_index#at t)#to_int) in
178 new signal freq func
179
180 method rwtable : signal_type -> signal_type ->
181 signal_type -> signal_type -> signal_type =
182 fun init -> fun wstream -> fun windex -> fun rindex ->
183 let freq = self#check_freq [init; wstream; windex; rindex] in
184 let () = init#add_memory ((self#at 0)#to_int) in
185 let () = wstream#add_memory ((self#at 0)#to_int) in
186 let func : time -> value_type = fun (ti : time) ->
187 let rec table : time -> index -> value_type =
188 fun t -> fun i ->
189 if t > 0 then
190 (if i = (windex#at t)#to_int then (wstream#at t)
191 else table (t - 1) i)
192 else if t = 0 then
193 (if i = (windex#at 0)#to_int then (wstream#at 0)
194 else init#at i)
195 else raise (Signal_operation "signal time should be > 0") in
196 table ti ((rindex#at ti)#to_int) in
197 new signal freq func
198
199 method select2 : signal_type -> signal_type -> signal_type =
200 fun s_first ->
201 fun s_second ->
202 let freq = self#check_freq [s_first; s_second] in
203 let func : time -> value_type =
204 fun t -> let i = (self#at t)#to_int in
205 if i = 0 then s_first#at t
206 else if i = 1 then s_second#at t
207 else raise (Signal_operation "select2 index 0|1.") in
208 new signal freq func
209
210 method select3 :
211 signal_type -> signal_type -> signal_type -> signal_type =
212 fun s_first -> fun s_second -> fun s_third ->
213 let freq = self#check_freq [s_first; s_second; s_third] in
214 let func : time -> value_type =
215 fun t -> let i = (self#at t)#to_int in
216 if i = 0 then s_first#at t
217 else if i = 1 then s_second#at t
218 else if i = 2 then s_third#at t
219 else raise (Signal_operation "select2 index 0|1.") in
220 new signal freq func
221
222 method prefix : signal_type -> signal_type =
223 fun (s_init : signal_type) ->
224 let () = self#add_memory 1 in
225 let func : time -> value_type =
226 fun t ->
227 if t = 0 then s_init#at 0
228 else if t > 0 then self#at (t - 1)
229 else raise (Signal_operation "prefix time < 0.") in
230 new signal self#frequency func
231
232
233 method vectorize : signal_type -> signal_type =
234 fun s_size ->
235 let size = (s_size#at 0)#to_int in
236 if size <= 0 then
237 raise (Signal_operation "Vectorize: size <= 0.")
238 else
239 let freq = self#frequency#div size in
240 let func : time -> value_type =
241 fun t ->
242 let vec = fun i -> (self#at (size * t + i))#get in
243 new value (Vec (new vector size vec)) in
244 new signal freq func
245
246
247 method serialize : signal_type =
248 let size =
249 match (self#at 0)#get with
250 | Vec vec -> vec#size
251 | _ -> raise (Signal_operation "Serialize: scalar input.") in
252 let freq = self#frequency#mul size in
253 let func : time -> value_type =
254 fun t ->
255 match (self#at (t/size))#get with
256 | Vec vec -> new value (vec#nth (t mod size))
257 | _ -> raise (Signal_operation
258 "Serialize: signal type not consistent.") in
259 new signal freq func
260
261 method vconcat : signal_type -> signal_type =
262 fun s ->
263 let freq = self#check_freq [s] in
264 let func : time -> value_type =
265 fun t ->
266 match ((self#at t)#get, (s#at t)#get) with
267 | (Vec vec1, Vec vec2) ->
268 let size1 = vec1#size in
269 let size2 = vec2#size in
270 let size = size1 + size2 in
271 let vec = fun i ->
272 if i < size1 then vec1#nth i
273 else vec2#nth (i - size1) in
274 new value (Vec (new vector size vec))
275 | _ -> raise (Signal_operation "Vconcat: scalar.") in
276 new signal freq func
277
278 method vpick : signal_type -> signal_type =
279 fun s_index ->
280 let freq = self#check_freq [s_index] in
281 let func : time -> value_type =
282 fun t ->
283 let i = (s_index#at t)#to_int in
284 match (self#at t)#get with
285 | Vec vec -> new value (vec#nth i)
286 | _ -> raise (Signal_operation "Vpick: scalar.") in
287 new signal freq func
288
289 end;;