X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/1059e1cc0c2ecfa237406949aa26155b6a5b9154..66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83:/interpretor/signal.ml diff --git a/interpretor/signal.ml b/interpretor/signal.ml deleted file mode 100644 index 66089e9..0000000 --- a/interpretor/signal.ml +++ /dev/null @@ -1,289 +0,0 @@ -(** - 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;;