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 private 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
  94         method delay : signal_type -> signal_type =
  95           fun (s : signal_type) ->
  96             let freq = self#check_freq [s] in
  97             let () = self#add_memory delay_memory_length in
  98             let func : time -> value_type =
  99               fun (t : time) ->
 100                 let i = (s#at t)#to_int in
 101                 self#delay_by t i  in
 102             new signal freq func
 103
 104         method mem : signal_type =
 105           let freq = self#frequency in
 106           let () = self#add_memory 1 in
 107           let func = fun (t : time) -> self#delay_by t 1 in
 108           new signal freq func
 109
 110         method rdtable : signal_type -> signal_type -> signal_type =
 111           fun (s_size : signal_type) ->
 112             fun (s_index : signal_type) ->
 113               let freq = self#check_freq [s_index] in
 114               let () = self#add_memory ((s_size#at 0)#to_int) in
 115               let func : time -> value_type = fun t ->
 116                 self#at ((s_index#at t)#to_int) in
 117               new signal freq func
 118
 119         method select2 : signal_type -> signal_type -> signal_type =
 120           fun s_first ->
 121             fun s_second ->
 122               let freq = self#check_freq [s_first; s_second] in
 123               let func : time -> value_type =
 124                 fun t -> let i = (self#at t)#to_int in
 125                 if i = 0 then s_first#at t
 126                 else if i = 1 then s_second#at t
 127                 else raise (Signal_operation "select2 index 0|1.") in
 128               new signal freq func
 129
 130         method select3 :
 131             signal_type -> signal_type -> signal_type -> signal_type =
 132               fun s_first -> fun s_second -> fun s_third ->
 133                 let freq = self#check_freq [s_first; s_second; s_third] in
 134                 let func : time -> value_type =
 135                   fun t -> let i = (self#at t)#to_int in
 136                   if i = 0 then s_first#at t
 137                   else if i = 1 then s_second#at t
 138                   else if i = 2 then s_third#at t
 139                   else raise (Signal_operation "select2 index 0|1.") in
 140                 new signal freq func
 141
 142         method prefix : signal_type -> signal_type =
 143             fun (s_init : signal_type) ->
 144               let func : time -> value_type =
 145                 fun t ->
 146                   if t = 0 then s_init#at 0
 147                   else if t > 0 then self#at t
 148                   else raise (Signal_operation "prefix time < 0.") in
 149               new signal self#frequency func
 150
 151
 152         method vectorize : signal_type -> signal_type =
 153           fun s_size ->
 154             let size = (s_size#at 0)#to_int in
 155             if size <= 0 then
 156               raise (Signal_operation "Vectorize: size <= 0.")
 157             else
 158               let freq = self#frequency / size in
 159               let func : time -> value_type =
 160                 fun t ->
 161                   let vec = fun i -> (self#at (size * t + i))#get in
 162                   new value (Vec (new vector size vec)) in
 163               new signal freq func
 164
 165
 166         method serialize : signal_type =
 167           let size =
 168             match (self#at 0)#get with
 169             | Vec vec -> vec#size
 170             | _ -> raise (Signal_operation "Serialize: scalar input.") in
 171           let freq = self#frequency * size in
 172           let func : time -> value_type =
 173             fun t ->
 174               match (self#at (t/size))#get with
 175               | Vec vec -> new value (vec#nth (t mod size))
 176               | _ -> raise (Signal_operation
 177                               "Serialize: signal type not consistent.") in
 178           new signal freq func
 179
 180         method vconcat : signal_type -> signal_type =
 181           fun s ->
 182             let freq = self#check_freq [s] in
 183             let func : time -> value_type =
 184               fun t ->
 185                 match ((self#at t)#get, (s#at t)#get) with
 186                 | (Vec vec1, Vec vec2) ->
 187                     let size1 = vec1#size in
 188                     let size2 = vec2#size in
 189                     let size = size1 + size2 in
 190                     let vec = fun i ->
 191                       if i < size1 then vec1#nth i
 192                       else vec2#nth (i - size1) in
 193                     new value (Vec (new vector size vec))
 194                 | _ -> raise (Signal_operation "Vconcat: scalar.") in
 195             new signal freq func
 196
 197         method vpick : signal_type -> signal_type =
 198           fun s_index ->
 199             let freq = self#check_freq [s_index] in
 200             let func : time -> value_type =
 201               fun t ->
 202                 let i = (s_index#at t)#to_int in
 203                 match (self#at t)#get with
 204                 | Vec vec -> new value (vec#nth i)
 205                 | _ -> raise (Signal_operation "Vpick: scalar.") in
 206             new signal freq func
 207
 208       end;;