Ported Normalize (not tested yet)
This commit is contained in:
Cédric Pasteur
parent
c657ce8ecb
commit
a188952ef6
|
|
@ -17,13 +17,9 @@ let compile pp p =
|
|||
(*let p = do_silent_pass Init.program "Initialization check" p !init in *)
|
||||
|
||||
(* Normalization to maximize opportunities *)
|
||||
(*let p = do_pass Normalize.program "Normalization" p pp true in*)
|
||||
let p = do_pass Normalize.program "Normalization" p pp true in
|
||||
|
||||
(* Scheduling *)
|
||||
let p = do_pass Schedule.program "Scheduling" p pp true in
|
||||
|
||||
(* Parametrized functions instantiation *)
|
||||
(*let p = do_pass Callgraph_mapfold.program
|
||||
"Parametrized functions instantiation" p pp true in *)
|
||||
|
||||
p
|
||||
|
|
|
|||
|
|
@ -35,13 +35,14 @@ let rec whenc context e c n =
|
|||
{ e with e_desc = Ewhen(e, c, n); e_ck = Con(e.e_ck, c, n) } in
|
||||
|
||||
match e.e_desc with
|
||||
| Etuple(e_list) ->
|
||||
| Eapp({ a_op = Etuple } as app, e_list, r) ->
|
||||
let context, e_list =
|
||||
List.fold_right
|
||||
(fun e (context, e_list) -> let context, e = whenc context e c n in
|
||||
(context, e :: e_list))
|
||||
e_list (context, []) in
|
||||
context, { e with e_desc = Etuple(e_list); e_ck = Con(e.e_ck, c, n) }
|
||||
context, { e with e_desc = Eapp (app, e_list, r);
|
||||
e_ck = Con(e.e_ck, c, n) }
|
||||
(* | Emerge _ -> let context, x = equation context e in
|
||||
context, when_on_c c n { e with e_desc = Evar(x) } *)
|
||||
| _ -> context, when_on_c c n e
|
||||
|
|
@ -70,7 +71,7 @@ let rec merge e x ci_a_list =
|
|||
let rec erasetuple ci_a_list =
|
||||
match ci_a_list with
|
||||
| [] -> []
|
||||
| (ci, { e_desc = Etuple(l) }) :: ci_a_list ->
|
||||
| (ci, { e_desc = Eapp({ a_op = Etuple }, l, _) }) :: ci_a_list ->
|
||||
(ci, false, l) :: erasetuple ci_a_list
|
||||
| (ci, e) :: ci_a_list ->
|
||||
(ci, true, [e]) :: erasetuple ci_a_list in
|
||||
|
|
@ -78,13 +79,13 @@ let rec merge e x ci_a_list =
|
|||
let ci_tas_list = distribute ci_tas_list in
|
||||
match ci_tas_list with
|
||||
| [e] -> e
|
||||
| l -> { e with e_desc = Etuple(l) }
|
||||
| l -> { e with e_desc = Eapp(mk_app Etuple, l, None) }
|
||||
|
||||
let ifthenelse context e1 e2 e3 =
|
||||
let context, n = intro context e1 in
|
||||
let context, e2 = whenc context e2 ctrue n in
|
||||
let context, e3 = whenc context e3 cfalse n in
|
||||
context, merge e1 n [ctrue, e2; cfalse, e3]
|
||||
context, merge e1 n [ctrue, e2; cfalse, e3]
|
||||
|
||||
let const e c =
|
||||
let rec const = function
|
||||
|
|
@ -105,20 +106,19 @@ let function_args_kind = Exp
|
|||
let merge_kind = Act
|
||||
|
||||
let rec constant e = match e.e_desc with
|
||||
| Econst _ | Econstvar _ -> true
|
||||
| Econst _ -> true
|
||||
| Ewhen(e, _, _) -> constant e
|
||||
| Evar _ -> true
|
||||
| _ -> false
|
||||
|
||||
let add context expected_kind ({ e_desc = de } as e) =
|
||||
let up = match de, expected_kind with
|
||||
| (Evar _ | Efield _ ) , VRef -> false
|
||||
| (Evar _ | Eapp ({ a_op = Efield }, _, _)) , VRef -> false
|
||||
| _ , VRef -> true
|
||||
| Ecall ({ op_kind = Efun; op_name = n }, _, _),
|
||||
| Eapp ({ a_op = Efun n }, _, _),
|
||||
(Exp|Act) when is_op n -> false
|
||||
| ( Emerge _ | Etuple _
|
||||
| Ecall _ | Efby _ | Earray_op _ ), Exp -> true
|
||||
| ( Ecall _ | Efby _ ), Act -> true
|
||||
| ( Emerge _ | Eapp _ | Efby _ ), Exp -> true
|
||||
| ( Eapp({ a_op = Efun _ | Enode _ }, _, _) | Efby _ ), Act -> true
|
||||
| _ -> false in
|
||||
if up then
|
||||
let context, n = equation context e in
|
||||
|
|
@ -135,21 +135,9 @@ let rec translate kind context e =
|
|||
context, ((tag, act) :: ta_list))
|
||||
tag_e_list (context, []) in
|
||||
context, merge e n ta_list
|
||||
| Eifthenelse(e1, e2, e3) ->
|
||||
let context, e1 = translate Any context e1 in
|
||||
let context, e2 = translate Act context e2 in
|
||||
let context, e3 = translate Act context e3 in
|
||||
ifthenelse context e1 e2 e3
|
||||
| Etuple(e_list) ->
|
||||
let context, e_list = translate_list kind context e_list in
|
||||
context, { e with e_desc = Etuple(e_list) }
|
||||
| Ewhen(e1, c, n) ->
|
||||
let context, e1 = translate kind context e1 in
|
||||
whenc context e1 c n
|
||||
| Ecall(op_desc, e_list, r) ->
|
||||
let context, e_list =
|
||||
translate_list function_args_kind context e_list in
|
||||
context, { e with e_desc = Ecall(op_desc, e_list, r) }
|
||||
| Efby(v, e1) ->
|
||||
let context, e1 = translate Exp context e1 in
|
||||
let context, e1' =
|
||||
|
|
@ -158,11 +146,7 @@ let rec translate kind context e =
|
|||
context, { e1 with e_desc = Evar(n) } in
|
||||
context, { e with e_desc = Efby(v, e1') }
|
||||
| Evar _ -> context, e
|
||||
| Econst(c) -> context, { e with e_desc = const e (Econst c) }
|
||||
| Econstvar x -> context, { e with e_desc = const e (Econstvar x) }
|
||||
| Efield(e', field) ->
|
||||
let context, e' = translate Exp context e' in
|
||||
context, { e with e_desc = Efield(e', field) }
|
||||
| Econst c -> context, { e with e_desc = const e (Econst c) }
|
||||
| Estruct(l) ->
|
||||
let context, l =
|
||||
List.fold_right
|
||||
|
|
@ -171,46 +155,61 @@ let rec translate kind context e =
|
|||
context, ((field, e) :: field_desc_list))
|
||||
l (context, []) in
|
||||
context, { e with e_desc = Estruct l }
|
||||
| Efield_update (f, e1, e2) ->
|
||||
let context, e1 = translate VRef context e1 in
|
||||
let context, e2 = translate Exp context e2 in
|
||||
context, { e with e_desc = Efield_update(f, e1, e2) }
|
||||
| Earray(e_list) ->
|
||||
let context, e_list = translate_list kind context e_list in
|
||||
context, { e with e_desc = Earray(e_list) }
|
||||
| Earray_op op ->
|
||||
let context, op = translate_array_exp kind context op in
|
||||
context, { e with e_desc = Earray_op op }
|
||||
| Eapp({ a_op = Eifthenelse }, [e1; e2; e3], _) ->
|
||||
let context, e1 = translate Any context e1 in
|
||||
let context, e2 = translate Act context e2 in
|
||||
let context, e2 = translate Act context e3 in
|
||||
ifthenelse context e1 e2 e3
|
||||
| Eapp(app, e_list, r) ->
|
||||
let context, e_list = translate_app kind context app.a_op e_list in
|
||||
context, { e with e_desc = Eapp(app, e_list, r) }
|
||||
| Eiterator (it, app, n, e_list, reset) ->
|
||||
let context, e_list =
|
||||
translate_list function_args_kind context e_list in
|
||||
context, { e with e_desc = Eiterator(it, app, n, e_list, reset) }
|
||||
in add context kind e
|
||||
|
||||
and translate_array_exp kind context op =
|
||||
match op with
|
||||
| Erepeat (n,e') ->
|
||||
and translate_app kind context op e_list =
|
||||
match op, e_list with
|
||||
| (Efun _ | Enode _), e_list ->
|
||||
let context, e_list =
|
||||
translate_list function_args_kind context e_list in
|
||||
context, e_list
|
||||
| Etuple, e_list ->
|
||||
let context, e_list = translate_list kind context e_list in
|
||||
context, e_list
|
||||
| Efield, [e'] ->
|
||||
let context, e' = translate Exp context e' in
|
||||
context, [e']
|
||||
| Efield_update, [e1; e2] ->
|
||||
let context, e1 = translate VRef context e1 in
|
||||
let context, e2 = translate Exp context e2 in
|
||||
context, [e1; e2]
|
||||
| Earray, e_list ->
|
||||
let context, e_list = translate_list kind context e_list in
|
||||
context, e_list
|
||||
| Earray_fill, [e] ->
|
||||
let context, e = translate VRef context e in
|
||||
context, [e]
|
||||
| Eselect, [e'] ->
|
||||
let context, e' = translate VRef context e' in
|
||||
context, Erepeat(n, e')
|
||||
| Eselect (idx,e') ->
|
||||
let context, e' = translate VRef context e' in
|
||||
context, Eselect(idx, e')
|
||||
| Eselect_dyn (idx, e1, e2) ->
|
||||
context, [e']
|
||||
| Eselect_dyn, e1::e2::idx ->
|
||||
let context, e1 = translate VRef context e1 in
|
||||
let context, idx = translate_list Exp context idx in
|
||||
let context, e2 = translate Exp context e2 in
|
||||
context, Eselect_dyn(idx, e1, e2)
|
||||
| Eupdate (idx, e1, e2) ->
|
||||
context, e1::e2::idx
|
||||
| Eupdate, [e1; e2] ->
|
||||
let context, e1 = translate VRef context e1 in
|
||||
let context, e2 = translate Exp context e2 in
|
||||
context, Eupdate(idx, e1, e2)
|
||||
| Eselect_slice (idx1, idx2, e') ->
|
||||
context, [e1; e2]
|
||||
| Eselect_slice, [e'] ->
|
||||
let context, e' = translate VRef context e' in
|
||||
context, Eselect_slice(idx1, idx2, e')
|
||||
| Econcat (e1, e2) ->
|
||||
context, [e']
|
||||
| Econcat, [e1; e2] ->
|
||||
let context, e1 = translate VRef context e1 in
|
||||
let context, e2 = translate VRef context e2 in
|
||||
context, Econcat(e1, e2)
|
||||
| Eiterator (it, op_desc, n, e_list, reset) ->
|
||||
let context, e_list =
|
||||
translate_list function_args_kind context e_list in
|
||||
context, Eiterator(it, op_desc, n, e_list, reset)
|
||||
context, [e1; e2]
|
||||
|
||||
and translate_list kind context e_list =
|
||||
match e_list with
|
||||
|
|
@ -231,7 +230,7 @@ let rec translate_eq context eq =
|
|||
let (d_list, eq_list), n = equation context e in
|
||||
d_list,
|
||||
{ eq with eq_rhs = { e with e_desc = Evar n } } :: eq_list
|
||||
| Etuplepat(pat_list), Etuple(e_list) ->
|
||||
| Etuplepat(pat_list), Eapp({ a_op = Etuple }, e_list, _) ->
|
||||
let eqs = List.map2 mk_equation pat_list e_list in
|
||||
List.fold_left distribute context eqs
|
||||
| _ -> d_list, eq :: eq_list in
|
||||
|
|
|
|||
Loading…
Reference in a new issue