--- /dev/null
+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;
--- /dev/null
+faustine -d primitives.dsp -t 30 --oformat csv
#
# 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
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
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;;
*)
open Types;;
+open Aux;;
exception Convert_Error of string;;
exception Basic_operation of string;;
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 =
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;;
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) ->
(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;;
|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 ->
|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 ->
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
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
| "/" { 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 }
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 "!=";
public:
- Log10Prim() : xtended("log10f") {}
+ Log10Prim() : xtended("logten") {}
virtual unsigned int arity () { return 1; }
((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
((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
| 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 =
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) ->
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 ->
(* 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;;
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;;
| 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
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
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
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 ->
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;;
projects / Faustine.git / commitdiff