OOP initial commit.

diff --git a/interpretor/Makefile b/interpretor/Makefile
index 56a213b..d9be60a 100644 (file)
--- a/interpretor/Makefile
+++ b/interpretor/Makefile
@@ -2,11 +2,11 @@
 #
 # The Caml sources (including camlyacc and camllex source files)
 
 #
 # The Caml sources (including camlyacc and camllex source files)
 

-SOURCES = types.ml parser.mly lexer.mll value.ml signal.ml faustexp.ml interpreter.ml preprocess.ml main.ml preprocess_stubs.cpp
+SOURCES = types.ml parser.mly lexer.mll basic.ml value.ml signal.ml beam.ml faustexp.ml interpreter.ml preprocess.ml main.ml preprocess_stubs.cpp

 
 # The executable file to generate
 
 
 # The executable file to generate
 

-EXEC = faustine
+EXEC = mrfausti

 
 # Path to ocaml include header files
 export OCAML_INCLUDE_PATH
 
 # Path to ocaml include header files
 export OCAML_INCLUDE_PATH


@@ -15,7 +15,7 @@ export OCAML_INCLUDE_PATH
 #SNDFILE_PATH = /home/wang/Desktop/libsndfile-ocaml
 export SNDFILE_PATH
 
 #SNDFILE_PATH = /home/wang/Desktop/libsndfile-ocaml
 export SNDFILE_PATH
 

-# Path to Faust.mr3
+# Path to Faust.mr2

 FAUST_PATH = faust-0.9.47mr3
 
 # Path to preprocessor library
 FAUST_PATH = faust-0.9.47mr3
 
 # Path to preprocessor library

diff --git a/interpretor/faustexp.ml b/interpretor/faustexp.ml
index 5904569..6b324a0 100644 (file)
--- a/interpretor/faustexp.ml
+++ b/interpretor/faustexp.ml
@@ -8,15 +8,77 @@
 open Types;;
 open Value;;
 
 open Types;;
 open Value;;
 

-(* EXCEPTIONS *)

 
 

