mls2obc.ml 33.7 KB
Newer Older
1 2 3 4 5 6 7 8
(***********************************************************************)
(*                                                                     *)
(*                             Heptagon                                *)
(*                                                                     *)
(* Gwenael Delaval, LIG/INRIA, UJF                                     *)
(* Leonard Gerard, Parkas, ENS                                         *)
(* Adrien Guatto, Parkas, ENS                                          *)
(* Cedric Pasteur, Parkas, ENS                                         *)
Gwenaël Delaval's avatar
Gwenaël Delaval committed
9
(* Marc Pouzet, Parkas, ENS                                            *)
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
(*                                                                     *)
(* Copyright 2012 ENS, INRIA, UJF                                      *)
(*                                                                     *)
(* This file is part of the Heptagon compiler.                         *)
(*                                                                     *)
(* Heptagon is free software: you can redistribute it and/or modify it *)
(* under the terms of the GNU General Public License as published by   *)
(* the Free Software Foundation, either version 3 of the License, or   *)
(* (at your option) any later version.                                 *)
(*                                                                     *)
(* Heptagon is distributed in the hope that it will be useful,         *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
(* GNU General Public License for more details.                        *)
(*                                                                     *)
(* You should have received a copy of the GNU General Public License   *)
(* along with Heptagon.  If not, see <http://www.gnu.org/licenses/>    *)
(*                                                                     *)
(***********************************************************************)
Adrien Guatto's avatar
Adrien Guatto committed
29

Cédric Pasteur's avatar
Cédric Pasteur committed
30
(* Translation from Minils to Obc. *)
Adrien Guatto's avatar
Adrien Guatto committed
31
open Misc
Cédric Pasteur's avatar
Cédric Pasteur committed
32
open Names
33
open Idents
Cédric Pasteur's avatar
Cédric Pasteur committed
34
open Signature
Adrien Guatto's avatar
Adrien Guatto committed
35
open Obc
Léonard Gérard's avatar
Léonard Gérard committed
36 37
open Obc_utils
open Obc_mapfold
38
open Types
39
open Clocks
40 41
open Initial

Cédric Pasteur's avatar
Cédric Pasteur committed
42 43 44 45

let build_anon, find_anon =
  let anon_nodes = ref QualEnv.empty in
  let build_anon nodes =
Leonard Gerard's avatar
Leonard Gerard committed
46
    let build env nd = match nd with
Léonard Gérard's avatar
Léonard Gérard committed
47
      | Minils.Pnode nd ->
Leonard Gerard's avatar
Leonard Gerard committed
48 49 50
          if Itfusion.is_anon_node nd.Minils.n_name
          then QualEnv.add nd.Minils.n_name nd env
          else env
Léonard Gérard's avatar
Léonard Gérard committed
51
      | _ -> env
Cédric Pasteur's avatar
Cédric Pasteur committed
52
    in
Leonard Gerard's avatar
Leonard Gerard committed
53
    anon_nodes := List.fold_left build QualEnv.empty nodes
Cédric Pasteur's avatar
Cédric Pasteur committed
54
  in
Leonard Gerard's avatar
Leonard Gerard committed
55 56
  let find_anon qn = QualEnv.find qn !anon_nodes in
  build_anon, find_anon
Cédric Pasteur's avatar
Cédric Pasteur committed
57

58 59 60 61
let var_from_name map x =
  begin try
    Env.find x map
  with
Adrien Guatto's avatar
Adrien Guatto committed
62 63 64 65 66
      _ ->
        Format.eprintf
          "Internal compiler error: unknown identifier %a@."
          Global_printer.print_ident x;
        assert false
67
  end
68

69
let ext_value_exp_from_name map x = exp_of_pattern (var_from_name map x)
70 71 72

(* let lvar_from_name map ty x = mk_pattern ty (Lvar (var_from_name map x)) *)

Léonard Gérard's avatar
again  
Léonard Gérard committed
73 74 75
let fresh_it () =
  let id = Idents.gen_var "mls2obc" "i" in
  id, mk_var_dec id Initial.tint
76

Léonard Gérard's avatar
Léonard Gérard committed
77
let gen_obj_ident n = Idents.gen_var "mls2obc" ((shortname n) ^ "_inst")
78
let fresh_for = fresh_for "mls2obc"
79
(*let copy_array = copy_array "mls2obc"*)
80

Léonard Gérard's avatar
Léonard Gérard committed
81
let op_from_string op = { qual = Pervasives; name = op; }
82

83
let pattern_of_idx_list p l =
84
  let rec aux p l = match Modules.unalias_type p.pat_ty, l with
Léonard Gérard's avatar
again  
Léonard Gérard committed
85
    | _, [] -> p
86
    | Tarray (ty',_), idx :: l -> aux (mk_pattern ty' (Larray (p, idx))) l
Léonard Gérard's avatar
Léonard Gérard committed
87
    | _ -> internal_error "mls2obc"
Léonard Gérard's avatar
again  
Léonard Gérard committed
88
  in
89
  aux p l
90

Cédric Pasteur's avatar
Cédric Pasteur committed
91
let rec exp_of_idx_list e l = match Modules.unalias_type e.w_ty, l with
92 93 94
  | _, [] -> e
  | Tarray (ty',_), idx :: l ->
    exp_of_idx_list (mk_ext_value ty' (Warray (e, idx))) l
Cédric Pasteur's avatar
Cédric Pasteur committed
95
  | _ -> internal_error "mls2obc exp_of_idx_list"
96

Cédric Pasteur's avatar
Cédric Pasteur committed
97
let rec extvalue_of_idx_list w l = match Modules.unalias_type w.w_ty, l with
98 99 100
  | _, [] -> w
  | Tarray (ty',_), idx :: l ->
    extvalue_of_idx_list (mk_ext_value ty' (Warray (w, idx))) l
Cédric Pasteur's avatar
Cédric Pasteur committed
101
  | _ -> internal_error "mls2obc extvalue_of_idx_list"
102

103
let ext_value_of_trunc_idx_list p l =
104
  let mk_between idx se =
105
    mk_exp_int (Eop (mk_pervasives "between", [idx; mk_ext_value_exp se.se_ty (Wconst se)]))
106
  in
107
  let rec aux p l = match Modules.unalias_type p.w_ty, l with
108
    | _, [] -> p
109
    | Tarray (ty', se), idx :: l -> aux (mk_ext_value ty' (Warray (p, mk_between idx se))) l
Cédric Pasteur's avatar
Cédric Pasteur committed
110
    | _ -> internal_error "mls2obc ext_value_of_trunc_idx_list"
111
  in
112
  aux p l
113

114 115
let rec ty_of_idx_list ty idx_list = match ty, idx_list with
  | _, [] -> ty
116
  | Tarray(ty, _), _idx::idx_list -> ty_of_idx_list ty idx_list
117 118 119 120 121 122 123 124
  | _, _ -> internal_error "mls2obc ty_of_idx_list"

let mk_static_array_power ty c params = match params with
  | [] -> mk_ext_value_exp ty (Wconst c)
  | _ ->
    let se = mk_static_exp ty (Sarray_power (c, params)) in
    mk_ext_value_exp ty (Wconst se)

125
let array_elt_of_exp idx e =
Léonard Gérard's avatar
again  
Léonard Gérard committed
126
  match e.e_desc, Modules.unalias_type e.e_ty with
127 128
  | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, _::new_params) }; }, Tarray (ty,_) ->
     mk_static_array_power ty c new_params
129 130
  | _, Tarray (ty,_) ->
      mk_ext_value_exp ty (Warray(ext_value_of_exp e, idx))
Cédric Pasteur's avatar
Cédric Pasteur committed
131
  | _ -> internal_error "mls2obc array_elt_of_exp"
132

133
let array_elt_of_exp_list idx_list e =
134
  match e.e_desc, Modules.unalias_type e.e_ty with
135 136 137 138
    | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, params) } }, Tarray (ty,n) ->
      let new_params, _ = Misc.split_at (List.length params - List.length idx_list) params in
      let ty = ty_of_idx_list (Tarray(ty,n)) idx_list in
      mk_static_array_power ty c new_params
