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 signal : int -> (time -> value_type) -> signal_type =
  17   fun (freq_init : int) ->
  18     fun (func_init : time -> value_type) ->
  19       object (self)
  20         val mutable signal_func = func_init
  21         val mutable memory_length = 0
  22         method frequency = freq_init
  23         method at = signal_func
  24
  25         method private check_freq : signal_type list -> int =
  26           fun (sl : signal_type list) ->
  27             let check : int -> signal_type -> int =
  28               fun (f : int) ->
  29                 fun (s : signal_type) ->
  30                   if f = s#frequency || s#frequency = 0 then f
  31                   else if f = 0 then s#frequency
  32                   else raise (Signal_operation "frequency not matched.") in
  33             List.fold_left check self#frequency sl
  34
  35         method add_memory : int -> unit =
  36           fun (length : int) ->
  37             assert (length >= 0);
  38             if memory_length >= length then ()
  39             else
  40               let memory = Hashtbl.create length in
  41               let func : time -> value =
  42                 fun (t : time) ->
  43                   try Hashtbl.find memory t
  44                   with Not_found ->
  45                     let result = func_init t in
  46                     let () = Hashtbl.replace memory t result in
  47                     let () =
  48                       if (t - length) >= 0 then
  49                         Hashtbl.remove memory (t - length)
  50                       else () in
  51                     result in
  52               memory_length <- length;
  53               signal_func <- func
  54
  55         method private delay_by : int -> time -> value =
  56           fun i -> fun t ->
  57             if (t - i) >= 0 then
  58               self#at (t - i)
  59             else if t >= 0 && (t - i) < 0 then
  60               (self#at 0)#zero
  61             else raise (Signal_operation "Delay time < 0.")
  62
  63         method private prim1 :
  64             (time -> value_type) -> signal_type =
  65               fun (func : time -> value_type) ->
  66                 let freq = self#frequency in
  67                 new signal freq func
  68
  69         method private prim2 :
  70             (time -> value_type -> value_type) -> signal_type -> signal_type =
  71           fun (func_binary : time -> value_type -> value_type) ->
  72             fun (s : signal_type) ->
  73               let freq = self#check_freq [s] in
  74               let func = fun t -> (func_binary t) (s#at t) in
  75               new signal freq func
  76
  77         method neg = self#prim1 (fun t -> (self#at t)#neg)
  78         method floor = self#prim1 (fun t -> (self#at t)#floor)
  79         method sin = self#prim1 (fun t -> (self#at t)#sin)
  80         method cos = self#prim1 (fun t -> (self#at t)#cos)
  81         method atan = self#prim1 (fun t -> (self#at t)#atan)
  82         method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
  83         method int = self#prim1 (fun t -> (self#at t)#int)
  84
  85         method add = self#prim2 (fun t -> (self#at t)#add)
  86         method sub = self#prim2 (fun t -> (self#at t)#sub)
  87         method mul = self#prim2 (fun t -> (self#at t)#mul)
  88         method div = self#prim2 (fun t -> (self#at t)#div)
  89         method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
  90         method _mod = self#prim2 (fun t -> (self#at t)#_mod)
  91         method larger = self#prim2 (fun t -> (self#at t)#larger)
  92         method smaller = self#prim2 (fun t -> (self#at t)#smaller)
  93         method max = self#prim2 (fun t -> (self#at t)#max)
  94         method min = self#prim2 (fun t -> (self#at t)#min)
  95
  96         method delay : signal_type -> signal_type =
  97           fun (s : signal_type) ->
  98             let freq = self#check_freq [s] in
  99             let () = self#add_memory delay_memory_length in
 100             let func : time -> value_type =
 101               fun (t : time) ->
 102                 let i = (s#at t)#to_int in
 103                 self#delay_by i t  in
 104             new signal freq func
 105
 106         method mem : signal_type =
 107           let freq = self#frequency in
 108           let () = self#add_memory 1 in
 109           let func = fun (t : time) -> self#delay_by 1 t in
 110           new signal freq func
 111
 112         method rdtable : signal_type -> signal_type -> signal_type =
 113           fun (s_size : signal_type) ->
 114             fun (s_index : signal_type) ->
 115               let freq = self#check_freq [s_index] in
 116               let () = self#add_memory ((s_size#at 0)#to_int) in
 117               let func : time -> value_type = fun t ->
 118                 self#at ((s_index#at t)#to_int) in
 119               new signal freq func
 120
 121         method select2 : signal_type -> signal_type -> signal_type =
 122           fun s_first ->
 123             fun s_second ->
 124               let freq = self#check_freq [s_first; s_second] in
 125               let func : time -> value_type =
 126                 fun t -> let i = (self#at t)#to_int in
 127                 if i = 0 then s_first#at t
 128                 else if i = 1 then s_second#at t
 129                 else raise (Signal_operation "select2 index 0|1.") in
 130               new signal freq func
 131
 132         method select3 :
 133             signal_type -> signal_type -> signal_type -> signal_type =
 134               fun s_first -> fun s_second -> fun s_third ->
 135                 let freq = self#check_freq [s_first; s_second; s_third] in
 136                 let func : time -> value_type =
 137                   fun t -> let i = (self#at t)#to_int in
 138                   if i = 0 then s_first#at t
 139                   else if i = 1 then s_second#at t
 140                   else if i = 2 then s_third#at t
 141                   else raise (Signal_operation "select2 index 0|1.") in
 142                 new signal freq func
 143
 144         method prefix : signal_type -> signal_type =
 145             fun (s_init : signal_type) ->
 146               let () = self#add_memory 1 in
 147               let func : time -> value_type =
 148                 fun t ->
 149                   if t = 0 then s_init#at 0
 150                   else if t > 0 then self#at (t - 1)
 151                   else raise (Signal_operation "prefix time < 0.") in
 152               new signal self#frequency func
 153
 154
 155         method vectorize : signal_type -> signal_type =
 156           fun s_size ->
 157             let size = (s_size#at 0)#to_int in
 158             if size <= 0 then
 159               raise (Signal_operation "Vectorize: size <= 0.")
 160             else
 161               let freq = self#frequency / size in
 162               let func : time -> value_type =
 163                 fun t ->
 164                   let vec = fun i -> (self#at (size * t + i))#get in
 165                   new value (Vec (new vector size vec)) in
 166               new signal freq func
 167
 168
 169         method serialize : signal_type =
 170           let size =
 171             match (self#at 0)#get with
 172             | Vec vec -> vec#size
 173             | _ -> raise (Signal_operation "Serialize: scalar input.") in
 174           let freq = self#frequency * size in
 175           let func : time -> value_type =
 176             fun t ->
 177               match (self#at (t/size))#get with
 178               | Vec vec -> new value (vec#nth (t mod size))
 179               | _ -> raise (Signal_operation
 180                               "Serialize: signal type not consistent.") in
 181           new signal freq func
 182
 183         method vconcat : signal_type -> signal_type =
 184           fun s ->
 185             let freq = self#check_freq [s] in
 186             let func : time -> value_type =
 187               fun t ->
 188                 match ((self#at t)#get, (s#at t)#get) with
 189                 | (Vec vec1, Vec vec2) ->
 190                     let size1 = vec1#size in
 191                     let size2 = vec2#size in
 192                     let size = size1 + size2 in
 193                     let vec = fun i ->
 194                       if i < size1 then vec1#nth i
 195                       else vec2#nth (i - size1) in
 196                     new value (Vec (new vector size vec))
 197                 | _ -> raise (Signal_operation "Vconcat: scalar.") in
 198             new signal freq func
 199
 200         method vpick : signal_type -> signal_type =
 201           fun s_index ->
 202             let freq = self#check_freq [s_index] in
 203             let func : time -> value_type =
 204               fun t ->
 205                 let i = (s_index#at t)#to_int in
 206                 match (self#at t)#get with
 207                 | Vec vec -> new value (vec#nth i)
 208                 | _ -> raise (Signal_operation "Vpick: scalar.") in
 209             new signal freq func
 210
 211       end;;