interpretor/signal.ml

   1 (**
   2         Module: Signal
   3         Description: signal definition and operations.
   4         @author WANG Haisheng
   5         Created: 03/06/2013     Modified: 03/06/2013
   6 *)
   7
   8 open Types;;
   9 open Basic;;
  10 open Value;;
  11
  12 exception Signal_operation of string;;
  13
  14 let delay_memory_length = 10000;;
  15
  16 class rate : int -> int -> rate_type =
  17   fun (num_init : int) ->
  18     fun (denom_init : int) ->
  19       let rec pgcd : int -> int -> int =
  20         fun i1 -> fun i2 ->
  21           let r = i1 mod i2 in
  22           if r = 0 then i2 else pgcd i2 r in
  23       let num_positive =
  24         if num_init >= 0 then num_init
  25         else (-num_init) in
  26       let denom_positive =
  27         if denom_init > 0 then denom_init
  28         else if denom_init < 0 then -denom_init
  29         else raise (Signal_operation "sample rate denominater = 0.") in
  30       let factor = pgcd num_positive denom_positive in
  31       let num_corrected = num_init / factor in
  32       let denom_corrected = denom_init / factor in
  33       object (self)
  34         val _num = num_corrected
  35         val _denom = denom_corrected
  36         method num = _num
  37         method denom = _denom
  38         method to_int =
  39           self#num / self#denom
  40         method to_float =
  41           (float_of_int self#num) /. (float_of_int self#denom)
  42         method to_string =
  43           (string_of_int self#num) ^ "/" ^ (string_of_int self#denom)
  44         method equal : rate_type -> bool =
  45           fun (r : rate_type) -> (self#num = r#num) && (self#denom = r#denom)
  46         method mul : int -> rate_type =
  47           fun (i : int) -> new rate (self#num * i) self#denom
  48         method div : int -> rate_type =
  49           fun (i : int) -> new rate self#num (self#denom * i)
  50       end
  51
  52
  53 class signal : rate_type -> (time -> value_type) -> signal_type =
  54   fun (freq_init : rate_type) ->
  55     fun (func_init : time -> value_type) ->
  56       object (self)
  57         val mutable signal_func = func_init
  58         val mutable memory_length = 0
  59         method frequency = freq_init
  60         method at = signal_func
  61
  62         method private check_freq : signal_type list -> rate_type =
  63           fun (sl : signal_type list) ->
  64             let check : rate_type -> signal_type -> rate_type =
  65               fun (f : rate_type) ->
  66                 fun (s : signal_type) ->
  67                   if f#equal s#frequency || s#frequency#num = 0 then f
  68                   else if f#num = 0 then s#frequency
  69                   else raise (Signal_operation "frequency not matched.") in
  70             List.fold_left check self#frequency sl
  71
  72         method add_memory : int -> unit =
  73           fun (length : int) ->
  74             assert (length >= 0);
  75             if memory_length >= length then ()
  76             else
  77               let memory = Hashtbl.create length in
  78               let func : time -> value =
  79                 fun (t : time) ->
  80                   try Hashtbl.find memory t
  81                   with Not_found ->
  82                     let result = func_init t in
  83                     let () = Hashtbl.replace memory t result in
  84                     let () =
  85                       if (t - length) >= 0 then
  86                         Hashtbl.remove memory (t - length)
  87                       else () in
  88                     result in
  89               memory_length <- length;
  90               signal_func <- func
  91
  92         method private delay_by : int -> time -> value =
  93           fun i -> fun t ->
  94             if (t - i) >= 0 then
  95               self#at (t - i)
  96             else if t >= 0 && (t - i) < 0 then
  97               (self#at 0)#zero
  98             else raise (Signal_operation "Delay time < 0.")
  99
 100         method private prim1 :
 101             (time -> value_type) -> signal_type =
 102               fun (func : time -> value_type) ->
 103                 let freq = self#frequency in
 104                 new signal freq func
 105
 106         method private prim2 :
 107             (time -> value_type -> value_type) -> signal_type -> signal_type =
 108           fun (func_binary : time -> value_type -> value_type) ->
 109             fun (s : signal_type) ->
 110               let freq = self#check_freq [s] in
 111               let func = fun t -> (func_binary t) (s#at t) in
 112               new signal freq func
 113
 114         method neg = self#prim1 (fun t -> (self#at t)#neg)
 115         method floor = self#prim1 (fun t -> (self#at t)#floor)
 116         method sin = self#prim1 (fun t -> (self#at t)#sin)
 117         method cos = self#prim1 (fun t -> (self#at t)#cos)
 118         method atan = self#prim1 (fun t -> (self#at t)#atan)
 119         method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
 120         method int = self#prim1 (fun t -> (self#at t)#int)
 121
 122         method add = self#prim2 (fun t -> (self#at t)#add)
 123         method sub = self#prim2 (fun t -> (self#at t)#sub)
 124         method mul = self#prim2 (fun t -> (self#at t)#mul)
 125         method div = self#prim2 (fun t -> (self#at t)#div)
 126         method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
 127         method _mod = self#prim2 (fun t -> (self#at t)#_mod)
 128         method larger = self#prim2 (fun t -> (self#at t)#larger)
 129         method smaller = self#prim2 (fun t -> (self#at t)#smaller)
 130         method max = self#prim2 (fun t -> (self#at t)#max)
 131         method min = self#prim2 (fun t -> (self#at t)#min)
 132
 133         method delay : signal_type -> signal_type =
 134           fun (s : signal_type) ->
 135             let freq = self#check_freq [s] in
 136             let () = self#add_memory delay_memory_length in
 137             let func : time -> value_type =
 138               fun (t : time) ->
 139                 let i = (s#at t)#to_int in
 140                 self#delay_by i t  in
 141             new signal freq func
 142
 143         method mem : signal_type =
 144           let freq = self#frequency in
 145           let () = self#add_memory 1 in
 146           let func = fun (t : time) -> self#delay_by 1 t in
 147           new signal freq func
 148
 149         method rdtable : signal_type -> signal_type -> signal_type =
 150           fun (s_size : signal_type) ->
 151             fun (s_index : signal_type) ->
 152               let freq = self#check_freq [s_index] in
 153               let () = self#add_memory ((s_size#at 0)#to_int) in
 154               let func : time -> value_type = fun t ->
 155                 self#at ((s_index#at t)#to_int) in
 156               new signal freq func
 157
 158         method select2 : signal_type -> signal_type -> signal_type =
 159           fun s_first ->
 160             fun s_second ->
 161               let freq = self#check_freq [s_first; s_second] in
 162               let func : time -> value_type =
 163                 fun t -> let i = (self#at t)#to_int in
 164                 if i = 0 then s_first#at t
 165                 else if i = 1 then s_second#at t
 166                 else raise (Signal_operation "select2 index 0|1.") in
 167               new signal freq func
 168
 169         method select3 :
 170             signal_type -> signal_type -> signal_type -> signal_type =
 171               fun s_first -> fun s_second -> fun s_third ->
 172                 let freq = self#check_freq [s_first; s_second; s_third] in
 173                 let func : time -> value_type =
 174                   fun t -> let i = (self#at t)#to_int in
 175                   if i = 0 then s_first#at t
 176                   else if i = 1 then s_second#at t
 177                   else if i = 2 then s_third#at t
 178                   else raise (Signal_operation "select2 index 0|1.") in
 179                 new signal freq func
 180
 181         method prefix : signal_type -> signal_type =
 182             fun (s_init : signal_type) ->
 183               let () = self#add_memory 1 in
 184               let func : time -> value_type =
 185                 fun t ->
 186                   if t = 0 then s_init#at 0
 187                   else if t > 0 then self#at (t - 1)
 188                   else raise (Signal_operation "prefix time < 0.") in
 189               new signal self#frequency func
 190
 191
 192         method vectorize : signal_type -> signal_type =
 193           fun s_size ->
 194             let size = (s_size#at 0)#to_int in
 195             if size <= 0 then
 196               raise (Signal_operation "Vectorize: size <= 0.")
 197             else
 198               let freq = self#frequency#div size in
 199               let func : time -> value_type =
 200                 fun t ->
 201                   let vec = fun i -> (self#at (size * t + i))#get in
 202                   new value (Vec (new vector size vec)) in
 203               new signal freq func
 204
 205
 206         method serialize : signal_type =
 207           let size =
 208             match (self#at 0)#get with
 209             | Vec vec -> vec#size
 210             | _ -> raise (Signal_operation "Serialize: scalar input.") in
 211           let freq = self#frequency#mul size in
 212           let func : time -> value_type =
 213             fun t ->
 214               match (self#at (t/size))#get with
 215               | Vec vec -> new value (vec#nth (t mod size))
 216               | _ -> raise (Signal_operation
 217                               "Serialize: signal type not consistent.") in
 218           new signal freq func
 219
 220         method vconcat : signal_type -> signal_type =
 221           fun s ->
 222             let freq = self#check_freq [s] in
 223             let func : time -> value_type =
 224               fun t ->
 225                 match ((self#at t)#get, (s#at t)#get) with
 226                 | (Vec vec1, Vec vec2) ->
 227                     let size1 = vec1#size in
 228                     let size2 = vec2#size in
 229                     let size = size1 + size2 in
 230                     let vec = fun i ->
 231                       if i < size1 then vec1#nth i
 232                       else vec2#nth (i - size1) in
 233                     new value (Vec (new vector size vec))
 234                 | _ -> raise (Signal_operation "Vconcat: scalar.") in
 235             new signal freq func
 236
 237         method vpick : signal_type -> signal_type =
 238           fun s_index ->
 239             let freq = self#check_freq [s_index] in
 240             let func : time -> value_type =
 241               fun t ->
 242                 let i = (s_index#at t)#to_int in
 243                 match (self#at t)#get with
 244                 | Vec vec -> new value (vec#nth i)
 245                 | _ -> raise (Signal_operation "Vpick: scalar.") in
 246             new signal freq func
 247
 248       end;;