684eb751526501f15464f3b2cba7c98b7c912cda
[Faustine.git] / interpretor / faustexp.ml
1 (**
2 Module: Faustexp
3 Description: Faust expression evaluation
4 @author WANG Haisheng
5 Created: 03/06/2013 Modified: 04/08/2013
6 *)
7
8 open Types;;
9 open Value;;
10 open Signal;;
11 open Beam;;
12
13 exception NotYetDone;;
14 exception Dimension_error of string;;
15
16 class dimension : int * int -> dimension_type =
17 fun (init : int * int) ->
18 object (self)
19 val dim_input = fst init
20 val dim_output = snd init
21
22 method input = dim_input
23 method output = dim_output
24
25 method par : dimension_type -> dimension_type =
26 fun dim ->
27 new dimension
28 ((self#input + dim#input), (self#output + dim#output))
29
30 method seq : dimension_type -> dimension_type =
31 fun dim ->
32 if self#output = dim#input then
33 new dimension (self#input, dim#output)
34 else raise (Dimension_error "seq dimension not matched.")
35
36 method split : dimension_type -> dimension_type =
37 fun dim ->
38 if dim#input mod self#output = 0 then
39 new dimension (self#input, dim#output)
40 else raise (Dimension_error "split dimension not matched.")
41
42 method merge : dimension_type -> dimension_type =
43 fun dim ->
44 if self#output mod dim#input = 0 then
45 new dimension (self#input, dim#output)
46 else raise (Dimension_error "merge dimension not matched.")
47
48 method _rec : dimension_type -> dimension_type =
49 fun dim ->
50 if self#output >= dim#input && self#input >= dim#output then
51 new dimension (self#input - dim#output, self#output)
52 else raise (Dimension_error "rec dimension not matched.")
53 end;;
54
55 class process : faust_exp -> process_type =
56 fun (exp_init : faust_exp) ->
57 object (self)
58 val exp = exp_init
59 val left =
60 match exp_init with
61 | Const b -> exp_init
62 | Ident s -> exp_init
63 | Par (e1, e2) -> e1
64 | Seq (e1, e2) -> e1
65 | Split (e1, e2) -> e1
66 | Merge (e1, e2) -> e1
67 | Rec (e1, e2) -> e1
68
69 val right =
70 match exp_init with
71 | Const b -> exp_init
72 | Ident s -> exp_init
73 | Par (e1, e2) -> e2
74 | Seq (e1, e2) -> e2
75 | Split (e1, e2) -> e2
76 | Merge (e1, e2) -> e2
77 | Rec (e1, e2) -> e2
78
79 val proc_left =
80
81 val dim = new dimension
82 val delay = 0
83 method get_exp = exp
84 method get_dim = dim
85 method get_delay = delay
86 method to_string = "NotYetDone"
87 method virtual evaluate : beam_type -> beam_type
88 end;;
89
90
91 class proc_const : faust_exp -> process_type =
92 fun (exp_init : faust_exp) ->
93 object (self)
94 val exp = exp_init
95 val dim =
96 method evaluate = fun b1 ->
97
98 end;;
99
100
101 class exp_ident =
102 object
103 inherit expression
104
105 end;;
106
107
108 class exp_par =
109 object
110 inherit expression
111
112 end;;
113
114
115 class exp_split =
116 object
117 inherit expression
118
119 end;;
120
121
122 class exp_merge =
123 object
124 inherit expression
125
126 end;;
127
128 class exp_seq =
129 object
130 inherit expression
131
132 end;;
133
134 class exp_rec =
135 object
136 inherit expression
137
138 end;;
139
140 *)
141
142
143
144
145 (* PROCESS DELAY ESTIMATION *)
146
147 (** val delay : faust_exp -> int, returns the number of delays estimated staticly.
148 Attention: delays of "@" is estimated as 10 constant,
149 delays of "vectorize" and "serialize" haven't been implemented,
150 delays of "rdtable" hasn't been implemented.*)
151 let rec delay exp_faust = match exp_faust with
152 |Const v -> 0
153 |Ident s ->
154 (
155 match s with
156 |Add -> 0
157 |Sup -> 0
158 |Mul -> 0
159 |Div -> 0
160 |Pass -> 0
161 |Stop -> 0
162 |Mem -> 1
163 |Delay -> 100000
164 |Floor -> 0
165 |Int -> 0
166 |Sin -> 0
167 |Rdtable -> 100000
168 |Mod -> 0
169 |Larger -> 0
170 |Smaller -> 0
171 |Vectorize -> 100
172 |Concat -> 0
173 |Nth -> 0
174 |Serialize -> 0
175 |Prefix -> 1
176 |Selecttwo -> 0
177 |Selectthree -> 0
178 )
179 |Par (e1, e2) -> max (delay e1) (delay e2)
180 |Seq (e1, e2) -> (delay e1) + (delay e2)
181 |Split (e1, e2) -> (delay e1) + (delay e2)
182 |Merge (e1, e2) -> (delay e1) + (delay e2)
183 |Rec (e1, e2) -> delay e1;;
184
185
186 (* PARSER *)
187
188 (** val exp_of_string : string -> faust_exp, faust expression parser. *)
189 let exp_of_string s = (Parser.main Lexer.token (Lexing.from_string s));;
190
191
192
193 (* PROCESS DIMENSION ESTIMATION *)
194 (* process dimension := (size of input beam, size of output beam).*)
195
196
197 (** val get_root : dimension -> int * int, returns the root of dimension tree. *)
198 let get_root = fun d_tree -> match d_tree with
199 | End d -> d
200 | Tree (d, branches) -> d;;
201
202
203 (** val subtree : dimention -> int -> dimension, returns a subtree of dimension tree.*)
204 let subtree = fun d_tree -> fun i ->
205 match d_tree with
206 | End d -> raise (Beam_Matching_Error "Subtree left absent.")
207 | Tree (d, branches) -> (
208 match branches with
209 (left, right) -> if i = 0 then left else right);;
210
211 (** val subtree_left : dimension -> dimension, returns the left subtree of dimension tree.*)
212 let subtree_left = fun d_tree -> subtree d_tree 0;;
213
214
215 (** val subtree_right : dimension -> dimension, returns the right subtree of dimension tree.*)
216 let subtree_right = fun d_tree -> subtree d_tree 1;;
217
218 (** val dim : faust_exp -> int * int, returns dimension for faust expression,
219 along with beam matching.*)
220 let rec dim exp_faust =
221
222 (** val dimension_constructor : ((int * int) -> (int * int) -> (int * int)) -> faust_exp
223 -> faust_exp -> dimension,
224 returns the dimension tree of constructor(e1, e2).*)
225 let dimension_constructor = fun constructor -> fun e1 -> fun e2 ->
226 let subtree1 = dim e1 in
227 let subtree2 = dim e2 in
228 let root = constructor (get_root subtree1) (get_root subtree2) in
229 Tree (root, (subtree1, subtree2)) in
230
231 match exp_faust with
232 |Const v -> End (0, 1)
233 |Ident s ->
234 (
235 match s with
236 |Add -> End (2, 1)
237 |Sup -> End (2, 1)
238 |Mul -> End (2, 1)
239 |Div -> End (2, 1)
240 |Pass -> End (1, 1)
241 |Stop -> End (1, 0)
242 |Mem -> End (1, 1)
243 |Delay -> End (2, 1)
244 |Floor -> End (1, 1)
245 |Int -> End (1, 1)
246 |Sin -> End (1, 1)
247 |Rdtable -> End (3, 1)
248 |Mod -> End (2, 1)
249 |Vectorize -> End (2, 1)
250 |Concat -> End (2, 1)
251 |Nth -> End (2, 1)
252 |Serialize -> End (1, 1)
253 |Larger -> End (2, 1)
254 |Smaller -> End (2, 1)
255 |Prefix -> End (2, 1)
256 |Selecttwo -> End (3, 1)
257 |Selectthree -> End (4, 1)
258 )
259
260 |Par (e1, e2) -> dimension_constructor d_par e1 e2
261 |Seq (e1, e2) -> dimension_constructor d_seq e1 e2
262 |Split (e1, e2) -> dimension_constructor d_split e1 e2
263 |Merge (e1, e2) -> dimension_constructor d_merge e1 e2
264 |Rec (e1, e2) -> dimension_constructor d_rec e1 e2;;
265
266
267
268 (* AUXILIARY 'CONVERT_TO_STRING' FUNCTIONS *)
269
270 (** val print_exp : faust_exp -> unit, print to console the input faust expression.*)
271 let print_exp exp =
272 let rec string_of_exp exp = match exp with
273 |Const v -> "Const" ^ " (" ^ (string_of_value v) ^ ")"
274 |Ident s -> "Ident" ^ " \"" ^ "s" ^ "\""
275 |Par (e1, e2) -> "Par" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
276 |Seq (e1, e2) -> "Seq" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
277 |Split (e1, e2) -> "Split" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
278 |Merge (e1, e2) -> "Merge" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
279 |Rec (e1, e2) -> "Rec" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
280 in
281 print_string("Parer : Types.faust_exp = "^ (string_of_exp exp));;