139
    | _ , t ->
Cédric Pasteur's avatar
Cédric Pasteur committed
140
        let rec ty id_l t = match id_l, Modules.unalias_type t with
141 142
          | [] , t -> t
          | _::id_l , Tarray (t,_) -> ty id_l t
Cédric Pasteur's avatar
Cédric Pasteur committed
143
          | _, _ -> internal_error "mls2obc ty"
144 145 146
        in
        mk_exp (ty idx_list t) (Eextvalue (extvalue_of_idx_list (ext_value_of_exp e) idx_list))

147

Cédric Pasteur's avatar
Cédric Pasteur committed
148 149 150
(** Creates the expression that checks that the indices
    in idx_list are in the bounds. If idx_list=[e1;..;ep]
    and bounds = [n1;..;np], it returns
Cédric Pasteur's avatar
Cédric Pasteur committed
151
    0<= e1 < n1 && .. && 0 <= ep < np *)
Cédric Pasteur's avatar
Cédric Pasteur committed
152
let rec bound_check_expr idx_list bounds =
Cédric Pasteur's avatar
Cédric Pasteur committed
153 154
  let mk_comp idx n =
        let e1 = mk_exp_bool (Eop (op_from_string "<",
155
                                 [idx; mk_ext_value_exp_int (Wconst n)])) in
Cédric Pasteur's avatar
Cédric Pasteur committed
156
        let e2 = mk_exp_bool (Eop (op_from_string "<=",
157
                                 [mk_ext_value_exp_int (Wconst (mk_static_int 0)); idx])) in
Cédric Pasteur's avatar
Cédric Pasteur committed
158 159
          mk_exp_bool (Eop (op_from_string "&", [e1;e2]))
  in
Cédric Pasteur's avatar
Cédric Pasteur committed
160
  match (idx_list, bounds) with
161
    | [idx], n::_ -> mk_comp idx n
Adrien Guatto's avatar
Adrien Guatto committed
162
    | (idx :: idx_list, n :: bounds) ->
Cédric Pasteur's avatar
Cédric Pasteur committed
163 164 165
        let e = mk_comp idx n in
          mk_exp_bool (Eop (op_from_string "&",
                           [e; bound_check_expr idx_list bounds]))
Léonard Gérard's avatar
Léonard Gérard committed
166
    | (_, _) -> internal_error "mls2obc"
Adrien Guatto's avatar
Adrien Guatto committed
167

Cédric Pasteur's avatar
Cédric Pasteur committed
168
let mk_plus_one e = match e.e_desc with
169
  | Eextvalue ({ w_desc = Wconst idx } as w) ->
Cédric Pasteur's avatar
Cédric Pasteur committed
170
      let idx_plus_one = mk_static_int_op (mk_pervasives "+") [idx; mk_static_int 1] in
171
        { e with e_desc = Eextvalue { w with w_desc = Wconst idx_plus_one; }; }
Cédric Pasteur's avatar
Cédric Pasteur committed
172 173 174 175
  | _ ->
      let idx_plus_one = Eop (mk_pervasives "+", [e; mk_exp_const_int 1]) in
        { e with e_desc = idx_plus_one }

176 177
(** Creates the action list that copies [src] to [dest],
    updating the value at index [idx_list] with the value [v]. *)
178
let rec ssa_update_array dest src idx_list v = match Modules.unalias_type dest.pat_ty, idx_list with
179 180 181
  | Tarray (t, n), idx::idx_list ->
      (*Body of the copy loops*)
      let copy i =
182
        let src_i = array_elt_of_exp i src in
183
        let dest_i = mk_pattern t (Larray (dest, i)) in
184
        [Aassgn(dest_i, src_i)]
185 186
      in
      (*Copy values < idx*)
Cédric Pasteur's avatar
Cédric Pasteur committed
187
      let a_lower = fresh_for (mk_exp_const_int 0) idx copy in
188
      (* Update the correct element*)
189
      let src_idx = array_elt_of_exp idx src in
Cédric Pasteur's avatar
Cédric Pasteur committed
190
      let dest_idx = mk_pattern t (Larray (dest, idx)) in
191
      let a_update = ssa_update_array dest_idx src_idx idx_list v in
192
      (*Copy values > idx*)
Cédric Pasteur's avatar
Cédric Pasteur committed
193 194
      let idx_plus_one = mk_plus_one idx in
      let a_upper = fresh_for idx_plus_one (mk_exp_static_int n) copy in
195
      [a_lower] @ a_update @ [a_upper]
196 197 198 199 200
  | _, _ ->
      [Aassgn(dest, v)]

(** Creates the action list that copies [src] to [dest],
    updating the value of field [f] with the value [v]. *)
201
let ssa_update_record dest src f v =
202 203
  let assgn_act { f_name = l; f_type = ty } =
    let dest_l = mk_pattern ty (Lfield(dest, l)) in
