interpretor/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 Signal;;
  12
  13 class beam : signal_type array -> beam_type =
  14   fun (signals_init : signal_type array) ->
  15     object (self)
  16       val signals = signals_init
  17
  18       method get = signals
  19       method length = Array.length signals
  20
  21       method sub : int -> int -> beam_type =
  22         fun start ->
  23           fun len ->
  24             new beam (Array.sub self#get start len)
  25
  26       method append : beam_type -> beam_type =
  27         fun (b : beam_type) ->
  28           new beam (Array.append self#get b#get)
  29
  30       method private add_memory : int -> unit =
  31         fun (window : int) ->
  32           let signal_add_memory : int -> signal_type -> unit =
  33             fun (l : int) ->
  34               fun (s : signal) ->
  35                 s#add_memory l in
  36           let _ = Array.map (signal_add_memory window) self#get in ()
  37
  38       method matching : int -> beam_type =
  39           fun size ->
  40             if size = self#length then new beam self#get
  41
  42             else if (size > self#length) && (size mod self#length = 0) then
  43               let () = self#add_memory 1 in
  44               let split_signals =
  45                 Array.concat (Array.to_list
  46                      (Array.make (size/self#length) self#get)) in
  47               new beam split_signals
  48
  49             else if (size < self#length) && (self#length mod size = 0) then
  50               let rec merge_rec  =
  51                 fun (sa : signal_type array) ->
  52                   fun (l : int) ->
  53                     fun (i : int) ->
  54                       if i + l < Array.length sa then
  55                         (sa.(i))#add (merge_rec sa l (i + l))
  56                       else sa.(i) in
  57               let merge_signals = Array.init size (merge_rec self#get size) in
  58               new beam merge_signals
  59
  60             else raise (Beam_matching "matching size error")
  61
  62       method time : time -> value_type array =
  63         fun t ->
  64           let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
  65           Array.map (signal_at t) self#get
  66
  67       method output : int -> (int list) * (float array list) =
  68
  69     end