interpretor/faustexp.ml

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