204
    let src_l = mk_ext_value_exp ty (Wfield(src, l)) in
205 206 207 208 209
    if f = l then
      Aassgn(dest_l, v)
    else
      Aassgn(dest_l, src_l)
  in
210 211
  let fields = match dest.pat_ty with
    | Tid n -> Modules.find_struct n
Léonard Gérard's avatar
Léonard Gérard committed
212
    | _ -> Misc.internal_error "mls2obc field of nonstruct"
213 214
  in
  List.map assgn_act fields
215

216
let rec control map ck s = match ck with
Nicolas Berthier's avatar
Nicolas Berthier committed
217
  | Clocks.Cbase | Cvar { contents = Cindex _ } -> s
218
  | Cvar { contents = Clink ck } -> control map ck s
Nicolas Berthier's avatar
Nicolas Berthier committed
219
  | Clocks.Con(ck, c, n)  ->
220 221
    let x = ext_value_exp_from_name map n in
    control map ck (Acase(x, [(c, mk_block [s])]))
222

223 224
let reinit o =
  Acall ([], o, Mreset, [])
Adrien Guatto's avatar
Adrien Guatto committed
225

226 227 228 229 230
let rec translate_pat map ty pat = match pat, ty with
  | Minils.Evarpat x, _ -> [ var_from_name map x ]
  | Minils.Etuplepat pat_list, Tprod ty_l  ->
      List.fold_right2 (fun ty pat acc -> (translate_pat map ty pat) @ acc)
        ty_l pat_list []
231
  | Minils.Etuplepat _, _ -> Misc.internal_error "Ill-typed pattern"
Adrien Guatto's avatar
Adrien Guatto committed
232

233
let translate_var_dec l =
234 235
  let one_var { Minils.v_ident = x; Minils.v_type = t; Minils.v_linearity = lin; v_loc = loc } =
    mk_var_dec ~loc:loc ~linearity:lin x t
236
  in
Gwenaël Delaval's avatar
Gwenaël Delaval committed
237
  List.rev (List.rev_map one_var l)
238

239 240 241 242 243
let rec translate_extvalue map w = match w.Minils.w_desc with
  | Minils.Wvar x -> ext_value_of_pattern (var_from_name map x)
  | _ ->
    let desc = match w.Minils.w_desc with
      | Minils.Wconst v -> Wconst v
244
      | Minils.Wvar _ -> assert false
245
      | Minils.Wfield (w1, f) -> Wfield (translate_extvalue map w1, f)
Cédric Pasteur's avatar
Cédric Pasteur committed
246
      | Minils.Wwhen (w1, _, _) | Minils.Wreinit(_, w1)  -> (translate_extvalue map w1).w_desc
247 248 249 250 251
    in
    mk_ext_value w.Minils.w_ty desc

and translate_extvalue_to_exp map w =
  mk_exp ~loc:w.Minils.w_loc w.Minils.w_ty (Eextvalue (translate_extvalue map w))
Cédric Pasteur's avatar
Cédric Pasteur committed
252

Adrien Guatto's avatar
Adrien Guatto committed
253
(* [translate e = c] *)
254
let rec translate map e =
255
  let desc = match e.Minils.e_desc with
Cédric Pasteur's avatar
Cédric Pasteur committed
256
    | Minils.Eextvalue w ->
257 258 259
        let w = translate_extvalue map w in Eextvalue w
    | Minils.Eapp ({ Minils.a_op = Minils.Eequal }, w_list, _) ->
      Eop (op_from_string "=", List.map (translate_extvalue_to_exp map) w_list)
Cédric Pasteur's avatar
Cédric Pasteur committed
260 261
    | Minils.Eapp ({ Minils.a_op = Minils.Efun n }, e_list, _)
        when Mls_utils.is_op n ->
262
        Eop (n, List.map (translate_extvalue_to_exp map ) e_list)
Adrien Guatto's avatar
Adrien Guatto committed
263
    | Minils.Estruct f_e_list ->
264 265 266
        let type_name = (match e.Minils.e_ty with
                           | Tid name -> name
                           | _ -> assert false) in
Cédric Pasteur's avatar
Cédric Pasteur committed
267
        let f_e_list = List.map
268
          (fun (f, e) -> (f, (translate_extvalue_to_exp map e))) f_e_list in
269 270
          Estruct (type_name, f_e_list)
  (*Remaining array operators*)
271
    | Minils.Eapp ({ Minils.a_op = Minils.Earray }, e_list, _) ->
272
        Earray (List.map (translate_extvalue_to_exp map ) e_list)
273
    | Minils.Eapp ({ Minils.a_op = Minils.Eselect;
274
                     Minils.a_params = idx_list }, e_list, _) ->
Cédric Pasteur's avatar
Cédric Pasteur committed
275
        let e = translate_extvalue map (assert_1 e_list) in
276 277
        let idx_list = List.map mk_exp_static_int idx_list in
        Eextvalue (extvalue_of_idx_list e idx_list)
278 279 280
    | Minils.Ewhen(e,_,_) ->
        let e = translate map e in
        e.e_desc
281 282
  (* Already treated cases when translating the [eq] *)
    | Minils.Eiterator _ | Minils.Emerge _ | Minils.Efby _
283
    | Minils.Eapp ({Minils.a_op=(Minils.Enode _|Minils.Efun _|Minils.Econcat
284 285 286
                                |Minils.Eupdate|Minils.Eselect_dyn
                                |Minils.Eselect_trunc|Minils.Eselect_slice
                                |Minils.Earray_fill|Minils.Efield_update
Leonard Gerard's avatar
Leonard Gerard committed
287
                                |Minils.Eifthenelse)}, _, _) ->
Léonard Gérard's avatar
Léonard Gérard committed
288
        internal_error "mls2obc"
289
  in
Cédric Pasteur's avatar
Cédric Pasteur committed
290
    mk_exp e.Minils.e_ty desc
Adrien Guatto's avatar
Adrien Guatto committed
291

Cédric Pasteur's avatar
Cédric Pasteur committed
292 293 294
and translate_act_extvalue map pat w =
  match pat with
    | Minils.Evarpat n ->
295
        [Aassgn (var_from_name map n, translate_extvalue_to_exp map w)]
Cédric Pasteur's avatar
Cédric Pasteur committed
296 297
    | _ -> assert false

298
(* [translate pat act = si, d] *)
299
and translate_act map pat
Adrien Guatto's avatar
Adrien Guatto committed
300
    ({ Minils.e_desc = desc } as act) =
