gitignore update.
[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 signal : int -> (time -> value_type) -> signal_type =
17 fun (freq_init : int) ->
18 fun (func_init : time -> value_type) ->
19 object (self)
20 val mutable signal_func = func_init
21 val mutable memory_length = 0
22 method frequency = freq_init
23 method at = signal_func
24
25 method private check_freq : signal_type list -> int =
26 fun (sl : signal_type list) ->
27 let check : int -> signal_type -> int =
28 fun (f : int) ->
29 fun (s : signal_type) ->
30 if f = s#frequency || s#frequency = 0 then f
31 else if f = 0 then s#frequency
32 else raise (Signal_operation "frequency not matched.") in
33 List.fold_left check self#frequency sl
34
35 method add_memory : int -> unit =
36 fun (length : int) ->
37 assert (length >= 0);
38 if memory_length >= length then ()
39 else
40 let memory = Hashtbl.create length in
41 let func : time -> value =
42 fun (t : time) ->
43 try Hashtbl.find memory t
44 with Not_found ->
45 let result = func_init t in
46 let () = Hashtbl.replace memory t result in
47 let () =
48 if (t - length) >= 0 then
49 Hashtbl.remove memory (t - length)
50 else () in
51 result in
52 memory_length <- length;
53 signal_func <- func
54
55 method private delay_by : int -> time -> value =
56 fun i -> fun t ->
57 if (t - i) >= 0 then
58 self#at (t - i)
59 else if t >= 0 && (t - i) < 0 then
60 (self#at 0)#zero
61 else raise (Signal_operation "Delay time < 0.")
62
63 method private prim1 :
64 (time -> value_type) -> signal_type =
65 fun (func : time -> value_type) ->
66 let freq = self#frequency in
67 new signal freq func
68
69 method private prim2 :
70 (time -> value_type -> value_type) -> signal_type -> signal_type =
71 fun (func_binary : time -> value_type -> value_type) ->
72 fun (s : signal_type) ->
73 let freq = self#check_freq [s] in
74 let func = fun t -> (func_binary t) (s#at t) in
75 new signal freq func
76
77 method neg = self#prim1 (fun t -> (self#at t)#neg)
78 method floor = self#prim1 (fun t -> (self#at t)#floor)
79 method sin = self#prim1 (fun t -> (self#at t)#sin)
80 method cos = self#prim1 (fun t -> (self#at t)#cos)
81 method atan = self#prim1 (fun t -> (self#at t)#atan)
82 method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
83 method int = self#prim1 (fun t -> (self#at t)#int)
84
85 method add = self#prim2 (fun t -> (self#at t)#add)
86 method sub = self#prim2 (fun t -> (self#at t)#sub)
87 method mul = self#prim2 (fun t -> (self#at t)#mul)
88 method div = self#prim2 (fun t -> (self#at t)#div)
89 method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
90 method _mod = self#prim2 (fun t -> (self#at t)#_mod)
91 method larger = self#prim2 (fun t -> (self#at t)#larger)
92 method smaller = self#prim2 (fun t -> (self#at t)#smaller)
93 method max = self#prim2 (fun t -> (self#at t)#max)
94 method min = self#prim2 (fun t -> (self#at t)#min)
95
96 method delay : signal_type -> signal_type =
97 fun (s : signal_type) ->
98 let freq = self#check_freq [s] in
99 let () = self#add_memory delay_memory_length in
100 let func : time -> value_type =
101 fun (t : time) ->
102 let i = (s#at t)#to_int in
103 self#delay_by i t in
104 new signal freq func
105
106 method mem : signal_type =
107 let freq = self#frequency in
108 let () = self#add_memory 1 in
109 let func = fun (t : time) -> self#delay_by 1 t in
110 new signal freq func
111
112 method rdtable : signal_type -> signal_type -> signal_type =
113 fun (s_size : signal_type) ->
114 fun (s_index : signal_type) ->
115 let freq = self#check_freq [s_index] in
116 let () = self#add_memory ((s_size#at 0)#to_int) in
117 let func : time -> value_type = fun t ->
118 self#at ((s_index#at t)#to_int) in
119 new signal freq func
120
121 method select2 : signal_type -> signal_type -> signal_type =
122 fun s_first ->
123 fun s_second ->
124 let freq = self#check_freq [s_first; s_second] in
125 let func : time -> value_type =
126 fun t -> let i = (self#at t)#to_int in
127 if i = 0 then s_first#at t
128 else if i = 1 then s_second#at t
129 else raise (Signal_operation "select2 index 0|1.") in
130 new signal freq func
131
132 method select3 :
133 signal_type -> signal_type -> signal_type -> signal_type =
134 fun s_first -> fun s_second -> fun s_third ->
135 let freq = self#check_freq [s_first; s_second; s_third] in
136 let func : time -> value_type =
137 fun t -> let i = (self#at t)#to_int in
138 if i = 0 then s_first#at t
139 else if i = 1 then s_second#at t
140 else if i = 2 then s_third#at t
141 else raise (Signal_operation "select2 index 0|1.") in
142 new signal freq func
143
144 method prefix : signal_type -> signal_type =
145 fun (s_init : signal_type) ->
146 let () = self#add_memory 1 in
147 let func : time -> value_type =
148 fun t ->
149 if t = 0 then s_init#at 0
150 else if t > 0 then self#at (t - 1)
151 else raise (Signal_operation "prefix time < 0.") in
152 new signal self#frequency func
153
154
155 method vectorize : signal_type -> signal_type =
156 fun s_size ->
157 let size = (s_size#at 0)#to_int in
158 if size <= 0 then
159 raise (Signal_operation "Vectorize: size <= 0.")
160 else
161 let freq = self#frequency / size in
162 let func : time -> value_type =
163 fun t ->
164 let vec = fun i -> (self#at (size * t + i))#get in
165 new value (Vec (new vector size vec)) in
166 new signal freq func
167
168
169 method serialize : signal_type =
170 let size =
171 match (self#at 0)#get with
172 | Vec vec -> vec#size
173 | _ -> raise (Signal_operation "Serialize: scalar input.") in
174 let freq = self#frequency * size in
175 let func : time -> value_type =
176 fun t ->
177 match (self#at (t/size))#get with
178 | Vec vec -> new value (vec#nth (t mod size))
179 | _ -> raise (Signal_operation
180 "Serialize: signal type not consistent.") in
181 new signal freq func
182
183 method vconcat : signal_type -> signal_type =
184 fun s ->
185 let freq = self#check_freq [s] in
186 let func : time -> value_type =
187 fun t ->
188 match ((self#at t)#get, (s#at t)#get) with
189 | (Vec vec1, Vec vec2) ->
190 let size1 = vec1#size in
191 let size2 = vec2#size in
192 let size = size1 + size2 in
193 let vec = fun i ->
194 if i < size1 then vec1#nth i
195 else vec2#nth (i - size1) in
196 new value (Vec (new vector size vec))
197 | _ -> raise (Signal_operation "Vconcat: scalar.") in
198 new signal freq func
199
200 method vpick : signal_type -> signal_type =
201 fun s_index ->
202 let freq = self#check_freq [s_index] in
203 let func : time -> value_type =
204 fun t ->
205 let i = (s_index#at t)#to_int in
206 match (self#at t)#get with
207 | Vec vec -> new value (vec#nth i)
208 | _ -> raise (Signal_operation "Vpick: scalar.") in
209 new signal freq func
210
211 end;;