-(** Exception raised in beam matching of faust expressions.*)
-exception Beam_Matching_Error of string;;
-
-(** Exception raised in case that the branch under call hasn't yet been programed.*)

 exception NotYetDone;;
 
 
 exception NotYetDone;;
 
 

+
+class virtual expression : expression_type = 
+  fun (exp_init : faust_exp) ->
+  object
+      val exp = exp_init
+      val dim = new dimension
+      val delay = 0
+      method get_exp = exp
+      method get_dim = dim
+      method get_delay = delay
+      method to_string = "NotYetDone"
+      method virtual evaluate : beam_type -> beam_type
+end;;
+
+
+class exp_const = 
+  object
+      inherit expression
+      method evaluate = fun b1 ->
+       
+      end;;
+
+
+class exp_ident = 
+  object
+      inherit expression
+
+      end;;
+
+
+class exp_par = 
+  object
+     inherit expression
+
+      end;;
+
+
+class exp_split = 
+  object
+     inherit expression
+
+      end;;
+
+
+class exp_merge = 
+  object
+     inherit expression
+
+      end;;
+
+class exp_seq = 
+  object
+     inherit expression
+
+      end;;
+
+class exp_rec = 
+  object
+     inherit expression
+
+      end;;
+
+
+
+
+
+

 (* PROCESS DELAY ESTIMATION *)
 
 (** val delay : faust_exp -> int, returns the number of delays estimated staticly.
 (* PROCESS DELAY ESTIMATION *)
 
 (** val delay : faust_exp -> int, returns the number of delays estimated staticly.


@@ -39,10 +101,6 @@ let rec delay exp_faust = match exp_faust with
                        |Floor                  ->      0
                        |Int                    ->      0
                        |Sin                    ->      0
                        |Floor                  ->      0
                        |Int                    ->      0
                        |Sin                    ->      0

-                       |Cos                    ->      0
-                       |Atan                   ->      0
-                       |Atantwo                ->      0
-                       |Sqrt                   ->      0

                        |Rdtable                ->      100000 (* danger! *)
                        |Mod                    ->      0
                        |Larger                 ->      0
                        |Rdtable                ->      100000 (* danger! *)
                        |Mod                    ->      0
                        |Larger                 ->      0


@@ -163,10 +221,6 @@ returns the dimension tree of constructor(e1, e2).*)
                        |Floor                  ->      End (1, 1)
                        |Int                    ->      End (1, 1)
                        |Sin                    ->      End (1, 1)
                        |Floor                  ->      End (1, 1)
                        |Int                    ->      End (1, 1)
                        |Sin                    ->      End (1, 1)

-                       |Cos                    ->      End (1, 1)
-                       |Atan                   ->      End (1, 1)
-                       |Atantwo                ->      End (2, 1)
-                       |Sqrt                   ->      End (1, 1)

                        |Rdtable                ->      End (3, 1)
                        |Mod                    ->      End (2, 1)
                        |Vectorize              ->      End (2, 1)
                        |Rdtable                ->      End (3, 1)
                        |Mod                    ->      End (2, 1)
                        |Vectorize              ->      End (2, 1)

diff --git a/interpretor/lexer.mll b/interpretor/lexer.mll
index a3a4746..c6a7cb5 100644 (file)
--- a/interpretor/lexer.mll
+++ b/interpretor/lexer.mll
@@ -1,18 +1,48 @@
-{open Parser}
+{
+open Parser
+open Types
+}

 
 rule token = parse
 
 rule token = parse

-  [' ' '\t' '\n' ]                                                     { token lexbuf }
-| ['a'-'z' 'A'-'Z']+ as x                                              { IDENT x }
-| ['+' '*' '-' '/' '!' '_' '#' 
-   '@' '<' '>' '%'] as x                       { IDENT (String.make 1 x) }
-| "[]"                                      { IDENT "[]" }
-| ['0'-'9']+ as a                                                                    { CONST a }
-| '.'                                       { POINT }
-| '('                                                          { LPAR }
-| ')'                                                    { RPAR }
-| ','                                                                                              { PAR }
-| ':'                                                                                          { SEQ }
-| "<:"                                                                                         { SPLIT }
-| ":>"                                                                                         { MERGE }
-| "~"                                                                                          { REC }
-| eof                                                                                          { EOF }
+  [' ' '\t' '\n' ]                     { token lexbuf }
+
+| "+"                                   { IDENT Add}
+| "-"                                   { IDENT Sup}
+| "*"                                   { IDENT Mul}
+| "/"                                   { IDENT Div}
+| "_"                                   { IDENT Pass}
+| "!"                                   { IDENT Stop}
+| "mem"                                 { IDENT Mem}
+| "@"                                   { IDENT Delay}
+| "floor"                               { IDENT Floor}
+| "int"                                 { IDENT Int}
+| "sin"                                 { IDENT Sin}
+| "cos"                                 { IDENT Cos}
+| "atan"                                { IDENT Atan}
+| "atantwo"                             { IDENT Atantwo}
+| "sqrt"                                { IDENT Sqrt}
+| "rdtable"                             { IDENT Rdtable}
+| "%"                                   { IDENT Mod}
+| "vectorize"                           { IDENT Vectorize}
+| "#"                                   { IDENT Vconcat}
+| "[]"                                  { IDENT Vpick }
+| "serialize"                           { IDENT Serialize}
+| ">"                                   { IDENT Larger}
+| "<"                                   { IDENT Smaller}
+| "prefix"                              { IDENT Prefix}
+| "selecttwo"                           { IDENT Selecttwo}
+| "selectthree"                         { IDENT Selectthree}  
+
+
+| ['0'-'9']+ as a                      { CONST a }
+| '.'                                   { POINT }
+
+
+| '('                                  { LPAR }
+| ')'                                  { RPAR }
+| ','                                  { PAR }
+| ':'                                  { SEQ }
+| "<:"                                 { SPLIT }
+| ":>"                                 { MERGE }
+| "~"                                  { REC }
+| eof                                  { EOF }

diff --git a/interpretor/signal.ml b/interpretor/signal.ml
index 3440adc..b493b6c 100644 (file)
--- a/interpretor/signal.ml
+++ b/interpretor/signal.ml
@@ -1,339 +1,208 @@
 (**
        Module: Signal  
 (**
        Module: Signal  

-       Description: type signal = rate * (int -> value), operations of signals.
+       Description: signal definition and operations.

        @author WANG Haisheng   
        Created: 03/06/2013     Modified: 03/06/2013
 *)
 
 open Types;;
        @author WANG Haisheng   
        Created: 03/06/2013     Modified: 03/06/2013
 *)
 
 open Types;;

+open Basic;;

 open Value;;
 
 open Value;;
 

-(* EXCEPTIONS *)
-
-(** Exception raised in operations of signals.*)

 exception Signal_operation of string;;
 
 exception Signal_operation of string;;
 

-
-
-(* MACRO *)
-
-(** Macro constants of the file.*)
-type signal_macro = Delay_Memory_Length_int;;
-
-
-(** val signal_macro_to_int : signal_macro -> int.*)
-let signal_macro_to_int m = match m with
-                                 |Delay_Memory_Length_int -> 10000;;
-
-
-(* SIGNAL OPERATIONS *)
-
-(** val frequency : signal -> int, returns the frequency of a signal.*)
-let frequency s = fst s;;
-
-
-(** val signal_fun : signal -> (int -> value), returns the functional part of a signal.*)
-let signal_fun s = snd s;;
-
-
-(** val check_frequency : int -> int -> int, returns the correction of frequency.*)
-let check_frequency = fun f1 -> fun f2 ->
-       if f1 = f2 || f2 = 0 then f1
-       else if f1 = 0 then f2
-       else raise (Signal_operation "frequency not matched.");;
-
-(** val signal_check_frequency : signal -> signal -> int, 
-checks the frequencies of two input signals, and returns common frequency or raise an exception.*)
-let signal_check_frequency = fun s1 -> fun s2 ->
-        let f1 = frequency s1 in
-       let f2 = frequency s2 in
-       check_frequency f1 f2;;
-
-
-(** val signal_check_frequency3 : signal -> signal -> signal -> int,
-checks the frequencies of three input signal, and returns common frequency or raise an exception.*)
-let signal_check_frequency3 = fun s1 -> fun s2 -> fun s3 ->
-        let f1 = signal_check_frequency s1 s2 in
-       let f2 = signal_check_frequency s1 s3 in
-       check_frequency f1 f2;;
-
-
-(** val signal_check_frequency4 : signal -> signal -> signal -> signal -> int,
-checks the frequencies of three input signal, and returns common frequency or raise an exception.*)
-let signal_check_frequency4 = fun s1 -> fun s2 -> fun s3 -> fun s4 ->
-        let f1 = signal_check_frequency s1 s2 in
-       let f2 = signal_check_frequency s3 s4 in
-       check_frequency f1 f2;;
-
-
-(** val signal_add_one_memory : signal -> signal, 
-returns the signal with memory of one latest sample.*)
-let signal_add_one_memory = fun s ->
-        let new_signal = factory_add_memory (signal_fun s) 1 in
-           (frequency s, new_signal);;
-
-
-(** val beam_add_one_memory : signal list -> signal list,
-adds memory of one latest sample for each element in signal list.*)
-let beam_add_one_memory = fun beam -> 
-        List.map signal_add_one_memory beam;;
-
-
-(** val signal_add : signal -> signal -> signal, output(t) = input1(t) + input2(t), 
-    frequency consistent.*)
-let signal_add s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> ((signal_fun s1) t) +~ ((signal_fun s2) t) in
-       (f, new_signal);;
-
-
-(** val signal_neg : signal -> signal, output(t) = -input(t), frequency consistent.*)
-let signal_neg s = 
-       let new_signal = fun t -> v_neg ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-(** val signal_sub : signal -> signal -> signal, output(t) = input1(t) - input2(t),
-    frequency consistent.*)
-let signal_sub s1 s2 = signal_add s1 (signal_neg s2);;
-
-
-(** val signal_mul : signal -> signal -> signal, output(t) = input1(t) * input2(t), 
-    frequency consistent.*)
-let signal_mul s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> ((signal_fun s1) t) *~ ((signal_fun s2) t) in
-       (f, new_signal);;
-
-
-(** val signal_div : signal -> signal -> signal, output(t) = input1(t) / input2(t), 
-    frequency consistent.*)
-let signal_div s1 s2 =         
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> ((signal_fun s1) t) /~ ((signal_fun s2) t) in
-       (f, new_signal);;
-
-
-(** val signal_delay : signal -> signal -> signal, output(t) = input1(t - input2(t)), 
-    Attention: delay dynamic, frequency of output signal equals to that of first input signal.*)
-let signal_delay s1 s2 = 
-        let s1_mem = factory_add_memory (signal_fun s1) 
-           (signal_macro_to_int Delay_Memory_Length_int) in
-       let new_signal = fun t -> 
-       let delay = (signal_fun s2) t in
-               match delay with
-               |N i -> if i < 0 then raise (Signal_operation "Delay time < 0.") 
-                               else if (t - i) >= 0 then s1_mem (t - i) 
-                               else v_zero (s1_mem 0)
-               |R f -> let i = int_of_float f in
-                               if i < 0 then raise (Signal_operation "Delay time < 0.") 
-                               else if (t - i) >= 0 then s1_mem (t - i) 
-                               else v_zero (s1_mem 0)
-               |Vec (size, vec) -> raise (Signal_operation "Delay time can not be a vector.")
-               |Zero -> s1_mem t
-               |W -> raise (Signal_operation "Delay time error.")
-       in
-       (frequency s1, new_signal);;
-
-
-(** val signal_mem : signal -> signal, equivalent to signal_delay with constant delay 1.*)
-let signal_mem s = signal_delay s (1, (fun t -> N 1));;
-
-
-(** val signal_vectorize : signal -> signal -> signal, output(t)(i) = input1(input2(0) * t + i), 
-Attention: vector size n static, frequency of output signal is (1/n * frequency of input1)*)
-let signal_vectorize s1 s2 = 
-       let size = (signal_fun s2) 0 in
-       match size with
-       |N size_int ->
-               (
-                       let new_signal = fun t -> 
-                         make_vector size_int (fun i -> (signal_fun s1) (size_int * t + i)) in
-                       let new_frequency = (frequency s1) / size_int in
-                       (new_frequency, new_signal)
-               )
-       |_ -> raise (Signal_operation "Vectorize: vector size should be int.");;
-
-
-(** val signal_serialize : signal -> signal, output(t) = input(floor(t/n))(t%n), 
-    with n = size of input(0). 
-    Attention: input size unknown in the cas of "rec".*)
-let signal_serialize s = 
-       let temp0 = (signal_fun s) 0 in
-       match temp0 with
-       |Vec (size0, vec0) ->
-           let new_signal = fun t ->
-               (
-                       let temp = (signal_fun s) (t/size0) in
-                       match temp with
-                       |Vec (size, vec) ->
-                               if size = size0 then 
-                                 vec (t mod size)
-                               else 
-                                 raise (Signal_operation "Serialize: vector length not consistent.")
-                       |_ -> raise (Signal_operation "Serialize: signal type not consistent.")
-               )
-           in
-           let new_frequency = (frequency s) * size0 in
-           (new_frequency, new_signal)
-       |_ -> raise (Signal_operation "Serialize: input signal should be vector.");;
-
-
-(** val signal_append : signal -> signal -> signal, symbol "#", 
-    appends vectors of the two input signals at each time, frequency consistent.*)
-let signal_append s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> 
-               let temp1 = (signal_fun s1) t in
-               let temp2 = (signal_fun s2) t in
-               match (temp1, temp2) with
-               |(Vec (size1, vec1), Vec (size2, vec2)) ->
-                       let new_vec = fun i -> if i < size1 then vec1 i else vec2 (i - size1) in
-                       make_vector (size1 + size2) new_vec
-               |_ -> raise (Signal_operation "Append: input signals should be vectors.")
-       in
-       (f, new_signal);;
-
-
-(** val signal_nth : signal -> signal -> signal, symbol "[]", output(t) = input1(t)(input2(t)), 
-    frequency consistent. Attention: selection index dynamic.*)
-let signal_nth s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> 
-               let temp1 = (signal_fun s1) t in
-               let temp2 = (signal_fun s2) t in
-               match temp1 with
-               |Vec (size1, vec1) ->
-               (
-                       match temp2 with
-                       |N i -> vec1 i
-                       |R f -> 
-                           raise (Signal_operation "Get: second input signal should be int.")
-                       |Vec (size2, vec2) -> 
-                           raise (Signal_operation "Get: second input signal should be int.")
-                       |Zero -> vec1 0
-                       |W -> 
-                           raise (Signal_operation "Get: second input signal should be int.")
-               )
-               |_ -> raise (Signal_operation "Get: first input signal should be vector.")
-       in
-       (f, new_signal);;
-
-
-(** val signal_floor : signal -> signal, output(t) = v_floor(input(t)), frequency consistent.*)
-let signal_floor s = 
-       let new_signal = fun t -> v_floor ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-(** val signal_int : signal -> signal, output(t) = v_int(input(t)), frequency consistent.*)
-let signal_int s = 
-       let new_signal = fun t -> v_int ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-(** val signal_sin : signal -> signal, output(t) = v_sin(input(t)), frequency consistent.*)
-let signal_sin s = 
-       let new_signal = fun t -> v_sin ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-(** val signal_cos : signal -> signal, output(t) = v_cos(input(t)), frequency consistent.*)
-let signal_cos s = 
-       let new_signal = fun t -> v_cos ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-(** val signal_atan : signal -> signal, output(t) = v_atan(input(t)), frequency consistent.*)
-let signal_atan s = 
-       let new_signal = fun t -> v_atan ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-let signal_atantwo s1 s2 = 
-       let new_signal = fun t -> v_atantwo ((signal_fun s1) t) ((signal_fun s2) t) in
-       (frequency s1, new_signal);;
-
-
-(** val signal_sqrt : signal -> signal, output(t) = v_sqrt(input(t)), frequency consistent.*)
-let signal_sqrt s = 
-       let new_signal = fun t -> v_sqrt ((signal_fun s) t) in
-       (frequency s, new_signal);;
-
-
-(** val signal_rdtable : signal -> signal -> signal, 
-    output(t) = input1(input2(t)), frequency equals to that of input2. 
-    Attention: no memory implemented, very expensive when input1 comes from rec or delays.*)
-let signal_rdtable s0 s1 s2 = 
-        let memory_length_int = take_off_N ((signal_fun s0) 0) in
-        let s1_mem = factory_add_memory (signal_fun s1) memory_length_int in
-       let new_signal = fun t ->
-               let index = (signal_fun s2) t in
-               match index with
-               |N i -> s1_mem i
-               |R f -> raise (Signal_operation "Rdtable index cannot be float.")
-               |Vec (size, vec) -> raise (Signal_operation "Rdtable index cannot be vector.")
-               |Zero -> s1_mem 0
-               |W -> raise (Signal_operation "Rdtable index cannot be Error.")
-       in
-       (frequency s2, new_signal);;
-
-
-(** val signal_mod : signal -> signal -> signal, 
-    output(t) = input1(t) % input2(t), frequency consistent.*)
-let signal_mod s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> v_mod ((signal_fun s1) t) ((signal_fun s2) t) in
-       (f, new_signal);;
-
-
-(** val signal_sup : signal -> signal -> signal, 
-    output(t) = input1(t) > input2(t), frequency consistent.*)
-let signal_sup s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> v_sup ((signal_fun s1) t) ((signal_fun s2) t) in
-       (f, new_signal);;
-
-
-(** val signal_inf : signal -> signal -> signal, 
-    output(t) = input1(t) < input2(t), frequency consistent.*)
-let signal_inf s1 s2 = 
-        let f = signal_check_frequency s1 s2 in
-       let new_signal = fun t -> v_inf ((signal_fun s1) t) ((signal_fun s2) t) in
-       (f, new_signal);;
-
-
-(** val signal_select2 : signal -> signal -> signal -> signal,
-[signal_select2 si s0 s1] selects s0 or s1 by index si, frequency consistent.*)
-let signal_select2 si s0 s1 = 
-        let f = signal_check_frequency3 si s0 s1 in
-       let new_signal = fun t -> 
-               if (signal_fun si) t = N 0 then (signal_fun s0) t
-               else if (signal_fun si) t = N 1 then (signal_fun s1) t
-               else raise (Signal_operation "select2 index should be 0 or 1.")
-       in
-       (f, new_signal);;
-
-
-(** val signal_select3 : signal -> signal -> signal -> signal -> signal,
-[signal_select3 si s0 s1 s2] selects s0 or s1 or s2 by index si, frequency consistent.*)
-let signal_select3 si s0 s1 s2 = 
-        let f = signal_check_frequency4 si s0 s1 s2 in
-       let new_signal = fun t -> 
-               if (signal_fun si) t = N 0 then (signal_fun s0) t
-               else if (signal_fun si) t = N 1 then (signal_fun s1) t
-               else if (signal_fun si) t = N 2 then (signal_fun s2) t
-               else raise (Signal_operation "select3 index should be 0 or 1 or 2.")
-       in
-       (f, new_signal);;
-
-
-(** val signal_prefix : signal -> signal -> signal,
-[signal_prefix s0 s1] returns s0(0) if t = 0, s1(t-1) if t > 0, frequency same to s1.*)
-let signal_prefix = fun s0 -> fun s1 -> 
-        let new_signal = fun t ->
-               if t = 0 then (signal_fun s0) 0
-               else if t > 0 then (signal_fun s1) t
-                else raise (Signal_operation "prefix time cannot be < 0.")
-        in
-       (frequency s1, new_signal);;
+let delay_memory_length = 10000;;
+
+class signal : int -> (time -> value_type) -> signal_type = 
+  fun (freq_init : int) ->
+    fun (func_init : time -> value_type) ->
+      object (self)
+       val mutable signal_func = func_init
+       val mutable memory_length = 0
+       method frequency = freq_init
+       method at = signal_func
+
+       method private check_freq : signal_type list -> int = 
+         fun (sl : signal_type list) ->
+           let check : int -> signal_type -> int = 
+             fun (f : int) ->
+               fun (s : signal_type) ->
+                 if f = s#frequency || s#frequency = 0 then f
+                 else if f = 0 then s#frequency
+                 else raise (Signal_operation "frequency not matched.") in
+           List.fold_left check self#frequency sl
+
+       method private add_memory : int -> unit = 
+         fun (length : int) ->
+           assert (length >= 0);
+           if memory_length >= length then ()
+           else
+             let memory = Hashtbl.create length in
+             let func : time -> value = 
+               fun (t : time) ->
+                 try Hashtbl.find memory t
+                 with Not_found ->
+                   let result = func_init t in
+                   let () = Hashtbl.replace memory t result in
+                   let () = 
+                     if (t - length) >= 0 then
+                       Hashtbl.remove memory (t - length)
+                     else () in
+                   result in
+             memory_length <- length;
+             signal_func <- func
+
+       method private delay_by : int -> time -> value = 
+         fun i -> fun t ->
+           if (t - i) >= 0 then
+             self#at (t - i)
+           else if t >= 0 && (t - i) < 0 then
+             (self#at 0)#zero
+           else raise (Signal_operation "Delay time < 0.")
+
+       method private prim1 : 
+           (time -> value_type) -> signal_type = 
+             fun (func : time -> value_type) ->
+               let freq = self#frequency in
+               new signal freq func 
+
+       method private prim2 : 
+           (time -> value_type -> value_type) -> signal_type -> signal_type = 
+         fun (func_binary : time -> value_type -> value_type) ->
+           fun (s : signal_type) ->
+             let freq = self#check_freq [s] in
+             let func = fun t -> (func_binary t) (s#at t) in
+             new signal freq func
+
+       method neg = self#prim1 (fun t -> (self#at t)#neg)
+       method floor = self#prim1 (fun t -> (self#at t)#floor)
+       method sin = self#prim1 (fun t -> (self#at t)#sin)
+       method cos = self#prim1 (fun t -> (self#at t)#cos)
+       method atan = self#prim1 (fun t -> (self#at t)#atan)
+       method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
+       method int = self#prim1 (fun t -> (self#at t)#int)
+
+       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 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 delay : signal_type -> signal_type =
+         fun (s : signal_type) ->
+           let freq = self#check_freq [s] in
+           let () = self#add_memory delay_memory_length in
+           let func : time -> value_type = 
+             fun (t : time) ->
+               let i = (s#at t)#to_int in
+               self#delay_by t i  in
+           new signal freq func
+
+       method mem : signal_type = 
+         let freq = self#frequency in
+         let () = self#add_memory 1 in
+         let func = fun (t : time) -> self#delay_by t 1 in
+         new signal freq func
+
+       method rdtable : signal_type -> signal_type -> signal_type = 
+         fun (s_size : signal_type) ->
+           fun (s_index : signal_type) ->
+             let freq = self#check_freq [s_index] in
+             let () = self#add_memory ((s_size#at 0)#to_int) in
+             let func : time -> value_type = fun t -> 
+               self#at ((s_index#at t)#to_int) in
+             new signal freq func
+
+       method select2 : signal_type -> signal_type -> signal_type =
+         fun s_first -> 
+           fun s_second ->
+             let freq = self#check_freq [s_first; s_second] in
+             let func : time -> value_type = 
+               fun t -> let i = (self#at t)#to_int in
+               if i = 0 then s_first#at t
+               else if i = 1 then s_second#at t
+               else raise (Signal_operation "select2 index 0|1.") in
+             new signal freq func
+
+       method select3 : 
+           signal_type -> signal_type -> signal_type -> signal_type =
+             fun s_first -> fun s_second -> fun s_third ->
+               let freq = self#check_freq [s_first; s_second; s_third] in
+               let func : time -> value_type = 
+                 fun t -> let i = (self#at t)#to_int in
+                 if i = 0 then s_first#at t
+                 else if i = 1 then s_second#at t
+                 else if i = 2 then s_third#at t
+                 else raise (Signal_operation "select2 index 0|1.") in
+               new signal freq func    
+                   
+       method prefix : signal_type -> signal_type =
+           fun (s_init : signal_type) ->
+             let func : time -> value_type = 
+               fun t ->
+                 if t = 0 then s_init#at 0
+                 else if t > 0 then self#at t
+                 else raise (Signal_operation "prefix time < 0.") in
+             new signal self#frequency func
+
+
+       method vectorize : signal_type -> signal_type =
+         fun s_size ->
+           let size = (s_size#at 0)#to_int in
+           if size <= 0 then      
+             raise (Signal_operation "Vectorize: size <= 0.")
+           else 
+             let freq = self#frequency / size in
+             let func : time -> value_type = 
+               fun t ->
+                 let vec = fun i -> (self#at (size * t + i))#get in
+                 new value (Vec (new vector size vec)) in
+             new signal freq func
+
+
+       method serialize : signal_type = 
+         let size = 
+           match (self#at 0)#get with
+           | Vec vec -> vec#size
+           | _ -> raise (Signal_operation "Serialize: scalar input.") in
+         let freq = self#frequency * size in
+         let func : time -> value_type = 
+           fun t -> 
+             match (self#at (t/size))#get with
+             | Vec vec -> new value (vec#nth (t mod size))
+             | _ -> raise (Signal_operation 
+                             "Serialize: signal type not consistent.") in
+         new signal freq func
+
+       method vconcat : signal_type -> signal_type = 
+         fun s ->
+           let freq = self#check_freq [s] in
+           let func : time -> value_type = 
+             fun t ->
+               match ((self#at t)#get, (s#at t)#get) with
+               | (Vec vec1, Vec vec2) ->
+                   let size1 = vec1#size in
+                   let size2 = vec2#size in
+                   let size = size1 + size2 in
+                   let vec = fun i -> 
+                     if i < size1 then vec1#nth i
+                     else vec2#nth (i - size1) in
+                   new value (Vec (new vector size vec))
+               | _ -> raise (Signal_operation "Vconcat: scalar.") in
+           new signal freq func
+
+       method vpick : signal_type -> signal_type = 
+         fun s_index ->
+           let freq = self#check_freq [s_index] in
+           let func : time -> value_type = 
+             fun t -> 
+               let i = (s_index#at t)#to_int in
+               match (self#at t)#get with
+               | Vec vec -> new value (vec#nth i)
+               | _ -> raise (Signal_operation "Vpick: scalar.") in
+           new signal freq func
+
+      end;;

diff --git a/interpretor/types.ml b/interpretor/types.ml
index 5c2c29d..ba61990 100644 (file)
--- a/interpretor/types.ml
+++ b/interpretor/types.ml
@@ -1,10 +1,49 @@
-type value = N of int
+
+type index = int;;
+
+type time = int;;
+
+type basic = N of int

            | R of float
            | R of float

-           | Vec of int * (int -> value)
+           | Vec of vector

           | Zero
           | Zero

-           | W
+           | Error
+and vector = < size : int; nth : (index -> basic) >;;
+
+class type vector_type = 
+       object
+         method size : int
+         method nth : index -> basic
+       end;;
+
+class type value_type = 
+  object
+    method get : basic
+    method to_int : int
+    method to_float : float
+    method to_float_array : float array
+    method to_string : string
+    method normalize : unit
+    method add : value_type -> value_type
+    method neg : value_type
+    method sub : value_type -> value_type
+    method mul : value_type -> value_type
+    method recip : value_type
+    method div : value_type -> value_type
+    method zero : value_type
+    method floor : value_type
+    method int : value_type
+    method sin : value_type
+    method cos : value_type
+    method atan : value_type
+    method sqrt : value_type
+    method atan2 : value_type -> value_type
+    method _mod : value_type -> value_type
+    method larger : value_type -> value_type
+    method smaller : value_type -> value_type
+  end;;
+

 
 

-(** type symbol, defines valid identifiers in faust expressions.*)

 type symbol = Add
            | Sup
            | Mul
 type symbol = Add
            | Sup
            | Mul


@@ -23,8 +62,8 @@ type symbol = Add
            | Rdtable
            | Mod
            | Vectorize
            | Rdtable
            | Mod
            | Vectorize

-           | Concat
-           | Nth
+           | Vconcat
+           | Vpick

            | Serialize
            | Larger
            | Smaller
            | Serialize
            | Larger
            | Smaller


@@ -32,45 +71,9 @@ type symbol = Add
            | Selecttwo
            | Selectthree
 
            | Selecttwo
            | Selectthree
 

-exception Symbol_not_defined;;
-
-let symbol_of_string = fun s ->
-                        match s with
-                       |"+"                    ->      Add
-                       |"-"                    ->      Sup             
-                       |"*"                    ->      Mul
-                       |"/"                    ->      Div
-                       |"_"                    ->      Pass
-                       |"!"                    ->      Stop
-                       |"mem"                  ->      Mem
-                       |"@"                    ->      Delay
-                       |"floor"                ->      Floor
-                       |"int"                  ->      Int
-                       |"sin"                  ->      Sin
-                       |"cos"                  ->      Cos
-                       |"atan"                 ->      Atan
-                       |"atantwo"              ->      Atantwo
-                       |"sqrt"                 ->      Sqrt
-                       |"rdtable"              ->      Rdtable
-                       |"%"                    ->      Mod
-                       |"vectorize"            ->      Vectorize
-                       |"#"                    ->      Concat
-                       |"[]"                   ->      Nth
-                       |"serialize"            ->      Serialize
-                       |">"                    ->      Larger
-                       |"<"                    ->      Smaller
-                       |"prefix"               ->      Prefix
-                       |"selecttwo"            ->      Selecttwo
-                       |"selectthree"          ->      Selectthree
-                       | _                     ->      raise Symbol_not_defined
-
-
-
-type signal = int * (int -> value)
-

 
 type faust_exp =
 
 type faust_exp =

-         Const of value
+         Const of basic

        | Ident of symbol
        | Par   of faust_exp * faust_exp
        | Seq   of faust_exp * faust_exp
        | Ident of symbol
        | Par   of faust_exp * faust_exp
        | Seq   of faust_exp * faust_exp


@@ -79,5 +82,61 @@ type faust_exp =
        | Merge of faust_exp * faust_exp
 
 
        | Merge of faust_exp * faust_exp
 
 

-type dimension = End of (int * int)
-               | Tree of (int * int) * (dimension * dimension)
+class type signal_type = 
+    object
+      method frequency : int
+      method at : time -> value_type
+      method add : signal_type -> signal_type
+      method neg : signal_type
+      method sub : signal_type -> signal_type
+      method mul : signal_type -> signal_type
+      method div : signal_type -> signal_type
+      method delay : signal_type -> signal_type
+      method mem : signal_type
+      method vectorize : signal_type -> signal_type
+      method serialize : signal_type
+      method vconcat : signal_type -> signal_type
+      method vpick : signal_type -> signal_type
+      method floor : signal_type
+      method int : signal_type
+      method sin : signal_type
+      method cos : signal_type
+      method atan : signal_type
+      method atan2 : signal_type -> signal_type
+      method sqrt : signal_type
+      method _mod : signal_type -> signal_type
+      method larger : signal_type -> signal_type
+      method smaller : signal_type -> signal_type
+      method rdtable : 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
+    end;;
+
+
+class type beam_type =
+    object
+      method length : int
+      method sub : start: int -> length: int -> beam_type
+      method append : beam_type -> beam_type
+      method matching : size: int -> beam_type
+      method time : time -> basic list
+      method output : length: int -> (int list) * (float array list)
+    end;;
+
+
+class type dimension_type = 
+  object
+    method input : int
+    method output : int
+  end;;
+
+
+class type expression_type = 
+    object
+      method get_exp : faust_exp
+      method get_dim : dimension_type
+      method get_delay : int
+      method to_string : string
+      method evaluate : beam_type -> beam_type
+    end;;

diff --git a/interpretor/value.ml b/interpretor/value.ml
index 1701b4e..a13739e 100644 (file)
--- a/interpretor/value.ml
+++ b/interpretor/value.ml
@@ -2,479 +2,54 @@
        Module: Value   
        Description: basic data type in the vectorial faust interpreter.
        @author WANG Haisheng   
        Module: Value   
        Description: basic data type in the vectorial faust interpreter.
        @author WANG Haisheng   

-       Created: 31/05/2013     Modified: 03/06/2013
+       Created: 31/05/2013     Modified: 17/07/2013

 *)
 
 open Types;;
 *)
 
 open Types;;

-
-(* EXCEPTIONS *)
-
-(** Exception raised in convertions between float/int and type 'Value'.*)
-exception Convert_Error of string;;
-
-(** Exception raised in type 'Value' operations.*)
-exception Value_operation of string;;
-
-
-(* MACRO *)
-
-(** Macro constants of the file.*)
-type value_macro = Faust_Max_int       
-               | Faust_Min_int         
-               | Faust_Bits_int;;      
-
-(** val value_macro_to_value : value_macro -> int.*)
-let value_macro_to_int m = match m with
-                               |Faust_Max_int -> 2147483647
-                               |Faust_Min_int -> -2147483648
-                               |Faust_Bits_int -> 32;;
-
-
-(* VALUE CONVERT FUNCTIONS *)
-
-(** val return_N : int -> value, convert from int to value N.*)
-let return_N i = N i;;
-
-(** val return_R : float -> value, convert from float to value R.*)
-let return_R f = R f;;
-
-(** val return_Vec : int * (int -> value) -> value, convert (size, vec) to value Vec.*)
-let return_Vec (size, vec) = Vec (size, vec);;
-
-(** val fail, return value W.*)
-let fail = W;;
-
-(** val take_off_N : value -> int, convert from value N to int. 
-Attention: Zero and W are converted to 0.*)
-let rec take_off_N v = 
-       match v with
-       |N i -> i
-       |R f -> 
-           raise (Convert_Error "float take_off_N int")
-       |Vec (size, vec) -> 
-           raise (Convert_Error "take_off_N can not convert vector.")
-       |Zero -> 0
-       |W -> 0;; (* Danger! *)
-
-(** val take_off_R : value -> float, convert from value R to float. 
-Attention: Zero and W are converted to 0.0, int converted to float.*)
-let take_off_R v = 
-       match v with
-       |N i -> float_of_int i
-       |R f -> f
-       |Vec (size, vec) -> 
-           raise (Convert_Error "take_off_R can not convert vector.")
-       |Zero -> 0.
-       |W -> 0.;;
-
-(** val convert_back_r : value -> float array, 
-return a float array of size 1 if v is N|R|Zero|W, a float array of size n if v is Vec.*)
-let convert_back_R v = 
-       match v with
-       |N i -> [| float_of_int i |]
-       |R f -> [| f |]
-       (** realise the function int -> value into float list.*)
-       |Vec (size, vec) ->
-               let result_value_array = Array.init size vec in
-               let result_float_array = Array.map take_off_R result_value_array in
-               result_float_array              
-       |Zero -> [| 0. |]
-       |W -> [| 0. |];;
-
-
-
-(* AUXILIARY FUNCTIONS*)
-
-(** val string_of_value : value -> string, converts value to following 
-strings "N i" | "R f" | "Vec" | "Zero" | "W".*)
-let rec string_of_value v = match v with
-       |N i1 -> "N " ^ (string_of_int i1)
-       |R f1 -> "R " ^ (string_of_float f1)
-       |Vec (size, vec) -> "Vec"
-       |Zero -> "Zero" 
-       |W -> "W";;
-
-(** val print_value_list: value list -> unit, prints to console the value list.*)
-let print_value_list value_list = 
-       let s = ref "[" in
-       let n = List.length value_list in
-               for i = 0 to n - 1 do
-                       let current = List.nth value_list i in
-                       s := if i + 1 < n then !s ^ string_of_value current ^ "; " 
-                             else !s ^ string_of_value current ^ "]"
-               done;
-       print_endline !s;;
-
-
-(** val factory_add_memory : (int -> 'b) -> int -> (int -> 'b),
-[factory_add_memory f n] adds a memory of size n to fun f.*)
-let factory_add_memory = fun f -> fun n ->
-  if n > 0 then
-    (
-        let memory = Hashtbl.create n in
-       let new_fun = fun i ->
-               try Hashtbl.find memory i
-               with Not_found ->
-                       let result = f i in
-                       let () = Hashtbl.replace memory i result in
-                       let () = Hashtbl.remove memory (i - n) in
-                       result
-       in
-       new_fun
-     )
-  else raise (Value_operation "memory length cannot be < 0." );;
-
-
-(** val v_memory : value -> value, returns value Vec with memory.*)
-let v_memory v = match v with
-  | Vec (size, vec) ->
-      let memory_array = Array.create size W in
-      let index_array = Array.create size false in
-      let new_vec = fun i -> 
-       if i >= 0 && i < size then 
-         (
-           if index_array.(i) then 
-             memory_array.(i)
-           else 
-             let result = vec i in
-             let () = memory_array.(i) <- result in
-             let () = index_array.(i) <- true in
-             result            
-         )
-       else raise (Invalid_argument "vector overflow.")
-      in
-      return_Vec (size, new_vec)
-  | _ -> v;;
-
-
-(** val v_list_memory : value list -> value list, returns value list with memory. *)
-let v_list_memory vl = List.map v_memory vl;;
-
-
-(** val make_vector : int -> (int -> value) -> value,
-[make_vector size vec], return a value Vec of (size, vec).*)
-let make_vector = fun size -> fun vec ->
-        let new_vec = fun i ->
-               if  i >= 0 && i < size then vec i
-               else raise (Value_operation "vector overflow")
-       in
-       v_memory (return_Vec (size, new_vec));;    
-
-
-(* VALUE OPERATIONS *)
-
-(** val normalize: value -> value, normalize value to bounded [-2147483648,2147483647].*)
-let rec normalize v = 
-       let n = 2. ** float_of_int (value_macro_to_int Faust_Bits_int) in
-       match v with
-       |N i -> 
-           if i > value_macro_to_int Faust_Max_int then 
-             return_N (i - int_of_float (n *. floor (((float_of_int i) +. n/.2.)/.n)))
-           else if i < value_macro_to_int Faust_Min_int then 
-             return_N (i + int_of_float (n *. floor ((n/.2. -. (float_of_int i) -. 1.)/.n)))
-           else return_N i
-       |R f -> 
-           if f > float_of_int (value_macro_to_int Faust_Max_int) then 
-             return_R (f -. (n *. floor ((f +. n/.2.)/.n)))
-           else if f < float_of_int (value_macro_to_int Faust_Min_int) then    
-             return_R (f +. (n *. floor ((n/.2. -. f -. 1.)/.n)))
-           else return_R f
-       |Vec (size, vec) -> make_vector size (fun i -> normalize (vec i))
-       |Zero -> Zero
-       |W -> W;;
-
-
-(** val v_add : value -> value -> value, value addition, recursive for value.Vec.*)
-let rec v_add v1 v2 = match v1 with
-       |Vec (size1, vec1) -> 
-           (
-                       match v2 with
-                       |Vec (size2, vec2) -> 
-                               if size1 = size2 then 
-                                 make_vector size1 (fun i -> v_add (vec1 i) (vec2 i))
-                               else raise (Value_operation "vector size not matched.")
-                       |Zero -> v1
-                       |_ -> raise (Value_operation "Vector_Scalar vec1 +~ sca2")
-            )
-       |N i1 ->
-           (
-                       match v2 with
-                       |N i2 -> normalize (return_N (i1 + i2))
-                       |R f2 -> normalize (return_R ((float_of_int i1) +. f2))
-                       |Vec (size2, vec2) -> raise (Value_operation "Vector_Scalar i1 +~ vec2")
-                       |Zero -> v1
-                       |W -> fail
-           )
-       |R f1 ->
-           (
-                       match v2 with
-                       |N i2 -> normalize (return_R (f1 +. (float_of_int i2)))
-                       |R f2 -> normalize (return_R (f1 +. f2))
-                       |Vec (size2, vec2) -> raise (Value_operation "Vector_Scalar f1 +~ vec2")
-                       |Zero -> v1
-                       |W -> fail
-           )
-       |Zero -> v2
-       |W ->
-           (
-                       match v2 with
-                       |N i2 -> fail
-                       |R f2 -> fail
-                       |Vec (size2, vec2) -> raise (Value_operation "Vector_Scalar W +~ vec2")
-                       |Zero -> v1
-                       |W -> fail
-           );;
-
-
-(** val (+~) : value -> value -> value, operator of v_add.*)
-let (+~) v1 v2 = v_add v1 v2;;
-
-
-(** val v_neg : value -> value, v_neg v = -v.*)
-let rec v_neg v = match v with
-       |N i -> return_N (-i)
-       |R f -> return_R (-.f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_neg (vec i))
-       |Zero -> Zero
-       |W -> fail;;
-
-
-(** val v_sub : value -> value -> value, returns (v1 - v2).*)
-let v_sub v1 v2 = v_add v1 (v_neg v2);; 
-
-
-(** val (-~) : value -> value -> value, operator of v_sub.*)
-let (-~) v1 v2 = v_sub v1 v2;; 
-
-
-(** val v_mul : value -> value -> value, returns (v1 * v2), recursive for value.Vec.*)
-let rec v_mul v1 v2 = match v1 with
-       |Vec (size1, vec1) -> 
-               (
-                       match v2 with
-                       |Vec (size2, vec2) -> 
-                               if size1 = size2 then 
-                                 make_vector size1 (fun i -> v_mul (vec1 i) (vec2 i))
-                               else raise (Value_operation "vector size not matched.")
-                       |Zero -> make_vector size1 (fun i -> v_mul (vec1 i) Zero)
-                       |_ -> raise (Value_operation "Vector_Scalar vec1 *~ sca2")
-               )
-       |N i1 ->
-               (
-                       match v2 with
-                       |N i2 -> normalize (return_N (i1 * i2))
-                       |R f2 -> normalize (return_R ((float_of_int i1) *. f2))
-                       |Vec (size2, vec2) -> 
-                           raise (Value_operation "Vector_Scalar i1 *~ vec2")
-                       |Zero -> return_N 0
-                       |W -> if i1 = 0 then N 0 else fail
-               )
-       |R f1 ->
-               (
-                       match v2 with
-                       |N i2 -> normalize (return_R (f1 *. (float_of_int i2)))
-                       |R f2 -> normalize (return_R (f1 *. f2))
-                       |Vec (size2, vec2) -> 
-                           raise (Value_operation "Vector_Scalar f1 *~ vec2")
-                       |Zero -> return_R 0.
-                       |W -> if f1 = 0. then R 0. else fail
-               )
-       |Zero -> 
-               (
-                       match v2 with
-                       |N i2 -> return_N 0
-                       |R f2 -> return_R 0.
-                       |Vec (size2, vec2) -> make_vector size2 (fun i -> v_mul Zero (vec2 i))
-                       |Zero -> Zero
-                       |W -> Zero (* Danger! *)
-               )
-       |W ->
-               (
-                       match v2 with
-                       |N i2 -> if i2 = 0 then N 0 else fail
-                       |R f2 -> if f2 = 0. then R 0. else fail
-                       |Vec (size2, vec2) -> 
-                           raise (Value_operation "Vector_Scalar W +~ vec2")
-                       |Zero -> Zero
-                       |W -> fail
-               );;
-
-
-(** val ( *~ ) : value -> value -> value, operator of v_mul.*)
-let ( *~ ) v1 v2 = v_mul v1 v2;;
-
-
-(** val v_recip : value -> value, v_recip v = 1./.v.*)
-let rec v_recip v = match v with
-       |N i -> v_recip (R (float_of_int i))
-       |R f -> if f = 0. then fail else return_R (1./.f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_recip (vec i))
-       |Zero -> fail
-       |W -> return_R 0. ;; (* Danger! *)
-
-
-(** val v_div : value -> value -> value, value division, returns (v1/.v2).*)
-let v_div v1 v2 = 
-  match (v1, v2) with
-  | (N i1, N i2) -> N (i1/i2)
-  | _ -> v_mul v1 (v_recip v2);;
-
-
-(** val (/~) : value -> value -> value, operator of v_div.*)
-let (/~) v1 v2 = v_div v1 v2;;  
-
-
-(** val v_zero : value -> value, Attention: N i -> N 0 | R f -> R 0. | Zero -> Zero | W -> R 0., 
-and recursive for value.Vec.*)
-let rec v_zero v = match v with
-       |N i -> N 0
-       |R f -> R 0.
-       |Vec (size, vec) -> make_vector size (fun i -> v_zero (vec i))
-       |Zero -> Zero (* Danger! *)
-       |W -> R 0.;; (* Danger! *)
-
-
-(** val v_floor : value -> value, returns floor of float, converts int to float, Zero to 0.,
- error to error, recursive for value.Vec.*)
-let rec v_floor v = match v with
-       |N i -> return_R (float_of_int i)
-       |R f -> return_R (floor f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_floor (vec i))
-       |Zero -> return_R 0.
-       |W -> W;;
-
-
-(** val v_int : value -> value, converts value to value.N, error to error, recursive for value.Vec.*)
-let rec v_int v = match v with
-       |N i -> v
-       |R f -> return_N (int_of_float f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_int (vec i))
-       |Zero -> return_N 0
-       |W -> W;;
-
-
-(** val v_sin : value -> value, returns sin(v), recursive for value.Vec.*)
-let rec v_sin v = match v with
-       |N i -> return_R (sin (float_of_int i))
-       |R f -> return_R (sin f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_sin (vec i))
-       |Zero -> return_R (sin 0.)
-       |W -> W;;
-
-(** val v_cos : value -> value, returns cos(v), recursive for value.Vec.*)
-let rec v_cos v = match v with
-       |N i -> return_R (cos (float_of_int i))
-       |R f -> return_R (cos f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_cos (vec i))
-       |Zero -> return_R (cos 0.)
-       |W -> W;;
-
-(** val v_atan : value -> value, returns atan(v), recursive for value.Vec.*)
-let rec v_atan v = match v with
-       |N i -> return_R (atan (float_of_int i))
-       |R f -> return_R (atan f)
-       |Vec (size, vec) -> make_vector size (fun i -> v_atan (vec i))
-       |Zero -> return_R (atan 0.)
-       |W -> W;;
-
-
-(** val v_atantwo : value -> value, returns atantwo(v), recursive for value.Vec.*)
-let rec v_atantwo v1 v2 = match (v1, v2) with
-        | (N i1, N i2) -> v_atantwo (R (float_of_int i1)) (R (float_of_int i2))
-       | (N i1, R f2) -> v_atantwo (R (float_of_int i1)) v2
-       | (N i1, Zero) -> v_atantwo (R (float_of_int i1)) (R 0.)
-       | (N i1, Vec (size2, vec2)) -> raise (Value_operation "atan2 sca vec.")
-       | (N i1, W) -> W
-
-       | (R f1, N i2) -> v_atantwo v1 (R (float_of_int i2))
-       | (R f1, R f2) -> R (atan2 f1 f2)
-       | (R f1, Zero) -> v_atantwo v1 (R 0.)
-       | (R f1, Vec (size2, vec2)) -> raise (Value_operation "atan2 sca vec.")
-       | (R f1, W) -> W
-
-       | (Vec (size1, vec1), Vec (size2, vec2)) -> make_vector size1 (fun i -> v_atantwo (vec1 i) (vec2 i))
-       | (Vec (size1, vec1), Zero) -> make_vector size1 (fun i -> v_atantwo (vec1 i) Zero)
-       | (Vec (size1, vec1), _) -> raise (Value_operation "atan2 vec sca.")
- 
-       | (Zero, N i2) -> v_atantwo (R 0.) (R (float_of_int i2))
-       | (Zero, R f2) -> v_atantwo (R 0.) v2
-       | (Zero, Vec (size2, vec2)) -> make_vector size2 (fun i -> v_atantwo Zero (vec2 i))
-       | (Zero, Zero) -> v_atantwo (R 0.) (R 0.)
-       | (Zero, W) -> W
-
-       | (W, Vec (size2, vec2)) -> raise (Value_operation "atan2 sca vec.")
-       | (W, _) -> W;;
-
-
-(** val v_sqrt : value -> value, returns sqrt(v), recursive for value.Vec.*)
-let rec v_sqrt v = match v with
-       |N i -> 
-           if i >= 0 then return_R (sqrt (float_of_int i))
-           else raise (Value_operation "sqrt parameter < 0.")
-       |R f -> 
-           if f >= 0. then return_R (sqrt f)
-           else raise (Value_operation "sqrt parameter < 0.")
-       |Vec (size, vec) -> make_vector size (fun i -> v_sqrt (vec i))
-       |Zero -> return_R (sqrt 0.)
-       |W -> W;;
-
-
-(** val v_mod : value -> value -> value, returns (v1 % v2), recursive for value.Vec.*)
-let rec v_mod v1 v2 = match v1 with
-       |N i1 ->
-               (
-                       match v2 with
-                       |N i2 -> return_N (i1 mod i2)
-                       |R f2 -> return_N (i1 mod (int_of_float f2))
-                       |Vec (size, vec) -> raise (Value_operation "Scalaire_Vector: int mod vec.")
-                       |Zero -> raise (Value_operation "v1 mod v2: v2 cannot be zero.")
-                       |W -> W
-               )
-       |R f1 -> let i = return_N (int_of_float f1) in v_mod i v2
-       |Vec (size1, vec1) ->
-               (
-                       match v2 with
-                       |Vec (size2, vec2) -> 
-                               if size1 = size2 then 
-                                 make_vector size1 (fun i -> v_mod (vec1 i) (vec2 i))
-                               else raise (Value_operation "vector size not matched.")
-                       |Zero -> raise (Value_operation "v1 mod v2: v2 cannot be zero.")
-                       |_ -> raise (Value_operation "Vector_Scalaire: vec mod int.")
-               )
-       |Zero -> 
-               (
-                       match v2 with
-                       |Vec (size2, vec2) -> 
-                               let v = make_vector size2 (fun i -> Zero) in
-                               v_mod v v2
-                       |_ -> v_mod (N 0) v2
-               )
-       |W -> 
-               (
-                       match v2 with
-                       |Vec (size2, vec2) -> raise (Value_operation "Scalaire_Vector: int mod vec.")
-                       |Zero -> raise (Value_operation "v1 mod v2: v2 cannot be zero.")
-                       |_ -> W
-               );;
-
-
-(** val v_larger_than_zero : value -> value, primitive comparison between value and zero, 
-returns value.N 1 if true, value.N 0 if false.*)
-let rec v_larger_than_zero v = match v with
-       |N i -> if i > 0 then return_N 1 else return_N 0
-       |R f -> if f > 0. then return_N 1 else return_N 0
-       |Vec (size, vec) -> make_vector size (fun i -> v_larger_than_zero (vec i))
-       |Zero -> return_N 0
-       |W -> W;;
-
-
-(** val v_sup : value -> value -> value, comparison of two values, returns value.N 1 if (v1 > v2), 
-value.N 0 else.*)
-let v_sup v1 v2 = v_larger_than_zero (v1 -~ v2);;
-
-
-(** val v_inf : value -> value -> value, comparison of two values, returns value.N 1 if (v1 < v2), 
-value.N 0 else.*)
-let v_inf v1 v2 = v_larger_than_zero (v2 -~ v1);;
-
+open Basic;;
+
+let convert : (basic -> 'a) -> basic -> 'a = 
+  fun oper -> fun b -> oper b;;
+
+class value : basic -> value_type = 
+  fun (b_init : basic) ->
+    object (self)
+      val mutable b = b_init
+      method get = b
+      method normalize = b <- basic_normalize self#get
+
+      method to_float = convert basic_to_float self#get
+      method to_int = convert basic_to_int self#get      
+      method to_float_array = convert basic_to_float_array self#get
+      method to_string = convert basic_to_string self#get
+
+      method private prim1 : (basic -> basic) -> value = 
+       fun oper -> 
+         new value (oper self#get)
+
+      method neg = self#prim1 basic_neg
+      method recip = self#prim1 basic_recip
+      method zero = self#prim1 basic_zero
+      method floor = self#prim1 basic_floor
+      method int = self#prim1 basic_int
+      method sin = self#prim1 basic_sin
+      method cos = self#prim1 basic_cos
+      method atan = self#prim1 basic_atan
+      method sqrt = self#prim1 basic_sqrt
+
+      method private prim2 : (basic -> basic -> basic) -> value -> value = 
+       fun oper ->
+         fun v ->
+           new value (oper self#get v#get)
+
+      method add = self#prim2 basic_add
+      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 _mod = self#prim2 basic_mod
+      method larger = self#prim2 basic_larger
+      method smaller = self#prim2 basic_smaller
+
+    end;;