From 4d5f39ea1ae1eff1d8eadf7875851be467e40a47 Mon Sep 17 00:00:00 2001 From: WANG Date: Mon, 5 Aug 2013 17:27:50 +0200 Subject: [PATCH] Refactoring in faustexp.ml. --- interpretor/beam.ml | 35 ++++- .../faust-0.9.47mr3/compiler/preprocess.a | Bin 2948944 -> 2948944 bytes interpretor/faustexp.ml | 137 ++++++++++-------- interpretor/types.ml | 19 ++- 4 files changed, 124 insertions(+), 67 deletions(-) diff --git a/interpretor/beam.ml b/interpretor/beam.ml index 0468e42..a4f22b8 100644 --- a/interpretor/beam.ml +++ b/interpretor/beam.ml @@ -8,6 +8,8 @@ exception Beam_matching of string;; open Types;; +open Basic;; +open Value;; open Signal;; class beam : signal_type array -> beam_type = @@ -59,12 +61,39 @@ class beam : signal_type array -> beam_type = else raise (Beam_matching "matching size error") - method time : time -> value_type array = + method at : time -> value_type array = fun t -> let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in Array.map (signal_at t) self#get - method output : int -> (int array) * (float array array) = + method output : int -> value_type array array = fun (length_max : int) -> - + let transpose : 'a array array -> 'a array array = + fun matrix -> + let get_element = fun i -> fun array -> array.(i) in + let get_column = fun m -> fun i -> Array.map (get_element i) m in + Array.init self#width (get_column matrix) in + let value_init = new value Error in + let container = Array.make length_max + (Array.make self#width value_init) in + let index = ref 0 in + + try + while !index < length_max do + container.(!index) <- self#at !index; + incr index; + done; + transpose container + with x -> + + let error_message = + match x with + | Convert_Error s -> "Convert_Error: " ^ s + | Basic_operation s -> "Basic_operation: " ^ s + | Signal_operation s -> "Signal_operation: " ^ s + | Beam_matching s -> "Beam_Matching_Error: " ^ s + | _ -> "Compute finished." + in + let () = print_string error_message in + transpose (Array.sub container 0 !index) end diff --git a/interpretor/faust-0.9.47mr3/compiler/preprocess.a b/interpretor/faust-0.9.47mr3/compiler/preprocess.a index 023801bc9620c853cbc6adb6b67d5c57d7180a81..8a4962e84f182e331cb74f61a4599ed69b2b3b6d 100644 GIT binary patch delta 1862 zcmZA2Ur19?90zc=n%;8mk6Z5AHd~vsyFZaM)0JWCpIIsyRE&xe8m0ubAg~9uyD;v^ z5UB_EU{MroM1+y`8z^|ekP%iZ41z}4Q|k|;;ll!{1`&Qw59i^0&iDL3+?)RONRiH$ zK}$ikuV!OyO~n4#u2A|_zS?|cXuic@qJUpvvjfDtk0>5Oonl2waU()?y)t|mL7r6F z#sH+n-evi+oECdkvjJ?#O{ge0Q4l^0NPQa$bNdlu7Yh@02*<_>!&!vv9d6Euu#n_} z0{~LTo)y%wXXUMTOUO%3M-e$4>Mq|Bnkac#o$dmN-+iGrL!IQ$YMDbA{-Nf!14y#3 zm}H+Otp=p~0gbE!h(`}-c0!$OuQZpGR5_%1zxh9I+lnw;tWDJ;h|O9yu^81RwqZg} zX=BV7=T$n9N$7U#QVcBg=>*&q`KNSA2GpEB%)tGA{TBsYYSL@)k}1zQCMQ4F=a`+( z=t~B7;CjV_C0S;S{01UQQpHM4TOb$rzb;`G{Wtc;VE7l4@^6~vTZ|Jtbd#prjrp>Q zrrS$xRnS1(P-%{N$`-4M&tRhUr>PY$Um92NG_EMC>ckXxx-3u%AcZ1j`Ldcq5i`FY z8YuR_?5{-lHed!XDGPTF;q7KC=SEmOX^oX3jPzJ_ z%(KfpvF7$+Vop)+XA-;W%7g8gNZu|_okAF1vBq`<;qCP`;a>=$Yc^pDKuQGHQX*(i z9RQ@O_w2z}08hFdBTlH(^le9&SxS(r$hKhO*x?H941)NyLewHyW-1ytAc)JHfqsO{ zfHUes5R*=xxxCT$&Jj2PUWznSQlw$s?;7kj+_R2PAf%mwz)WpCBxD6l@V!E!03p*S zv>ibReh}u05JF#tHs*?Fm%C;gFp+6;g$)QDCtNWPf~DW3gTDh$dna8lt(d6(=$bu* zP*v*|m|4#ExO0t|h)%f^usNPuzPnB3O9`GL#hy>hEPWo2!2AJH?Vd*FOuaWeG7M@W qZpt&qJbB~1CyGBdN*cVj=A~&(v~a>JG9T8#o8B;c9?!hhoBjaEu5icz delta 1830 zcmY+EUrgIo6vxvJN`dmD1?=zl1KMJt&_4+MLw~>iU@1c*WKPhTIky?%!30B$Wxi}L z1MIS`1|m_X`%U9&(1^|`{)?O~OabTW)CimIMV&SJ;6@fjd?53|&f9zLCF9{foX`25 zbI(2Z+5z8C96cx3Xnj37|+#fWfrw`KVtBQUvSvDcV_F+~Zg zI;l#8#TCoExgdW~y)I*|hV(xcQy1C`$6a!2F;WJL5na5J_gXJ75`pXyYrG4!5!|&sW1VHB4T)g3B{q|p3EOo8 z9Nu9Q@LpA>Bz&DIqdGnH7vI^|@4@_0AY_`gK*7|9cUAnsQYiWAXIN91yZ!r$9P5Az zaa-lgRyuKNYOS{t)_SYvB}~l*ZfUS8wKRAKEDhS7LF$PG^VcCkiEdv%iX?>7SS<5`0sItE_0H9gYfZ)L(pi`VtSXkL5A$CWBon`$h(zb&EQmV?qV9WbT|`(m_XCh zS&s~JQ_c%dP@>UZig2pfE(T>d?s{hc#0Vza=<*E9ouo?}YH0(7uT=961IofAk@Y-V=SbIivH(b(acGajjtc1qKyrkvFPSZA(Ez!-oR?1&edyJr-f0sC zgz)BnIpQ7I#|f=?@2}p~QbwTfhWCKHkz&Lz!S4mWY&R#g{Hr^B`ztx2RSXUI^Z+Mx zI-CNha`@pQp(E9Z0)*08MeW eve|V%cV`EhPsBI5Ur09(Z?u61IKF9)ME?gos3-~m diff --git a/interpretor/faustexp.ml b/interpretor/faustexp.ml index 6b324a0..684eb75 100644 --- a/interpretor/faustexp.ml +++ b/interpretor/faustexp.ml @@ -1,22 +1,83 @@ (** Module: Faustexp - Description: dimension estimation and delay estimation of faust expressions. + Description: Faust expression evaluation @author WANG Haisheng - Created: 03/06/2013 Modified: 04/06/2013 + Created: 03/06/2013 Modified: 04/08/2013 *) open Types;; open Value;; - +open Signal;; +open Beam;; exception NotYetDone;; - - - -class virtual expression : expression_type = +exception Dimension_error of string;; + +class dimension : int * int -> dimension_type = + fun (init : int * int) -> + object (self) + val dim_input = fst init + val dim_output = snd init + + method input = dim_input + method output = dim_output + + method par : dimension_type -> dimension_type = + fun dim -> + new dimension + ((self#input + dim#input), (self#output + dim#output)) + + method seq : dimension_type -> dimension_type = + fun dim -> + if self#output = dim#input then + new dimension (self#input, dim#output) + else raise (Dimension_error "seq dimension not matched.") + + method split : dimension_type -> dimension_type = + fun dim -> + if dim#input mod self#output = 0 then + new dimension (self#input, dim#output) + else raise (Dimension_error "split dimension not matched.") + + method merge : dimension_type -> dimension_type = + fun dim -> + if self#output mod dim#input = 0 then + new dimension (self#input, dim#output) + else raise (Dimension_error "merge dimension not matched.") + + method _rec : dimension_type -> dimension_type = + fun dim -> + if self#output >= dim#input && self#input >= dim#output then + new dimension (self#input - dim#output, self#output) + else raise (Dimension_error "rec dimension not matched.") + end;; + +class process : faust_exp -> process_type = fun (exp_init : faust_exp) -> - object - val exp = exp_init + object (self) + val exp = exp_init + val left = + match exp_init with + | Const b -> exp_init + | Ident s -> exp_init + | Par (e1, e2) -> e1 + | Seq (e1, e2) -> e1 + | Split (e1, e2) -> e1 + | Merge (e1, e2) -> e1 + | Rec (e1, e2) -> e1 + + val right = + match exp_init with + | Const b -> exp_init + | Ident s -> exp_init + | Par (e1, e2) -> e2 + | Seq (e1, e2) -> e2 + | Split (e1, e2) -> e2 + | Merge (e1, e2) -> e2 + | Rec (e1, e2) -> e2 + + val proc_left = + val dim = new dimension val delay = 0 method get_exp = exp @@ -24,12 +85,14 @@ class virtual expression : expression_type = method get_delay = delay method to_string = "NotYetDone" method virtual evaluate : beam_type -> beam_type -end;; + end;; -class exp_const = - object - inherit expression +class proc_const : faust_exp -> process_type = + fun (exp_init : faust_exp) -> + object (self) + val exp = exp_init + val dim = method evaluate = fun b1 -> end;; @@ -74,7 +137,7 @@ class exp_rec = end;; - +*) @@ -97,15 +160,15 @@ let rec delay exp_faust = match exp_faust with |Pass -> 0 |Stop -> 0 |Mem -> 1 - |Delay -> 100000 (* danger! *) + |Delay -> 100000 |Floor -> 0 |Int -> 0 |Sin -> 0 - |Rdtable -> 100000 (* danger! *) + |Rdtable -> 100000 |Mod -> 0 |Larger -> 0 |Smaller -> 0 - |Vectorize -> 100 (* danger! *) + |Vectorize -> 100 |Concat -> 0 |Nth -> 0 |Serialize -> 0 @@ -152,46 +215,6 @@ let subtree_left = fun d_tree -> subtree d_tree 0;; (** val subtree_right : dimension -> dimension, returns the right subtree of dimension tree.*) let subtree_right = fun d_tree -> subtree d_tree 1;; - -(** val d_par : int * int -> int * int -> int * int, process dimension for constructor "par(,)", -which is the addition of two dimensions.*) -let d_par a b = (((fst a) + (fst b)), ((snd a) + (snd b)));; - - -(** val d_seq : int * int -> int * int -> int * int, process dimension for constructor "seq(:)", -which is (size of input beam of first exp, size of output beam of second exp) -along with beam matching.*) -let d_seq a b = if (snd a) = (fst b) then (fst a, snd b) else raise (Beam_Matching_Error "seq");; - - -(** val d_split : int * int -> int * int -> int * int, process dimension for constructor "split(<:)", -which is (size of input beam of first exp, size of output beam of second exp) -along with beam matching.*) -let d_split a b = - if ((fst b) mod (snd a)) = 0 then - (fst a, snd b) - else raise (Beam_Matching_Error "split");; - - -(** val d_merge : int * int -> int * int -> int * int, process dimension for constructor "merge(:>)", -which is (size of input beam of first exp, size of output beam of second exp) -along with beam matching. *) -let d_merge a b = - if ((snd a) mod (fst b)) = 0 then - (fst a, snd b) - else raise (Beam_Matching_Error "merge");; - - -(** val d_rec : int * int -> int * int -> int * int, process dimension for constructor "rec(~)", -which is (size of input beam of first exp - size of output beam of second exp, -size of output beam of first exp) -along with beam matching.*) -let d_rec a b = - if (fst a) >= (snd b) && (snd a) >= (fst b) then - ((fst a) - (snd b), snd a) - else raise (Beam_Matching_Error "rec");; - - (** val dim : faust_exp -> int * int, returns dimension for faust expression, along with beam matching.*) let rec dim exp_faust = diff --git a/interpretor/types.ml b/interpretor/types.ml index d117836..6fa6513 100644 --- a/interpretor/types.ml +++ b/interpretor/types.ml @@ -118,12 +118,12 @@ class type signal_type = class type beam_type = object method get : signal_type array - method length : int + method width : int method sub : int -> int -> beam_type method append : beam_type -> beam_type method matching : int -> beam_type - method time : time -> value_type array - method output : int -> (int list) * (float array list) + method at : time -> value_type array + method output : int -> value_type array array end;; @@ -131,14 +131,19 @@ class type dimension_type = object method input : int method output : int + method par : dimension_type -> dimension_type + method seq : dimension_type -> dimension_type + method split : dimension_type -> dimension_type + method merge : dimension_type -> dimension_type + method _rec : dimension_type -> dimension_type end;; -class type expression_type = +class type process_type = object - method get_exp : faust_exp - method get_dim : dimension_type - method get_delay : int + method exp : faust_exp + method dim : dimension_type + method delay : int method to_string : string method evaluate : beam_type -> beam_type end;; -- 2.20.1