301
    match pat, desc with
Léonard Gérard's avatar
Léonard Gérard committed
302
   (* When Merge *)
303
    | pat, Minils.Ewhen (e,_,_) -> translate_act map pat e
Cédric Pasteur's avatar
Cédric Pasteur committed
304 305 306
    | Minils.Evarpat x, Minils.Emerge (y, c_act_list) ->
        let x = var_from_name map x in
        let translate_c_extvalue (c, w) =
307
          c, mk_block [Aassgn (x, translate_extvalue_to_exp map w)]
Cédric Pasteur's avatar
Cédric Pasteur committed
308
        in
309 310 311

        [Acase (ext_value_exp_from_name map y,
                List.map translate_c_extvalue c_act_list)]
Léonard Gérard's avatar
Léonard Gérard committed
312
   (* Array ops *)
Cédric Pasteur's avatar
Cédric Pasteur committed
313 314
    | Minils.Evarpat x,
        Minils.Eapp ({ Minils.a_op = Minils.Econcat }, [e1; e2], _) ->
Léonard Gérard's avatar
again  
Léonard Gérard committed
315 316
        let cpt1, cpt1d = fresh_it () in
        let cpt2, cpt2d = fresh_it () in
317
        let x = var_from_name map x in
318
        let _t = x.pat_ty in
Cédric Pasteur's avatar
Cédric Pasteur committed
319
        (match e1.Minils.w_ty, e2.Minils.w_ty with
Léonard Gérard's avatar
again  
Léonard Gérard committed
320
           | Tarray (t1, n1), Tarray (t2, n2) ->
321 322
               let e1 = translate_extvalue_to_exp map e1 in
               let e2 = translate_extvalue_to_exp map e2 in
323
               let a1 =
Cédric Pasteur's avatar
Cédric Pasteur committed
324
                 Afor (cpt1d, mk_exp_const_int 0, mk_exp_static_int n1,
Cédric Pasteur's avatar
Cédric Pasteur committed
325
                      mk_block [Aassgn (mk_pattern t1 (Larray (x, mk_evar_int cpt1)),
326
                                       array_elt_of_exp (mk_evar_int cpt1) e1)] ) in
Cédric Pasteur's avatar
Cédric Pasteur committed
327
               let idx = mk_exp_int (Eop (op_from_string "+",
328
                                         [ mk_exp_static_int n1; mk_evar_int cpt2])) in
329
               let p2 = array_elt_of_exp (mk_evar_int cpt2) e2 in
Cédric Pasteur's avatar
Cédric Pasteur committed
330
               let a2 = Afor (cpt2d, mk_exp_const_int 0, mk_exp_static_int n2,
Cédric Pasteur's avatar
Cédric Pasteur committed
331
                             mk_block [Aassgn (mk_pattern t2 (Larray (x, idx)), p2)] )
332 333
               in
               [a1; a2]
Cédric Pasteur's avatar
Cédric Pasteur committed
334 335 336
           | _ -> assert false)

    | Minils.Evarpat x,
337
          Minils.Eapp ({ Minils.a_op = Minils.Earray_fill; Minils.a_params = n_list }, [e], _) ->
338
        let e = translate_extvalue_to_exp map e in
339
        let x = var_from_name map x in
Léonard Gérard's avatar
blop  
Léonard Gérard committed
340 341
        let t = match x.pat_ty with
          | Tarray (t,_) -> t
Léonard Gérard's avatar
Léonard Gérard committed
342
          | _ -> Misc.internal_error "mls2obc select slice type"
Léonard Gérard's avatar
blop  
Léonard Gérard committed
343
        in
344

345 346 347 348
        let rec make_loop power_list replace = match power_list with
          | [] -> x, replace
          | p :: power_list ->
            let cpt, cptd = fresh_it () in
349 350 351
            let e, replace =
              make_loop power_list
                        (fun y -> [Afor (cptd, mk_exp_const_int 0,
352 353 354 355 356 357
                                         mk_exp_static_int p, mk_block (replace y))]) in
            let e = Larray (e, mk_evar_int cpt) in
            (mk_pattern t e, replace)
        in
        let e, b = make_loop n_list (fun y -> [Aassgn (y, e)]) in
        b e
Cédric Pasteur's avatar
Cédric Pasteur committed
358 359 360 361

    | Minils.Evarpat x,
            Minils.Eapp ({ Minils.a_op = Minils.Eselect_slice;
                           Minils.a_params = [idx1; idx2] }, [e], _) ->
Léonard Gérard's avatar
again  
Léonard Gérard committed
362
        let cpt, cptd = fresh_it () in
363
        let e = translate_extvalue_to_exp map e in
364
        let x = var_from_name map x in
Léonard Gérard's avatar
blop  
Léonard Gérard committed
365 366
        let t = match x.pat_ty with
          | Tarray (t,_) -> t
Léonard Gérard's avatar
Léonard Gérard committed
367
          | _ -> Misc.internal_error "mls2obc select slice type"
Léonard Gérard's avatar
blop  
Léonard Gérard committed
368
        in
Cédric Pasteur's avatar
Cédric Pasteur committed
369
        let idx = mk_exp_int (Eop (op_from_string "+",
370
                                  [mk_evar_int cpt; mk_exp_static_int idx1 ])) in
371 372
        (* bound = (idx2 - idx1) + 1*)
        let bound = mk_static_int_op (op_from_string "+")
Cédric Pasteur's avatar
Cédric Pasteur committed
373
          [ mk_static_int 1; mk_static_int_op (op_from_string "-") [idx2;idx1] ] in
Cédric Pasteur's avatar
Cédric Pasteur committed
374
         [ Afor (cptd, mk_exp_const_int 0, mk_exp_static_int bound,
Léonard Gérard's avatar
blop  
Léonard Gérard committed
375
                mk_block [Aassgn (mk_pattern t (Larray (x, mk_evar_int cpt)),
376
                                  array_elt_of_exp idx e)] ) ]
Cédric Pasteur's avatar
Cédric Pasteur committed
377

Léonard Gérard's avatar
Léonard Gérard committed
378
    | Minils.Evarpat x, Minils.Eapp ({ Minils.a_op = Minils.Eselect_dyn }, e1::e2::idx, _) ->
379
        let x = var_from_name map x in
Cédric Pasteur's avatar
Cédric Pasteur committed
380
        let bounds = Mls_utils.bounds_list e1.Minils.w_ty in
