Added 'make test' in the Makefile.in, upon sin.dsp.
[Faustine.git] / interpretor / signal.ml
1 (**
2 Module: Signal
3 Description: type signal = rate * (int -> value), operations of signals.
4 @author WANG Haisheng
5 Created: 03/06/2013 Modified: 03/06/2013
6 *)
7
8 open Types;;
9 open Value;;
10
11 (* EXCEPTIONS *)
12
13 (** Exception raised in operations of signals.*)
14 exception Signal_operation of string;;
15
16
17
18 (* MACRO *)
19
20 (** Macro constants of the file.*)
21 type signal_macro = Delay_Memory_Length_int;;
22
23
24 (** val signal_macro_to_int : signal_macro -> int.*)
25 let signal_macro_to_int m = match m with
26 |Delay_Memory_Length_int -> 10000;;
27
28
29 (* SIGNAL OPERATIONS *)
30
31 (** val frequency : signal -> int, returns the frequency of a signal.*)
32 let frequency s = fst s;;
33
34
35 (** val signal_fun : signal -> (int -> value), returns the functional part of a signal.*)
36 let signal_fun s = snd s;;
37
38
39 (** val check_frequency : int -> int -> int, returns the correction of frequency.*)
40 let check_frequency = fun f1 -> fun f2 ->
41 if f1 = f2 || f2 = 0 then f1
42 else if f1 = 0 then f2
43 else raise (Signal_operation "frequency not matched.");;
44
45 (** val signal_check_frequency : signal -> signal -> int,
46 checks the frequencies of two input signals, and returns common frequency or raise an exception.*)
47 let signal_check_frequency = fun s1 -> fun s2 ->
48 let f1 = frequency s1 in
49 let f2 = frequency s2 in
50 check_frequency f1 f2;;
51
52
53 (** val signal_check_frequency3 : signal -> signal -> signal -> int,
54 checks the frequencies of three input signal, and returns common frequency or raise an exception.*)
55 let signal_check_frequency3 = fun s1 -> fun s2 -> fun s3 ->
56 let f1 = signal_check_frequency s1 s2 in
57 let f2 = signal_check_frequency s1 s3 in
58 check_frequency f1 f2;;
59
60
61 (** val signal_check_frequency4 : signal -> signal -> signal -> signal -> int,
62 checks the frequencies of three input signal, and returns common frequency or raise an exception.*)
63 let signal_check_frequency4 = fun s1 -> fun s2 -> fun s3 -> fun s4 ->
64 let f1 = signal_check_frequency s1 s2 in
65 let f2 = signal_check_frequency s3 s4 in
66 check_frequency f1 f2;;
67
68
69 (** val signal_add_one_memory : signal -> signal,
70 returns the signal with memory of one latest sample.*)
71 let signal_add_one_memory = fun s ->
72 let new_signal = factory_add_memory (signal_fun s) 1 in
73 (frequency s, new_signal);;
74
75
76 (** val beam_add_one_memory : signal list -> signal list,
77 adds memory of one latest sample for each element in signal list.*)
78 let beam_add_one_memory = fun beam ->
79 List.map signal_add_one_memory beam;;
80
81
82 (** val signal_add : signal -> signal -> signal, output(t) = input1(t) + input2(t),
83 frequency consistent.*)
84 let signal_add s1 s2 =
85 let f = signal_check_frequency s1 s2 in
86 let new_signal = fun t -> ((signal_fun s1) t) +~ ((signal_fun s2) t) in
87 (f, new_signal);;
88
89
90 (** val signal_neg : signal -> signal, output(t) = -input(t), frequency consistent.*)
91 let signal_neg s =
92 let new_signal = fun t -> v_neg ((signal_fun s) t) in
93 (frequency s, new_signal);;
94
95
96 (** val signal_sub : signal -> signal -> signal, output(t) = input1(t) - input2(t),
97 frequency consistent.*)
98 let signal_sub s1 s2 = signal_add s1 (signal_neg s2);;
99
100
101 (** val signal_mul : signal -> signal -> signal, output(t) = input1(t) * input2(t),
102 frequency consistent.*)
103 let signal_mul s1 s2 =
104 let f = signal_check_frequency s1 s2 in
105 let new_signal = fun t -> ((signal_fun s1) t) *~ ((signal_fun s2) t) in
106 (f, new_signal);;
107
108
109 (** val signal_div : signal -> signal -> signal, output(t) = input1(t) / input2(t),
110 frequency consistent.*)
111 let signal_div s1 s2 =
112 let f = signal_check_frequency s1 s2 in
113 let new_signal = fun t -> ((signal_fun s1) t) /~ ((signal_fun s2) t) in
114 (f, new_signal);;
115
116
117 (** val signal_delay : signal -> signal -> signal, output(t) = input1(t - input2(t)),
118 Attention: delay dynamic, frequency of output signal equals to that of first input signal.*)
119 let signal_delay s1 s2 =
120 let s1_mem = factory_add_memory (signal_fun s1)
121 (signal_macro_to_int Delay_Memory_Length_int) in
122 let new_signal = fun t ->
123 let delay = (signal_fun s2) t in
124 match delay with
125 |N i -> if i < 0 then raise (Signal_operation "Delay time < 0.")
126 else if (t - i) >= 0 then s1_mem (t - i)
127 else v_zero (s1_mem 0)
128 |R f -> let i = int_of_float f in
129 if i < 0 then raise (Signal_operation "Delay time < 0.")
130 else if (t - i) >= 0 then s1_mem (t - i)
131 else v_zero (s1_mem 0)
132 |Vec (size, vec) -> raise (Signal_operation "Delay time can not be a vector.")
133 |Zero -> s1_mem t
134 |W -> raise (Signal_operation "Delay time error.")
135 in
136 (frequency s1, new_signal);;
137
138
139 (** val signal_mem : signal -> signal, equivalent to signal_delay with constant delay 1.*)
140 let signal_mem s = signal_delay s (1, (fun t -> N 1));;
141
142
143 (** val signal_vectorize : signal -> signal -> signal, output(t)(i) = input1(input2(0) * t + i),
144 Attention: vector size n static, frequency of output signal is (1/n * frequency of input1)*)
145 let signal_vectorize s1 s2 =
146 let size = (signal_fun s2) 0 in
147 match size with
148 |N size_int ->
149 (
150 let new_signal = fun t ->
151 make_vector size_int (fun i -> (signal_fun s1) (size_int * t + i)) in
152 let new_frequency = (frequency s1) / size_int in
153 (new_frequency, new_signal)
154 )
155 |_ -> raise (Signal_operation "Vectorize: vector size should be int.");;
156
157
158 (** val signal_serialize : signal -> signal, output(t) = input(floor(t/n))(t%n),
159 with n = size of input(0).
160 Attention: input size unknown in the cas of "rec".*)
161 let signal_serialize s =
162 let temp0 = (signal_fun s) 0 in
163 match temp0 with
164 |Vec (size0, vec0) ->
165 let new_signal = fun t ->
166 (
167 let temp = (signal_fun s) (t/size0) in
168 match temp with
169 |Vec (size, vec) ->
170 if size = size0 then
171 vec (t mod size)
172 else
173 raise (Signal_operation "Serialize: vector length not consistent.")
174 |_ -> raise (Signal_operation "Serialize: signal type not consistent.")
175 )
176 in
177 let new_frequency = (frequency s) * size0 in
178 (new_frequency, new_signal)
179 |_ -> raise (Signal_operation "Serialize: input signal should be vector.");;
180
181
182 (** val signal_append : signal -> signal -> signal, symbol "#",
183 appends vectors of the two input signals at each time, frequency consistent.*)
184 let signal_append s1 s2 =
185 let f = signal_check_frequency s1 s2 in
186 let new_signal = fun t ->
187 let temp1 = (signal_fun s1) t in
188 let temp2 = (signal_fun s2) t in
189 match (temp1, temp2) with
190 |(Vec (size1, vec1), Vec (size2, vec2)) ->
191 let new_vec = fun i -> if i < size1 then vec1 i else vec2 (i - size1) in
192 make_vector (size1 + size2) new_vec
193 |_ -> raise (Signal_operation "Append: input signals should be vectors.")
194 in
195 (f, new_signal);;
196
197
198 (** val signal_nth : signal -> signal -> signal, symbol "[]", output(t) = input1(t)(input2(t)),
199 frequency consistent. Attention: selection index dynamic.*)
200 let signal_nth s1 s2 =
201 let f = signal_check_frequency s1 s2 in
202 let new_signal = fun t ->
203 let temp1 = (signal_fun s1) t in
204 let temp2 = (signal_fun s2) t in
205 match temp1 with
206 |Vec (size1, vec1) ->
207 (
208 match temp2 with
209 |N i -> vec1 i
210 |R f ->
211 raise (Signal_operation "Get: second input signal should be int.")
212 |Vec (size2, vec2) ->
213 raise (Signal_operation "Get: second input signal should be int.")
214 |Zero -> vec1 0
215 |W ->
216 raise (Signal_operation "Get: second input signal should be int.")
217 )
218 |_ -> raise (Signal_operation "Get: first input signal should be vector.")
219 in
220 (f, new_signal);;
221
222
223 (** val signal_floor : signal -> signal, output(t) = v_floor(input(t)), frequency consistent.*)
224 let signal_floor s =
225 let new_signal = fun t -> v_floor ((signal_fun s) t) in
226 (frequency s, new_signal);;
227
228
229 (** val signal_int : signal -> signal, output(t) = v_int(input(t)), frequency consistent.*)
230 let signal_int s =
231 let new_signal = fun t -> v_int ((signal_fun s) t) in
232 (frequency s, new_signal);;
233
234
235 (** val signal_sin : signal -> signal, output(t) = v_sin(input(t)), frequency consistent.*)
236 let signal_sin s =
237 let new_signal = fun t -> v_sin ((signal_fun s) t) in
238 (frequency s, new_signal);;
239
240
241 (** val signal_cos : signal -> signal, output(t) = v_cos(input(t)), frequency consistent.*)
242 let signal_cos s =
243 let new_signal = fun t -> v_cos ((signal_fun s) t) in
244 (frequency s, new_signal);;
245
246
247 (** val signal_atan : signal -> signal, output(t) = v_atan(input(t)), frequency consistent.*)
248 let signal_atan s =
249 let new_signal = fun t -> v_atan ((signal_fun s) t) in
250 (frequency s, new_signal);;
251
252
253 let signal_atantwo s1 s2 =
254 let new_signal = fun t -> v_atantwo ((signal_fun s1) t) ((signal_fun s2) t) in
255 (frequency s1, new_signal);;
256
257
258 (** val signal_sqrt : signal -> signal, output(t) = v_sqrt(input(t)), frequency consistent.*)
259 let signal_sqrt s =
260 let new_signal = fun t -> v_sqrt ((signal_fun s) t) in
261 (frequency s, new_signal);;
262
263
264 (** val signal_rdtable : signal -> signal -> signal,
265 output(t) = input1(input2(t)), frequency equals to that of input2.
266 Attention: no memory implemented, very expensive when input1 comes from rec or delays.*)
267 let signal_rdtable s0 s1 s2 =
268 let memory_length_int = take_off_N ((signal_fun s0) 0) in
269 let s1_mem = factory_add_memory (signal_fun s1) memory_length_int in
270 let new_signal = fun t ->
271 let index = (signal_fun s2) t in
272 match index with
273 |N i -> s1_mem i
274 |R f -> raise (Signal_operation "Rdtable index cannot be float.")
275 |Vec (size, vec) -> raise (Signal_operation "Rdtable index cannot be vector.")
276 |Zero -> s1_mem 0
277 |W -> raise (Signal_operation "Rdtable index cannot be Error.")
278 in
279 (frequency s2, new_signal);;
280
281
282 (** val signal_mod : signal -> signal -> signal,
283 output(t) = input1(t) % input2(t), frequency consistent.*)
284 let signal_mod s1 s2 =
285 let f = signal_check_frequency s1 s2 in
286 let new_signal = fun t -> v_mod ((signal_fun s1) t) ((signal_fun s2) t) in
287 (f, new_signal);;
288
289
290 (** val signal_sup : signal -> signal -> signal,
291 output(t) = input1(t) > input2(t), frequency consistent.*)
292 let signal_sup s1 s2 =
293 let f = signal_check_frequency s1 s2 in
294 let new_signal = fun t -> v_sup ((signal_fun s1) t) ((signal_fun s2) t) in
295 (f, new_signal);;
296
297
298 (** val signal_inf : signal -> signal -> signal,
299 output(t) = input1(t) < input2(t), frequency consistent.*)
300 let signal_inf s1 s2 =
301 let f = signal_check_frequency s1 s2 in
302 let new_signal = fun t -> v_inf ((signal_fun s1) t) ((signal_fun s2) t) in
303 (f, new_signal);;
304
305
306 (** val signal_select2 : signal -> signal -> signal -> signal,
307 [signal_select2 si s0 s1] selects s0 or s1 by index si, frequency consistent.*)
308 let signal_select2 si s0 s1 =
309 let f = signal_check_frequency3 si s0 s1 in
310 let new_signal = fun t ->
311 if (signal_fun si) t = N 0 then (signal_fun s0) t
312 else if (signal_fun si) t = N 1 then (signal_fun s1) t
313 else raise (Signal_operation "select2 index should be 0 or 1.")
314 in
315 (f, new_signal);;
316
317
318 (** val signal_select3 : signal -> signal -> signal -> signal -> signal,
319 [signal_select3 si s0 s1 s2] selects s0 or s1 or s2 by index si, frequency consistent.*)
320 let signal_select3 si s0 s1 s2 =
321 let f = signal_check_frequency4 si s0 s1 s2 in
322 let new_signal = fun t ->
323 if (signal_fun si) t = N 0 then (signal_fun s0) t
324 else if (signal_fun si) t = N 1 then (signal_fun s1) t
325 else if (signal_fun si) t = N 2 then (signal_fun s2) t
326 else raise (Signal_operation "select3 index should be 0 or 1 or 2.")
327 in
328 (f, new_signal);;
329
330
331 (** val signal_prefix : signal -> signal -> signal,
332 [signal_prefix s0 s1] returns s0(0) if t = 0, s1(t-1) if t > 0, frequency same to s1.*)
333 let signal_prefix = fun s0 -> fun s1 ->
334 let new_signal = fun t ->
335 if t = 0 then (signal_fun s0) 0
336 else if t > 0 then (signal_fun s1) t
337 else raise (Signal_operation "prefix time cannot be < 0.")
338 in
339 (frequency s1, new_signal);;