interpreter/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 factor =
  24         if denom_init = 0 then
  25           raise (Signal_operation "sample rate denominater = 0.")
  26         else
  27           pgcd (abs num_init) (abs denom_init) in
  28       object (self)
  29         val _num = num_init / factor
  30         val _denom = denom_init / factor
  31         method num = _num
  32         method denom = _denom
  33         method to_int =
  34           self#num / self#denom
  35         method to_float =
  36           (float_of_int self#num) /. (float_of_int self#denom)
  37         method to_string =
  38           (string_of_int self#num) ^ "/" ^ (string_of_int self#denom)
  39         method equal : rate_type -> bool =
  40           fun (r : rate_type) -> (self#num = r#num) && (self#denom = r#denom)
  41         method mul : int -> rate_type =
  42           fun (i : int) -> new rate (self#num * i) self#denom
  43         method div : int -> rate_type =
  44           fun (i : int) -> new rate self#num (self#denom * i)
  45       end
  46
  47
  48 class signal : rate_type -> (time -> value_type) -> signal_type =
  49   fun (freq_init : rate_type) ->
  50     fun (func_init : time -> value_type) ->
  51       object (self)
  52         val mutable signal_func = func_init
  53         val mutable memory_length = 0
  54         method frequency = freq_init
  55         method at = signal_func
  56
  57         method private check_freq : signal_type list -> rate_type =
  58           fun (sl : signal_type list) ->
  59             let check : rate_type -> signal_type -> rate_type =
  60               fun (f : rate_type) ->
  61                 fun (s : signal_type) ->
  62                   if f#equal s#frequency || s#frequency#num = 0 then f
  63                   else if f#num = 0 then s#frequency
  64                   else raise (Signal_operation "frequency not matched.") in
  65             List.fold_left check self#frequency sl
  66
  67         method add_memory : int -> unit =
  68           fun (length : int) ->
  69             assert (length >= 0);
  70             if memory_length >= length then ()
  71             else
  72               let memory = Hashtbl.create length in
  73               let func : time -> value =
  74                 fun (t : time) ->
  75                   try Hashtbl.find memory t
  76                   with Not_found ->
  77                     let result = func_init t in
  78                     let () = Hashtbl.replace memory t result in
  79                     let () =
  80                       if (t - length) >= 0 then
  81                         Hashtbl.remove memory (t - length)
  82                       else () in
  83                     result in
  84               memory_length <- length;
  85               signal_func <- func
  86
  87         method private delay_by : int -> time -> value =
  88           fun i -> fun t ->
  89             if (t - i) >= 0 then
  90               self#at (t - i)
  91             else if t >= 0 && (t - i) < 0 then
  92               (self#at 0)#zero
  93             else raise (Signal_operation "Delay time < 0.")
  94
  95         method private prim1 :
  96             (time -> value_type) -> signal_type =
  97               fun (func : time -> value_type) ->
  98                 let freq = self#frequency in
  99                 new signal freq func
 100
 101         method private prim2 :
 102             (time -> value_type -> value_type) -> signal_type -> signal_type =
 103           fun (func_binary : time -> value_type -> value_type) ->
 104             fun (s : signal_type) ->
 105               let freq = self#check_freq [s] in
 106               let func = fun t -> (func_binary t) (s#at t) in
 107               new signal freq func
 108
 109         method neg = self#prim1 (fun t -> (self#at t)#neg)
 110         method floor = self#prim1 (fun t -> (self#at t)#floor)
 111         method ceil = self#prim1 (fun t -> (self#at t)#ceil)
 112         method rint = self#prim1 (fun t -> (self#at t)#rint)
 113         method sin = self#prim1 (fun t -> (self#at t)#sin)
 114         method asin = self#prim1 (fun t -> (self#at t)#asin)
 115         method cos = self#prim1 (fun t -> (self#at t)#cos)
 116         method acos = self#prim1 (fun t -> (self#at t)#acos)
 117         method tan = self#prim1 (fun t -> (self#at t)#tan)
 118         method atan = self#prim1 (fun t -> (self#at t)#atan)
 119         method exp = self#prim1 (fun t -> (self#at t)#exp)
 120         method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
 121         method ln = self#prim1 (fun t -> (self#at t)#ln)
 122         method lg = self#prim1 (fun t -> (self#at t)#lg)
 123         method int = self#prim1 (fun t -> (self#at t)#int)
 124         method float = self#prim1 (fun t -> (self#at t)#float)
 125         method abs = self#prim1 (fun t -> (self#at t)#abs)
 126
 127         method add = self#prim2 (fun t -> (self#at t)#add)
 128         method sub = self#prim2 (fun t -> (self#at t)#sub)
 129         method mul = self#prim2 (fun t -> (self#at t)#mul)
 130         method div = self#prim2 (fun t -> (self#at t)#div)
 131         method power = self#prim2 (fun t -> (self#at t)#power)
 132         method _and = self#prim2 (fun t -> (self#at t)#_and)
 133         method _or = self#prim2 (fun t -> (self#at t)#_or)
 134         method _xor = self#prim2 (fun t -> (self#at t)#_xor)
 135         method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
 136         method _mod = self#prim2 (fun t -> (self#at t)#_mod)
 137         method fmod = self#prim2 (fun t -> (self#at t)#fmod)
 138         method remainder = self#prim2 (fun t -> (self#at t)#remainder)
 139         method gt = self#prim2 (fun t -> (self#at t)#gt)
 140         method lt = self#prim2 (fun t -> (self#at t)#lt)
 141         method geq = self#prim2 (fun t -> (self#at t)#geq)
 142         method leq = self#prim2 (fun t -> (self#at t)#leq)
 143         method eq = self#prim2 (fun t -> (self#at t)#eq)
 144         method neq = self#prim2 (fun t -> (self#at t)#neq)
 145         method max = self#prim2 (fun t -> (self#at t)#max)
 146         method min = self#prim2 (fun t -> (self#at t)#min)
 147         method shl = self#prim2 (fun t -> (self#at t)#shl)
 148         method shr = self#prim2 (fun t -> (self#at t)#shr)
 149
 150         method delay : signal_type -> signal_type =
 151           fun (s : signal_type) ->
 152             let freq = self#check_freq [s] in
 153             let () = self#add_memory delay_memory_length in
 154             let func : time -> value_type =
 155               fun (t : time) ->
 156                 let i = (s#at t)#to_int in
 157                 self#delay_by i t  in
 158             new signal freq func
 159
 160         method mem : signal_type =
 161           let freq = self#frequency in
 162           let () = self#add_memory 1 in
 163           let func = fun (t : time) -> self#delay_by 1 t in
 164           new signal freq func
 165
 166         method rdtable : signal_type -> signal_type -> signal_type =
 167           fun (s_size : signal_type) ->
 168             fun (s_index : signal_type) ->
 169               let freq = self#check_freq [s_index] in
 170               let () = self#add_memory ((s_size#at 0)#to_int) in
 171               let func : time -> value_type = fun t ->
 172                 self#at ((s_index#at t)#to_int) in
 173               new signal freq func
 174
 175         method rwtable : signal_type -> signal_type ->
 176           signal_type -> signal_type -> signal_type =
 177             fun init -> fun wstream -> fun windex -> fun rindex ->
 178               let freq = self#check_freq [init; wstream; windex; rindex] in
 179               let () = init#add_memory ((self#at 0)#to_int) in
 180               let () = wstream#add_memory ((self#at 0)#to_int) in
 181               let func : time -> value_type = fun (ti : time) ->
 182                 let rec table : time -> index -> value_type =
 183                   fun t -> fun i ->
 184                     if t > 0 then
 185                       (if i = (windex#at t)#to_int then (wstream#at t)
 186                       else table (t - 1) i)
 187                     else if t = 0 then
 188                       (if i = (windex#at 0)#to_int then (wstream#at 0)
 189                       else init#at i)
 190                     else raise (Signal_operation "signal time should be > 0") in
 191                 table ti ((rindex#at ti)#to_int) in
 192               new signal freq func
 193
 194         method select2 : signal_type -> signal_type -> signal_type =
 195           fun s_first ->
 196             fun s_second ->
 197               let freq = self#check_freq [s_first; s_second] in
 198               let func : time -> value_type =
 199                 fun t -> let i = (self#at t)#to_int in
 200                 if i = 0 then s_first#at t
 201                 else if i = 1 then s_second#at t
 202                 else raise (Signal_operation "select2 index 0|1.") in
 203               new signal freq func
 204
 205         method select3 :
 206             signal_type -> signal_type -> signal_type -> signal_type =
 207               fun s_first -> fun s_second -> fun s_third ->
 208                 let freq = self#check_freq [s_first; s_second; s_third] in
 209                 let func : time -> value_type =
 210                   fun t -> let i = (self#at t)#to_int in
 211                   if i = 0 then s_first#at t
 212                   else if i = 1 then s_second#at t
 213                   else if i = 2 then s_third#at t
 214                   else raise (Signal_operation "select2 index 0|1.") in
 215                 new signal freq func
 216
 217         method prefix : signal_type -> signal_type =
 218             fun (s_init : signal_type) ->
 219               let () = self#add_memory 1 in
 220               let func : time -> value_type =
 221                 fun t ->
 222                   if t = 0 then s_init#at 0
 223                   else if t > 0 then self#at (t - 1)
 224                   else raise (Signal_operation "prefix time < 0.") in
 225               new signal self#frequency func
 226
 227
 228         method vectorize : signal_type -> signal_type =
 229           fun s_size ->
 230             let size = (s_size#at 0)#to_int in
 231             if size <= 0 then
 232               raise (Signal_operation "Vectorize: size <= 0.")
 233             else
 234               let freq = self#frequency#div size in
 235               let func : time -> value_type =
 236                 fun t ->
 237                   let vec = fun i -> (self#at (size * t + i))#get in
 238                   new value (Vec (new vector size vec)) in
 239               new signal freq func
 240
 241         method serialize : signal_type =
 242           let size =
 243             match (self#at 0)#get with
 244             | Vec vec -> vec#size
 245             | _ -> raise (Signal_operation "Serialize: scalar input.") in
 246           let freq = self#frequency#mul size in
 247           let func : time -> value_type =
 248             fun t ->
 249               match (self#at (t/size))#get with
 250               | Vec vec -> new value (vec#nth (t mod size))
 251               | _ -> raise (Signal_operation
 252                               "Serialize: signal type not consistent.") in
 253           new signal freq func
 254
 255         method vconcat : signal_type -> signal_type =
 256           fun s ->
 257             let freq = self#check_freq [s] in
 258             let func : time -> value_type =
 259               fun t ->
 260                 match ((self#at t)#get, (s#at t)#get) with
 261                 | (Vec vec1, Vec vec2) ->
 262                     let size1 = vec1#size in
 263                     let size2 = vec2#size in
 264                     let size = size1 + size2 in
 265                     let vec = fun i ->
 266                       if i < size1 then vec1#nth i
 267                       else vec2#nth (i - size1) in
 268                     new value (Vec (new vector size vec))
 269                 | _ -> raise (Signal_operation "Vconcat: scalar.") in
 270             new signal freq func
 271
 272         method vpick : signal_type -> signal_type =
 273           fun s_index ->
 274             let freq = self#check_freq [s_index] in
 275             let func : time -> value_type =
 276               fun t ->
 277                 let i = (s_index#at t)#to_int in
 278                 match (self#at t)#get with
 279                 | Vec vec -> new value (vec#nth i)
 280                 | _ -> raise (Signal_operation "Vpick: scalar.") in
 281             new signal freq func
 282
 283       end;;