Cédric Pasteur's avatar
Cédric Pasteur committed
381
        let e1 = translate_extvalue map e1 in
382 383 384 385
        let idx = List.map (translate_extvalue_to_exp map) idx in
        let w = extvalue_of_idx_list e1 idx in
        let true_act = Aassgn (x, mk_exp w.w_ty (Eextvalue w)) in
        let false_act = Aassgn (x, translate_extvalue_to_exp map e2) in
386
        let cond = bound_check_expr idx bounds in
Cédric Pasteur's avatar
Cédric Pasteur committed
387
          [ mk_ifthenelse cond [true_act] [false_act] ]
388 389

    | Minils.Evarpat x, Minils.Eapp ({ Minils.a_op = Minils.Eselect_trunc }, e1::idx, _) ->
390
        let x = var_from_name map x in
391
        let _bounds = Mls_utils.bounds_list e1.Minils.w_ty in
Cédric Pasteur's avatar
Cédric Pasteur committed
392
        let e1 = translate_extvalue map e1 in
393 394 395
        let idx = List.map (translate_extvalue_to_exp map) idx in
        let w = ext_value_of_trunc_idx_list e1 idx in
        [Aassgn (x, mk_exp w.w_ty (Eextvalue w))]
396

Léonard Gérard's avatar
Léonard Gérard committed
397
    | Minils.Evarpat x, Minils.Eapp ({ Minils.a_op = Minils.Eupdate }, e1::e2::idx, _) ->
398
        let x = var_from_name map x in
Cédric Pasteur's avatar
Cédric Pasteur committed
399
        let bounds = Mls_utils.bounds_list e1.Minils.w_ty in
400 401 402
        let idx = List.map (translate_extvalue_to_exp map) idx in
        let e1 = translate_extvalue_to_exp map e1 in
        let e2 = translate_extvalue_to_exp map e2 in
403
        let cond = bound_check_expr idx bounds in
404 405 406 407 408 409 410 411 412
        let copy = Aassgn (x, e1) in
        if !Compiler_options.strict_ssa
        then (
          let ssa_up = ssa_update_array x e1 idx e2 in
          [ mk_ifthenelse cond ssa_up [copy] ]
        ) else (
          let assgn = Aassgn (pattern_of_idx_list x idx, e2) in
          [copy; mk_if cond [assgn]]
        )
413 414

    | Minils.Evarpat x,
Cédric Pasteur's avatar
Cédric Pasteur committed
415 416
      Minils.Eapp ({ Minils.a_op = Minils.Efield_update;
                     Minils.a_params = [{ se_desc = Sfield f }] }, [e1; e2], _) ->
417
        let x = var_from_name map x in
418
        let e1' = translate_extvalue map e1 in
419
        let e2 = translate_extvalue_to_exp map e2 in
420 421 422 423 424 425 426
        if !Compiler_options.strict_ssa
        then ssa_update_record x e1' f e2
        else (
          let copy = Aassgn (x, translate_extvalue_to_exp map e1) in
          let action = Aassgn (mk_pattern (Types.Tid (Modules.find_field f)) (Lfield (x, f)), e2) in
          [copy; action]
        )
Adrien Guatto's avatar
Adrien Guatto committed
427
    | Minils.Evarpat n, _ ->
428
        [Aassgn (var_from_name map n, translate map act)]
429
    | _ ->
430 431 432
      Format.eprintf "%a The pattern %a should be a simple var to be translated to obc.@."
        Location.print_location act.Minils.e_loc Mls_printer.print_pat pat;
      assert false
Adrien Guatto's avatar
Adrien Guatto committed
433

Léonard Gérard's avatar
Léonard Gérard committed
434
(** In an iteration, objects used are element of object arrays *)
435
type obj_array = { oa_index : Obc.pattern list; oa_size : static_exp list }
Léonard Gérard's avatar
Léonard Gérard committed
436 437 438 439 440 441 442

(** A [None] context is normal, otherwise, we are in an iteration *)
type call_context = obj_array option

let mk_obj_call_from_context c n = match c with
  | None -> Oobj n
  | Some oa -> Oarray (n, oa.oa_index)
443

Léonard Gérard's avatar
Léonard Gérard committed
444 445 446
let size_from_call_context c = match c with
  | None -> None
  | Some oa -> Some (oa.oa_size)
447

Léonard Gérard's avatar
Léonard Gérard committed
448
let empty_call_context = None
449

Léonard Gérard's avatar
Léonard Gérard committed
450
(** [si] the initialization actions used in the reset method,
451
    [j] obj decs
Léonard Gérard's avatar
Léonard Gérard committed
452
    [s] the actions used in the step method.
453
    [v] var decs *)
454
let rec translate_eq map call_context
Gwenaël Delaval's avatar
Gwenaël Delaval committed
455 456
    (v, si, j, s)
    ({ Minils.eq_lhs = pat; Minils.eq_base_ck = ck; Minils.eq_rhs = e } as eq) =
457
  let { Minils.e_desc = desc; Minils.e_loc = loc } = e in
458
  match (pat, desc) with
459
    | _pat, Minils.Ewhen (e,_,_) ->
Gwenaël Delaval's avatar
Gwenaël Delaval committed
460
        translate_eq map call_context (v, si, j, s) {eq with Minils.eq_rhs = e}
Léonard Gérard's avatar
Léonard Gérard committed
461
    (* TODO Efby and Eifthenelse should be dealt with in translate_act, no ? *)
Adrien Guatto's avatar
Adrien Guatto committed
462
    | Minils.Evarpat n, Minils.Efby (opt_c, e) ->
463
        let x = var_from_name map n in
Adrien Guatto's avatar
Adrien Guatto committed
464 465
        let si = (match opt_c with
                    | None -> si
Adrien Guatto's avatar
Adrien Guatto committed
466
                    | Some c -> (Aassgn (x, mk_ext_value_exp_static x.pat_ty c)) :: si) in
467
        let action = Aassgn (var_from_name map n, translate_extvalue_to_exp map e) in
468
        v, si, j, (control map ck action) :: s
Cédric Pasteur's avatar
Cédric Pasteur committed
469
(* should be unnecessary
470
    | Minils.Etuplepat p_list,
471
        Minils.Eapp({ Minils.a_op = Minils.Etuple }, act_list, _) ->
Adrien Guatto's avatar
Adrien Guatto committed
472 473
        List.fold_right2
          (fun pat e ->
474
             translate_eq map call_context
Adrien Guatto's avatar
Adrien Guatto committed
475
               (Minils.mk_equation pat e))
476
          p_list act_list (v, si, j, s)
Cédric Pasteur's avatar
Cédric Pasteur committed
477
*)
478
    | pat, Minils.Eapp({ Minils.a_op = Minils.Eifthenelse }, [e1;e2;e3], _) ->
