X-Git-Url: https://scm.cri.minesparis.psl.eu/git/Faustine.git/blobdiff_plain/1059e1cc0c2ecfa237406949aa26155b6a5b9154..66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83:/interpreter/signal.ml

diff --git a/interpreter/signal.ml b/interpreter/signal.ml
new file mode 100644
index 0000000..66089e9
--- /dev/null
+++ b/interpreter/signal.ml
@@ -0,0 +1,289 @@
+(**
+ 	Module: Signal	
+	Description: signal definition and operations.
+	@author WANG Haisheng	
+	Created: 03/06/2013	Modified: 03/06/2013
+*)
+
+open Types;;
+open Basic;;
+open Value;;
+
+exception Signal_operation of string;;
+
+let delay_memory_length = 10000;;
+
+class rate : int -> int -> rate_type = 
+  fun (num_init : int) ->
+    fun (denom_init : int) ->
+      let rec pgcd : int -> int -> int = 
+	fun i1 -> fun i2 ->
+	  let r = i1 mod i2 in 
+	  if r = 0 then i2 else pgcd i2 r in
+      let num_positive = 
+	if num_init >= 0 then num_init 
+	else (-num_init) in
+      let denom_positive = 
+	if denom_init > 0 then denom_init 
+	else if denom_init < 0 then -denom_init
+	else raise (Signal_operation "sample rate denominater = 0.") in
+      let factor = pgcd num_positive denom_positive in
+      let num_corrected = num_init / factor in
+      let denom_corrected = denom_init / factor in
+      object (self)
+	val _num = num_corrected
+	val _denom = denom_corrected
+	method num = _num
+	method denom = _denom
+	method to_int = 
+	  self#num / self#denom
+	method to_float = 
+	  (float_of_int self#num) /. (float_of_int self#denom)
+	method to_string = 
+	  (string_of_int self#num) ^ "/" ^ (string_of_int self#denom)
+	method equal : rate_type -> bool = 
+	  fun (r : rate_type) -> (self#num = r#num) && (self#denom = r#denom)
+	method mul : int -> rate_type = 
+	  fun (i : int) -> new rate (self#num * i) self#denom
+	method div : int -> rate_type = 
+	  fun (i : int) -> new rate self#num (self#denom * i)
+      end
+	  
+
+class signal : rate_type -> (time -> value_type) -> signal_type = 
+  fun (freq_init : rate_type) ->
+    fun (func_init : time -> value_type) ->
+      object (self)
+	val mutable signal_func = func_init
+	val mutable memory_length = 0
+	method frequency = freq_init
+	method at = signal_func
+
+	method private check_freq : signal_type list -> rate_type = 
+	  fun (sl : signal_type list) ->
+	    let check : rate_type -> signal_type -> rate_type = 
+	      fun (f : rate_type) ->
+		fun (s : signal_type) ->
+		  if f#equal s#frequency || s#frequency#num = 0 then f
+		  else if f#num = 0 then s#frequency
+		  else raise (Signal_operation "frequency not matched.") in
+	    List.fold_left check self#frequency sl
+
+	method add_memory : int -> unit = 
+	  fun (length : int) ->
+	    assert (length >= 0);
+	    if memory_length >= length then ()
+	    else
+	      let memory = Hashtbl.create length in
+	      let func : time -> value = 
+		fun (t : time) ->
+		  try Hashtbl.find memory t
+		  with Not_found ->
+		    let result = func_init t in
+		    let () = Hashtbl.replace memory t result in
+		    let () = 
+		      if (t - length) >= 0 then
+			Hashtbl.remove memory (t - length)
+		      else () in
+		    result in
+	      memory_length <- length;
+	      signal_func <- func
+
+	method private delay_by : int -> time -> value = 
+	  fun i -> fun t ->
+	    if (t - i) >= 0 then
+	      self#at (t - i)
+	    else if t >= 0 && (t - i) < 0 then
+	      (self#at 0)#zero
+	    else raise (Signal_operation "Delay time < 0.")
+
+	method private prim1 : 
+	    (time -> value_type) -> signal_type = 
+	      fun (func : time -> value_type) ->
+		let freq = self#frequency in
+		new signal freq func 
+
+	method private prim2 : 
+	    (time -> value_type -> value_type) -> signal_type -> signal_type = 
+	  fun (func_binary : time -> value_type -> value_type) ->
+	    fun (s : signal_type) ->
+	      let freq = self#check_freq [s] in
+	      let func = fun t -> (func_binary t) (s#at t) in
+	      new signal freq func
+
+	method neg = self#prim1 (fun t -> (self#at t)#neg)
+	method floor = self#prim1 (fun t -> (self#at t)#floor)
+	method ceil = self#prim1 (fun t -> (self#at t)#ceil)
+	method rint = self#prim1 (fun t -> (self#at t)#rint)
+	method sin = self#prim1 (fun t -> (self#at t)#sin)
+	method asin = self#prim1 (fun t -> (self#at t)#asin)
+	method cos = self#prim1 (fun t -> (self#at t)#cos)
+	method acos = self#prim1 (fun t -> (self#at t)#acos)
+	method tan = self#prim1 (fun t -> (self#at t)#tan)
+	method atan = self#prim1 (fun t -> (self#at t)#atan)
+	method exp = self#prim1 (fun t -> (self#at t)#exp)
+	method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
+	method ln = self#prim1 (fun t -> (self#at t)#ln)
+	method lg = self#prim1 (fun t -> (self#at t)#lg)
+	method int = self#prim1 (fun t -> (self#at t)#int)
+	method float = self#prim1 (fun t -> (self#at t)#float)
+	method abs = self#prim1 (fun t -> (self#at t)#abs)
+
+	method add = self#prim2 (fun t -> (self#at t)#add)
+	method sub = self#prim2 (fun t -> (self#at t)#sub)
+	method mul = self#prim2 (fun t -> (self#at t)#mul)
+	method div = self#prim2 (fun t -> (self#at t)#div)
+	method power = self#prim2 (fun t -> (self#at t)#power)
+	method _and = self#prim2 (fun t -> (self#at t)#_and)
+	method _or = self#prim2 (fun t -> (self#at t)#_or)
+	method _xor = self#prim2 (fun t -> (self#at t)#_xor)
+	method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
+	method _mod = self#prim2 (fun t -> (self#at t)#_mod)
+	method fmod = self#prim2 (fun t -> (self#at t)#fmod)
+	method remainder = self#prim2 (fun t -> (self#at t)#remainder)
+	method gt = self#prim2 (fun t -> (self#at t)#gt)
+	method lt = self#prim2 (fun t -> (self#at t)#lt)
+	method geq = self#prim2 (fun t -> (self#at t)#geq)
+	method leq = self#prim2 (fun t -> (self#at t)#leq)
+	method eq = self#prim2 (fun t -> (self#at t)#eq)
+	method neq = self#prim2 (fun t -> (self#at t)#neq)
+	method max = self#prim2 (fun t -> (self#at t)#max)
+	method min = self#prim2 (fun t -> (self#at t)#min)
+	method shl = self#prim2 (fun t -> (self#at t)#shl)
+	method shr = self#prim2 (fun t -> (self#at t)#shr)
+
+	method delay : signal_type -> signal_type =
+	  fun (s : signal_type) ->
+	    let freq = self#check_freq [s] in
+	    let () = self#add_memory delay_memory_length in
+	    let func : time -> value_type = 
+	      fun (t : time) ->
+		let i = (s#at t)#to_int in
+		self#delay_by i t  in
+	    new signal freq func
+
+	method mem : signal_type = 
+	  let freq = self#frequency in
+	  let () = self#add_memory 1 in
+	  let func = fun (t : time) -> self#delay_by 1 t in
+	  new signal freq func
+
+	method rdtable : signal_type -> signal_type -> signal_type = 
+	  fun (s_size : signal_type) ->
+	    fun (s_index : signal_type) ->
+	      let freq = self#check_freq [s_index] in
+	      let () = self#add_memory ((s_size#at 0)#to_int) in
+	      let func : time -> value_type = fun t -> 
+		self#at ((s_index#at t)#to_int) in
+	      new signal freq func
+
+	method rwtable : signal_type -> signal_type -> 
+	  signal_type -> signal_type -> signal_type = 
+	    fun init -> fun wstream -> fun windex -> fun rindex ->
+	      let freq = self#check_freq [init; wstream; windex; rindex] in
+	      let () = init#add_memory ((self#at 0)#to_int) in
+	      let () = wstream#add_memory ((self#at 0)#to_int) in
+	      let func : time -> value_type = fun (ti : time) -> 
+		let rec table : time -> index -> value_type = 
+		  fun t -> fun i -> 
+		    if t > 0 then
+		      (if i = (windex#at t)#to_int then (wstream#at t)
+		      else table (t - 1) i)
+		    else if t = 0 then
+		      (if i = (windex#at 0)#to_int then (wstream#at 0)
+		      else init#at i)
+		    else raise (Signal_operation "signal time should be > 0") in
+		table ti ((rindex#at ti)#to_int) in
+	      new signal freq func
+
+	method select2 : signal_type -> signal_type -> signal_type =
+	  fun s_first -> 
+	    fun s_second ->
+	      let freq = self#check_freq [s_first; s_second] in
+	      let func : time -> value_type = 
+		fun t -> let i = (self#at t)#to_int in
+		if i = 0 then s_first#at t
+		else if i = 1 then s_second#at t
+		else raise (Signal_operation "select2 index 0|1.") in
+	      new signal freq func
+
+	method select3 : 
+	    signal_type -> signal_type -> signal_type -> signal_type =
+	      fun s_first -> fun s_second -> fun s_third ->
+		let freq = self#check_freq [s_first; s_second; s_third] in
+		let func : time -> value_type = 
+		  fun t -> let i = (self#at t)#to_int in
+		  if i = 0 then s_first#at t
+		  else if i = 1 then s_second#at t
+		  else if i = 2 then s_third#at t
+		  else raise (Signal_operation "select2 index 0|1.") in
+		new signal freq func	
+		    
+	method prefix : signal_type -> signal_type =
+	    fun (s_init : signal_type) ->
+	      let () = self#add_memory 1 in
+	      let func : time -> value_type = 
+		fun t ->
+		  if t = 0 then s_init#at 0
+		  else if t > 0 then self#at (t - 1) 
+		  else raise (Signal_operation "prefix time < 0.") in
+	      new signal self#frequency func
+
+
+	method vectorize : signal_type -> signal_type =
+	  fun s_size ->
+	    let size = (s_size#at 0)#to_int in
+	    if size <= 0 then      
+	      raise (Signal_operation "Vectorize: size <= 0.")
+	    else 
+	      let freq = self#frequency#div size in
+	      let func : time -> value_type = 
+		fun t ->
+		  let vec = fun i -> (self#at (size * t + i))#get in
+		  new value (Vec (new vector size vec)) in
+	      new signal freq func
+
+
+	method serialize : signal_type = 
+	  let size = 
+	    match (self#at 0)#get with
+	    | Vec vec -> vec#size
+	    | _ -> raise (Signal_operation "Serialize: scalar input.") in
+	  let freq = self#frequency#mul size in
+	  let func : time -> value_type = 
+	    fun t -> 
+	      match (self#at (t/size))#get with
+	      | Vec vec -> new value (vec#nth (t mod size))
+	      | _ -> raise (Signal_operation 
+			      "Serialize: signal type not consistent.") in
+	  new signal freq func
+
+	method vconcat : signal_type -> signal_type = 
+	  fun s ->
+	    let freq = self#check_freq [s] in
+	    let func : time -> value_type = 
+	      fun t ->
+		match ((self#at t)#get, (s#at t)#get) with
+		| (Vec vec1, Vec vec2) ->
+		    let size1 = vec1#size in
+		    let size2 = vec2#size in
+		    let size = size1 + size2 in
+		    let vec = fun i -> 
+		      if i < size1 then vec1#nth i
+		      else vec2#nth (i - size1) in
+		    new value (Vec (new vector size vec))
+		| _ -> raise (Signal_operation "Vconcat: scalar.") in
+	    new signal freq func
+
+	method vpick : signal_type -> signal_type = 
+	  fun s_index ->
+	    let freq = self#check_freq [s_index] in
+	    let func : time -> value_type = 
+	      fun t -> 
+		let i = (s_index#at t)#to_int in
+		match (self#at t)#get with
+		| Vec vec -> new value (vec#nth i)
+		| _ -> raise (Signal_operation "Vpick: scalar.") in
+	    new signal freq func
+
+      end;;