From: WANG Date: Mon, 5 Aug 2013 15:27:50 +0000 (+0200) Subject: Refactoring in faustexp.ml. X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/commitdiff_plain/4d5f39ea1ae1eff1d8eadf7875851be467e40a47?ds=inline Refactoring in faustexp.ml. --- diff --git a/interpretor/beam.ml b/interpretor/beam.ml index 0468e42..a4f22b8 100644 --- a/interpretor/beam.ml +++ b/interpretor/beam.ml @@ -8,6 +8,8 @@ exception Beam_matching of string;; open Types;; +open Basic;; +open Value;; open Signal;; class beam : signal_type array -> beam_type = @@ -59,12 +61,39 @@ class beam : signal_type array -> beam_type = else raise (Beam_matching "matching size error") - method time : time -> value_type array = + method at : time -> value_type array = fun t -> let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in Array.map (signal_at t) self#get - method output : int -> (int array) * (float array array) = + method output : int -> value_type array array = fun (length_max : int) -> - + let transpose : 'a array array -> 'a array array = + fun matrix -> + let get_element = fun i -> fun array -> array.(i) in + let get_column = fun m -> fun i -> Array.map (get_element i) m in + Array.init self#width (get_column matrix) in + let value_init = new value Error in + let container = Array.make length_max + (Array.make self#width value_init) in + let index = ref 0 in + + try + while !index < length_max do + container.(!index) <- self#at !index; + incr index; + done; + transpose container + with x -> + + let error_message = + match x with + | Convert_Error s -> "Convert_Error: " ^ s + | Basic_operation s -> "Basic_operation: " ^ s + | Signal_operation s -> "Signal_operation: " ^ s + | Beam_matching s -> "Beam_Matching_Error: " ^ s + | _ -> "Compute finished." + in + let () = print_string error_message in + transpose (Array.sub container 0 !index) end diff --git a/interpretor/faust-0.9.47mr3/compiler/preprocess.a b/interpretor/faust-0.9.47mr3/compiler/preprocess.a index 023801b..8a4962e 100644 Binary files a/interpretor/faust-0.9.47mr3/compiler/preprocess.a and b/interpretor/faust-0.9.47mr3/compiler/preprocess.a differ diff --git a/interpretor/faustexp.ml b/interpretor/faustexp.ml index 6b324a0..684eb75 100644 --- a/interpretor/faustexp.ml +++ b/interpretor/faustexp.ml @@ -1,22 +1,83 @@ (** Module: Faustexp - Description: dimension estimation and delay estimation of faust expressions. + Description: Faust expression evaluation @author WANG Haisheng - Created: 03/06/2013 Modified: 04/06/2013 + Created: 03/06/2013 Modified: 04/08/2013 *) open Types;; open Value;; - +open Signal;; +open Beam;; exception NotYetDone;; - - - -class virtual expression : expression_type = +exception Dimension_error of string;; + +class dimension : int * int -> dimension_type = + fun (init : int * int) -> + object (self) + val dim_input = fst init + val dim_output = snd init + + method input = dim_input + method output = dim_output + + method par : dimension_type -> dimension_type = + fun dim -> + new dimension + ((self#input + dim#input), (self#output + dim#output)) + + method seq : dimension_type -> dimension_type = + fun dim -> + if self#output = dim#input then + new dimension (self#input, dim#output) + else raise (Dimension_error "seq dimension not matched.") + + method split : dimension_type -> dimension_type = + fun dim -> + if dim#input mod self#output = 0 then + new dimension (self#input, dim#output) + else raise (Dimension_error "split dimension not matched.") + + method merge : dimension_type -> dimension_type = + fun dim -> + if self#output mod dim#input = 0 then + new dimension (self#input, dim#output) + else raise (Dimension_error "merge dimension not matched.") + + method _rec : dimension_type -> dimension_type = + fun dim -> + if self#output >= dim#input && self#input >= dim#output then + new dimension (self#input - dim#output, self#output) + else raise (Dimension_error "rec dimension not matched.") + end;; + +class process : faust_exp -> process_type = fun (exp_init : faust_exp) -> - object - val exp = exp_init + object (self) + val exp = exp_init + val left = + match exp_init with + | Const b -> exp_init + | Ident s -> exp_init + | Par (e1, e2) -> e1 + | Seq (e1, e2) -> e1 + | Split (e1, e2) -> e1 + | Merge (e1, e2) -> e1 + | Rec (e1, e2) -> e1 + + val right = + match exp_init with + | Const b -> exp_init + | Ident s -> exp_init + | Par (e1, e2) -> e2 + | Seq (e1, e2) -> e2 + | Split (e1, e2) -> e2 + | Merge (e1, e2) -> e2 + | Rec (e1, e2) -> e2 + + val proc_left = + val dim = new dimension val delay = 0 method get_exp = exp @@ -24,12 +85,14 @@ class virtual expression : expression_type = method get_delay = delay method to_string = "NotYetDone" method virtual evaluate : beam_type -> beam_type -end;; + end;; -class exp_const = - object - inherit expression +class proc_const : faust_exp -> process_type = + fun (exp_init : faust_exp) -> + object (self) + val exp = exp_init + val dim = method evaluate = fun b1 -> end;; @@ -74,7 +137,7 @@ class exp_rec = end;; - +*) @@ -97,15 +160,15 @@ let rec delay exp_faust = match exp_faust with |Pass -> 0 |Stop -> 0 |Mem -> 1 - |Delay -> 100000 (* danger! *) + |Delay -> 100000 |Floor -> 0 |Int -> 0 |Sin -> 0 - |Rdtable -> 100000 (* danger! *) + |Rdtable -> 100000 |Mod -> 0 |Larger -> 0 |Smaller -> 0 - |Vectorize -> 100 (* danger! *) + |Vectorize -> 100 |Concat -> 0 |Nth -> 0 |Serialize -> 0 @@ -152,46 +215,6 @@ let subtree_left = fun d_tree -> subtree d_tree 0;; (** val subtree_right : dimension -> dimension, returns the right subtree of dimension tree.*) let subtree_right = fun d_tree -> subtree d_tree 1;; - -(** val d_par : int * int -> int * int -> int * int, process dimension for constructor "par(,)", -which is the addition of two dimensions.*) -let d_par a b = (((fst a) + (fst b)), ((snd a) + (snd b)));; - - -(** val d_seq : int * int -> int * int -> int * int, process dimension for constructor "seq(:)", -which is (size of input beam of first exp, size of output beam of second exp) -along with beam matching.*) -let d_seq a b = if (snd a) = (fst b) then (fst a, snd b) else raise (Beam_Matching_Error "seq");; - - -(** val d_split : int * int -> int * int -> int * int, process dimension for constructor "split(<:)", -which is (size of input beam of first exp, size of output beam of second exp) -along with beam matching.*) -let d_split a b = - if ((fst b) mod (snd a)) = 0 then - (fst a, snd b) - else raise (Beam_Matching_Error "split");; - - -(** val d_merge : int * int -> int * int -> int * int, process dimension for constructor "merge(:>)", -which is (size of input beam of first exp, size of output beam of second exp) -along with beam matching. *) -let d_merge a b = - if ((snd a) mod (fst b)) = 0 then - (fst a, snd b) - else raise (Beam_Matching_Error "merge");; - - -(** val d_rec : int * int -> int * int -> int * int, process dimension for constructor "rec(~)", -which is (size of input beam of first exp - size of output beam of second exp, -size of output beam of first exp) -along with beam matching.*) -let d_rec a b = - if (fst a) >= (snd b) && (snd a) >= (fst b) then - ((fst a) - (snd b), snd a) - else raise (Beam_Matching_Error "rec");; - - (** val dim : faust_exp -> int * int, returns dimension for faust expression, along with beam matching.*) let rec dim exp_faust = diff --git a/interpretor/types.ml b/interpretor/types.ml index d117836..6fa6513 100644 --- a/interpretor/types.ml +++ b/interpretor/types.ml @@ -118,12 +118,12 @@ class type signal_type = class type beam_type = object method get : signal_type array - method length : int + method width : int method sub : int -> int -> beam_type method append : beam_type -> beam_type method matching : int -> beam_type - method time : time -> value_type array - method output : int -> (int list) * (float array list) + method at : time -> value_type array + method output : int -> value_type array array end;; @@ -131,14 +131,19 @@ class type dimension_type = object method input : int method output : int + method par : dimension_type -> dimension_type + method seq : dimension_type -> dimension_type + method split : dimension_type -> dimension_type + method merge : dimension_type -> dimension_type + method _rec : dimension_type -> dimension_type end;; -class type expression_type = +class type process_type = object - method get_exp : faust_exp - method get_dim : dimension_type - method get_delay : int + method exp : faust_exp + method dim : dimension_type + method delay : int method to_string : string method evaluate : beam_type -> beam_type end;;