From: WANG <wang@wang-OptiPlex-780.(none)>
Date: Tue, 13 Aug 2013 13:59:51 +0000 (+0200)
Subject: Refactoring of rec process "~" in faustexp.ml.
X-Git-Url: https://svn.cri.ensmp.fr/git/Faustine.git/commitdiff_plain/a6a80a5868c766f1a5360fd27f132fad425f8fe5?ds=inline;hp=-c

Refactoring of rec process "~" in faustexp.ml.
---

a6a80a5868c766f1a5360fd27f132fad425f8fe5
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;;