Bug fixed for unix error "readlink /proc/self/fd/0" on MacOS.

[Faustine.git] / interpreter / faustio.ml

diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml
index 8cca058..408d750 100644 (file)
--- a/interpreter/faustio.ml
+++ b/interpreter/faustio.ml
@@ -11,10 +11,12 @@ open Value;;
 open Signal;;
 open Beam;;
 open Aux;;
+open Nest;;
 
 exception IO_Error of string;;
 
 let csv_read_buffer_length = 0xFFFF;;
+let nst_read_buffer_length = 0xFFFF;;
 
 class virtual io = 
   object
@@ -28,7 +30,7 @@ class virtual io =
            _filename <- filename; _basename <- basename; _dir <- dir
 
     method virtual read : string array -> beam
-    method virtual write : rate array -> data -> string * string -> string array
+    (*method virtual write : rate array -> data -> string * string -> string array*)
     
     method private concat : data -> matrix = 
       fun (origin : data) ->
@@ -171,10 +173,87 @@ class csvio : io_type =
   end;;
 
 
+
+class nstio = 
+  object (self)
+    inherit io
+    method private nstread : in_channel -> signal = 
+      fun (ic : in_channel) ->
+       let buffer = Buffer.create nst_read_buffer_length in
+       let () = 
+         try
+           while true do
+             Buffer.add_string buffer (input_line ic);
+             Buffer.add_char buffer '\t';
+           done; 
+         with End_of_file -> () in
+       let content = Buffer.contents buffer in
+       let lines = Str.split (Str.regexp "\t") content in
+        let basics = List.map basic_from_nest (List.map nest_from_string lines) in
+        let values = Array.map (new value) (Array.of_list basics) in
+       new signal (new rate 0 1) (Array.get values)
+
+    method read : string array -> beam =
+      fun (paths : string array) ->
+       let files = Array.map open_in paths in
+       let signals = Array.map self#nstread files in
+       new beam signals
+
+    method write : rate array -> raw_data -> string * string -> string array = 
+      fun (rates : rate array) ->
+       fun (data : raw_data) ->
+         fun (info : string * string) -> 
+           let stdoutput = fst info in
+           let basename = snd info in
+           let length = Array.length data in
+            let width = Array.length rates in
+
+           let strings = 
+              let value2string : value -> string =
+                fun (v : value) -> v#to_neststring in
+              let init = "" in
+              let container = Array.make length (Array.make width init) in
+              let index = ref 0 in
+
+              try 
+                while !index < length do
+                  container.(!index) <- Array.map value2string data.(!index);
+                  incr index;
+                done;
+                Array.map (String.concat "\n") 
+                  (Array.map Array.to_list (transpose width container))
+
+              with x -> 
+                match x with
+                | Invalid_argument s -> 
+                    let fragments = Array.sub container 0 !index in
+                    let string_lists = 
+                      Array.map Array.to_list (transpose width fragments) in
+                    Array.map (String.concat "\n") string_lists
+                | _ -> raise x in
+
+           if stdoutput = "" && basename = "" then
+             let _ = Array.map (output_string stdout) strings in
+             [|"Stdout"|]
+           else 
+             let paths = 
+               if width = 1 && stdoutput <> "" && basename = "" then 
+                 let () = Unix.unlink stdoutput in [|stdoutput|]
+               else if stdoutput = "" && basename <> "" then 
+                 Array.init width (fun i -> 
+                   _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".nst") 
+               else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
+              let files = Array.map open_out paths in
+             let _ = array_map2 output_string files strings in
+             let _ = Array.map close_out files in
+             paths
+  end;;
+
 class iomanager = 
   object (self)
     val wave = new waveio
     val csv = new csvio
+    val nst = new nstio
     val mutable _filename = ""
     val mutable _dir = ""
     val mutable _format = ""
@@ -188,6 +267,7 @@ class iomanager =
            fun (path : string) ->
              if format = "wav" then wave#read [|path|]
              else if format = "csv" then csv#read [|path|]
+             else if format = "nst" then nst#read [|path|]
              else raise (Invalid_argument "Unknown format.") in
        let beams = List.map2 read_one formats paths in
        let concat : beam_type -> beam_type -> beam_type = 
@@ -204,7 +284,8 @@ class iomanager =
              _format <- format; 
              _basename <- basename;
              wave#set _filename _dir _basename;
-             csv#set _filename _dir _basename
+             csv#set _filename _dir _basename;
+             nst#set _filename _dir _basename
 
     method write : rate array -> data -> string array = 
       fun (rates : rate array) ->
@@ -235,4 +316,21 @@ class iomanager =
 
          else 
            [|"no output signal."|]
+
+    method write_nst : rate array -> raw_data -> string array = 
+      fun (rates : rate array) ->
+       fun (rd : raw_data) ->
+         let n = Array.length rates in   
+          let info = 
+              if _filename <> "" && n = 1 then (_filename, "")
+              else if _basename <> "" && _format <> "" then ("", _basename)
+              else if _filename = "" && _basename = "" && _format = "" then
+                ("", "")             
+              else if _filename <> "" && n > 1 then 
+                raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
+              else raise (IO_Error "Please specify both --obasename and --oformat.") in
+          nst#write rates rd info
+
   end;;
+
+