Refactoring of process classes 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 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 -> value_type array array =
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 value_init = new value Error in
81 let container = Array.make length_max
82 (Array.make self#width value_init) in
83 let index = ref 0 in
84
85 try
86 while !index < length_max do
87 container.(!index) <- self#at !index;
88 incr index;
89 done;
90 transpose container
91 with x ->
92
93 let error_message =
94 match x with
95 | Convert_Error s -> "Convert_Error: " ^ s
96 | Basic_operation s -> "Basic_operation: " ^ s
97 | Signal_operation s -> "Signal_operation: " ^ s
98 | Beam_matching s -> "Beam_Matching_Error: " ^ s
99 | _ -> "Compute finished."
100 in
101 let () = print_string error_message in
102 transpose (Array.sub container 0 !index)
103 end