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 ceil = self#prim1 (fun t -> (self#at t)#ceil)
 117         method rint = self#prim1 (fun t -> (self#at t)#rint)
 118         method sin = self#prim1 (fun t -> (self#at t)#sin)
 119         method asin = self#prim1 (fun t -> (self#at t)#asin)
 120         method cos = self#prim1 (fun t -> (self#at t)#cos)
 121         method acos = self#prim1 (fun t -> (self#at t)#acos)
 122         method tan = self#prim1 (fun t -> (self#at t)#tan)
 123         method atan = self#prim1 (fun t -> (self#at t)#atan)
 124         method exp = self#prim1 (fun t -> (self#at t)#exp)
 125         method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
 126         method ln = self#prim1 (fun t -> (self#at t)#ln)
 127         method lg = self#prim1 (fun t -> (self#at t)#lg)
 128         method int = self#prim1 (fun t -> (self#at t)#int)
 129         method float = self#prim1 (fun t -> (self#at t)#float)
 130         method abs = self#prim1 (fun t -> (self#at t)#abs)
 131
 132         method add = self#prim2 (fun t -> (self#at t)#add)
 133         method sub = self#prim2 (fun t -> (self#at t)#sub)
 134         method mul = self#prim2 (fun t -> (self#at t)#mul)
 135         method div = self#prim2 (fun t -> (self#at t)#div)
 136         method power = self#prim2 (fun t -> (self#at t)#power)
 137         method _and = self#prim2 (fun t -> (self#at t)#_and)
 138         method _or = self#prim2 (fun t -> (self#at t)#_or)
 139         method _xor = self#prim2 (fun t -> (self#at t)#_xor)
 140         method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
 141         method _mod = self#prim2 (fun t -> (self#at t)#_mod)
 142         method fmod = self#prim2 (fun t -> (self#at t)#fmod)
 143         method remainder = self#prim2 (fun t -> (self#at t)#remainder)
 144         method gt = self#prim2 (fun t -> (self#at t)#gt)
 145         method lt = self#prim2 (fun t -> (self#at t)#lt)
 146         method geq = self#prim2 (fun t -> (self#at t)#geq)
 147         method leq = self#prim2 (fun t -> (self#at t)#leq)
 148         method eq = self#prim2 (fun t -> (self#at t)#eq)
 149         method neq = self#prim2 (fun t -> (self#at t)#neq)
 150         method max = self#prim2 (fun t -> (self#at t)#max)
 151         method min = self#prim2 (fun t -> (self#at t)#min)
 152         method shl = self#prim2 (fun t -> (self#at t)#shl)
 153         method shr = self#prim2 (fun t -> (self#at t)#shr)
 154
 155         method delay : signal_type -> signal_type =
 156           fun (s : signal_type) ->
 157             let freq = self#check_freq [s] in
 158             let () = self#add_memory delay_memory_length in
 159             let func : time -> value_type =
 160               fun (t : time) ->
 161                 let i = (s#at t)#to_int in
 162                 self#delay_by i t  in
 163             new signal freq func
 164
 165         method mem : signal_type =
 166           let freq = self#frequency in
 167           let () = self#add_memory 1 in
 168           let func = fun (t : time) -> self#delay_by 1 t in
 169           new signal freq func
 170
 171         method rdtable : signal_type -> signal_type -> signal_type =
 172           fun (s_size : signal_type) ->
 173             fun (s_index : signal_type) ->
 174               let freq = self#check_freq [s_index] in
 175               let () = self#add_memory ((s_size#at 0)#to_int) in
 176               let func : time -> value_type = fun t ->
 177                 self#at ((s_index#at t)#to_int) in
 178               new signal freq func
 179
 180         method rwtable : signal_type -> signal_type ->
 181           signal_type -> signal_type -> signal_type =
 182             fun init -> fun wstream -> fun windex -> fun rindex ->
 183               let freq = self#check_freq [init; wstream; windex; rindex] in
 184               let () = init#add_memory ((self#at 0)#to_int) in
 185               let () = wstream#add_memory ((self#at 0)#to_int) in
 186               let func : time -> value_type = fun (ti : time) ->
 187                 let rec table : time -> index -> value_type =
 188                   fun t -> fun i ->
 189                     if t > 0 then
 190                       (if i = (windex#at t)#to_int then (wstream#at t)
 191                       else table (t - 1) i)
 192                     else if t = 0 then
 193                       (if i = (windex#at 0)#to_int then (wstream#at 0)
 194                       else init#at i)
 195                     else raise (Signal_operation "signal time should be > 0") in
 196                 table ti ((rindex#at ti)#to_int) in
 197               new signal freq func
 198
 199         method select2 : signal_type -> signal_type -> signal_type =
 200           fun s_first ->
 201             fun s_second ->
 202               let freq = self#check_freq [s_first; s_second] in
 203               let func : time -> value_type =
 204                 fun t -> let i = (self#at t)#to_int in
 205                 if i = 0 then s_first#at t
 206                 else if i = 1 then s_second#at t
 207                 else raise (Signal_operation "select2 index 0|1.") in
 208               new signal freq func
 209
 210         method select3 :
 211             signal_type -> signal_type -> signal_type -> signal_type =
 212               fun s_first -> fun s_second -> fun s_third ->
 213                 let freq = self#check_freq [s_first; s_second; s_third] in
 214                 let func : time -> value_type =
 215                   fun t -> let i = (self#at t)#to_int in
 216                   if i = 0 then s_first#at t
 217                   else if i = 1 then s_second#at t
 218                   else if i = 2 then s_third#at t
 219                   else raise (Signal_operation "select2 index 0|1.") in
 220                 new signal freq func
 221
 222         method prefix : signal_type -> signal_type =
 223             fun (s_init : signal_type) ->
 224               let () = self#add_memory 1 in
 225               let func : time -> value_type =
 226                 fun t ->
 227                   if t = 0 then s_init#at 0
 228                   else if t > 0 then self#at (t - 1)
 229                   else raise (Signal_operation "prefix time < 0.") in
 230               new signal self#frequency func
 231
 232
 233         method vectorize : signal_type -> signal_type =
 234           fun s_size ->
 235             let size = (s_size#at 0)#to_int in
 236             if size <= 0 then
 237               raise (Signal_operation "Vectorize: size <= 0.")
 238             else
 239               let freq = self#frequency#div size in
 240               let func : time -> value_type =
 241                 fun t ->
 242                   let vec = fun i -> (self#at (size * t + i))#get in
 243                   new value (Vec (new vector size vec)) in
 244               new signal freq func
 245
 246
 247         method serialize : signal_type =
 248           let size =
 249             match (self#at 0)#get with
 250             | Vec vec -> vec#size
 251             | _ -> raise (Signal_operation "Serialize: scalar input.") in
 252           let freq = self#frequency#mul size in
 253           let func : time -> value_type =
 254             fun t ->
 255               match (self#at (t/size))#get with
 256               | Vec vec -> new value (vec#nth (t mod size))
 257               | _ -> raise (Signal_operation
 258                               "Serialize: signal type not consistent.") in
 259           new signal freq func
 260
 261         method vconcat : signal_type -> signal_type =
 262           fun s ->
 263             let freq = self#check_freq [s] in
 264             let func : time -> value_type =
 265               fun t ->
 266                 match ((self#at t)#get, (s#at t)#get) with
 267                 | (Vec vec1, Vec vec2) ->
 268                     let size1 = vec1#size in
 269                     let size2 = vec2#size in
 270                     let size = size1 + size2 in
 271                     let vec = fun i ->
 272                       if i < size1 then vec1#nth i
 273                       else vec2#nth (i - size1) in
 274                     new value (Vec (new vector size vec))
 275                 | _ -> raise (Signal_operation "Vconcat: scalar.") in
 276             new signal freq func
 277
 278         method vpick : signal_type -> signal_type =
 279           fun s_index ->
 280             let freq = self#check_freq [s_index] in
 281             let func : time -> value_type =
 282               fun t ->
 283                 let i = (s_index#at t)#to_int in
 284                 match (self#at t)#get with
 285                 | Vec vec -> new value (vec#nth i)
 286                 | _ -> raise (Signal_operation "Vpick: scalar.") in
 287             new signal freq func
 288
 289       end;;