Bug fixed for unix error "readlink /proc/self/fd/0" on MacOS.
[Faustine.git] / interpreter / faustio.ml
1 (**
2 Module: Faustio
3 Description: audio input/output, csv input/output
4 @author WANG Haisheng
5 Created: 12/08/2013 Modified: 13/08/2013
6 *)
7
8 open Types;;
9 open Basic;;
10 open Value;;
11 open Signal;;
12 open Beam;;
13 open Aux;;
14 open Nest;;
15
16 exception IO_Error of string;;
17
18 let csv_read_buffer_length = 0xFFFF;;
19 let nst_read_buffer_length = 0xFFFF;;
20
21 class virtual io =
22 object
23 val mutable _filename = ""
24 val mutable _basename = ""
25 val mutable _dir = ""
26 method set : string -> string -> string -> unit =
27 fun (filename : string) ->
28 fun (dir : string) ->
29 fun (basename : string) ->
30 _filename <- filename; _basename <- basename; _dir <- dir
31
32 method virtual read : string array -> beam
33 (*method virtual write : rate array -> data -> string * string -> string array*)
34
35 method private concat : data -> matrix =
36 fun (origin : data) ->
37 Array.map Array.concat (Array.map Array.to_list origin)
38
39 method private channels : data -> int array =
40 fun data ->
41 let get_channel = fun s ->
42 let l = Array.length s in
43 Array.length s.(l - 1) in
44 Array.map get_channel data
45 end;;
46
47 class waveio : io_type =
48 object (self)
49 inherit io
50 method read : string array -> beam =
51 fun (paths : string array) ->
52 let n = Array.length paths in
53 if n = 0 then
54 new beam [||]
55 else
56 let signals =
57 let files = Array.map Sndfile.openfile paths in
58 let frames = Array.map Int64.to_int
59 (Array.map Sndfile.frames files) in
60 let make_rate =
61 fun (denom : int) ->
62 fun (num : int) ->
63 new rate num denom in
64 let nums = Array.map Sndfile.samplerate files in
65 let rates = Array.map (make_rate 1) nums in
66 let create_container = fun l -> Array.create l 1. in
67 let containers = Array.map create_container frames in
68 let _ = array_map2 Sndfile.read files containers in
69 let _ = Array.map Sndfile.close files in
70 let stream2func =
71 fun stream -> fun t -> new value (R stream.(t)) in
72 array_map2 (new signal) rates (Array.map stream2func containers) in
73 new beam signals
74
75 method write : rate array -> data -> string * string -> string array =
76 fun (rates : rate array) ->
77 fun (output : data) ->
78 fun (info : string * string) ->
79 let stdoutput = fst info in
80 let basename = snd info in
81 let n = Array.length output in
82 let paths =
83 if n = 1 && stdoutput <> "" && basename = "" then
84 let () = Unix.unlink stdoutput in [|stdoutput|]
85 else if stdoutput = "" && basename <> "" then
86 Array.init n (fun i ->
87 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav")
88 else if stdoutput = "" && basename = "" then
89 raise (IO_Error "Please specify stdout or output basename.")
90 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
91 let get_freq = fun (r : rate) -> r#to_int in
92 let freqs = Array.map get_freq rates in
93
94 let files =
95 let channels = self#channels output in
96 let file_format = Sndfile.format
97 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
98 let openwr = fun path -> fun channel -> fun freq ->
99 Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
100 array_map3 openwr paths channels freqs in
101
102 let data = self#concat output in
103 let _ = array_map2 Sndfile.write files data in
104 let _ = Array.map Sndfile.close files in
105 paths
106 end;;
107
108
109
110 class csvio : io_type =
111 object (self)
112 inherit io
113 method private csvread : in_channel -> signal =
114 fun (ic : in_channel) ->
115 let buffer = Buffer.create csv_read_buffer_length in
116 let () =
117 try
118 while true do
119 Buffer.add_string buffer (input_line ic);
120 Buffer.add_char buffer '\t';
121 done;
122 with End_of_file -> () in
123 let content = Buffer.contents buffer in
124 let lines = Str.split (Str.regexp "\t") content in
125 let elements = List.map (Str.split (Str.regexp ",")) lines in
126 let data =
127 let data_in_list = List.map (List.map float_of_string) elements in
128 Array.of_list (List.map Array.of_list data_in_list) in
129 let values =
130 let convertor = new value Zero in
131 Array.map (convertor#of_float_array) data in
132 new signal (new rate 0 1) (Array.get values)
133
134 method read : string array -> beam =
135 fun (paths : string array) ->
136 let files = Array.map open_in paths in
137 let signals = Array.map self#csvread files in
138 new beam signals
139
140 method write : rate array -> data -> string * string -> string array =
141 fun (rates : rate array) ->
142 fun (data : data) ->
143 fun (info : string * string) ->
144 let stdoutput = fst info in
145 let basename = snd info in
146 let n = Array.length data in
147 let strings =
148 let value2string : float array -> string =
149 fun (v : float array) ->
150 let strings = Array.map string_of_float v in
151 String.concat "," (Array.to_list strings) in
152 let signal2string : float array array -> string =
153 fun (s : float array array) ->
154 let lines = Array.map value2string s in
155 String.concat "\n" (Array.to_list lines) in
156 Array.map signal2string data in
157
158 if stdoutput = "" && basename = "" then
159 let _ = Array.map (output_string stdout) strings in
160 [|"Stdout"|]
161 else
162 let paths =
163 if n = 1 && stdoutput <> "" && basename = "" then
164 let () = Unix.unlink stdoutput in [|stdoutput|]
165 else if stdoutput = "" && basename <> "" then
166 Array.init n (fun i ->
167 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv")
168 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
169 let files = Array.map open_out paths in
170 let _ = array_map2 output_string files strings in
171 let _ = Array.map close_out files in
172 paths
173 end;;
174
175
176
177 class nstio =
178 object (self)
179 inherit io
180 method private nstread : in_channel -> signal =
181 fun (ic : in_channel) ->
182 let buffer = Buffer.create nst_read_buffer_length in
183 let () =
184 try
185 while true do
186 Buffer.add_string buffer (input_line ic);
187 Buffer.add_char buffer '\t';
188 done;
189 with End_of_file -> () in
190 let content = Buffer.contents buffer in
191 let lines = Str.split (Str.regexp "\t") content in
192 let basics = List.map basic_from_nest (List.map nest_from_string lines) in
193 let values = Array.map (new value) (Array.of_list basics) in
194 new signal (new rate 0 1) (Array.get values)
195
196 method read : string array -> beam =
197 fun (paths : string array) ->
198 let files = Array.map open_in paths in
199 let signals = Array.map self#nstread files in
200 new beam signals
201
202 method write : rate array -> raw_data -> string * string -> string array =
203 fun (rates : rate array) ->
204 fun (data : raw_data) ->
205 fun (info : string * string) ->
206 let stdoutput = fst info in
207 let basename = snd info in
208 let length = Array.length data in
209 let width = Array.length rates in
210
211 let strings =
212 let value2string : value -> string =
213 fun (v : value) -> v#to_neststring in
214 let init = "" in
215 let container = Array.make length (Array.make width init) in
216 let index = ref 0 in
217
218 try
219 while !index < length do
220 container.(!index) <- Array.map value2string data.(!index);
221 incr index;
222 done;
223 Array.map (String.concat "\n")
224 (Array.map Array.to_list (transpose width container))
225
226 with x ->
227 match x with
228 | Invalid_argument s ->
229 let fragments = Array.sub container 0 !index in
230 let string_lists =
231 Array.map Array.to_list (transpose width fragments) in
232 Array.map (String.concat "\n") string_lists
233 | _ -> raise x in
234
235 if stdoutput = "" && basename = "" then
236 let _ = Array.map (output_string stdout) strings in
237 [|"Stdout"|]
238 else
239 let paths =
240 if width = 1 && stdoutput <> "" && basename = "" then
241 let () = Unix.unlink stdoutput in [|stdoutput|]
242 else if stdoutput = "" && basename <> "" then
243 Array.init width (fun i ->
244 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".nst")
245 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
246 let files = Array.map open_out paths in
247 let _ = array_map2 output_string files strings in
248 let _ = Array.map close_out files in
249 paths
250 end;;
251
252 class iomanager =
253 object (self)
254 val wave = new waveio
255 val csv = new csvio
256 val nst = new nstio
257 val mutable _filename = ""
258 val mutable _dir = ""
259 val mutable _format = ""
260 val mutable _basename = ""
261
262 method read : string list -> beam_type =
263 fun (paths : string list) ->
264 let formats = List.map format_of_file paths in
265 let read_one : string -> string -> beam_type =
266 fun (format : string) ->
267 fun (path : string) ->
268 if format = "wav" then wave#read [|path|]
269 else if format = "csv" then csv#read [|path|]
270 else if format = "nst" then nst#read [|path|]
271 else raise (Invalid_argument "Unknown format.") in
272 let beams = List.map2 read_one formats paths in
273 let concat : beam_type -> beam_type -> beam_type =
274 fun b1 -> fun b2 -> b1#append b2 in
275 List.fold_left concat (new beam [||]) beams
276
277 method set : string -> string -> string -> string -> unit =
278 fun (filename : string) ->
279 fun (dir : string) ->
280 fun (format : string) ->
281 fun (basename : string) ->
282 _filename <- filename;
283 _dir <- dir;
284 _format <- format;
285 _basename <- basename;
286 wave#set _filename _dir _basename;
287 csv#set _filename _dir _basename;
288 nst#set _filename _dir _basename
289
290 method write : rate array -> data -> string array =
291 fun (rates : rate array) ->
292 fun (data : data) ->
293 let n = Array.length rates in
294 if n = 1 then (
295 if _filename <> "" then (
296 let fmt = format_of_file _filename in
297 if fmt = "csv" then csv#write rates data (_filename, "")
298 else if fmt = "wav" then wave#write rates data (_filename, "")
299 else raise (IO_Error "Unknown stdout format."))
300 else if _basename <> "" && _format <> "" then (
301 if _format = "csv" then csv#write rates data ("", _basename)
302 else if _format = "wav" then wave#write rates data ("", _basename)
303 else raise (IO_Error "Unknown --oformat."))
304 else if _filename = "" && _basename = "" && _format = "" then
305 csv#write rates data ("", "")
306 else raise (IO_Error "Please specify both --obasename and --oformat."))
307
308 else if n > 1 then (
309 if _filename <> "" then
310 raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
311 else if _basename <> "" && _format <> "" then (
312 if _format = "csv" then csv#write rates data ("", _basename)
313 else if _format = "wav" then wave#write rates data ("", _basename)
314 else raise (IO_Error "Unknown --oformat."))
315 else raise (IO_Error "Please specify both --obasename and --oformat."))
316
317 else
318 [|"no output signal."|]
319
320 method write_nst : rate array -> raw_data -> string array =
321 fun (rates : rate array) ->
322 fun (rd : raw_data) ->
323 let n = Array.length rates in
324 let info =
325 if _filename <> "" && n = 1 then (_filename, "")
326 else if _basename <> "" && _format <> "" then ("", _basename)
327 else if _filename = "" && _basename = "" && _format = "" then
328 ("", "")
329 else if _filename <> "" && n > 1 then
330 raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
331 else raise (IO_Error "Please specify both --obasename and --oformat.") in
332 nst#write rates rd info
333
334 end;;
335
336