From 02c1ef905d2101df872ccccccb2e4c7c0a508571 Mon Sep 17 00:00:00 2001 From: wang Date: Fri, 25 Oct 2013 17:42:09 +0200 Subject: [PATCH] Nested vectors are implemented, including parser and class nstio. New example of "nstvector" is added to examples' folder, and tested. --- examples/dilation/Makefile | 8 ++- examples/nstvector/Makefile | 14 ++++ examples/nstvector/nstvector.dsp | 8 +++ examples/nstvector/nstvector1.csv | 80 +++++++++++++++++++++++ examples/sinwave/Makefile | 6 +- interpreter/Makefile | 2 +- interpreter/aux.ml | 6 ++ interpreter/beam.ml | 32 ++++++++-- interpreter/faustio.ml | 102 +++++++++++++++++++++++++++++- interpreter/main.ml | 79 +++++++++++++++-------- interpreter/nest.ml | 42 ++++++++++++ interpreter/nstlexer.mll | 15 +++++ interpreter/nstparser.mly | 24 +++++++ interpreter/types.ml | 11 ++++ interpreter/value.ml | 2 + 15 files changed, 390 insertions(+), 41 deletions(-) create mode 100644 examples/nstvector/Makefile create mode 100644 examples/nstvector/nstvector.dsp create mode 100644 examples/nstvector/nstvector1.csv create mode 100644 interpreter/nest.ml create mode 100644 interpreter/nstlexer.mll create mode 100644 interpreter/nstparser.mly diff --git a/examples/dilation/Makefile b/examples/dilation/Makefile index 93a2ece..ef567ac 100644 --- a/examples/dilation/Makefile +++ b/examples/dilation/Makefile @@ -2,15 +2,21 @@ SRC = dilation.dsp IMGIN = letter_j.png LINES = 150 +BASENAME = $(SRC:.dsp=) +FORMAT = nst +FILEOUT = $(BASENAME).$(FORMAT) CSVOUT = dilation.csv CSVIN = $(IMGIN:.png=.csv) IMGOUT = $(SRC:.dsp=.png) -all: $(IMGOUT) +all: $(IMGOUT) #$(FILEOUT) $(IMGOUT): $(CSVOUT) octave -qf img_write.m +$(FILEOUT): $(SRC) $(CSVIN) + faustine -f $(SRC) -l $(LINES) < $(CSVIN) 1> $@ + $(CSVOUT): $(SRC) $(CSVIN) faustine -f $(SRC) -l $(LINES) < $(CSVIN) 1> $@ diff --git a/examples/nstvector/Makefile b/examples/nstvector/Makefile new file mode 100644 index 0000000..4222e5e --- /dev/null +++ b/examples/nstvector/Makefile @@ -0,0 +1,14 @@ +SRC = nstvector.dsp +LINES = 100000 + +BASENAME = $(SRC:.dsp=) +FORMAT = nst +FILEOUT = $(BASENAME).$(FORMAT) + +all: .nst + +.nst: $(SRC) + faustine -f $< -l $(LINES) --oformat $(FORMAT) --obasename $(BASENAME) < nstvector1.csv + +clean: + rm -f gmon.out *.nst *~ diff --git a/examples/nstvector/nstvector.dsp b/examples/nstvector/nstvector.dsp new file mode 100644 index 0000000..a1dbb78 --- /dev/null +++ b/examples/nstvector/nstvector.dsp @@ -0,0 +1,8 @@ +time = (_, 1 : +)~_; +a = _; +b = _ : vectorize(3); +c = _ : vectorize(3) : vectorize(4); + +process = _ : serialize <: a, b, c; +//process = vectorize(1) : vectorize(2) : vectorize(2); +//process = serialize; diff --git a/examples/nstvector/nstvector1.csv b/examples/nstvector/nstvector1.csv new file mode 100644 index 0000000..bd03f59 --- /dev/null +++ b/examples/nstvector/nstvector1.csv @@ -0,0 +1,80 @@ +1.,2.,3. +4.,5.,6. +7.,8.,9. +10.,11.,12. +13.,14.,15. +16.,17.,18. +19.,20.,21. +22.,23.,24. +25.,26.,27. +28.,29.,30. +31.,32.,33. +34.,35.,36. +37.,38.,39. +40.,41.,42. +43.,44.,45. +46.,47.,48. +49.,50.,51. +52.,53.,54. +55.,56.,57. +58.,59.,60. +61.,62.,63. +64.,65.,66. +67.,68.,69. +70.,71.,72. +73.,74.,75. +76.,77.,78. +79.,80.,81. +82.,83.,84. +85.,86.,87. +88.,89.,90. +91.,92.,93. +94.,95.,96. +97.,98.,99. +100.,101.,102. +103.,104.,105. +106.,107.,108. +109.,110.,111. +112.,113.,114. +115.,116.,117. +118.,119.,120. +121.,122.,123. +124.,125.,126. +127.,128.,129. +130.,131.,132. +133.,134.,135. +136.,137.,138. +139.,140.,141. +142.,143.,144. +145.,146.,147. +148.,149.,150. +151.,152.,153. +154.,155.,156. +157.,158.,159. +160.,161.,162. +163.,164.,165. +166.,167.,168. +169.,170.,171. +172.,173.,174. +175.,176.,177. +178.,179.,180. +181.,182.,183. +184.,185.,186. +187.,188.,189. +190.,191.,192. +193.,194.,195. +196.,197.,198. +199.,200.,201. +202.,203.,204. +205.,206.,207. +208.,209.,210. +211.,212.,213. +214.,215.,216. +217.,218.,219. +220.,221.,222. +223.,224.,225. +226.,227.,228. +229.,230.,231. +232.,233.,234. +235.,236.,237. +238.,239.,240. \ No newline at end of file diff --git a/examples/sinwave/Makefile b/examples/sinwave/Makefile index cdd957c..7c08a75 100644 --- a/examples/sinwave/Makefile +++ b/examples/sinwave/Makefile @@ -1,8 +1,8 @@ SRC = sin.dsp -BASENAME = output +BASENAME = $(SRC:.dsp=) FORMAT = wav -WAVOUT = $(BASENAME)1.$(FORMAT) +WAVOUT = $(BASENAME).$(FORMAT) all: $(WAVOUT) @@ -10,4 +10,4 @@ $(WAVOUT): $(SRC) faustine -f $< > sin.wav clean:: - rm -f gmon.out $(BASENAME)* *.wav *~ + rm -f gmon.out $(WAVOUT) *~ diff --git a/interpreter/Makefile b/interpreter/Makefile index 785feb6..e6d1d0e 100644 --- a/interpreter/Makefile +++ b/interpreter/Makefile @@ -4,7 +4,7 @@ # # The Caml sources (including camlyacc and camllex source files) -SOURCES = types.ml parser.mly lexer.mll aux.ml basic.ml symbol.ml value.ml signal.ml beam.ml process.ml faustio.ml preprocess.ml main.ml preprocess_stubs.cpp +SOURCES = types.ml parser.mly lexer.mll nstparser.mly nstlexer.mll aux.ml basic.ml nest.ml symbol.ml value.ml signal.ml beam.ml process.ml faustio.ml preprocess.ml main.ml preprocess_stubs.cpp # The executable file to generate EXEC = faustine diff --git a/interpreter/aux.ml b/interpreter/aux.ml index 0564c30..4709724 100644 --- a/interpreter/aux.ml +++ b/interpreter/aux.ml @@ -40,3 +40,9 @@ let format_of_file : string -> string = let fragments = Str.split (Str.regexp "\.") path in let n = List.length fragments in List.nth fragments (n - 1);; + +let transpose : int -> 'a array array -> 'a array array = + fun width -> fun matrix -> + let get_element = fun i -> fun array -> array.(i) in + let get_column = fun m -> fun i -> Array.map (get_element i) m in + Array.init width (get_column matrix);; \ No newline at end of file diff --git a/interpreter/beam.ml b/interpreter/beam.ml index bec7ed0..fd6fca6 100644 --- a/interpreter/beam.ml +++ b/interpreter/beam.ml @@ -11,6 +11,7 @@ open Types;; open Basic;; open Value;; open Signal;; +open Aux;; class beam : signal_type array -> beam_type = fun (signals_init : signal_type array) -> @@ -72,11 +73,6 @@ class beam : signal_type array -> beam_type = method output : int -> data = fun (length_max : int) -> - let transpose : 'a array array -> 'a array array = - fun matrix -> - let get_element = fun i -> fun array -> array.(i) in - let get_column = fun m -> fun i -> Array.map (get_element i) m in - Array.init self#width (get_column matrix) in let value2float = fun (v : value_type) -> v#to_float_array in let init = [|0.|] in let container = Array.make length_max @@ -88,14 +84,36 @@ class beam : signal_type array -> beam_type = container.(!index) <- Array.map value2float (self#at !index); incr index; done; - transpose container + transpose self#width container with x -> match x with | Invalid_argument s -> - transpose (Array.sub container 0 !index) + transpose self#width (Array.sub container 0 !index) | _ -> raise x + + method output_values : int -> raw_data = + fun (length_max : int) -> + let init = new value (N 0) in + let container = Array.make length_max + (Array.make self#width init) in + let index = ref 0 in + + try + while !index < length_max do + container.(!index) <- self#at !index; + incr index; + done; + container + + with x -> + match x with + | Invalid_argument s -> + Array.sub container 0 !index + | _ -> raise x + + method frequency : rate_type array = let each_rate : signal -> rate = fun (s : signal) -> diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml index 8cca058..408d750 100644 --- 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;; + + diff --git a/interpreter/main.ml b/interpreter/main.ml index 94b0ae1..4444646 100644 --- a/interpreter/main.ml +++ b/interpreter/main.ml @@ -36,20 +36,20 @@ let time_max = ref 0xFFFF;; let dir_output = ref "";; let format_output = ref "";; let basename_output = ref "";; -let output = ref "";; +let stdout_filename = ref "";; let option_usage = "usage: " ^ Sys.argv.(0) - ^ " [-f dsp_src] [-i input] [-l length] [--odir dir] [--oformat wav/csv] [--obasename name]";; + ^ " [-f dsp_src] [-i input] [-l length] [--odir dir] [--oformat wav/csv/nst] [--obasename name]";; let option_unknown = fun x -> raise (Arg.Bad ("Bad argument : " ^ x)) let speclist = [ ("-f", Arg.String (fun s -> path_dsp := s), ": faust .dsp source file"); - ("-i", Arg.String (fun s -> incr size_input; inputs := !inputs @ [s]), ": set input wave file"); + ("-i", Arg.String (fun s -> incr size_input; inputs := !inputs @ [s]), ": set input file"); ("-l", Arg.Int (fun i -> time_max := i), ": maximun number of output samples"); ("--odir", Arg.String (fun s -> dir_output := s), ": set output directory"); - ("--oformat", Arg.String (fun s -> format_output := s), ": set output format"); + ("--oformat", Arg.String (fun s -> format_output := s), ": set output format wav/csv/nst"); ("--obasename", Arg.String (fun s -> basename_output := s), ": set output basename"); ];; @@ -59,18 +59,22 @@ let file_of_path : string -> string = let n = List.length fragments in List.nth fragments (n - 1);; -let valid_input_file : string -> bool = +let get_extension : string -> string = fun (file : string) -> let fragments = Str.split (Str.regexp "\.") file in let n = List.length fragments in - let extension = List.nth fragments (n - 1) in - if extension = "csv" || extension = "wav" then true + List.nth fragments (n - 1);; + +let chk_extension : string -> bool = + fun (file : string) -> + let extension = get_extension file in + if extension = "csv" || extension = "wav" || extension = "nst" then true else false;; let chk_input_path : string -> bool = fun (path : string) -> let file_in = file_of_path path in - valid_input_file file_in;; + chk_extension file_in;; let stdinput = fun (x : unit) -> let path = Unix.readlink "/proc/self/fd/0" in @@ -88,7 +92,7 @@ let chk_output_path : string -> bool = let stdoutput = fun (x : unit) -> let path = Unix.readlink "/proc/self/fd/1" in - if chk_output_path path then output := path + if chk_output_path path then stdout_filename := path else ();; let stdio = fun (x : unit) -> @@ -102,7 +106,7 @@ let main () = let _ = Sys.signal Sys.sigalrm Sys.Signal_ignore in let _ = set_GC () in let io = new iomanager in - let () = io#set !output !dir_output !format_output !basename_output in + let () = io#set !stdout_filename !dir_output !format_output !basename_output in let () = output_string stderr ("\n Faustine -> Reading input ...") in @@ -134,23 +138,44 @@ let main () = let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc3 -. tic3)) ^ "s.)\n") in - let () = output_string stderr (" Faustine -> Evaluating...") in - let tic4 = Unix.time () in - let data = output#output !time_max in - let rates = output#frequency in - let toc4 = Unix.time () in - let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc4 -. tic4)) ^ "s.)\n") in - - - let () = output_string stderr (" Faustine -> Writing output...") in - let tic5 = Unix.time () in - let output_paths = io#write rates data in - let toc5 = Unix.time () in - let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc5 -. tic5)) ^ "s.)\n") in - - let _ = Array.map (output_string stderr) - (Array.map decorate output_paths) in - ();; + if (!stdout_filename = "" && !format_output = "") || (!format_output = "nst") + || (!stdout_filename <> "" && (get_extension !stdout_filename) = "nst") then ( + let () = output_string stderr (" Faustine -> Evaluating...") in + let tic4 = Unix.time () in + let raws = output#output_values !time_max in + let rates = output#frequency in + let toc4 = Unix.time () in + let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc4 -. tic4)) ^ "s.)\n") in + + + let () = output_string stderr (" Faustine -> Writing output...") in + let tic5 = Unix.time () in + let output_paths = io#write_nst rates raws in + let toc5 = Unix.time () in + let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc5 -. tic5)) ^ "s.)\n") in + + let _ = Array.map (output_string stderr) (Array.map decorate output_paths) in + () + ) + + else ( + let () = output_string stderr (" Faustine -> Evaluating...") in + let tic6 = Unix.time () in + let data = output#output !time_max in + let rates = output#frequency in + let toc6 = Unix.time () in + let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc6 -. tic6)) ^ "s.)\n") in + + + let () = output_string stderr (" Faustine -> Writing output...") in + let tic7 = Unix.time () in + let output_paths = io#write rates data in + let toc7 = Unix.time () in + let () = output_string stderr (" Done. (duration: " ^ (string_of_float (toc7 -. tic7)) ^ "s.)\n") in + + let _ = Array.map (output_string stderr) (Array.map decorate output_paths) in + () + );; main();; diff --git a/interpreter/nest.ml b/interpreter/nest.ml new file mode 100644 index 0000000..bc581ff --- /dev/null +++ b/interpreter/nest.ml @@ -0,0 +1,42 @@ +open Types;; +open Basic;; + +let nest_from_string : string -> nest = + fun (s : string) -> + Nstparser.main Nstlexer.token (Lexing.from_string s);; + +let rec basic_from_nest : nest -> basic = + fun (nst : nest) -> + let rec basic_from_nestpar : nestpar -> basic = + fun (nstpar : nestpar) -> + let rec list_from_nestpar : nestpar -> basic list = + fun (np : nestpar) -> + match np with + | Unary n -> [basic_from_nest n] + | Binary (n1, np2) -> [basic_from_nest n1] @ (list_from_nestpar np2) + in + match nstpar with + | Unary n -> basic_from_nest n + | Binary (n1, np2) -> + let bl = list_from_nestpar nstpar in + Vec (new vector (List.length bl) (Array.get (Array.of_list bl))) + in + match nst with + | Scalar s -> R s + | Vector np -> basic_from_nestpar np;; + +let rec basic_to_neststring : basic -> string = + fun (b : basic) -> + match b with + | N i -> string_of_int i + | R f -> string_of_float f + | Zero -> basic_to_neststring (N 0) + | Error -> "Error" + | Vec vec -> + let lpar = "[" in + let rpar = "]" in + let comma_space = ", " in + let basics = Array.init vec#size vec#nth in + let strings = Array.map basic_to_neststring basics in + let combine = String.concat comma_space (Array.to_list strings) in + lpar ^ combine ^ rpar;; \ No newline at end of file diff --git a/interpreter/nstlexer.mll b/interpreter/nstlexer.mll new file mode 100644 index 0000000..65196c7 --- /dev/null +++ b/interpreter/nstlexer.mll @@ -0,0 +1,15 @@ +{ +open Nstparser +open Types +} + +rule token = parse + [' ' '\t' '\n' ] { token lexbuf } + +| ['0'-'9']+ as a { CONST a } +| '.' { POINT } + +| '[' { LPAR } +| ']' { RPAR } +| ',' { COMMA } +| eof { EOF } diff --git a/interpreter/nstparser.mly b/interpreter/nstparser.mly new file mode 100644 index 0000000..fadf9f6 --- /dev/null +++ b/interpreter/nstparser.mly @@ -0,0 +1,24 @@ +%{ + open Types +%} + +%token CONST +%token LPAR RPAR EOF POINT COMMA +%right COMMA +%left POINT +%start main +%type main +%% +main: nest EOF { $1 }; + +scalar: CONST { Scalar(float_of_string $1) } + | CONST POINT { Scalar(float_of_string $1) } + | CONST POINT CONST { Scalar(float_of_string ($1 ^ "." ^ $3)) }; + +vector: LPAR nestpar RPAR { Vector($2) }; + +nestpar: nest { Unary($1) } + | nest COMMA nestpar { Binary($1,$3) }; + +nest: scalar { $1 } + | vector { $1 }; diff --git a/interpreter/types.ml b/interpreter/types.ml index 585b0ed..aa82868 100644 --- a/interpreter/types.ml +++ b/interpreter/types.ml @@ -24,6 +24,7 @@ class type value_type = method to_float_array : float array method of_float_array : float array -> value_type method to_string : string + method to_neststring : string method normalize : unit method add : value_type -> value_type method neg : value_type @@ -216,6 +217,8 @@ type matrix = float array array;; type data = float array array array;; +type raw_data = value_type array array;; + class type beam_type = object method get : signal_type array @@ -226,6 +229,7 @@ class type beam_type = method matching : int -> beam_type method at : time -> value_type array method output : int -> data + method output_values : int -> raw_data method frequency : rate_type array end;; @@ -257,3 +261,10 @@ class type io_type = method read : string array -> beam_type method write : rate_type array -> data -> string * string -> string array end;; + + +type nest = + Scalar of float + | Vector of nestpar +and nestpar = Unary of nest + | Binary of nest * nestpar;; \ No newline at end of file diff --git a/interpreter/value.ml b/interpreter/value.ml index 48fc31c..7551237 100644 --- a/interpreter/value.ml +++ b/interpreter/value.ml @@ -7,6 +7,7 @@ open Types;; open Basic;; +open Nest;; let convert : (basic -> 'a) -> basic -> 'a = fun oper -> fun b -> oper b;; @@ -22,6 +23,7 @@ class value : basic -> value_type = method to_int = convert basic_to_int self#get method to_float_array = convert basic_to_float_array self#get method to_string = convert basic_to_string self#get + method to_neststring = convert basic_to_neststring self#get method of_float_array : float array -> value_type = fun data -> new value (basic_of_float_array data) -- 2.20.1