479
        let cond = translate_extvalue_to_exp map e1 in
Cédric Pasteur's avatar
Cédric Pasteur committed
480 481 482
        let true_act = translate_act_extvalue map pat e2 in
        let false_act = translate_act_extvalue map pat e3 in
        let action = mk_ifthenelse cond true_act false_act in
483
        v, si, j, (control map ck action) :: s
484

485
    | _pat, Minils.Eapp({ Minils.a_op =
Cédric Pasteur's avatar
Cédric Pasteur committed
486 487 488 489 490
        Minils.Efun ({ qual = Module "Iostream"; name = "printf" | "fprintf" } as q)},
                       args, _) ->
      let action = Aop (q, List.map (translate_extvalue_to_exp map) args) in
      v, si, j, (control map ck action) :: s

Léonard Gérard's avatar
again  
Léonard Gérard committed
491
    | pat, Minils.Eapp ({ Minils.a_op = Minils.Efun _ | Minils.Enode _ } as app, e_list, r) ->
492 493
        let name_list = translate_pat map e.Minils.e_ty pat in
        let c_list = List.map (translate_extvalue_to_exp map) e_list in
Cédric Pasteur's avatar
Cédric Pasteur committed
494 495
        let v', si', j', action = mk_node_call map call_context
          app loc name_list c_list e.Minils.e_ty in
496
        let action = List.map (control map ck) action in
497 498
        let s = (match r, app.Minils.a_op with
                   | Some r, Minils.Enode _ ->
499
                       let ck = Clocks.Con (ck, Initial.ptrue, r) in
500
                       let ra = List.map (control map ck) si' in
501 502
                       ra @ action @ s
                   | _, _ -> action @ s) in
503
        v' @ v, si'@si, j'@j, s
504

505
    | pat, Minils.Eiterator (it, app, n_list, pe_list, e_list, reset) ->
506 507 508
        let name_list = translate_pat map e.Minils.e_ty pat in
        let p_list = List.map (translate_extvalue_to_exp map) pe_list in
        let c_list = List.map (translate_extvalue_to_exp map) e_list in
509
        let xl, xdl = List.split (List.map (fun _ -> fresh_it ()) n_list) in
Léonard Gérard's avatar
Léonard Gérard committed
510
        let call_context =
511 512 513
          Some { oa_index = List.map (fun x -> mk_pattern_int (Lvar x)) xl;
                 oa_size = n_list} in
        let n_list = List.map mk_exp_static_int n_list in
514
        let si', j', action = translate_iterator map call_context it
515
          name_list app loc n_list xl xdl p_list c_list e.Minils.e_ty in
516
        let action = List.map (control map ck) action in
Adrien Guatto's avatar
Adrien Guatto committed
517
        let s =
518 519
          (match reset, app.Minils.a_op with
             | Some r, Minils.Enode _ ->
520
                 let ck = Clocks.Con (ck, Initial.ptrue, r) in
521
                 let ra = List.map (control map ck) si' in
522
                   ra @ action @ s
523
             | _, _ -> action @ s)
524
        in (v, si' @ si, j' @ j, s)
Adrien Guatto's avatar
Adrien Guatto committed
525 526

    | (pat, _) ->
527
        let action = translate_act map pat e in
528
        let action = List.map (control map ck) action in
529
          v, si, j, action @ s
530

531
and translate_eq_list map call_context act_list =
Gwenaël Delaval's avatar
Gwenaël Delaval committed
532 533
  let rev_act = List.rev act_list in
  List.fold_left (translate_eq map call_context) ([], [], [], []) rev_act
534

535
and mk_node_call map call_context app loc (name_list : Obc.pattern list) args ty =
536
  match app.Minils.a_op with
537
    | Minils.Efun f when Mls_utils.is_op f ->
538 539 540 541 542 543
        let act = match name_list with
          | [] -> Aop (f, args)
          | [name] ->
              let e = mk_exp ty (Eop(f, args)) in
              Aassgn (name, e)
          | _ ->
Léonard Gérard's avatar
Léonard Gérard committed
544
            Misc.unsupported "mls2obc: external function with multiple return values" in
545
        [], [], [], [act]
546

547
    | Minils.Enode f when Itfusion.is_anon_node f ->
548 549 550
        let add_input env vd =
          Env.add vd.Minils.v_ident
            (mk_pattern vd.Minils.v_type (Lvar vd.Minils.v_ident)) env in
Léonard Gérard's avatar
Léonard Gérard committed
551
        let build env vd a = Env.add vd.Minils.v_ident a env in
552
        let subst_act_list env act_list =
553
          let exp funs env e = match e.e_desc with
554
            | Eextvalue { w_desc = Wvar x } ->
555 556 557 558 559 560 561
                let e =
                  (try Env.find x env
                  with Not_found -> e) in
                  e, env
            | _ -> Obc_mapfold.exp funs env e
          in
          let funs = { Obc_mapfold.defaults with exp = exp } in
562 563
          let act_list, _ = mapfold (Obc_mapfold.act_it funs) env act_list in
            act_list
564 565
        in

Cédric Pasteur's avatar
Cédric Pasteur committed
566
        let nd = find_anon f in
Cédric Pasteur's avatar
Cédric Pasteur committed
567 568 569 570 571 572 573 574
        let map = List.fold_left add_input map nd.Minils.n_input in
        let map = List.fold_left2 build map nd.Minils.n_output name_list in
        let map = List.fold_left add_input map nd.Minils.n_local in
        let v, si, j, s = translate_eq_list map call_context nd.Minils.n_equs in
        let env = List.fold_left2 build Env.empty nd.Minils.n_input args in
          v @ nd.Minils.n_local, si, j, subst_act_list env s

    | Minils.Enode f | Minils.Efun f ->
575 576 577 578
        let id = match app.Minils.a_id with
          | None -> gen_obj_ident f
          | Some id -> id
        in
579
        let o = mk_obj_call_from_context call_context id in
Cédric Pasteur's avatar
Cédric Pasteur committed
580
        let obj =
Léonard Gérard's avatar
Léonard Gérard committed
581
          { o_ident = obj_ref_name o; o_class = f;
Cédric Pasteur's avatar
Cédric Pasteur committed
582 583
            o_params = app.Minils.a_params;
            o_size = size_from_call_context call_context; o_loc = loc } in
