(** val interpret_par : faust_exp -> faust_exp -> beam -> beam,
-interprets par(e1, e2) with input beam, produces output beam.*)
-let interpret_par = fun e1 ->fun e2 ->fun dimension_tree ->fun input_beam ->
- let n = List.length input_beam in
- let subtree1 = subtree_left dimension_tree in
- let subtree2 = subtree_right dimension_tree in
- let d1 = get_root subtree1 in
- let d2 = get_root subtree2 in
- if n = (fst d1) + (fst d2) then
- (
- let input_beam1 = sublist input_beam 0 (fst d1) in
- let input_beam2 = sublist input_beam (fst d1) (fst d2) in
- let output_beam1 = interpreter_rec e1 subtree1 input_beam1 in
- let output_beam2 = interpreter_rec e2 subtree2 input_beam2 in
- ifList.length output_beam1 = snd d1 &&List.length output_beam2 = snd d2
- then (output_beam1 @ output_beam2)
- else raise (Evaluation_Error"Par")
- )
- else raise (Evaluation_Error"Par") in
-
-
-
(** val interpret_seq : faust_exp -> faust_exp -> beam -> beam,
-interprets seq(e1, e2) with input beam, produces output beam.*)
-let interpret_seq = fun e1 ->fun e2 ->fun dimension_tree ->fun input_beam ->
- let n = List.length input_beam in
- let subtree1 = subtree_left dimension_tree in
- let subtree2 = subtree_right dimension_tree in
- let d1 = get_root subtree1 in
- let d2 = get_root subtree2 in
- if n = fst d1 then
- (
- let output_beam1 = interpreter_rec e1 subtree1 input_beam in
- ifList.length output_beam1 = fst d2
- then interpreter_rec e2 subtree2 output_beam1
- else raise (Evaluation_Error"Seq")
- )
- else raise (Evaluation_Error"Seq") in
-
-
-
(** val interpret_split : faust_exp -> faust_exp -> beam -> beam,
-interprets split(e1, e2) with input beam, produces output beam.*)
-let interpret_split = fun e1 ->fun e2 ->fun dimension_tree ->fun input_beam ->
- let n = List.length input_beam in
- let subtree1 = subtree_left dimension_tree in
- let subtree2 = subtree_right dimension_tree in
- let d1 = get_root subtree1 in
- let d2 = get_root subtree2 in
- if n = fst d1 then
- (
- let output_beam1 = interpreter_rec e1 subtree1 input_beam in
- let ref_output_beam1 = ref (beam_add_one_memory output_beam1) in
- let input_beam2 = List.concat
- (Array.to_list (Array.make ((fst d2)/(List.length output_beam1)) !ref_output_beam1))
- in
- ifList.length input_beam2 = fst d2
- then interpreter_rec e2 subtree2 input_beam2
- else raise (Evaluation_Error"Split")
- )
- else raise (Evaluation_Error"Split") in
-
-
-
(** val interpret_merge : faust_exp -> faust_exp -> beam -> beam,
-interprets merge(e1, e2) with input beam, produces output beam.*)
-let interpret_merge = fun e1 ->fun e2 ->fun dimension_tree ->fun input_beam ->
- let n = List.length input_beam in
- let subtree1 = subtree_left dimension_tree in
- let subtree2 = subtree_right dimension_tree in
- let d1 = get_root subtree1 in
- let d2 = get_root subtree2 in
- if n = fst d1 then
- (
- let output_beam1 = interpreter_rec e1 subtree1 input_beam in
- let input_beam2 =
- (
- let fois = (snd d1)/(fst d2) in
- let ref_beam = ref (sublist output_beam1 0 (fst d2)) in
- for i = 1 to fois - 1 do
- let temp_beam = sublist output_beam1 (i*(fst d2)) (fst d2) in
- ref_beam := List.map2 signal_add (!ref_beam) temp_beam;
- done;
- !ref_beam
- )
- in
- ifList.length input_beam2 = fst d2
- then interpreter_rec e2 subtree2 input_beam2
- else raise (Evaluation_Error"Merge")
- )
- else raise (Evaluation_Error"Merge") in
-
-
-
(** val interpret_rec : faust_exp -> faust_exp -> beam -> beam,
-interprets rec(e1, e2) with input beam, produces output beam.*)
-let interpret_rec = fun e1 ->fun e2 ->fun dimension_tree ->fun input_beam ->
- let n = List.length input_beam in
- let subtree1 = subtree_left dimension_tree in
- let subtree2 = subtree_right dimension_tree in
- let d1 = get_root subtree1 in
- let d2 = get_root subtree2 in
- if n = (fst d1) - (snd d2) then
- (
- let aux1 = fun t ->fun f -> f t in
- let aux2 = fun beam_fun ->fun i ->fun t ->List.nth (snd (beam_fun t)) i in
- let aux3 = fun beam_fun ->List.map
- (aux2 beam_fun)
- (Array.to_list (Array.init (snd d1) (fun n -> n)))
- in
- let make_signal = fun rate ->fun f -> (rate, f) in
- let delay_int = 1 + delay e2 + delay e1 in
- let memory_hashtbl = Hashtbl.create delay_int in
- let rate_list = ref (Array.to_list (Array.make (snd d1) 0)) in
- letrec output_beam_fun = fun t ->
- if t < 0 then
- let init_rate_list = Array.to_list (Array.make (snd d1) 0) in
- let value_list = Array.to_list (Array.make (snd d1) Zero) in
- (init_rate_list, value_list)
- elseifHashtbl.mem memory_hashtbl t then
- (!rate_list, Hashtbl.find memory_hashtbl t)
- else
- let mid_output_fun_list1 = aux3 output_beam_fun in(* danger! *)
- let b_input_fun_list = List.map
- (fun s ->fun t -> s (t - 1))
- (sublist mid_output_fun_list1 0 (fst d2))
- in
- let b_input_beam = List.map2 make_signal !rate_list b_input_fun_list in
- let b_output_beam = (interpreter_rec e2 subtree2 b_input_beam) in
- let a_input_beam = b_output_beam @ input_beam in
- let mid_output_beam2 = interpreter_rec e1 subtree1 a_input_beam in
- let mid_output_rate_list = List.map fst mid_output_beam2 in
- let mid_output_value_list = List.map (aux1 t) (List.map snd mid_output_beam2) in
- let () = (rate_list := mid_output_rate_list) in
- let mid_output_value_list_for_stock = v_list_memory mid_output_value_list in
- let () = Hashtbl.add memory_hashtbl t mid_output_value_list_for_stock in
- let () = Hashtbl.remove memory_hashtbl (t - delay_int) in
- (mid_output_rate_list, mid_output_value_list_for_stock)
- in
- let output_beam = List.map2 make_signal !rate_list (aux3 output_beam_fun) in
- output_beam
- )
- else raise (Evaluation_Error"Rec1") in
-
-
-
(** Call for previous functions *)
- match exp_faust with
- |Const v -> interpret_const v input_beam
- |Ident s -> interpret_ident s input_beam
- |Par (e1, e2) -> interpret_par e1 e2 dimension_tree input_beam
- |Seq (e1, e2) -> interpret_seq e1 e2 dimension_tree input_beam
- |Split (e1, e2) -> interpret_split e1 e2 dimension_tree input_beam
- |Merge (e1, e2) -> interpret_merge e1 e2 dimension_tree input_beam
- |Rec (e1, e2) -> interpret_rec e1 e2 dimension_tree input_beam
\ No newline at end of file