Indentation fixes + remove unnecessary code
This commit is contained in:
parent
12bd4e9c45
commit
d2c4f09aa2
|
@ -7,8 +7,8 @@ open Heptagon
|
||||||
(* Iterator fusion *)
|
(* Iterator fusion *)
|
||||||
|
|
||||||
let is_stateful app =
|
let is_stateful app =
|
||||||
match app.a_op with
|
match app.a_op with
|
||||||
| Enode _ -> true
|
| Enode _ -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
|
||||||
(* Functions to temporarily store anonymous nodes*)
|
(* Functions to temporarily store anonymous nodes*)
|
||||||
|
@ -88,7 +88,7 @@ let mk_call app acc_eq_list =
|
||||||
| _ ->
|
| _ ->
|
||||||
(*more than one output, we need to create a new equation *)
|
(*more than one output, we need to create a new equation *)
|
||||||
let eq = mk_equation ~stateful:(is_stateful app)
|
let eq = mk_equation ~stateful:(is_stateful app)
|
||||||
(Eeq(pat_of_vd_list new_outp, e)) in
|
(Eeq(pat_of_vd_list new_outp, e)) in
|
||||||
let e = tuple_of_vd_list new_outp in
|
let e = tuple_of_vd_list new_outp in
|
||||||
new_inp, e, eq::acc_eq_list
|
new_inp, e, eq::acc_eq_list
|
||||||
|
|
||||||
|
@ -125,11 +125,11 @@ let edesc funs acc ed =
|
||||||
let _, outp = get_node_inp_outp f in
|
let _, outp = get_node_inp_outp f in
|
||||||
let f_out_type = Types.prod (List.map (fun v -> v.v_type) outp) in
|
let f_out_type = Types.prod (List.map (fun v -> v.v_type) outp) in
|
||||||
let call = mk_exp (Eapp(f, largs, None)) f_out_type in
|
let call = mk_exp (Eapp(f, largs, None)) f_out_type in
|
||||||
let eq = mk_equation ~stateful:(is_stateful f)
|
let eq = mk_equation ~stateful:(is_stateful f)
|
||||||
(Eeq(pat_of_vd_list outp, call)) in
|
(Eeq(pat_of_vd_list outp, call)) in
|
||||||
(* create the lambda *)
|
(* create the lambda *)
|
||||||
let anon = mk_app
|
let anon = mk_app
|
||||||
(Enode (add_anon_node inp outp [] (eq::acc_eq_list))) in
|
(Enode (add_anon_node inp outp [] (eq::acc_eq_list))) in
|
||||||
Eiterator(Imap, anon, n, [], args, r), acc)
|
Eiterator(Imap, anon, n, [], args, r), acc)
|
||||||
else
|
else
|
||||||
ed, acc
|
ed, acc
|
||||||
|
|
|
@ -33,7 +33,7 @@ struct
|
||||||
raise Errors.Error
|
raise Errors.Error
|
||||||
end
|
end
|
||||||
|
|
||||||
let is_stateful e = match e.e_desc with
|
let is_stateful e = match e.e_desc with
|
||||||
| Efby _ | Epre _ -> true
|
| Efby _ | Epre _ -> true
|
||||||
| Eapp({ a_op = Enode _ }, _, _) -> true
|
| Eapp({ a_op = Enode _ }, _, _) -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
@ -44,8 +44,8 @@ let exp_list_of_static_exp_list se_list =
|
||||||
in
|
in
|
||||||
List.map mk_one_const se_list
|
List.map mk_one_const se_list
|
||||||
|
|
||||||
let is_list e = match e.e_desc with
|
let is_list e = match e.e_desc with
|
||||||
| Eapp({ a_op = Etuple }, _, _)
|
| Eapp({ a_op = Etuple }, _, _)
|
||||||
| Econst { se_desc = Stuple _ } -> true
|
| Econst { se_desc = Stuple _ } -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
|
||||||
|
@ -62,7 +62,7 @@ let flatten_e_list l =
|
||||||
in
|
in
|
||||||
List.flatten (List.map flatten l)
|
List.flatten (List.map flatten l)
|
||||||
|
|
||||||
(** Creates a new equation x = e, adds x to d_list
|
(** Creates a new equation x = e, adds x to d_list
|
||||||
and the equation to eq_list. *)
|
and the equation to eq_list. *)
|
||||||
let equation (d_list, eq_list) e =
|
let equation (d_list, eq_list) e =
|
||||||
let add_one_var ty d_list =
|
let add_one_var ty d_list =
|
||||||
|
@ -76,15 +76,15 @@ let equation (d_list, eq_list) e =
|
||||||
mapfold (fun d_list ty -> add_one_var ty d_list) d_list ty_list in
|
mapfold (fun d_list ty -> add_one_var ty d_list) d_list ty_list in
|
||||||
let pat_list = List.map (fun n -> Evarpat n) var_list in
|
let pat_list = List.map (fun n -> Evarpat n) var_list in
|
||||||
let eq_list = (mk_equation ~stateful:(is_stateful e)
|
let eq_list = (mk_equation ~stateful:(is_stateful e)
|
||||||
(Eeq (Etuplepat pat_list, e))) :: eq_list in
|
(Eeq (Etuplepat pat_list, e))) :: eq_list in
|
||||||
let e_list = List.map2
|
let e_list = List.map2
|
||||||
(fun n ty -> mk_exp (Evar n) ty) var_list ty_list in
|
(fun n ty -> mk_exp (Evar n) ty) var_list ty_list in
|
||||||
let e = Eapp(mk_app Etuple, e_list, None) in
|
let e = Eapp(mk_app Etuple, e_list, None) in
|
||||||
(d_list, eq_list), e
|
(d_list, eq_list), e
|
||||||
| _ ->
|
| _ ->
|
||||||
let n, d_list = add_one_var e.e_ty d_list in
|
let n, d_list = add_one_var e.e_ty d_list in
|
||||||
let eq_list = (mk_equation ~stateful:(is_stateful e)
|
let eq_list = (mk_equation ~stateful:(is_stateful e)
|
||||||
(Eeq (Evarpat n, e))) :: eq_list in
|
(Eeq (Evarpat n, e))) :: eq_list in
|
||||||
(d_list, eq_list), Evar n
|
(d_list, eq_list), Evar n
|
||||||
|
|
||||||
(* [(e1,...,ek) when C(n) = (e1 when C(n),...,ek when C(n))] *)
|
(* [(e1,...,ek) when C(n) = (e1 when C(n),...,ek when C(n))] *)
|
||||||
|
@ -110,7 +110,7 @@ let add context expected_kind ({ e_desc = de } as e) =
|
||||||
if up then
|
if up then
|
||||||
let context, n = equation context e in
|
let context, n = equation context e in
|
||||||
context, { e with e_desc = n }
|
context, { e with e_desc = n }
|
||||||
else
|
else
|
||||||
context, e
|
context, e
|
||||||
|
|
||||||
let rec translate kind context e =
|
let rec translate kind context e =
|
||||||
|
@ -120,17 +120,17 @@ let rec translate kind context e =
|
||||||
| Epre(v, e1) -> fby kind context e v e1
|
| Epre(v, e1) -> fby kind context e v e1
|
||||||
| Efby({ e_desc = Econst v }, e1) -> fby kind context e (Some v) e1
|
| Efby({ e_desc = Econst v }, e1) -> fby kind context e (Some v) e1
|
||||||
| Estruct l ->
|
| Estruct l ->
|
||||||
let translate_field context (f, e) =
|
let translate_field context (f, e) =
|
||||||
let context, e = translate ExtValue context e in
|
let context, e = translate ExtValue context e in
|
||||||
(f, e), context
|
(f, e), context
|
||||||
in
|
in
|
||||||
let l, context = mapfold translate_field context l in
|
let l, context = mapfold translate_field context l in
|
||||||
context, { e with e_desc = Estruct l }
|
context, { e with e_desc = Estruct l }
|
||||||
| Ewhen(e1, c, n) ->
|
| Ewhen(e1, c, n) ->
|
||||||
let context, e1 = translate kind context e1 in
|
let context, e1 = translate kind context e1 in
|
||||||
whenc context e1 c n
|
whenc context e1 c n
|
||||||
| Emerge(n, tag_e_list) ->
|
| Emerge(n, tag_e_list) ->
|
||||||
merge context e n tag_e_list
|
merge context e n tag_e_list
|
||||||
| Eapp({ a_op = Eifthenelse }, [e1; e2; e3], _) ->
|
| Eapp({ a_op = Eifthenelse }, [e1; e2; e3], _) ->
|
||||||
ifthenelse context e e1 e2 e3
|
ifthenelse context e e1 e2 e3
|
||||||
| Eapp(app, e_list, r) ->
|
| Eapp(app, e_list, r) ->
|
||||||
|
@ -140,19 +140,19 @@ let rec translate kind context e =
|
||||||
(* normalize anonymous nodes *)
|
(* normalize anonymous nodes *)
|
||||||
(match app.a_op with
|
(match app.a_op with
|
||||||
| Enode f when Itfusion.is_anon_node f ->
|
| Enode f when Itfusion.is_anon_node f ->
|
||||||
let nd = Itfusion.find_anon_node f in
|
let nd = Itfusion.find_anon_node f in
|
||||||
let d_list, eq_list =
|
let d_list, eq_list =
|
||||||
translate_eq_list nd.n_block.b_local nd.n_block.b_equs in
|
translate_eq_list nd.n_block.b_local nd.n_block.b_equs in
|
||||||
let b = { nd.n_block with b_local = d_list; b_equs = eq_list } in
|
let b = { nd.n_block with b_local = d_list; b_equs = eq_list } in
|
||||||
let nd = { nd with n_block = b } in
|
let nd = { nd with n_block = b } in
|
||||||
Itfusion.replace_anon_node f nd
|
Itfusion.replace_anon_node f nd
|
||||||
| _ -> () );
|
| _ -> () );
|
||||||
let context, pe_list = translate_list ExtValue context pe_list in
|
let context, pe_list = translate_list ExtValue context pe_list in
|
||||||
let context, e_list = translate_list ExtValue context e_list in
|
let context, e_list = translate_list ExtValue context e_list in
|
||||||
context, { e with e_desc = Eiterator(it, app, n, flatten_e_list pe_list,
|
context, { e with e_desc = Eiterator(it, app, n, flatten_e_list pe_list,
|
||||||
flatten_e_list e_list, reset) }
|
flatten_e_list e_list, reset) }
|
||||||
| Elast _ | Efby _ ->
|
| Elast _ | Efby _ ->
|
||||||
Error.message e.e_loc Error.Eunsupported_language_construct
|
Error.message e.e_loc Error.Eunsupported_language_construct
|
||||||
in add context kind e
|
in add context kind e
|
||||||
|
|
||||||
and translate_list kind context e_list =
|
and translate_list kind context e_list =
|
||||||
|
@ -191,16 +191,16 @@ and fby kind context e v e1 =
|
||||||
translate kind context e
|
translate kind context e
|
||||||
| _ -> context, { e with e_desc = Epre(v, e1) }
|
| _ -> context, { e with e_desc = Epre(v, e1) }
|
||||||
|
|
||||||
(** transforms [if x then e1, ..., en else e'1,..., e'n]
|
(** transforms [if x then e1, ..., en else e'1,..., e'n]
|
||||||
into [if x then e1 else e'1, ..., if x then en else e'n] *)
|
into [if x then e1 else e'1, ..., if x then en else e'n] *)
|
||||||
and ifthenelse context e e1 e2 e3 =
|
and ifthenelse context e e1 e2 e3 =
|
||||||
let context, e1 = translate ExtValue context e1 in
|
let context, e1 = translate ExtValue context e1 in
|
||||||
let context, e2 = translate ExtValue context e2 in
|
let context, e2 = translate ExtValue context e2 in
|
||||||
let context, e3 = translate ExtValue context e3 in
|
let context, e3 = translate ExtValue context e3 in
|
||||||
let mk_ite_list e2_list e3_list =
|
let mk_ite_list e2_list e3_list =
|
||||||
let mk_ite e2 e3 =
|
let mk_ite e2 e3 =
|
||||||
mk_exp ~loc:e.e_loc
|
mk_exp ~loc:e.e_loc
|
||||||
(Eapp (mk_app Eifthenelse, [e1; e2; e3], None)) e2.e_ty
|
(Eapp (mk_app Eifthenelse, [e1; e2; e3], None)) e2.e_ty
|
||||||
in
|
in
|
||||||
let e_list = List.map2 mk_ite e2_list e3_list in
|
let e_list = List.map2 mk_ite e2_list e3_list in
|
||||||
{ e with e_desc = Eapp(mk_app Etuple, e_list, None) }
|
{ e with e_desc = Eapp(mk_app Etuple, e_list, None) }
|
||||||
|
@ -220,46 +220,41 @@ and merge context e x c_e_list =
|
||||||
let mk_merge x c_list e_list =
|
let mk_merge x c_list e_list =
|
||||||
let ty = (List.hd e_list).e_ty in
|
let ty = (List.hd e_list).e_ty in
|
||||||
let t_e_list = List.map2 (fun t e -> (t,e)) c_list e_list in
|
let t_e_list = List.map2 (fun t e -> (t,e)) c_list e_list in
|
||||||
mk_exp ~loc:e.e_loc (Emerge(x, t_e_list)) ty
|
mk_exp ~loc:e.e_loc (Emerge(x, t_e_list)) ty
|
||||||
in
|
in
|
||||||
let context, x = translate ExtValue context x in
|
let context, x = translate ExtValue context x in
|
||||||
let c_e_list, context = mapfold translate_tag context c_e_list in
|
let c_e_list, context = mapfold translate_tag context c_e_list in
|
||||||
match c_e_list with
|
match c_e_list with
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| (_,e)::_ ->
|
| (_,e)::_ ->
|
||||||
if is_list e then (
|
if is_list e then (
|
||||||
let c_list = List.map (fun (t,_) -> t) c_e_list in
|
let c_list = List.map (fun (t,_) -> t) c_e_list in
|
||||||
let e_lists = List.map (fun (_,e) -> e_to_e_list e) c_e_list in
|
let e_lists = List.map (fun (_,e) -> e_to_e_list e) c_e_list in
|
||||||
let e_list = List.map (mk_merge x c_list) e_lists in
|
let e_list = List.map (mk_merge x c_list) e_lists in
|
||||||
context, { e with e_desc = Eapp(mk_app Etuple, e_list, None) }
|
context, { e with e_desc = Eapp(mk_app Etuple, e_list, None) }
|
||||||
) else
|
) else
|
||||||
context, { e with e_desc = Emerge(x, c_e_list) }
|
context, { e with e_desc = Emerge(x, c_e_list) }
|
||||||
|
|
||||||
(* applies distribution rules *)
|
(* applies distribution rules *)
|
||||||
(* [x = v fby e] should verifies that x is local *)
|
|
||||||
(* [(p1,...,pn) = (e1,...,en)] into [p1 = e1;...;pn = en] *)
|
(* [(p1,...,pn) = (e1,...,en)] into [p1 = e1;...;pn = en] *)
|
||||||
and distribute ((d_list, eq_list) as context) eq pat e =
|
and distribute ((d_list, eq_list) as context) eq pat e =
|
||||||
match pat, e.e_desc with
|
match pat, e.e_desc with
|
||||||
| Evarpat(x), Efby _ when not (vd_mem x d_list) ->
|
|
||||||
let (d_list, eq_list), n = equation context e in
|
|
||||||
let eq = { eq with eq_desc = Eeq(pat, { e with e_desc = n }) } in
|
|
||||||
d_list, eq::eq_list
|
|
||||||
| Etuplepat(pat_list), Eapp({ a_op = Etuple }, e_list, _) ->
|
| Etuplepat(pat_list), Eapp({ a_op = Etuple }, e_list, _) ->
|
||||||
let mk_eq pat e =
|
let mk_eq pat e =
|
||||||
mk_equation ~stateful:eq.eq_stateful (Eeq (pat, e))
|
mk_equation ~stateful:eq.eq_stateful (Eeq (pat, e))
|
||||||
in
|
in
|
||||||
let dis context eq = match eq.eq_desc with
|
let dis context eq = match eq.eq_desc with
|
||||||
| Eeq (pat, e) -> distribute context eq pat e
|
| Eeq (pat, e) -> distribute context eq pat e
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
in
|
in
|
||||||
let eqs = List.map2 mk_eq pat_list e_list in
|
let eqs = List.map2 mk_eq pat_list e_list in
|
||||||
List.fold_left dis context eqs
|
List.fold_left dis context eqs
|
||||||
| _ -> d_list, eq :: eq_list
|
| _ -> d_list, eq :: eq_list
|
||||||
|
|
||||||
and translate_eq context eq = match eq.eq_desc with
|
and translate_eq context eq = match eq.eq_desc with
|
||||||
| Eeq (pat, e) ->
|
| Eeq (pat, e) ->
|
||||||
let context, e = translate Any context e in
|
let context, e = translate Any context e in
|
||||||
distribute context eq pat e
|
distribute context eq pat e
|
||||||
| _ -> raise Errors.Fallback
|
| _ -> raise Errors.Fallback
|
||||||
|
|
||||||
and translate_eq_list d_list eq_list =
|
and translate_eq_list d_list eq_list =
|
||||||
|
|
Loading…
Reference in a new issue