From: WANG Date: Tue, 6 Aug 2013 16:19:33 +0000 (+0200) Subject: Create a new library symbol.ml. X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/commitdiff_plain/7aa377f6b67020aa1dff235ebb100943375cac94 Create a new library symbol.ml. Refactoring in faustexp.ml. --- diff --git a/interpretor/Makefile b/interpretor/Makefile index d9be60a..6de2b12 100644 --- a/interpretor/Makefile +++ b/interpretor/Makefile @@ -2,7 +2,7 @@ # # The Caml sources (including camlyacc and camllex source files) -SOURCES = types.ml parser.mly lexer.mll basic.ml value.ml signal.ml beam.ml faustexp.ml interpreter.ml preprocess.ml main.ml preprocess_stubs.cpp +SOURCES = types.ml parser.mly lexer.mll basic.ml symbol.ml value.ml signal.ml beam.ml faustexp.ml interpreter.ml preprocess.ml main.ml preprocess_stubs.cpp # The executable file to generate diff --git a/interpretor/beam.ml b/interpretor/beam.ml index a4f22b8..fe3ac61 100644 --- a/interpretor/beam.ml +++ b/interpretor/beam.ml @@ -25,6 +25,10 @@ class beam : signal_type array -> beam_type = fun len -> new beam (Array.sub self#get start len) + method cut : int -> beam_type * beam_type = + fun (cut_width : int)-> + ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width))) + method append : beam_type -> beam_type = fun (b : beam_type) -> new beam (Array.append self#get b#get) diff --git a/interpretor/faustexp.ml b/interpretor/faustexp.ml index 8ad37aa..ea50c66 100644 --- a/interpretor/faustexp.ml +++ b/interpretor/faustexp.ml @@ -7,6 +7,7 @@ open Types;; open Basic;; +open Symbol;; open Value;; open Signal;; open Beam;; @@ -18,11 +19,11 @@ exception Process_error of string;; class dimension : int * int -> dimension_type = fun (init : int * int) -> object (self) - val dim_input = fst init - val dim_output = snd init + val _input = fst init + val _output = snd init - method input = dim_input - method output = dim_output + method input = _input + method output = _output method par : dimension_type -> dimension_type = fun dim -> @@ -115,7 +116,7 @@ class proc_const : faust_exp -> process_type = end;; -class exp_ident : faust_exp -> process_type = +class proc_ident : faust_exp -> process_type = fun (exp_init : faust_exp) -> object (self) val _exp = exp_init @@ -123,21 +124,65 @@ class exp_ident : faust_exp -> process_type = match exp_init with | Ident s -> s | _ -> raise (Process_error "ident process constructor.") - val _dim = dimension_of_symbol _symbol - val _delay = 0 - + + val _dim = new dimension (dimension_of_symbol _symbol) + val _delay = delay_of_symbol _symbol method exp = _exp method dim = _dim method delay = _delay - method const = _const + method symb = _symbol + + method private beam_of_ident : int -> signal_type -> beam_type = + fun (n : int) -> + fun (s, signal_type) -> + if n = (self#dim)#input then + new beam [|s|] + else raise (Process_error ("Ident " ^ string_of_symbol self#symb)) method eval : beam_type -> beam_type = fun (input : beam_type) -> - if input = [||] then - new beam [| new signal 0 (fun t -> new value self#const)|] - else - raise (Process_error "proc_const accepts no input.") + let n = Array.length input#get in + match self#symb with + | Pass -> self#beam_of_ident n input#get.(0) + | Stop -> if n = 1 then new beam [||] + else raise (Process_error "Ident !") + | Add -> self#beam_of_ident n ((input#get.(0))#add input#get.(1)) + | Sub -> self#beam_of_ident n ((input#get.(0))#sub input#get.(1)) + | Mul -> self#beam_of_ident n ((input#get.(0))#mul input#get.(1)) + | Div -> self#beam_of_ident n ((input#get.(0))#div input#get.(1)) + | Mem -> self#beam_of_ident n ((input#get.(0))#mem) + | Delay -> self#beam_of_ident n ((input#get.(0))#delay input#get.(1)) + | Floor -> self#beam_of_ident n ((input#get.(0))#floor) + | Int -> self#beam_of_ident n ((input#get.(0))#int) + | Sin -> self#beam_of_ident n ((input#get.(0))#sin) + | Cos -> self#beam_of_ident n ((input#get.(0))#cos) + | Atan -> self#beam_of_ident n ((input#get.(0))#atan) + | Atan2 -> self#beam_of_ident n ((input#get.(0))#atan2 input#get.(1)) + | Sqrt -> self#beam_of_ident n ((input#get.(0))#sqrt) + | Rdtable -> self#beam_of_ident n + ((input#get.(1))#rdtable input#get.(0) input#get.(2)) + | Mod -> self#beam_of_ident n + ((input#get.(0))#_mod input#get.(1)) + | Vectorize -> self#beam_of_ident n + ((input#get.(0))#vectorzie input#get.(1)) + | Vconcat -> self#beam_of_ident n + ((input#get.(0))#vconcat input#get.(1)) + | Vpick -> self#beam_of_ident n + ((input#get.(0))#vpick input#get.(1)) + | Serialize -> self#beam_of_ident n + (input#get.(0))#serialize + | Larger -> self#beam_of_ident n + ((input#get.(0))#larger input#get.(1)) + | Smaller -> self#beam_of_ident n + ((input#get.(0))#smaller input#get.(1)) + | Prefix -> self#beam_of_ident n + ((input#get.(1))#prefix input#get.(0)) + | Selec2 -> self#beam_of_ident n + ((input#get.(0))#select2 input#get.(1) input#get.(2)) + | Select3 -> self#beam_of_ident n + ((input#get.(0))#select3 input#get.(1) + input#get.(2) input#get.(3)) end;; diff --git a/interpretor/signal.ml b/interpretor/signal.ml index b8f0e68..ae312b0 100644 --- a/interpretor/signal.ml +++ b/interpretor/signal.ml @@ -141,10 +141,11 @@ class signal : int -> (time -> value_type) -> signal_type = method prefix : signal_type -> signal_type = fun (s_init : signal_type) -> + let () = self#add_memory 1 in let func : time -> value_type = fun t -> if t = 0 then s_init#at 0 - else if t > 0 then self#at t + else if t > 0 then self#at (t - 1) else raise (Signal_operation "prefix time < 0.") in new signal self#frequency func diff --git a/interpretor/symbol.ml b/interpretor/symbol.ml new file mode 100644 index 0000000..68f5d5f --- /dev/null +++ b/interpretor/symbol.ml @@ -0,0 +1,75 @@ +(** + Module: Symbol + Description: Symbols' information in faust. + @author WANG Haisheng + Created: 05/08/2013 Modified: 05/08/2013 +*) + +open Types;; + +exception Symbol_error of string;; + +(* MACRO *) +let delay_memory_length = 100000;; +let rdtable_memory_length = 100000;; +let vectorize_memory_length = 1000;; + +let dimension_of_symbol : symbol -> int * int = + fun (s : symbol) -> + match s with + |Add -> (2, 1) + |Sub -> (2, 1) + |Mul -> (2, 1) + |Div -> (2, 1) + |Pass -> (1, 1) + |Stop -> (1, 0) + |Mem -> (1, 1) + |Delay -> (2, 1) + |Floor -> (1, 1) + |Int -> (1, 1) + |Sin -> (1, 1) + |Cos -> (1, 1) + |Atan -> (1, 1) + |Atan2 -> (2, 1) + |Sqrt -> (1, 1) + |Rdtable -> (3, 1) + |Mod -> (2, 1) + |Vectorize -> (2, 1) + |Vconcat -> (2, 1) + |Vpick -> (2, 1) + |Serialize -> (1, 1) + |Larger -> (2, 1) + |Smaller -> (2, 1) + |Prefix -> (2, 1) + |Select2 -> (3, 1) + |Select3 -> (4, 1);; + +let delay_of_symbol : symbol -> int = + fun (s : symbol) -> + match s with + |Add -> 0 + |Sub -> 0 + |Mul -> 0 + |Div -> 0 + |Pass -> 0 + |Stop -> 0 + |Mem -> 1 + |Delay -> delay_memory_length + |Floor -> 0 + |Int -> 0 + |Sin -> 0 + |Cos -> 0 + |Atan -> 0 + |Atan2 -> 0 + |Sqrt -> 0 + |Rdtable -> rdtable_memory_length + |Mod -> 0 + |Larger -> 0 + |Smaller -> 0 + |Vectorize -> vectorize_memory_length + |Vconcat -> 0 + |Vpick -> 0 + |Serialize -> 0 + |Prefix -> 1 + |Select2 -> 0 + |Select3 -> 0;; diff --git a/interpretor/types.ml b/interpretor/types.ml index 5e88a1a..3ad5f8a 100644 --- a/interpretor/types.ml +++ b/interpretor/types.ml @@ -45,7 +45,7 @@ class type value_type = type symbol = Add - | Sup + | Sub | Mul | Div | Pass @@ -57,7 +57,7 @@ type symbol = Add | Sin | Cos | Atan - | Atantwo + | Atan2 | Sqrt | Rdtable | Mod @@ -68,8 +68,8 @@ type symbol = Add | Larger | Smaller | Prefix - | Selecttwo - | Selectthree + | Select2 + | Select3 type faust_exp = @@ -120,6 +120,7 @@ class type beam_type = method get : signal_type array method width : int method sub : int -> int -> beam_type + method cut : int -> beam_type * beam_type method append : beam_type -> beam_type method matching : int -> beam_type method at : time -> value_type array @@ -144,5 +145,5 @@ class type process_type = method exp : faust_exp method dim : dimension_type method delay : int - method evaluate : beam_type -> beam_type + method eval : beam_type -> beam_type end;;