From: WANG Date: Thu, 12 Sep 2013 12:19:32 +0000 (+0200) Subject: Merge branch 'libsndfile' X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/commitdiff_plain/63cf293f572ae7d5c1c83b9dffb31e7d774f8854?hp=056d65cce93f673551b565e7d11f196be2e8ec93 Merge branch 'libsndfile' --- diff --git a/examples/primitives/primitives.dsp b/examples/primitives/primitives.dsp new file mode 100644 index 0000000..99a3e7a --- /dev/null +++ b/examples/primitives/primitives.dsp @@ -0,0 +1,3 @@ +import ("fft.lib"); + +process = 3.3 : vectorize(5) <: float, floor, ceil, rint, (_, (2 : vectorize(5)) <: ^, pow), (int : _, (2 : vectorize(5)) : - : _, (0 : vectorize(5)) <: &, |, xor), (_, (3 : vectorize(5)) <: >=, <=, ==, !=, >, <), (_, (3.3 : vectorize(5)) <: >=, <=, ==, !=, >, <), (_, (3 : vectorize(5)) : - <: acos, asin, tan, exp, log, log10, abs), (_, (2 : vectorize(5) : float) <: fmod, remainder) : nconcat(30) : serialize; diff --git a/examples/primitives/primitives.sh b/examples/primitives/primitives.sh new file mode 100644 index 0000000..ad607b1 --- /dev/null +++ b/examples/primitives/primitives.sh @@ -0,0 +1 @@ +faustine -d primitives.dsp -t 30 --oformat csv diff --git a/interpretor/Makefile b/interpretor/Makefile index 30a10c9..f8ea173 100644 --- a/interpretor/Makefile +++ b/interpretor/Makefile @@ -4,7 +4,7 @@ # # The Caml sources (including camlyacc and camllex source files) -SOURCES = types.ml parser.mly lexer.mll basic.ml symbol.ml aux.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 aux.ml basic.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/interpretor/aux.ml b/interpretor/aux.ml index 3f75f06..7c21a61 100644 --- a/interpretor/aux.ml +++ b/interpretor/aux.ml @@ -5,11 +5,6 @@ Created: 12/08/2013 Modified: 13/08/2013 *) - -let array_map = fun f -> fun a -> - let n = Array.length a in - Array.init n (fun i -> f a.(i));; - let array_map2 = fun f -> fun a -> fun b -> let n1 = Array.length a in let n2 = Array.length b in @@ -24,3 +19,18 @@ let array_map3 = fun f -> fun a -> fun b -> fun c -> else raise (Invalid_argument "Array.map3 size not matched.");; let decorate = fun s -> " Faustine -> " ^ s;; + +let xor : bool -> bool -> bool = + fun a -> fun b -> (a || b) && (not (a && b));; + +let rint : float -> float = + fun f -> + if (f -. (floor f)) >= 0.5 then ceil f + else floor f;; + +let remainder_float : float -> float -> float = + fun f1 -> fun f2 -> + let r = mod_float f1 f2 in + if (abs_float r) > ((abs_float f2) /. 2.) then + (if r *. f2 > 0. then (r -. f2) else (r +. f2)) + else r;; diff --git a/interpretor/basic.ml b/interpretor/basic.ml index ae096af..55f0fb5 100644 --- a/interpretor/basic.ml +++ b/interpretor/basic.ml @@ -6,6 +6,7 @@ *) open Types;; +open Aux;; exception Convert_Error of string;; exception Basic_operation of string;; @@ -111,6 +112,20 @@ let rec basic_of_float_array : float array -> basic = let vec = Array.get (Array.map basic_of_float data) in Vec (new vector n vec);; +let basic_to_bool : basic -> bool = + fun b -> + match b with + | N i -> + if i = 1 then true + else if i = 0 then false + else raise (Convert_Error "basic_to_bool : only for 0 or 1.") + | Zero -> false + | _ -> raise (Convert_Error "basic_to_bool : only for 0 or 1.");; + +let basic_of_bool : bool -> basic = + fun tof -> if tof then N 1 else N 0;; + + (* VALUE OPERATIONS *) let rec basic_normalize : basic -> basic = @@ -143,24 +158,20 @@ let rec basic_add : basic -> basic -> basic = match (b1, b2) with | (Zero, _) -> b2 | (_, Zero) -> b1 - | (Vec vec1, Vec vec2) -> if vec1#size = vec2#size then Vec (new vector vec1#size (fun_binary basic_add vec1#nth vec2#nth)) else raise (Basic_operation "vector size not matched.") | (Vec vec1, _) -> raise (Basic_operation "vec1 +~ sca2") - | (N i1, N i2) -> basic_normalize (N (i1 + i2)) | (N i1, R f2) -> basic_normalize (R ((float_of_int i1) +. f2)) | (N i1, Vec vec2) -> raise (Basic_operation "i1 +~ vec2") | (N i1, Error) -> Error - | (R f1, N i2) -> basic_normalize (R (f1 +. (float_of_int i2))) | (R f1, R f2) -> basic_normalize (R (f1 +. f2)) | (R f1, Vec vec2) -> raise (Basic_operation "f1 +~ vec2") | (R f1, Error) -> Error - | (Error, Vec vec2) -> raise (Basic_operation "Error +~ vec2") | (Error, _) -> Error;; @@ -200,19 +211,16 @@ let rec basic_mul : basic -> basic -> basic = Vec (new vector vec1#size (fun_unary (basic_mul Zero) vec1#nth)) | (Vec vec1, _) -> raise (Basic_operation "vec1 *~ sca2") - | (N i1, N i2) -> basic_normalize (N (i1 * i2)) | (N i1, R f2) -> basic_normalize (R ((float_of_int i1) *. f2)) | (N i1, Vec vec2) -> raise (Basic_operation "i1 *~ vec2") | (N i1, Zero) -> N 0 | (N i1, Error) -> Error - | (R f1, N i2) -> basic_normalize (R (f1 *. (float_of_int i2))) | (R f1, R f2) -> basic_normalize (R (f1 *. f2)) | (R f1, Vec vec2) -> raise (Basic_operation "f1 *~ vec2") | (R f1, Zero) -> R 0. | (R f1, Error) -> Error - | (Zero, N i2) -> N 0 | (Zero, R f2) -> R 0. | (Zero, Vec vec2) -> @@ -220,8 +228,7 @@ let rec basic_mul : basic -> basic -> basic = (fun i -> basic_mul Zero (vec2#nth i))) | (Zero, Zero) -> Zero | (Zero, Error) -> Error - - | (Error, Vec vec2) -> raise (Basic_operation "Error +~ vec2") + | (Error, Vec vec2) -> raise (Basic_operation "Error *~ vec2") | (Error, _) -> Error;; @@ -259,27 +266,150 @@ let rec basic_zero : basic -> basic = |Error -> R 0.;; -let rec basic_floor : basic -> basic = - fun v -> - match v with - |N i -> R (float_of_int i) - |R f -> R (floor f) +let rec basic_power : basic -> basic -> basic = + fun b1 -> + fun b2 -> + match (b1, b2) with + | (Vec vec1, Vec vec2) -> + if vec1#size = vec2#size then + Vec (new vector vec1#size + (fun_binary basic_power vec1#nth vec2#nth)) + else raise (Basic_operation "vector size not matched.") + | (Vec vec1, Zero) -> + let vec_zeros = Vec (new vector vec1#size (fun i -> Zero)) in + basic_power b1 vec_zeros + | (Vec vec1, _) -> raise (Basic_operation "vec1 ** sca2") + | (N i1, _) -> basic_power (R (float_of_int i1)) b2 + | (R f1, N i2) -> basic_power b1 (R (float_of_int i2)) + | (R f1, R f2) -> basic_normalize (R (f1 ** f2)) + | (R f1, Vec vec2) -> raise (Basic_operation "f1 ** vec2") + | (R f1, Zero) -> basic_power b1 (R 0.) + | (R f1, Error) -> Error + | (Zero, N i2) -> basic_power b1 (R (float_of_int i2)) + | (Zero, R f2) -> basic_power (R 0.) b2 + | (Zero, Vec vec2) -> + let vec_zeros = Vec (new vector vec2#size (fun i -> Zero)) in + basic_power vec_zeros b2 + | (Zero, Zero) -> basic_power (R 0.) (R 0.) + | (Zero, Error) -> Error + | (Error, Vec vec2) -> raise (Basic_operation "Error ** vec2") + | (Error, _) -> Error;; + +let rec basic_shift : (int -> int -> int) -> basic -> basic -> basic = + fun oper -> fun b1 -> fun b2 -> + match (b1, b2) with + | (Vec vec1, Vec vec2) -> + if vec1#size = vec2#size then + Vec (new vector vec1#size + (fun_binary (basic_shift oper) vec1#nth vec2#nth)) + else raise (Basic_operation "vector size not matched.") + | (Vec vec1, Zero) -> + let vec_zeros = Vec (new vector vec1#size (fun i -> Zero)) in + basic_shift oper b1 vec_zeros + | (Vec vec1, _) -> raise (Basic_operation "vec1 shift sca2") + | (N i1, N i2) -> basic_normalize (N (oper i1 i2)) + | (N i1, Vec vec2) -> raise (Basic_operation "sca1 shift vec2") + | (N i1, Zero) -> basic_shift oper b1 (N 0) + | (N i1, R f2) -> + raise (Basic_operation "Logical shift doesn't accept float.") + | (N i1, Error) -> Error + | (R f1, _) -> + raise (Basic_operation "Logical shift doesn't accept float.") + | (Zero, N i2) -> basic_shift oper (N 0) b2 + | (Zero, R f2) -> + raise (Basic_operation "Logical shift doesn't accept float.") + | (Zero, Vec vec2) -> + let vec_zeros = Vec (new vector vec2#size (fun i -> Zero)) in + basic_shift oper vec_zeros b2 + | (Zero, Zero) -> basic_shift oper (N 0) (N 0) + | (Zero, Error) -> Error + | (Error, Vec vec2) -> raise (Basic_operation "sca1 shift vec2") + | (Error, _) -> Error;; + +let basic_shl = basic_shift (lsl);; +let basic_shr = basic_shift (lsr);; + +let rec basic_logic : + (bool -> bool -> bool) -> basic -> basic -> basic = + fun oper -> fun b1 -> fun b2 -> + match (b1, b2) with + | (Vec vec1, Vec vec2) -> + if vec1#size = vec2#size then + Vec (new vector vec1#size + (fun_binary (basic_logic oper) vec1#nth vec2#nth)) + else raise (Basic_operation "vector size not matched.") + | (Vec vec1, Zero) -> + let vec_zeros = Vec (new vector vec1#size (fun i -> Zero)) in + basic_logic oper b1 vec_zeros + | (Vec vec1, _) -> raise (Basic_operation "vec1 logic sca2") + | (N i1, N i2) -> basic_of_bool (oper (basic_to_bool b1) + (basic_to_bool b2)) + | (N i1, R f2) -> + raise (Basic_operation "Float shouldn't be in logical oper.") + | (N i1, Vec vec2) -> raise (Basic_operation "f1 logic vec2") + | (N i1, Zero) -> basic_logic oper b1 (N 0) + | (N i1, Error) -> Error + | (R f1, _) -> + raise (Basic_operation "Float shouldn't be in logical oper.") + | (Zero, N i2) -> basic_logic oper (N 0) b2 + | (Zero, R f2) -> + raise (Basic_operation "Float shouldn't be in logical oper.") + | (Zero, Vec vec2) -> + let vec_zeros = Vec (new vector vec2#size (fun i -> Zero)) in + basic_logic oper vec_zeros b2 + | (Zero, Zero) -> basic_logic oper (N 0) (N 0) + | (Zero, Error) -> Error + | (Error, Vec vec2) -> raise (Basic_operation "Error logic vec2") + | (Error, _) -> Error;; + +let basic_and = basic_logic (&&);; +let basic_or = basic_logic (||);; +let basic_xor = basic_logic xor;; + +let rec basic_adjust : (float -> float) -> basic -> basic = + fun oper -> fun b -> + match b with + |N i -> R (oper (float_of_int i)) + |R f -> R (oper f) |Vec vec -> Vec (new vector vec#size - (fun_unary basic_floor vec#nth)) - |Zero -> R 0. + (fun_unary (basic_adjust oper) vec#nth)) + |Zero -> R (oper 0.) |Error -> Error;; +let basic_floor = basic_adjust floor;; +let basic_ceil = basic_adjust ceil;; +let basic_rint = basic_adjust rint;; let rec basic_int : basic -> basic = - fun v -> - match v with - |N i -> v + fun b -> + match b with + |N i -> b |R f -> N (int_of_float f) |Vec vec -> Vec (new vector vec#size (fun_unary basic_int vec#nth)) |Zero -> N 0 |Error -> Error;; +let rec basic_float : basic -> basic = + fun b -> + match b with + | N i -> R (float_of_int i) + | R f -> b + | Vec vec -> Vec (new vector vec#size + (fun_unary basic_float vec#nth)) + | Zero -> R 0. + | Error -> Error;; + +let rec basic_abs : basic -> basic = + fun b -> + match b with + | N i -> N (abs i) + | R f -> R (abs_float f) + | Vec vec -> Vec (new vector vec#size + (fun_unary basic_abs vec#nth)) + | Zero -> Zero + | Error -> Error;; + let rec basic_unary : (float -> float) -> basic -> basic = fun oper -> @@ -292,11 +422,15 @@ let rec basic_unary : (float -> float) -> basic -> basic = |Zero -> R (oper 0.) |Error -> Error;; - let basic_sin : basic -> basic = basic_unary sin;; +let basic_asin : basic -> basic = basic_unary asin;; let basic_cos : basic -> basic = basic_unary cos;; +let basic_acos : basic -> basic = basic_unary acos;; +let basic_tan : basic -> basic = basic_unary tan;; let basic_atan : basic -> basic = basic_unary atan;; - +let basic_exp : basic -> basic = basic_unary exp;; +let basic_ln : basic -> basic = basic_unary log;; +let basic_lg : basic -> basic = basic_unary log10;; let rec basic_atan2 : basic -> basic -> basic = fun v1 -> @@ -349,59 +483,93 @@ let rec basic_mod : basic -> basic -> basic = fun b2 -> match (b1, b2) with | (N i1, N i2) -> N (i1 mod i2) - | (N i1, R f2) -> basic_mod b1 (N (int_of_float f2)) + | (_, R f2) -> + raise (Basic_operation "b1 mod b2: b2 cannot be float.") + | (R f1, _) -> + raise (Basic_operation "b1 mod b2: b1 cannot be float.") | (N i1, Vec vec2) -> - raise (Basic_operation "Scalaire_Vector: int mod vec.") + raise (Basic_operation "Scalar_Vector: sca mod vec.") | (_, Zero) -> raise (Basic_operation "b1 mod b2: b2 cannot be zero.") | (N i1, Error) -> Error - - | (R f1, _) -> basic_mod (N (int_of_float f1)) b2 - | (Vec vec1, Vec vec2) -> if vec1#size = vec2#size then - Vec (new vector vec1#size (fun_binary basic_mod vec1#nth vec2#nth)) + Vec (new vector vec1#size + (fun_binary basic_mod vec1#nth vec2#nth)) else raise (Basic_operation "vector size not matched.") | (Vec vec1, _) -> - raise (Basic_operation "Vector_Scalaire: vec mod int.") - + raise (Basic_operation "Vector_Scalar: vec mod sca.") | (Zero, Vec vec2) -> basic_mod (Vec (new vector vec2#size (fun i -> Zero))) b2 | (Zero, _) -> basic_mod (N 0) b2 - | (Error, Vec vec2) -> - raise (Basic_operation "Scalaire_Vector: int mod vec.") + raise (Basic_operation "Scalar_Vector: sca mod vec.") | (Error, _) -> Error;; +let rec basic_mod_float : + (float -> float -> float) -> basic -> basic -> basic = + fun oper -> fun b1 -> fun b2 -> + match (b1, b2) with + | (R f1, R f2) -> R (oper f1 f2) + | (_, N i2) -> + raise (Basic_operation "b1 mod_float b2: b2 cannot be int.") + | (N i1, _) -> + raise (Basic_operation "b1 mod_float b2: b1 cannot be int.") + | (R f1, Vec vec2) -> + raise (Basic_operation "Scalar_Vector: sca mod_float vec.") + | (_, Zero) -> + raise (Basic_operation "b1 mod_float b2: b2 cannot be zero.") + | (R f1, Error) -> Error + | (Vec vec1, Vec vec2) -> + if vec1#size = vec2#size then + Vec (new vector vec1#size + (fun_binary (basic_mod_float oper) vec1#nth vec2#nth)) + else raise (Basic_operation "vector size not matched.") + | (Vec vec1, _) -> + raise (Basic_operation "Vector_Scalaire: vec mod_float sca.") + | (Zero, Vec vec2) -> + basic_mod_float oper (Vec (new vector vec2#size (fun i -> Zero))) b2 + | (Zero, _) -> basic_mod_float oper (R 0.) b2 + | (Error, Vec vec2) -> + raise (Basic_operation "Scalaire_Vector: int mod_float vec.") + | (Error, _) -> Error;; -let rec basic_larger_than_zero : basic -> basic = - fun v -> - match v with - |N i -> if i > 0 then N 1 else N 0 - |R f -> if f > 0. then N 1 else N 0 - |Vec vec -> - Vec (new vector vec#size - (fun_unary basic_larger_than_zero vec#nth )) - |Zero -> N 0 - |Error -> Error;; - +let basic_fmod = basic_mod_float mod_float;; +let basic_remainder = basic_mod_float remainder_float;; -let basic_larger : basic -> basic -> basic = - fun b1 -> - fun b2 -> - basic_larger_than_zero (b1 -~ b2);; +let rec basic_compare_zero : + ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> basic -> basic = + fun oper1 -> fun oper2 -> fun v -> + match v with + |N i -> if oper1 i 0 then N 1 else N 0 + |R f -> if oper2 f 0. then N 1 else N 0 + |Vec vec -> + Vec (new vector vec#size + (fun_unary (basic_compare_zero oper1 oper2) vec#nth )) + |Zero -> basic_compare_zero oper1 oper2 (N 0) + |Error -> Error;; +let basic_gt_zero = basic_compare_zero (>) (>);; +let basic_lt_zero = basic_compare_zero (<) (<);; +let basic_geq_zero = basic_compare_zero (>=) (>=);; +let basic_leq_zero = basic_compare_zero (<=) (<=);; +let basic_eq_zero = basic_compare_zero (=) (=);; +let basic_neq_zero = basic_compare_zero (<>) (<>);; -let basic_smaller : basic -> basic -> basic = - fun b1 -> - fun b2 -> - basic_larger_than_zero (b2 -~ b1);; +let basic_compare : (basic -> basic) -> basic -> basic -> basic = + fun oper -> fun b1 -> fun b2 -> oper (b1 -~ b2);; +let basic_gt = basic_compare basic_gt_zero;; +let basic_lt = basic_compare basic_lt_zero;; +let basic_geq = basic_compare basic_geq_zero;; +let basic_leq = basic_compare basic_leq_zero;; +let basic_eq = basic_compare basic_eq_zero;; +let basic_neq = basic_compare basic_neq_zero;; let basic_max : basic -> basic -> basic = fun b1 -> fun b2 -> - let compare = basic_larger_than_zero (b1 -~ b2) in + let compare = basic_gt_zero (b1 -~ b2) in match compare with | N i -> if i = 1 then b1 @@ -420,7 +588,7 @@ let basic_max : basic -> basic -> basic = let basic_min : basic -> basic -> basic = fun b1 -> fun b2 -> - let compare = basic_larger_than_zero (b1 -~ b2) in + let compare = basic_gt_zero (b1 -~ b2) in match compare with | N i -> if i = 1 then b2 diff --git a/interpretor/lexer.mll b/interpretor/lexer.mll index 3cb9847..353712a 100644 --- a/interpretor/lexer.mll +++ b/interpretor/lexer.mll @@ -12,34 +12,55 @@ rule token = parse | "/" { IDENT Div} | "_" { IDENT Pass} | "!" { IDENT Stop} +| "&" { IDENT And} +| "|" { IDENT Or} +| "^" { IDENT Xor} | "mem" { IDENT Mem} | "@" { IDENT Delay} | "floor" { IDENT Floor} +| "ceil" { IDENT Ceil} +| "rint" { IDENT Rint} | "int" { IDENT Int} +| "float" { IDENT Float} | "sin" { IDENT Sin} +| "asin" { IDENT Asin} | "cos" { IDENT Cos} +| "acos" { IDENT Acos} +| "tan" { IDENT Tan} | "atan" { IDENT Atan} -| "atantwo" { IDENT Atan2} +| "atantwo" { IDENT Atan2} +| "exp" { IDENT Exp} | "sqrt" { IDENT Sqrt} -| "rdtable" { IDENT Rdtable} +| "log" { IDENT Ln} +| "logten" { IDENT Lg} +| "powf" { IDENT Power} +| "abs" { IDENT Abs} +| "fmodf" { IDENT Fmod} | "%" { IDENT Mod} +| "remainder" { IDENT Remainder} | "vectorize" { IDENT Vectorize} | "#" { IDENT Vconcat} | "[]" { IDENT Vpick } | "serialize" { IDENT Serialize} -| ">" { IDENT Larger} -| "<" { IDENT Smaller} +| '>' { IDENT Gt} +| '<' { IDENT Lt} +| ">=" { IDENT Geq} +| "<=" { IDENT Leq} +| "==" { IDENT Eq} +| "!=" { IDENT Neq} +| "<<" { IDENT Shl} +| ">>" { IDENT Shr} | "max" { IDENT Max} | "min" { IDENT Min} | "prefix" { IDENT Prefix} | "selecttwo" { IDENT Select2} | "selectthree" { IDENT Select3} - +| "rdtable" { IDENT Rdtable} +| "rwtable" { IDENT Rwtable} | ['0'-'9']+ as a { CONST a } | '.' { POINT } - | '(' { LPAR } | ')' { RPAR } | ',' { PAR } diff --git a/interpretor/preprocessor/faust-0.9.47mr3/compiler/boxes/ppbox.cpp b/interpretor/preprocessor/faust-0.9.47mr3/compiler/boxes/ppbox.cpp index 10e6389..c54701b 100644 --- a/interpretor/preprocessor/faust-0.9.47mr3/compiler/boxes/ppbox.cpp +++ b/interpretor/preprocessor/faust-0.9.47mr3/compiler/boxes/ppbox.cpp @@ -56,13 +56,13 @@ const char * prim2name(CTree *(*ptr) (CTree *, CTree *)) if (ptr == sigOR ) return "|"; if (ptr == sigXOR) return "^"; - if (ptr == sigLeftShift ) return "<<"; - if (ptr == sigRightShift) return ">>"; + if (ptr == sigLeftShift ) return "<< "; + if (ptr == sigRightShift) return " >>"; if (ptr == sigLT) return "< "; if (ptr == sigLE) return "<="; if (ptr == sigGT) return " >"; - if (ptr == sigGE) return ">="; + if (ptr == sigGE) return " >="; if (ptr == sigEQ) return "=="; if (ptr == sigNE) return "!="; diff --git a/interpretor/preprocessor/faust-0.9.47mr3/compiler/extended/log10prim.cpp b/interpretor/preprocessor/faust-0.9.47mr3/compiler/extended/log10prim.cpp index f93cc93..e1c32df 100644 --- a/interpretor/preprocessor/faust-0.9.47mr3/compiler/extended/log10prim.cpp +++ b/interpretor/preprocessor/faust-0.9.47mr3/compiler/extended/log10prim.cpp @@ -10,7 +10,7 @@ class Log10Prim : public xtended public: - Log10Prim() : xtended("log10f") {} + Log10Prim() : xtended("logten") {} virtual unsigned int arity () { return 1; } diff --git a/interpretor/process.ml b/interpretor/process.ml index f094b7b..ba13961 100644 --- a/interpretor/process.ml +++ b/interpretor/process.ml @@ -131,28 +131,58 @@ class proc_ident : faust_exp -> process_type = ((input#get.(0))#mul input#get.(1)) | Div -> self#beam_of_ident n ((input#get.(0))#div input#get.(1)) + | Power -> self#beam_of_ident n + ((input#get.(0))#power input#get.(1)) + | And -> self#beam_of_ident n + ((input#get.(0))#_and input#get.(1)) + | Or -> self#beam_of_ident n + ((input#get.(0))#_or input#get.(1)) + | Xor -> self#beam_of_ident n + ((input#get.(0))#_xor 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) + | Ceil -> self#beam_of_ident n + ((input#get.(0))#ceil) + | Rint -> self#beam_of_ident n + ((input#get.(0))#rint) | Int -> self#beam_of_ident n ((input#get.(0))#int) + | Float -> self#beam_of_ident n + ((input#get.(0))#float) | Sin -> self#beam_of_ident n ((input#get.(0))#sin) + | Asin -> self#beam_of_ident n + ((input#get.(0))#asin) | Cos -> self#beam_of_ident n ((input#get.(0))#cos) + | Acos -> self#beam_of_ident n + ((input#get.(0))#acos) + | Tan -> self#beam_of_ident n + ((input#get.(0))#tan) | Atan -> self#beam_of_ident n ((input#get.(0))#atan) | Atan2 -> self#beam_of_ident n ((input#get.(0))#atan2 input#get.(1)) + | Exp -> self#beam_of_ident n + ((input#get.(0))#exp) | 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)) + | Ln -> self#beam_of_ident n + ((input#get.(0))#ln) + | Lg -> self#beam_of_ident n + ((input#get.(0))#lg) + | Abs -> self#beam_of_ident n + ((input#get.(0))#abs) | Mod -> self#beam_of_ident n ((input#get.(0))#_mod input#get.(1)) + | Fmod -> self#beam_of_ident n + ((input#get.(0))#fmod input#get.(1)) + | Remainder -> self#beam_of_ident n + ((input#get.(0))#remainder input#get.(1)) | Vectorize -> self#beam_of_ident n ((input#get.(0))#vectorize input#get.(1)) | Vconcat -> self#beam_of_ident n @@ -161,14 +191,26 @@ class proc_ident : faust_exp -> process_type = ((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)) + | Gt -> self#beam_of_ident n + ((input#get.(0))#gt input#get.(1)) + | Lt -> self#beam_of_ident n + ((input#get.(0))#lt input#get.(1)) + | Geq -> self#beam_of_ident n + ((input#get.(0))#geq input#get.(1)) + | Leq -> self#beam_of_ident n + ((input#get.(0))#leq input#get.(1)) + | Eq -> self#beam_of_ident n + ((input#get.(0))#eq input#get.(1)) + | Neq -> self#beam_of_ident n + ((input#get.(0))#neq input#get.(1)) | Max -> self#beam_of_ident n ((input#get.(0))#max input#get.(1)) | Min -> self#beam_of_ident n ((input#get.(0))#min input#get.(1)) + | Shl -> self#beam_of_ident n + ((input#get.(0))#shl input#get.(1)) + | Shr -> self#beam_of_ident n + ((input#get.(0))#shr input#get.(1)) | Prefix -> self#beam_of_ident n ((input#get.(1))#prefix input#get.(0)) | Select2 -> self#beam_of_ident n @@ -176,6 +218,11 @@ class proc_ident : faust_exp -> process_type = | Select3 -> self#beam_of_ident n ((input#get.(0))#select3 input#get.(1) input#get.(2) input#get.(3)) + | Rdtable -> self#beam_of_ident n + ((input#get.(1))#rdtable input#get.(0) input#get.(2)) + | Rwtable -> self#beam_of_ident n + ((input#get.(0))#rwtable input#get.(1) + input#get.(2) input#get.(3) input#get.(4)) end;; class virtual process_binary = diff --git a/interpretor/signal.ml b/interpretor/signal.ml index 00a1709..66089e9 100644 --- a/interpretor/signal.ml +++ b/interpretor/signal.ml @@ -113,22 +113,44 @@ class signal : rate_type -> (time -> value_type) -> signal_type = method neg = self#prim1 (fun t -> (self#at t)#neg) method floor = self#prim1 (fun t -> (self#at t)#floor) + method ceil = self#prim1 (fun t -> (self#at t)#ceil) + method rint = self#prim1 (fun t -> (self#at t)#rint) method sin = self#prim1 (fun t -> (self#at t)#sin) + method asin = self#prim1 (fun t -> (self#at t)#asin) method cos = self#prim1 (fun t -> (self#at t)#cos) + method acos = self#prim1 (fun t -> (self#at t)#acos) + method tan = self#prim1 (fun t -> (self#at t)#tan) method atan = self#prim1 (fun t -> (self#at t)#atan) + method exp = self#prim1 (fun t -> (self#at t)#exp) method sqrt = self#prim1 (fun t -> (self#at t)#sqrt) + method ln = self#prim1 (fun t -> (self#at t)#ln) + method lg = self#prim1 (fun t -> (self#at t)#lg) method int = self#prim1 (fun t -> (self#at t)#int) + method float = self#prim1 (fun t -> (self#at t)#float) + method abs = self#prim1 (fun t -> (self#at t)#abs) method add = self#prim2 (fun t -> (self#at t)#add) method sub = self#prim2 (fun t -> (self#at t)#sub) method mul = self#prim2 (fun t -> (self#at t)#mul) method div = self#prim2 (fun t -> (self#at t)#div) + method power = self#prim2 (fun t -> (self#at t)#power) + method _and = self#prim2 (fun t -> (self#at t)#_and) + method _or = self#prim2 (fun t -> (self#at t)#_or) + method _xor = self#prim2 (fun t -> (self#at t)#_xor) method atan2 = self#prim2 (fun t -> (self#at t)#atan2) method _mod = self#prim2 (fun t -> (self#at t)#_mod) - method larger = self#prim2 (fun t -> (self#at t)#larger) - method smaller = self#prim2 (fun t -> (self#at t)#smaller) + method fmod = self#prim2 (fun t -> (self#at t)#fmod) + method remainder = self#prim2 (fun t -> (self#at t)#remainder) + method gt = self#prim2 (fun t -> (self#at t)#gt) + method lt = self#prim2 (fun t -> (self#at t)#lt) + method geq = self#prim2 (fun t -> (self#at t)#geq) + method leq = self#prim2 (fun t -> (self#at t)#leq) + method eq = self#prim2 (fun t -> (self#at t)#eq) + method neq = self#prim2 (fun t -> (self#at t)#neq) method max = self#prim2 (fun t -> (self#at t)#max) method min = self#prim2 (fun t -> (self#at t)#min) + method shl = self#prim2 (fun t -> (self#at t)#shl) + method shr = self#prim2 (fun t -> (self#at t)#shr) method delay : signal_type -> signal_type = fun (s : signal_type) -> @@ -155,6 +177,25 @@ class signal : rate_type -> (time -> value_type) -> signal_type = self#at ((s_index#at t)#to_int) in new signal freq func + method rwtable : signal_type -> signal_type -> + signal_type -> signal_type -> signal_type = + fun init -> fun wstream -> fun windex -> fun rindex -> + let freq = self#check_freq [init; wstream; windex; rindex] in + let () = init#add_memory ((self#at 0)#to_int) in + let () = wstream#add_memory ((self#at 0)#to_int) in + let func : time -> value_type = fun (ti : time) -> + let rec table : time -> index -> value_type = + fun t -> fun i -> + if t > 0 then + (if i = (windex#at t)#to_int then (wstream#at t) + else table (t - 1) i) + else if t = 0 then + (if i = (windex#at 0)#to_int then (wstream#at 0) + else init#at i) + else raise (Signal_operation "signal time should be > 0") in + table ti ((rindex#at ti)#to_int) in + new signal freq func + method select2 : signal_type -> signal_type -> signal_type = fun s_first -> fun s_second -> diff --git a/interpretor/symbol.ml b/interpretor/symbol.ml index bdfa410..4d58697 100644 --- a/interpretor/symbol.ml +++ b/interpretor/symbol.ml @@ -12,101 +12,75 @@ exception Symbol_error of string;; (* MACRO *) let delay_memory_length = 100000;; let rdtable_memory_length = 100000;; +let rwtable_memory_length = 100000;; let vectorize_memory_length = 1000;; -let dimension_of_symbol : symbol -> int * int = +let dictionary_of_symbol : symbol -> (int * int) * int * string = 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) - |Max -> (2, 1) - |Min -> (2, 1) - |Prefix -> (2, 1) - |Select2 -> (3, 1) - |Select3 -> (4, 1);; + |Add -> ((2, 1), 0, "Add") + |Sub -> ((2, 1), 0, "Sub") + |Mul -> ((2, 1), 0, "Mul") + |Div -> ((2, 1), 0, "Div") + |Power -> ((2, 1), 0, "Power") + |Pass -> ((1, 1), 0, "Pass") + |Stop -> ((1, 0), 0, "Stop") + |And -> ((2, 1), 0, "And") + |Or -> ((2, 1), 0, "Or") + |Xor -> ((2, 1), 0, "Xor") + |Mem -> ((1, 1), 0, "Mem") + |Delay -> ((2, 1), delay_memory_length, "Delay") + |Floor -> ((1, 1), 0, "Floor") + |Ceil -> ((1, 1), 0, "Ceil") + |Rint -> ((1, 1), 0, "Rint") + |Int -> ((1, 1), 0, "Int") + |Float -> ((1, 1), 0, "Float") + |Sin -> ((1, 1), 0, "Sin") + |Asin -> ((1, 1), 0, "Asin") + |Cos -> ((1, 1), 0, "Cos") + |Acos -> ((1, 1), 0, "Acos") + |Tan -> ((1, 1), 0, "Tan") + |Atan -> ((1, 1), 0, "Atan") + |Atan2 -> ((2, 1), 0, "Atan2") + |Exp -> ((1, 1), 0, "Exp") + |Sqrt -> ((1, 1), 0, "Sqrt") + |Ln -> ((1, 1), 0, "Ln") + |Lg -> ((1, 1), 0, "Lg") + |Abs -> ((1, 1), 0, "Abs") + |Mod -> ((2, 1), 0, "Mod") + |Fmod -> ((2, 1), 0, "Fmod") + |Remainder -> ((2, 1), 0, "Remainder") + |Vectorize -> ((2, 1), vectorize_memory_length, "Vectorize") + |Vconcat -> ((2, 1), 0, "Vconcat") + |Vpick -> ((2, 1), 0, "Vpick") + |Serialize -> ((1, 1), 0, "Serialize") + |Gt -> ((2, 1), 0, "Gt") + |Lt -> ((2, 1), 0, "Lt") + |Geq -> ((2, 1), 0, "Geq") + |Leq -> ((2, 1), 0, "Leq") + |Eq -> ((2, 1), 0, "Eq") + |Neq -> ((2, 1), 0, "Neq") + |Shl -> ((2, 1), 0, "shift_left") + |Shr -> ((2, 1), 0, "shift_right") + |Max -> ((2, 1), 0, "Max") + |Min -> ((2, 1), 0, "Min") + |Prefix -> ((2, 1), 0, "Prefix") + |Select2 -> ((3, 1), 0, "Select2") + |Select3 -> ((4, 1), 0, "Select3") + |Rdtable -> ((3, 1), rdtable_memory_length, "Rdtalbe") + |Rwtable -> ((5, 1), rwtable_memory_length, "Rwtable");; + +let dimension_of_symbol : symbol -> int * int = + fun (s : symbol) -> + match (dictionary_of_symbol s) with + | (dimension, delay, name) -> dimension;; 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 - |Max -> 0 - |Min -> 0 - |Vectorize -> vectorize_memory_length - |Vconcat -> 0 - |Vpick -> 0 - |Serialize -> 0 - |Prefix -> 1 - |Select2 -> 0 - |Select3 -> 0;; + match (dictionary_of_symbol s) with + | (dimension, delay, name) -> delay;; let string_of_symbol : symbol -> string = fun (s : symbol) -> - match s with - |Add -> "Add" - |Sub -> "Sub" - |Mul -> "Mul" - |Div -> "Div" - |Pass -> "Pass" - |Stop -> "Stop" - |Mem -> "Mem" - |Delay -> "Delay" - |Floor -> "Floor" - |Int -> "Int" - |Sin -> "Sin" - |Cos -> "Cos" - |Atan -> "Atan" - |Atan2 -> "Atan2" - |Sqrt -> "Sqrt" - |Rdtable -> "Rdtable" - |Mod -> "Mod" - |Larger -> "Larger" - |Smaller -> "Smaller" - |Max -> "Max" - |Min -> "Min" - |Vectorize -> "Vectorize" - |Vconcat -> "Vconcat" - |Vpick -> "Vpick" - |Serialize -> "Serialize" - |Prefix -> "Prefix" - |Select2 -> "Select2" - |Select3 -> "Select3";; - + match (dictionary_of_symbol s) with + | (dimension, delay, name) -> name;; diff --git a/interpretor/types.ml b/interpretor/types.ml index 0b7cfde..dd82e7c 100644 --- a/interpretor/types.ml +++ b/interpretor/types.ml @@ -31,17 +31,39 @@ class type value_type = method mul : value_type -> value_type method recip : value_type method div : value_type -> value_type + method power : value_type -> value_type + method _and : value_type -> value_type + method _or : value_type -> value_type + method _xor : value_type -> value_type method zero : value_type method floor : value_type + method ceil : value_type + method rint : value_type method int : value_type + method float : value_type method sin : value_type + method asin : value_type method cos : value_type + method acos : value_type + method tan : value_type method atan : value_type - method sqrt : value_type method atan2 : value_type -> value_type + method exp : value_type + method sqrt : value_type + method ln : value_type + method lg : value_type + method abs : value_type + method fmod : value_type -> value_type method _mod : value_type -> value_type - method larger : value_type -> value_type - method smaller : value_type -> value_type + method remainder : value_type -> value_type + method gt : value_type -> value_type + method lt : value_type -> value_type + method geq : value_type -> value_type + method leq : value_type -> value_type + method eq : value_type -> value_type + method neq : value_type -> value_type + method shl : value_type -> value_type + method shr : value_type -> value_type method max : value_type -> value_type method min : value_type -> value_type end;; @@ -51,31 +73,53 @@ type symbol = Add | Sub | Mul | Div + | Power | Pass | Stop + | And + | Or + | Xor | Mem | Delay | Floor + | Ceil + | Rint | Int + | Float | Sin + | Asin | Cos + | Acos + | Tan | Atan | Atan2 + | Exp | Sqrt - | Rdtable + | Ln + | Lg + | Abs + | Fmod | Mod + | Remainder | Vectorize | Vconcat | Vpick | Serialize - | Larger - | Smaller + | Gt + | Lt + | Geq + | Leq + | Eq + | Neq + | Shl + | Shr | Max | Min | Prefix | Select2 | Select3 - + | Rdtable + | Rwtable type faust_exp = Const of basic @@ -109,6 +153,10 @@ class type signal_type = method sub : signal_type -> signal_type method mul : signal_type -> signal_type method div : signal_type -> signal_type + method power : signal_type -> signal_type + method _and : signal_type -> signal_type + method _or : signal_type -> signal_type + method _xor : signal_type -> signal_type method delay : signal_type -> signal_type method mem : signal_type method vectorize : signal_type -> signal_type @@ -116,18 +164,38 @@ class type signal_type = method vconcat : signal_type -> signal_type method vpick : signal_type -> signal_type method floor : signal_type + method ceil : signal_type + method rint : signal_type method int : signal_type + method float : signal_type method sin : signal_type + method asin : signal_type method cos : signal_type + method acos : signal_type + method tan : signal_type method atan : signal_type method atan2 : signal_type -> signal_type + method exp : signal_type method sqrt : signal_type + method ln : signal_type + method lg : signal_type + method abs : signal_type + method fmod : signal_type -> signal_type method _mod : signal_type -> signal_type - method larger : signal_type -> signal_type - method smaller : signal_type -> signal_type + method remainder : signal_type -> signal_type + method gt : signal_type -> signal_type + method lt : signal_type -> signal_type + method geq : signal_type -> signal_type + method leq : signal_type -> signal_type + method eq : signal_type -> signal_type + method neq : signal_type -> signal_type + method shl : signal_type -> signal_type + method shr : signal_type -> signal_type method max : signal_type -> signal_type method min : signal_type -> signal_type method rdtable : signal_type -> signal_type -> signal_type + method rwtable : signal_type -> signal_type -> + signal_type -> signal_type -> signal_type method select2 : signal_type -> signal_type -> signal_type method select3 : signal_type -> signal_type -> signal_type -> signal_type method prefix : signal_type -> signal_type diff --git a/interpretor/value.ml b/interpretor/value.ml index ef05f43..48fc31c 100644 --- a/interpretor/value.ml +++ b/interpretor/value.ml @@ -33,11 +33,21 @@ class value : basic -> value_type = method recip = self#prim1 basic_recip method zero = self#prim1 basic_zero method floor = self#prim1 basic_floor + method ceil = self#prim1 basic_ceil + method rint = self#prim1 basic_rint method int = self#prim1 basic_int + method float = self#prim1 basic_float method sin = self#prim1 basic_sin + method asin = self#prim1 basic_asin method cos = self#prim1 basic_cos + method acos = self#prim1 basic_acos + method tan = self#prim1 basic_tan method atan = self#prim1 basic_atan + method exp = self#prim1 basic_exp method sqrt = self#prim1 basic_sqrt + method ln = self#prim1 basic_ln + method lg = self#prim1 basic_lg + method abs = self#prim1 basic_abs method private prim2 : (basic -> basic -> basic) -> value -> value = fun oper -> @@ -48,12 +58,24 @@ class value : basic -> value_type = method sub = self#prim2 basic_sub method mul = self#prim2 basic_mul method div = self#prim2 basic_div - method atan2 = self#prim2 basic_atan2 + method power = self#prim2 basic_power + method _and = self#prim2 basic_and + method _or = self#prim2 basic_or + method _xor = self#prim2 basic_xor method _mod = self#prim2 basic_mod - method larger = self#prim2 basic_larger - method smaller = self#prim2 basic_smaller + method fmod = self#prim2 basic_fmod + method remainder = self#prim2 basic_remainder + method gt = self#prim2 basic_gt + method lt = self#prim2 basic_lt + method geq = self#prim2 basic_geq + method leq = self#prim2 basic_leq + method eq = self#prim2 basic_eq + method neq = self#prim2 basic_neq + method atan2 = self#prim2 basic_atan2 method max = self#prim2 basic_max method min = self#prim2 basic_min + method shl = self#prim2 basic_shl + method shr = self#prim2 basic_shr end;;