Refactoring of class process in faustexp.ml.
[Faustine.git] / 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 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 append : beam_type -> beam_type =
29 fun (b : beam_type) ->
30 new beam (Array.append self#get b#get)
31
32 method private add_memory : int -> unit =
33 fun (window : int) ->
34 let signal_add_memory : int -> signal_type -> unit =
35 fun (l : int) ->
36 fun (s : signal) ->
37 s#add_memory l in
38 let _ = Array.map (signal_add_memory window) self#get in ()
39
40 method matching : int -> beam_type =
41 fun size ->
42 if size = self#width then new beam self#get
43
44 else if (size > self#width) && (size mod self#width = 0) then
45 let () = self#add_memory 1 in
46 let split_signals =
47 Array.concat (Array.to_list
48 (Array.make (size/self#width) self#get)) in
49 new beam split_signals
50
51 else if (size < self#width) && (self#width mod size = 0) then
52 let rec merge_rec =
53 fun (sa : signal_type array) ->
54 fun (l : int) ->
55 fun (i : int) ->
56 if i + l < Array.length sa then
57 (sa.(i))#add (merge_rec sa l (i + l))
58 else sa.(i) in
59 let merge_signals = Array.init size (merge_rec self#get size) in
60 new beam merge_signals
61
62 else raise (Beam_matching "matching size error")
63
64 method at : time -> value_type array =
65 fun t ->
66 let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
67 Array.map (signal_at t) self#get
68
69 method output : int -> value_type array array =
70 fun (length_max : int) ->
71 let transpose : 'a array array -> 'a array array =
72 fun matrix ->
73 let get_element = fun i -> fun array -> array.(i) in
74 let get_column = fun m -> fun i -> Array.map (get_element i) m in
75 Array.init self#width (get_column matrix) in
76 let value_init = new value Error in
77 let container = Array.make length_max
78 (Array.make self#width value_init) in
79 let index = ref 0 in
80
81 try
82 while !index < length_max do
83 container.(!index) <- self#at !index;
84 incr index;
85 done;
86 transpose container
87 with x ->
88
89 let error_message =
90 match x with
91 | Convert_Error s -> "Convert_Error: " ^ s
92 | Basic_operation s -> "Basic_operation: " ^ s
93 | Signal_operation s -> "Signal_operation: " ^ s
94 | Beam_matching s -> "Beam_Matching_Error: " ^ s
95 | _ -> "Compute finished."
96 in
97 let () = print_string error_message in
98 transpose (Array.sub container 0 !index)
99 end