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
  15 class beam : signal_type array -> beam_type =
  16   fun (signals_init : signal_type array) ->
  17     object (self)
  18       val signals = signals_init
  19
  20       method get = signals
  21       method width = Array.length signals
  22
  23       method sub : int -> int -> beam_type =
  24         fun start ->
  25           fun len ->
  26             new beam (Array.sub self#get start len)
  27
  28       method cut : int -> beam_type * beam_type =
  29         fun (cut_width : int)->
  30           ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width)))
  31
  32       method append : beam_type -> beam_type =
  33         fun (b : beam_type) ->
  34           new beam (Array.append self#get b#get)
  35
  36       method private add_memory : int -> unit =
  37         fun (window : int) ->
  38           let signal_add_memory : int -> signal_type -> unit =
  39             fun (l : int) ->
  40               fun (s : signal) ->
  41                 s#add_memory l in
  42           let _ = Array.map (signal_add_memory window) self#get in ()
  43
  44       method matching : int -> beam_type =
  45           fun size ->
  46             if size = self#width then new beam self#get
  47
  48             else if (size > self#width) && (size mod self#width = 0) then
  49               let () = self#add_memory 1 in
  50               let split_signals =
  51                 Array.concat (Array.to_list
  52                      (Array.make (size/self#width) self#get)) in
  53               new beam split_signals
  54
  55             else if (size < self#width) && (self#width mod size = 0) then
  56               let rec merge_rec  =
  57                 fun (sa : signal_type array) ->
  58                   fun (l : int) ->
  59                     fun (i : int) ->
  60                       if i + l < Array.length sa then
  61                         (sa.(i))#add (merge_rec sa l (i + l))
  62                       else sa.(i) in
  63               let merge_signals = Array.init size (merge_rec self#get size) in
  64               new beam merge_signals
  65
  66             else raise (Beam_matching "matching size error")
  67
  68       method at : time -> value_type array =
  69         fun t ->
  70           let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
  71           Array.map (signal_at t) self#get
  72
  73       method output : int -> data =
  74           fun (length_max : int) ->
  75             let transpose : 'a array array -> 'a array array =
  76               fun matrix ->
  77                 let get_element = fun i -> fun array -> array.(i) in
  78                 let get_column = fun m -> fun i -> Array.map (get_element i) m in
  79                 Array.init self#width (get_column matrix) in
  80             let value2float = fun (v : value_type) -> v#to_float_array in
  81             let init = [|0.|] in
  82             let container = Array.make length_max
  83                 (Array.make self#width init) in
  84             let index = ref 0 in
  85
  86             try
  87               while !index < length_max do
  88                 container.(!index) <- Array.map value2float (self#at !index);
  89                 incr index;
  90               done;
  91               transpose container
  92
  93             with x ->
  94                 match x with
  95                 | Invalid_argument s ->
  96                     transpose (Array.sub container 0 !index)
  97                 | _ -> raise x
  98
  99       method frequency : rate_type array =
 100         let each_rate : signal -> rate =
 101           fun (s : signal) ->
 102             let rate = s#frequency in
 103             if rate#num > 0 then rate
 104             else if rate#num = 0 then new rate 44100 1
 105             else raise (Beam_matching "frequency error.") in
 106         Array.map each_rate self#get
 107
 108     end