From: WANG Date: Wed, 11 Sep 2013 12:10:38 +0000 (+0200) Subject: Add 21 primitives to Faustine. X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/commitdiff_plain/9fdfd04e29fcefdb9120a4d9467827ceaf8dfaa0?ds=inline;hp=-c Add 21 primitives to Faustine. Succeed in compilation. Not yet tested. --- 9fdfd04e29fcefdb9120a4d9467827ceaf8dfaa0 diff --git a/interpretor/Makefile b/interpretor/Makefile index 3a35e1c..89cf5a7 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 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 diff --git a/interpretor/aux.ml b/interpretor/aux.ml index a33e722..7c21a61 100644 --- a/interpretor/aux.ml +++ b/interpretor/aux.ml @@ -27,3 +27,10 @@ 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 ef8a0fd..cc01071 100644 --- a/interpretor/basic.ml +++ b/interpretor/basic.ml @@ -122,6 +122,10 @@ let basic_to_bool : basic -> bool = | 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 = @@ -154,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;; @@ -211,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) -> @@ -231,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;; @@ -283,15 +279,12 @@ let rec basic_power : basic -> basic -> basic = 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) -> R 1. | (R f1, Error) -> Error - | (Zero, N i2) -> basic_power b1 (R (float_of_int i2)) | (Zero, R f2) -> R 0. | (Zero, Vec vec2) -> @@ -299,7 +292,6 @@ let rec basic_power : basic -> basic -> basic = 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;; @@ -315,30 +307,27 @@ let rec basic_logic : else raise (Basic_operation "vector size not matched.") | (Vec vec1, Zero) -> let vec_zeros = Vec (new vector vec1#size (fun i -> Zero)) in - basic_and b1 vec_zeros - | (Vec vec1, _) -> raise (Basic_operation "vec1 logic sca2") - - | (N i1, N i2) -> 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;; + 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 (||);; @@ -350,7 +339,7 @@ let rec basic_adjust : (float -> float) -> basic -> basic = |N i -> R (float_of_int i) |R f -> R (floor f) |Vec vec -> Vec (new vector vec#size - (fun_unary basic_floor vec#nth)) + (fun_unary (basic_adjust oper) vec#nth)) |Zero -> R 0. |Error -> Error;; @@ -378,6 +367,16 @@ let rec basic_float : basic -> basic = | 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 -> @@ -390,11 +389,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 -> @@ -470,63 +473,70 @@ let rec basic_mod : basic -> basic -> basic = raise (Basic_operation "Scalar_Vector: sca mod vec.") | (Error, _) -> Error;; -let rec basic_fmod : basic -> basic -> basic = - fun b1 -> - fun b2 -> - match (b1, b2) with - | (R f1, R f2) -> R (mod_float f1 f2) +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 fmod b2: b2 cannot be int.") + raise (Basic_operation "b1 mod_float b2: b2 cannot be int.") | (N i1, _) -> - raise (Basic_operation "b1 fmod b2: b1 cannot be int.") + raise (Basic_operation "b1 mod_float b2: b1 cannot be int.") | (R f1, Vec vec2) -> - raise (Basic_operation "Scalar_Vector: sca fmod vec.") + raise (Basic_operation "Scalar_Vector: sca mod_float vec.") | (_, Zero) -> - raise (Basic_operation "b1 fmod b2: b2 cannot be 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_fmod vec1#nth vec2#nth)) + (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 fmod sca.") + raise (Basic_operation "Vector_Scalaire: vec mod_float sca.") | (Zero, Vec vec2) -> - basic_fmod (Vec (new vector vec2#size (fun i -> Zero))) b2 - | (Zero, _) -> basic_mod (N 0) b2 + 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 vec.") + raise (Basic_operation "Scalaire_Vector: int mod_float vec.") | (Error, _) -> Error;; +let basic_fmod = basic_mod_float mod_float;; +let basic_remainder = basic_mod_float remainder_float;; -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_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 @@ -545,7 +555,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 4f2f525..9659a41 100644 --- a/interpretor/lexer.mll +++ b/interpretor/lexer.mll @@ -33,7 +33,7 @@ rule token = parse | "exp" { IDENT Exp} | "sqrt" { IDENT Sqrt} | "log" { IDENT Ln} -| "logten" { IDENT Log10} +| "logten" { IDENT Lg} | "pow" { IDENT Power} | "abs" { IDENT Abs} | "fmod" { IDENT Fmod} @@ -43,12 +43,12 @@ rule token = parse | "#" { IDENT Vconcat} | "[]" { IDENT Vpick } | "serialize" { IDENT Serialize} -| '>' { IDENT Greater} -| '<' { IDENT Less} -| ">=" { IDENT Gore} -| "<=" { IDENT Lore} -| "==" { IDENT Equal} -| "!=" { IDENT Different} +| '>' { IDENT Gt} +| '<' { IDENT Lt} +| ">=" { IDENT Geq} +| "<=" { IDENT Leq} +| "==" { IDENT Eq} +| "!=" { IDENT Neq} | "max" { IDENT Max} | "min" { IDENT Min} | "prefix" { IDENT Prefix} diff --git a/interpretor/process.ml b/interpretor/process.ml index f094b7b..1d79f6f 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,10 +191,18 @@ 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 @@ -176,6 +214,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..f98e941 100644 --- a/interpretor/signal.ml +++ b/interpretor/signal.ml @@ -113,20 +113,40 @@ 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) @@ -155,6 +175,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..967a2a6 100644 --- a/interpretor/symbol.ml +++ b/interpretor/symbol.ml @@ -12,101 +12,73 @@ 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") + |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 68e550c..99a3877 100644 --- a/interpretor/types.ml +++ b/interpretor/types.ml @@ -48,19 +48,20 @@ class type value_type = method tan : value_type method atan : value_type method atan2 : value_type -> value_type - method expo : value_type + method exp : value_type method sqrt : value_type method ln : value_type - method log10 : value_type + method lg : value_type + method abs : value_type method fmod : value_type -> value_type method _mod : value_type -> value_type method remainder : value_type -> value_type - method greater : value_type -> value_type - method less : value_type -> value_type - method gore : value_type -> value_type - method lore : value_type -> value_type - method equal : value_type -> value_type - method different : 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 max : value_type -> value_type method min : value_type -> value_type end;; @@ -93,7 +94,7 @@ type symbol = Add | Exp | Sqrt | Ln - | Log10 + | Lg | Abs | Fmod | Mod @@ -102,12 +103,12 @@ type symbol = Add | Vconcat | Vpick | Serialize - | Greater - | Less - | Gore - | Lore - | Equal - | Different + | Gt + | Lt + | Geq + | Leq + | Eq + | Neq | Max | Min | Prefix @@ -170,20 +171,20 @@ class type signal_type = method tan : signal_type method atan : signal_type method atan2 : signal_type -> signal_type - method expo : signal_type + method exp : signal_type method sqrt : signal_type method ln : signal_type - method log10 : signal_type + method lg : signal_type method abs : signal_type method fmod : signal_type -> signal_type method _mod : signal_type -> signal_type method remainder : signal_type -> signal_type - method greater : signal_type -> signal_type - method less : signal_type -> signal_type - method gore : signal_type -> signal_type - method lore : signal_type -> signal_type - method equal : signal_type -> signal_type - method different : 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 max : signal_type -> signal_type method min : signal_type -> signal_type method rdtable : signal_type -> signal_type -> signal_type diff --git a/interpretor/value.ml b/interpretor/value.ml index ef05f43..e9b2746 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,10 +58,20 @@ 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