diff --git a/compiler/minils/main/mls_compiler.ml b/compiler/minils/main/mls_compiler.ml index 95a1fd6..bfbe40b 100644 --- a/compiler/minils/main/mls_compiler.ml +++ b/compiler/minils/main/mls_compiler.ml @@ -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 diff --git a/compiler/minils/transformations/normalize.ml b/compiler/minils/transformations/normalize.ml index ab88e97..30ccfd6 100644 --- a/compiler/minils/transformations/normalize.ml +++ b/compiler/minils/transformations/normalize.ml @@ -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