interpreter/beam.ml

   1 (**
   2         Module: Beam
   3         Description: beam definition and operations
   4         @author WANG Haisheng
   5         Created: 21/07/2013     Modified: 21/07/2013
   6 *)
   7
   8 exception Beam_matching of string;;
   9
  10 open Types;;
  11 open Basic;;
  12 open Value;;
  13 open Signal;;
  14 open Aux;;
  15
  16 class beam : signal_type array -> beam_type =
  17   fun (signals_init : signal_type array) ->
  18     object (self)
  19       val signals = signals_init
  20
  21       method get = signals
  22       method width = Array.length signals
  23
  24       method sub : int -> int -> beam_type =
  25         fun start ->
  26           fun len ->
  27             new beam (Array.sub self#get start len)
  28
  29       method cut : int -> beam_type * beam_type =
  30         fun (cut_width : int)->
  31           ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width)))
  32
  33       method append : beam_type -> beam_type =
  34         fun (b : beam_type) ->
  35           new beam (Array.append self#get b#get)
  36
  37       method private add_memory : int -> unit =
  38         fun (window : int) ->
  39           let signal_add_memory : int -> signal_type -> unit =
  40             fun (l : int) ->
  41               fun (s : signal) ->
  42                 s#add_memory l in
  43           let _ = Array.map (signal_add_memory window) self#get in ()
  44
  45       method matching : int -> beam_type =
  46           fun size ->
  47             if size = self#width then new beam self#get
  48
  49             else if (size > self#width) && (size mod self#width = 0) then
  50               let () = self#add_memory 1 in
  51               let split_signals =
  52                 Array.concat (Array.to_list
  53                      (Array.make (size/self#width) self#get)) in
  54               new beam split_signals
  55
  56             else if (size < self#width) && (self#width mod size = 0) then
  57               let rec merge_rec  =
  58                 fun (sa : signal_type array) ->
  59                   fun (l : int) ->
  60                     fun (i : int) ->
  61                       if i + l < Array.length sa then
  62                         (sa.(i))#add (merge_rec sa l (i + l))
  63                       else sa.(i) in
  64               let merge_signals = Array.init size (merge_rec self#get size) in
  65               new beam merge_signals
  66
  67             else raise (Beam_matching "matching size error")
  68
  69       method at : time -> value_type array =
  70         fun t ->
  71           let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
  72           Array.map (signal_at t) self#get
  73
  74       method output : int -> data =
  75           fun (length_max : int) ->
  76             let value2float = fun (v : value_type) -> v#to_float_array in
  77             let init = [|0.|] in
  78             let container = Array.make length_max
  79                 (Array.make self#width init) in
  80             let index = ref 0 in
  81
  82             try
  83               while !index < length_max do
  84                 container.(!index) <- Array.map value2float (self#at !index);
  85                 incr index;
  86               done;
  87               transpose self#width container
  88
  89             with x ->
  90                 match x with
  91                 | Invalid_argument s ->
  92                     transpose self#width (Array.sub container 0 !index)
  93                 | _ -> raise x
  94
  95
  96       method output_values : int -> raw_data =
  97         fun (length_max : int) ->
  98           let init = new value (N 0) in
  99           let container = Array.make length_max
 100               (Array.make self#width init) in
 101           let index = ref 0 in
 102
 103             try
 104               while !index < length_max do
 105                 container.(!index) <- self#at !index;
 106                 incr index;
 107               done;
 108               container
 109
 110             with x ->
 111                 match x with
 112                 | Invalid_argument s ->
 113                     Array.sub container 0 !index
 114                 | _ -> raise x
 115
 116
 117       method frequency : rate_type array =
 118         let each_rate : signal -> rate =
 119           fun (s : signal) ->
 120             let rate = s#frequency in
 121             if rate#num > 0 then rate
 122             else if rate#num = 0 then new rate 44100 1
 123             else raise (Beam_matching "frequency error.") in
 124         Array.map each_rate self#get
 125
 126     end