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