(** 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;;