584 585 586 587 588
        let si = match app.Minils.a_op with
          | Minils.Efun _ -> []
          | Minils.Enode _ -> [reinit o]
          | _ -> assert false
        in
Léonard Gérard's avatar
Léonard Gérard committed
589
        let s = [Acall (name_list, o, Mstep, args)] in
590
        [], si, [obj], s
591 592
    | _ -> assert false

593
and translate_iterator map call_context it name_list
594 595 596 597
    app loc n_list xl xdl p_list c_list ty =
  let rec unarray n ty = match ty, n with
    | Tarray (t,_), 1 -> t
    | Tarray (t,_), n -> unarray (n-1) t
598 599
    | _ ->
        Format.eprintf "%a" Global_printer.print_type ty;
Léonard Gérard's avatar
Léonard Gérard committed
600
        internal_error "mls2obc"
Léonard Gérard's avatar
again  
Léonard Gérard committed
601
  in
602
  let unarray = unarray (List.length n_list) in
Léonard Gérard's avatar
again  
Léonard Gérard committed
603
  let array_of_output name_list ty_list =
604 605
    let rec aux l ty xl = match ty, xl with
      | _, [] -> l
606
      | Tarray(tyn, _), x :: xl -> aux (mk_pattern ~loc:loc tyn (Larray(l, mk_evar_int x))) tyn xl
607 608 609
      | _, _ -> assert false
    in
    List.map2 (fun l ty -> aux l ty xl) name_list ty_list
Léonard Gérard's avatar
again  
Léonard Gérard committed
610
  in
611
  let array_of_input c_list =
Léonard Gérard's avatar
Léonard Gérard committed
612
    List.map (array_elt_of_exp_list (List.map mk_evar_int xl)) c_list
613 614 615 616 617 618 619
  in
  let mk_loop b xdl nl =
    let rec mk_loop b xdl nl = match xdl, nl with
      | xd::[], n::[] -> Afor (xd, mk_exp_const_int 0, n, b)
      | xd::xdl, n::nl -> mk_loop (mk_block [Afor (xd, mk_exp_const_int 0, n, b)]) xdl nl
      | _, _ -> assert false
    in
Léonard Gérard's avatar
Léonard Gérard committed
620
    mk_loop b (List.rev xdl) nl
621
  in
Cédric Pasteur's avatar
Cédric Pasteur committed
622
  match it with
623
    | Minils.Imap ->
624
        let c_list = array_of_input c_list in
Léonard Gérard's avatar
Léonard Gérard committed
625
        let ty_list = List.map unarray (Types.unprod ty) in
626
        let name_list = array_of_output name_list (Types.unprod ty) in
Léonard Gérard's avatar
Léonard Gérard committed
627
        let node_out_ty = Types.prod ty_list in
628
        let v, si, j, action = mk_node_call map call_context
629
          app loc name_list (p_list@c_list) node_out_ty in
630
        let v = translate_var_dec v in
631
        let b = mk_block ~locals:v action in
Léonard Gérard's avatar
Léonard Gérard committed
632
        let bi = mk_block si in
633
          [mk_loop bi xdl n_list], j, [mk_loop b xdl n_list]
Cédric Pasteur's avatar
Cédric Pasteur committed
634

Cédric Pasteur's avatar
Cédric Pasteur committed
635 636 637
    | Minils.Imapi ->
        let c_list = array_of_input c_list in
        let ty_list = List.map unarray (Types.unprod ty) in
638
        let name_list = array_of_output name_list (Types.unprod ty) in
Cédric Pasteur's avatar
Cédric Pasteur committed
639 640
        let node_out_ty = Types.prod ty_list in
        let v, si, j, action = mk_node_call map call_context
641
          app loc name_list (p_list@c_list@(List.map mk_evar_int xl)) node_out_ty in
Cédric Pasteur's avatar
Cédric Pasteur committed
642 643 644
        let v = translate_var_dec v in
        let b = mk_block ~locals:v action in
        let bi = mk_block si in
645
          [mk_loop bi xdl n_list], j, [mk_loop b xdl n_list]
Cédric Pasteur's avatar
Cédric Pasteur committed
646

647 648
    | Minils.Imapfold ->
        let (c_list, acc_in) = split_last c_list in
649
        let c_list = array_of_input c_list in
650 651
        let ty_list = Types.unprod ty in
        let ty_name_list, _ = Misc.split_last ty_list in
Léonard Gérard's avatar
Léonard Gérard committed
652 653
        let (name_list, acc_out) = Misc.split_last name_list in
        let name_list = array_of_output name_list ty_name_list in
654
        let node_out_ty = Types.prod (Misc.map_butlast unarray ty_list) in
655 656
        let v, si, j, action = mk_node_call map call_context app loc
          (name_list @ [ acc_out ])
657
          (p_list @ c_list @ [ exp_of_pattern acc_out ])
658
          node_out_ty
Léonard Gérard's avatar
again  
Léonard Gérard committed
659
        in
660
        let v = translate_var_dec v in
661
        let b = mk_block ~locals:v action in
Léonard Gérard's avatar
Léonard Gérard committed
662
        let bi = mk_block si in
663 664
          [mk_loop bi xdl n_list], j,
           [Aassgn (acc_out, acc_in); mk_loop b xdl n_list]
Cédric Pasteur's avatar
Cédric Pasteur committed
665

666 667
    | Minils.Ifold ->
        let (c_list, acc_in) = split_last c_list in
668
        let c_list = array_of_input c_list in
669
        let acc_out = last_element name_list in
Léonard Gérard's avatar
again  
Léonard Gérard committed
670
        let v, si, j, action =
671
          mk_node_call map call_context app loc name_list
672
            (p_list @ c_list @ [ exp_of_pattern acc_out ]) ty
Léonard Gérard's avatar
again  
Léonard Gérard committed
673
        in
674
        let v = translate_var_dec v in
675
        let b = mk_block ~locals:v action in
Léonard Gérard's avatar
Léonard Gérard committed
676
        let bi = mk_block si in
677 678
          [mk_loop bi xdl n_list], j,
           [ Aassgn (acc_out, acc_in); mk_loop b xdl n_list]
679

Cédric Pasteur's avatar
Cédric Pasteur committed
680 681 682 683
    | Minils.Ifoldi ->
        let (c_list, acc_in) = split_last c_list in
        let c_list = array_of_input c_list in
        let acc_out = last_element name_list in
