interpretor/faustexp.ml

   1 (**
   2         Module: Faustexp
   3         Description: dimension estimation and delay estimation of faust expressions.
   4         @author WANG Haisheng
   5         Created: 03/06/2013     Modified: 04/06/2013
   6 *)
   7
   8 open Types;;
   9 open Value;;
  10
  11
  12 exception NotYetDone;;
  13
  14
  15
  16 class virtual expression : expression_type =
  17   fun (exp_init : faust_exp) ->
  18   object
  19       val exp = exp_init
  20       val dim = new dimension
  21       val delay = 0
  22       method get_exp = exp
  23       method get_dim = dim
  24       method get_delay = delay
  25       method to_string = "NotYetDone"
  26       method virtual evaluate : beam_type -> beam_type
  27 end;;
  28
  29
  30 class exp_const =
  31   object
  32       inherit expression
  33       method evaluate = fun b1 ->
  34
  35       end;;
  36
  37
  38 class exp_ident =
  39   object
  40       inherit expression
  41
  42       end;;
  43
  44
  45 class exp_par =
  46   object
  47      inherit expression
  48
  49       end;;
  50
  51
  52 class exp_split =
  53   object
  54      inherit expression
  55
  56       end;;
  57
  58
  59 class exp_merge =
  60   object
  61      inherit expression
  62
  63       end;;
  64
  65 class exp_seq =
  66   object
  67      inherit expression
  68
  69       end;;
  70
  71 class exp_rec =
  72   object
  73      inherit expression
  74
  75       end;;
  76
  77
  78
  79
  80
  81
  82 (* PROCESS DELAY ESTIMATION *)
  83
  84 (** val delay : faust_exp -> int, returns the number of delays estimated staticly.
  85 Attention: delays of "@" is estimated as 10 constant,
  86 delays of "vectorize" and "serialize" haven't been implemented,
  87 delays of "rdtable" hasn't been implemented.*)
  88 let rec delay exp_faust = match exp_faust with
  89         |Const v        ->      0
  90         |Ident s        ->
  91                 (
  92                         match s with
  93                         |Add                    ->      0
  94                         |Sup                    ->      0
  95                         |Mul                    ->      0
  96                         |Div                    ->      0
  97                         |Pass                   ->      0
  98                         |Stop                   ->      0
  99                         |Mem                    ->      1
 100                         |Delay                  ->      100000 (* danger! *)
 101                         |Floor                  ->      0
 102                         |Int                    ->      0
 103                         |Sin                    ->      0
 104                         |Rdtable                ->      100000 (* danger! *)
 105                         |Mod                    ->      0
 106                         |Larger                 ->      0
 107                         |Smaller                ->      0
 108                         |Vectorize              ->      100 (* danger! *)
 109                         |Concat                 ->      0
 110                         |Nth                    ->      0
 111                         |Serialize              ->      0
 112                         |Prefix                 ->      1
 113                         |Selecttwo              ->      0
 114                         |Selectthree            ->      0
 115                 )
 116         |Par (e1, e2)   ->      max (delay e1) (delay e2)
 117         |Seq (e1, e2)   ->      (delay e1) + (delay e2)
 118         |Split (e1, e2) ->      (delay e1) + (delay e2)
 119         |Merge (e1, e2) ->      (delay e1) + (delay e2)
 120         |Rec (e1, e2)   ->      delay e1;;
 121
 122
 123 (* PARSER *)
 124
 125 (** val exp_of_string : string -> faust_exp, faust expression parser. *)
 126 let exp_of_string s = (Parser.main Lexer.token (Lexing.from_string s));;
 127
 128
 129
 130 (* PROCESS DIMENSION ESTIMATION *)
 131 (* process dimension := (size of input beam, size of output beam).*)
 132
 133
 134 (** val get_root : dimension -> int * int, returns the root of dimension tree. *)
 135 let get_root = fun d_tree -> match d_tree with
 136                         | End d -> d
 137                         | Tree (d, branches) -> d;;
 138
 139
 140 (** val subtree : dimention -> int -> dimension, returns a subtree of dimension tree.*)
 141 let subtree = fun d_tree -> fun i ->
 142   match d_tree with
 143   | End d -> raise (Beam_Matching_Error "Subtree left absent.")
 144   | Tree (d, branches) -> (
 145       match branches with
 146         (left, right) -> if i = 0 then left else right);;
 147
 148 (** val subtree_left : dimension -> dimension, returns the left subtree of dimension tree.*)
 149 let subtree_left = fun d_tree -> subtree d_tree 0;;
 150
 151
 152 (** val subtree_right : dimension -> dimension, returns the right subtree of dimension tree.*)
 153 let subtree_right = fun d_tree -> subtree d_tree 1;;
 154
 155
 156 (** val d_par : int * int -> int * int -> int * int, process dimension for constructor "par(,)",
 157 which is the addition of two dimensions.*)
 158 let d_par a b = (((fst a) + (fst b)), ((snd a) + (snd b)));;
 159
 160
 161 (** val d_seq : int * int -> int * int -> int * int, process dimension for constructor "seq(:)",
 162 which is (size of input beam of first exp, size of output beam of second exp)
 163 along with beam matching.*)
 164 let d_seq a b = if (snd a) = (fst b) then (fst a, snd b) else raise (Beam_Matching_Error "seq");;
 165
 166
 167 (** val d_split : int * int -> int * int -> int * int, process dimension for constructor "split(<:)",
 168 which is (size of input beam of first exp, size of output beam of second exp)
 169 along with beam matching.*)
 170 let d_split a b =
 171   if ((fst b) mod (snd a)) = 0 then
 172     (fst a, snd b)
 173   else raise (Beam_Matching_Error "split");;
 174
 175
 176 (** val d_merge : int * int -> int * int -> int * int, process dimension for constructor "merge(:>)",
 177 which is (size of input beam of first exp, size of output beam of second exp)
 178 along with beam matching. *)
 179 let d_merge a b =
 180   if ((snd a) mod (fst b)) = 0 then
 181     (fst a, snd b)
 182   else raise (Beam_Matching_Error "merge");;
 183
 184
 185 (** val d_rec : int * int -> int * int -> int * int, process dimension for constructor "rec(~)",
 186 which is (size of input beam of first exp - size of output beam of second exp,
 187 size of output beam of first exp)
 188 along with beam matching.*)
 189 let d_rec a b =
 190   if (fst a) >= (snd b) && (snd a) >= (fst b) then
 191     ((fst a) - (snd b), snd a)
 192   else raise (Beam_Matching_Error "rec");;
 193
 194
 195 (** val dim : faust_exp -> int * int, returns dimension for faust expression,
 196 along with beam matching.*)
 197 let rec dim exp_faust =
 198
 199 (** val dimension_constructor : ((int * int) -> (int * int) -> (int * int)) -> faust_exp
 200 -> faust_exp -> dimension,
 201 returns the dimension tree of constructor(e1, e2).*)
 202         let dimension_constructor = fun constructor -> fun e1 -> fun e2 ->
 203             let subtree1 = dim e1 in
 204             let subtree2 = dim e2 in
 205             let root = constructor (get_root subtree1) (get_root subtree2) in
 206             Tree (root, (subtree1, subtree2)) in
 207
 208         match exp_faust with
 209         |Const v -> End (0, 1)
 210         |Ident s ->
 211                 (
 212                         match s with
 213                         |Add                    ->      End (2, 1)
 214                         |Sup                    ->      End (2, 1)
 215                         |Mul                    ->      End (2, 1)
 216                         |Div                    ->      End (2, 1)
 217                         |Pass                   ->      End (1, 1)
 218                         |Stop                   ->      End (1, 0)
 219                         |Mem                    ->      End (1, 1)
 220                         |Delay                  ->      End (2, 1)
 221                         |Floor                  ->      End (1, 1)
 222                         |Int                    ->      End (1, 1)
 223                         |Sin                    ->      End (1, 1)
 224                         |Rdtable                ->      End (3, 1)
 225                         |Mod                    ->      End (2, 1)
 226                         |Vectorize              ->      End (2, 1)
 227                         |Concat                 ->      End (2, 1)
 228                         |Nth                    ->      End (2, 1)
 229                         |Serialize              ->      End (1, 1)
 230                         |Larger                 ->      End (2, 1)
 231                         |Smaller                ->      End (2, 1)
 232                         |Prefix                 ->      End (2, 1)
 233                         |Selecttwo              ->      End (3, 1)
 234                         |Selectthree            ->      End (4, 1)
 235                 )
 236
 237         |Par (e1, e2)           ->      dimension_constructor d_par e1 e2
 238         |Seq (e1, e2)           ->      dimension_constructor d_seq e1 e2
 239         |Split (e1, e2)         ->      dimension_constructor d_split e1 e2
 240         |Merge (e1, e2)         ->      dimension_constructor d_merge e1 e2
 241         |Rec (e1, e2)           ->      dimension_constructor d_rec e1 e2;;
 242
 243
 244
 245 (* AUXILIARY 'CONVERT_TO_STRING' FUNCTIONS *)
 246
 247 (** val print_exp : faust_exp -> unit, print to console the input faust expression.*)
 248 let print_exp exp =
 249   let rec string_of_exp exp = match exp with
 250     |Const v            ->      "Const" ^ " (" ^ (string_of_value v) ^ ")"
 251     |Ident s            ->      "Ident" ^ " \"" ^ "s" ^ "\""
 252     |Par (e1, e2)       ->      "Par" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 253     |Seq (e1, e2)       ->      "Seq" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 254     |Split (e1, e2)     ->      "Split" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 255     |Merge (e1, e2)     ->      "Merge" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 256     |Rec (e1, e2)       ->      "Rec" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 257   in
 258     print_string("Parer : Types.faust_exp = "^ (string_of_exp exp));;