From: WANG Date: Tue, 13 Aug 2013 13:59:51 +0000 (+0200) Subject: Refactoring of rec process "~" in faustexp.ml. X-Git-Url: https://scm.cri.mines-paristech.fr/git/Faustine.git/commitdiff_plain/a6a80a5868c766f1a5360fd27f132fad425f8fe5 Refactoring of rec process "~" in faustexp.ml. --- diff --git a/interpretor/beam.ml b/interpretor/beam.ml index fe3ac61..7726e95 100644 --- a/interpretor/beam.ml +++ b/interpretor/beam.ml @@ -100,4 +100,10 @@ class beam : signal_type array -> beam_type = in let () = print_string error_message in transpose (Array.sub container 0 !index) + + method frequency : int array = + let each_rate : signal -> int = + fun (s : signal) -> s#frequency in + Array.map each_rate self#get + end diff --git a/interpretor/faustexp.ml b/interpretor/faustexp.ml index cc725ba..e8ff318 100644 --- a/interpretor/faustexp.ml +++ b/interpretor/faustexp.ml @@ -205,7 +205,7 @@ class virtual process_binary = | Seq (e1, e2) -> proc_left#delay + proc_right#delay | Split (e1, e2) -> proc_left#delay + proc_right#delay | Merge (e1, e2) -> proc_left#delay + proc_right#delay - | Rec (e1, e2) -> proc_left#delay + proc_right#delay + | Rec (e1, e2) -> 1 + proc_left#delay + proc_right#delay | _ -> raise (Process_error "binary process constructor.") end @@ -232,7 +232,6 @@ and proc_split : faust_exp -> process_type = self#proc_right#eval mid_input end - and proc_merge : faust_exp -> process_type = fun (exp_init : faust_exp) -> object (self) @@ -256,13 +255,55 @@ and proc_seq : faust_exp -> process_type = and proc_rec : faust_exp -> process_type = fun (exp_init : faust_exp) -> - object (self) - inherit process_binary exp_init - method eval : beam_type -> beam_type = - fun (input : beam_type) -> - let mid_output = self#proc_left#eval input in - self#proc_right#eval mid_output - end + object (self) + inherit process_binary exp_init + method eval : beam_type -> beam_type = + fun (input : beam_type) -> + let memory = Hashtbl.create self#delay in + let rates = ref (Array.make self#dim#output 0) in + + let split : (time -> value_type array) -> (time -> value_type) array = + fun beam_at -> + let get_signal = + fun beam_func -> fun i -> fun t -> + (beam_func t).(i) in + Array.init self#dim#output (get_signal beam_at) in + + let array_map2 = fun f -> fun a -> fun b -> + let n1 = Array.length a in + let n2 = Array.length b in + if n1 = n2 then Array.init n1 (fun i -> f a.(i) b.(i)) + else raise (Process_error "Array.map2 size not matched.") in + + let feedback : (time -> value_type array) -> beam = + fun beam_at -> + let signals_at = split beam_at in + let delay_by_one = fun s -> fun t -> s (t - 1) in + let delay_signal_funcs = Array.map delay_by_one + (Array.sub signals_at 0 self#proc_right#dim#input) in + new beam (array_map2 (new signal) + (Array.sub !rates 0 self#proc_right#dim#input) + delay_signal_funcs) in + + let rec beam_at : time -> value_type array = + fun (t : time) -> + if t < 0 then + Array.make self#dim#output (new value Zero) + else if Hashtbl.mem memory t then + Hashtbl.find memory t + else + let beam_fb_in = feedback beam_at in + let beam_fb_out = self#proc_right#eval beam_fb_in in + let beam_in = beam_fb_out#append input in + let beam_out = self#proc_left#eval beam_in in + let values = beam_out#at t in + let () = (rates := beam_out#frequency) in + let () = Hashtbl.add memory t values in + let () = if t - self#delay >= 0 then + Hashtbl.remove memory (t - self#delay) else () in + values in + new beam (array_map2 (new signal) !rates (split beam_at)) + end and proc_factory = object diff --git a/interpretor/types.ml b/interpretor/types.ml index 3ad5f8a..a252ed9 100644 --- a/interpretor/types.ml +++ b/interpretor/types.ml @@ -125,6 +125,7 @@ class type beam_type = method matching : int -> beam_type method at : time -> value_type array method output : int -> value_type array array + method frequency : int array end;;