Léonard Gérard's avatar
again  
Léonard Gérard committed
684
        let v, si, j, action = mk_node_call map call_context app loc name_list
685
          (p_list @ c_list @ (List.map mk_evar_int xl) @ [ exp_of_pattern acc_out ]) ty
Léonard Gérard's avatar
again  
Léonard Gérard committed
686
        in
687
        let v = translate_var_dec v in
Cédric Pasteur's avatar
Cédric Pasteur committed
688
        let b = mk_block ~locals:v action in
Léonard Gérard's avatar
Léonard Gérard committed
689
        let bi = mk_block si in
690 691
          [mk_loop bi xdl n_list], j,
           [ Aassgn (acc_out, acc_in); mk_loop b xdl n_list]
Cédric Pasteur's avatar
Cédric Pasteur committed
692

Adrien Guatto's avatar
Adrien Guatto committed
693
let remove m d_list =
694
  List.filter (fun { Minils.v_ident = n } -> not (List.mem_assoc n m)) d_list
695

Léonard Gérard's avatar
again  
Léonard Gérard committed
696
let translate_contract map mem_var_tys =
Cédric Pasteur's avatar
Cédric Pasteur committed
697
  function
698
    | None -> ([], [], [], [], [])
699 700 701 702 703
    | Some
        {
          Minils.c_eq = eq_list;
          Minils.c_local = d_list;
        } ->
Léonard Gérard's avatar
again  
Léonard Gérard committed
704
        let (v, si, j, s_list) = translate_eq_list map empty_call_context eq_list in
705
        let d_list = translate_var_dec (v @ d_list) in
706 707 708
        let m, d_list = List.partition
          (fun vd -> List.exists (fun (i,_) -> i = vd.v_ident) mem_var_tys) d_list in
         (m, si, j, s_list, d_list)
709

Adrien Guatto's avatar
Adrien Guatto committed
710
(** Returns a map, mapping variables names to the variables
Cédric Pasteur's avatar
Cédric Pasteur committed
711
    where they will be stored. *)
712
let subst_map inputs outputs controllables c_locals locals mem_tys =
Cédric Pasteur's avatar
Cédric Pasteur committed
713
  (* Create a map that simply maps each var to itself *)
Léonard Gérard's avatar
again  
Léonard Gérard committed
714
  let map =
715
    List.fold_left
Léonard Gérard's avatar
again  
Léonard Gérard committed
716
      (fun m { Minils.v_ident = x; Minils.v_type = ty } -> Env.add x (mk_pattern ty (Lvar x)) m)
717
      Env.empty (inputs @ outputs @ controllables @ c_locals @ locals)
718
  in
Léonard Gérard's avatar
again  
Léonard Gérard committed
719
  List.fold_left (fun map (x, x_ty) -> Env.add x (mk_pattern x_ty (Lmem x)) map) map mem_tys
720

721
let translate_node
Léonard Gérard's avatar
blop  
Léonard Gérard committed
722 723 724
    ({ Minils.n_name = f; Minils.n_input = i_list; Minils.n_output = o_list;
      Minils.n_local = d_list; Minils.n_equs = eq_list; Minils.n_stateful = stateful;
      Minils.n_contract = contract; Minils.n_params = params; Minils.n_loc = loc;
725
      Minils.n_mem_alloc = mem_alloc
Cédric Pasteur's avatar
Cédric Pasteur committed
726
    } as n) =
Léonard Gérard's avatar
Léonard Gérard committed
727
  Idents.enter_node f;
Léonard Gérard's avatar
again  
Léonard Gérard committed
728
  let mem_var_tys = Mls_utils.node_memory_vars n in
729
  let c_list, c_locals =
730 731 732 733
    match contract with
    | None -> [], []
    | Some c -> c.Minils.c_controllables, c.Minils.c_local in
  let subst_map = subst_map i_list o_list c_list c_locals d_list mem_var_tys in
Léonard Gérard's avatar
Léonard Gérard committed
734
  let (v, si, j, s_list) = translate_eq_list subst_map empty_call_context eq_list in
735
  let (m_c, si', j', s_list', d_list') = translate_contract subst_map mem_var_tys contract in
736 737
  let i_list = translate_var_dec i_list in
  let o_list = translate_var_dec o_list in
Gwenaël Delaval's avatar
Gwenaël Delaval committed
738
  let d_list = translate_var_dec (List.rev_append v d_list) in
Cédric Pasteur's avatar
Cédric Pasteur committed
739 740
  let m, d_list = List.partition
    (fun vd -> List.exists (fun (i,_) -> i = vd.v_ident) mem_var_tys) d_list in
Cédric Pasteur's avatar
Cédric Pasteur committed
741 742 743
  let m', o_list =
    List.partition
      (fun vd -> List.exists (fun (i,_) -> i = vd.v_ident) mem_var_tys) o_list in
Gwenaël Delaval's avatar
Gwenaël Delaval committed
744
  let s = List.rev_append (List.rev s_list) s_list' in
Cédric Pasteur's avatar
Cédric Pasteur committed
745
  let j = j' @ j in
746
  let si = si @ si' in
Léonard Gérard's avatar
blop  
Léonard Gérard committed
747
  let stepm = { m_name = Mstep; m_inputs = i_list; m_outputs = o_list;
Gwenaël Delaval's avatar
Gwenaël Delaval committed
748
                m_body = mk_block ~locals:(List.rev_append d_list' d_list) s }
Léonard Gérard's avatar
blop  
Léonard Gérard committed
749 750 751
  in
  let resetm = { m_name = Mreset; m_inputs = []; m_outputs = []; m_body = mk_block si } in
  if stateful
752
  then { cd_name = f; cd_stateful = true; cd_mems = m' @ m @ m_c; cd_params = params;
753
         cd_objs = j; cd_methods = [stepm; resetm]; cd_loc = loc; cd_mem_alloc = mem_alloc }
Cédric Pasteur's avatar
Cédric Pasteur committed
754 755 756
  else (
    (* Functions won't have [Mreset] or memories,
       they still have [params] and instances (of functions) *)
Léonard Gérard's avatar
blop  
Léonard Gérard committed
757
    { cd_name = f; cd_stateful = false; cd_mems = []; cd_params = params;
758
      cd_objs = j; cd_methods = [stepm]; cd_loc = loc; cd_mem_alloc = mem_alloc }
Léonard Gérard's avatar
blop  
Léonard Gérard committed