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 (* EXCEPTIONS *)
  12
  13 (** Exception raised in beam matching of faust expressions.*)
  14 exception Beam_Matching_Error of string;;
  15
  16 (** Exception raised in case that the branch under call hasn't yet been programed.*)
  17 exception NotYetDone;;
  18
  19
  20 (* PROCESS DELAY ESTIMATION *)
  21
  22 (** val delay : faust_exp -> int, returns the number of delays estimated staticly.
  23 Attention: delays of "@" is estimated as 10 constant,
  24 delays of "vectorize" and "serialize" haven't been implemented,
  25 delays of "rdtable" hasn't been implemented.*)
  26 let rec delay exp_faust = match exp_faust with
  27         |Const v        ->      0
  28         |Ident s        ->
  29                 (
  30                         match s with
  31                         |Add                    ->      0
  32                         |Sup                    ->      0
  33                         |Mul                    ->      0
  34                         |Div                    ->      0
  35                         |Pass                   ->      0
  36                         |Stop                   ->      0
  37                         |Mem                    ->      1
  38                         |Delay                  ->      100000 (* danger! *)
  39                         |Floor                  ->      0
  40                         |Int                    ->      0
  41                         |Sin                    ->      0
  42                         |Cos                    ->      0
  43                         |Atan                   ->      0
  44                         |Atantwo                ->      0
  45                         |Sqrt                   ->      0
  46                         |Rdtable                ->      100000 (* danger! *)
  47                         |Mod                    ->      0
  48                         |Larger                 ->      0
  49                         |Smaller                ->      0
  50                         |Vectorize              ->      100 (* danger! *)
  51                         |Concat                 ->      0
  52                         |Nth                    ->      0
  53                         |Serialize              ->      0
  54                         |Prefix                 ->      1
  55                         |Selecttwo              ->      0
  56                         |Selectthree            ->      0
  57                 )
  58         |Par (e1, e2)   ->      max (delay e1) (delay e2)
  59         |Seq (e1, e2)   ->      (delay e1) + (delay e2)
  60         |Split (e1, e2) ->      (delay e1) + (delay e2)
  61         |Merge (e1, e2) ->      (delay e1) + (delay e2)
  62         |Rec (e1, e2)   ->      delay e1;;
  63
  64
  65 (* PARSER *)
  66
  67 (** val exp_of_string : string -> faust_exp, faust expression parser. *)
  68 let exp_of_string s = (Parser.main Lexer.token (Lexing.from_string s));;
  69
  70
  71
  72 (* PROCESS DIMENSION ESTIMATION *)
  73 (* process dimension := (size of input beam, size of output beam).*)
  74
  75
  76 (** val get_root : dimension -> int * int, returns the root of dimension tree. *)
  77 let get_root = fun d_tree -> match d_tree with
  78                         | End d -> d
  79                         | Tree (d, branches) -> d;;
  80
  81
  82 (** val subtree : dimention -> int -> dimension, returns a subtree of dimension tree.*)
  83 let subtree = fun d_tree -> fun i ->
  84   match d_tree with
  85   | End d -> raise (Beam_Matching_Error "Subtree left absent.")
  86   | Tree (d, branches) -> (
  87       match branches with
  88         (left, right) -> if i = 0 then left else right);;
  89
  90 (** val subtree_left : dimension -> dimension, returns the left subtree of dimension tree.*)
  91 let subtree_left = fun d_tree -> subtree d_tree 0;;
  92
  93
  94 (** val subtree_right : dimension -> dimension, returns the right subtree of dimension tree.*)
  95 let subtree_right = fun d_tree -> subtree d_tree 1;;
  96
  97
  98 (** val d_par : int * int -> int * int -> int * int, process dimension for constructor "par(,)",
  99 which is the addition of two dimensions.*)
 100 let d_par a b = (((fst a) + (fst b)), ((snd a) + (snd b)));;
 101
 102
 103 (** val d_seq : int * int -> int * int -> int * int, process dimension for constructor "seq(:)",
 104 which is (size of input beam of first exp, size of output beam of second exp)
 105 along with beam matching.*)
 106 let d_seq a b = if (snd a) = (fst b) then (fst a, snd b) else raise (Beam_Matching_Error "seq");;
 107
 108
 109 (** val d_split : int * int -> int * int -> int * int, process dimension for constructor "split(<:)",
 110 which is (size of input beam of first exp, size of output beam of second exp)
 111 along with beam matching.*)
 112 let d_split a b =
 113   if ((fst b) mod (snd a)) = 0 then
 114     (fst a, snd b)
 115   else raise (Beam_Matching_Error "split");;
 116
 117
 118 (** val d_merge : int * int -> int * int -> int * int, process dimension for constructor "merge(:>)",
 119 which is (size of input beam of first exp, size of output beam of second exp)
 120 along with beam matching. *)
 121 let d_merge a b =
 122   if ((snd a) mod (fst b)) = 0 then
 123     (fst a, snd b)
 124   else raise (Beam_Matching_Error "merge");;
 125
 126
 127 (** val d_rec : int * int -> int * int -> int * int, process dimension for constructor "rec(~)",
 128 which is (size of input beam of first exp - size of output beam of second exp,
 129 size of output beam of first exp)
 130 along with beam matching.*)
 131 let d_rec a b =
 132   if (fst a) >= (snd b) && (snd a) >= (fst b) then
 133     ((fst a) - (snd b), snd a)
 134   else raise (Beam_Matching_Error "rec");;
 135
 136
 137 (** val dim : faust_exp -> int * int, returns dimension for faust expression,
 138 along with beam matching.*)
 139 let rec dim exp_faust =
 140
 141 (** val dimension_constructor : ((int * int) -> (int * int) -> (int * int)) -> faust_exp
 142 -> faust_exp -> dimension,
 143 returns the dimension tree of constructor(e1, e2).*)
 144         let dimension_constructor = fun constructor -> fun e1 -> fun e2 ->
 145             let subtree1 = dim e1 in
 146             let subtree2 = dim e2 in
 147             let root = constructor (get_root subtree1) (get_root subtree2) in
 148             Tree (root, (subtree1, subtree2)) in
 149
 150         match exp_faust with
 151         |Const v -> End (0, 1)
 152         |Ident s ->
 153                 (
 154                         match s with
 155                         |Add                    ->      End (2, 1)
 156                         |Sup                    ->      End (2, 1)
 157                         |Mul                    ->      End (2, 1)
 158                         |Div                    ->      End (2, 1)
 159                         |Pass                   ->      End (1, 1)
 160                         |Stop                   ->      End (1, 0)
 161                         |Mem                    ->      End (1, 1)
 162                         |Delay                  ->      End (2, 1)
 163                         |Floor                  ->      End (1, 1)
 164                         |Int                    ->      End (1, 1)
 165                         |Sin                    ->      End (1, 1)
 166                         |Cos                    ->      End (1, 1)
 167                         |Atan                   ->      End (1, 1)
 168                         |Atantwo                ->      End (2, 1)
 169                         |Sqrt                   ->      End (1, 1)
 170                         |Rdtable                ->      End (3, 1)
 171                         |Mod                    ->      End (2, 1)
 172                         |Vectorize              ->      End (2, 1)
 173                         |Concat                 ->      End (2, 1)
 174                         |Nth                    ->      End (2, 1)
 175                         |Serialize              ->      End (1, 1)
 176                         |Larger                 ->      End (2, 1)
 177                         |Smaller                ->      End (2, 1)
 178                         |Prefix                 ->      End (2, 1)
 179                         |Selecttwo              ->      End (3, 1)
 180                         |Selectthree            ->      End (4, 1)
 181                 )
 182
 183         |Par (e1, e2)           ->      dimension_constructor d_par e1 e2
 184         |Seq (e1, e2)           ->      dimension_constructor d_seq e1 e2
 185         |Split (e1, e2)         ->      dimension_constructor d_split e1 e2
 186         |Merge (e1, e2)         ->      dimension_constructor d_merge e1 e2
 187         |Rec (e1, e2)           ->      dimension_constructor d_rec e1 e2;;
 188
 189
 190
 191 (* AUXILIARY 'CONVERT_TO_STRING' FUNCTIONS *)
 192
 193 (** val print_exp : faust_exp -> unit, print to console the input faust expression.*)
 194 let print_exp exp =
 195   let rec string_of_exp exp = match exp with
 196     |Const v            ->      "Const" ^ " (" ^ (string_of_value v) ^ ")"
 197     |Ident s            ->      "Ident" ^ " \"" ^ "s" ^ "\""
 198     |Par (e1, e2)       ->      "Par" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 199     |Seq (e1, e2)       ->      "Seq" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 200     |Split (e1, e2)     ->      "Split" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 201     |Merge (e1, e2)     ->      "Merge" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 202     |Rec (e1, e2)       ->      "Rec" ^ " (" ^ (string_of_exp e1) ^ ", " ^ (string_of_exp e2) ^ ")"
 203   in
 204     print_string("Parer : Types.faust_exp = "^ (string_of_exp exp));;