Project

General

Profile

Revision e7def055 src/plugins/scopes/scopes.ml

View differences:

src/plugins/scopes/scopes.ml
169 169
let scopes_map : (LustreSpec.ident list  * scope_t) list ref  = ref []
170 170

  
171 171
let register_scopes s = 
172
  option_scopes := true;
172 173
  option_all_scopes:=false; 
173 174
  let scope_list = Str.split (Str.regexp ", *") s in
174 175
  let scope_list = List.map (fun scope -> Str.split (Str.regexp "\\.") scope) scope_list in
175 176
  scopes_def := scope_list
176 177

  
177 178
let register_inputs s = 
179
  option_scopes := true;
178 180
  let input_list = Str.split (Str.regexp "[;]") s in
179 181
  let input_list = List.map (fun s -> match Str.split (Str.regexp "=") s with | [v;e] -> v, e | _ -> raise (Invalid_argument ("Input list error: " ^ s))) input_list in
180 182
  let input_list = List.map (fun (v, e) -> v, Str.split (Str.regexp "[;]") e) input_list in
......
185 187
   iterer sur path pour construire la suite des xx_mem._reg.yy_mem._reg......flow
186 188
par ex main_mem->n8->n9->_reg.flow
187 189
*)
188
let pp_scopes fmt scopes = 
190
let extract_scopes_defs scopes =
189 191
  let rec scope_path (path, flow) accu = 
190 192
    match path with 
191
      | [] -> accu ^ "_reg." ^ flow.var_id, flow.var_type
192
      | (_, _, Some instance_id)::tl -> scope_path (tl, flow) ( accu ^ instance_id ^ "->" ) 
193
      | _ -> assert false
193
    | [] -> accu ^ "_reg." ^ flow.var_id, flow.var_type
194
    | (_, _, Some instance_id)::tl -> scope_path (tl, flow) ( accu ^ instance_id ^ "->" ) 
195
    | _ -> assert false
194 196
  in
195 197
  let scopes_vars = 
196 198
    List.map 
......
198 200
	String.concat "." sl, scope_path scope "main_mem.") 
199 201
      scopes 
200 202
  in
201
  List.iter (fun (id, (var, typ)) -> 
202
    match (Types.repr typ).Types.tdesc with
203
      | Types.Tint -> Format.fprintf fmt "_put_int(\"%s\", %s);@ " id var
204
      | Types.Tbool -> Format.fprintf fmt "_put_bool(\"%s\", %s);@ " id var
205
      | Types.Treal when !Options.mpfr ->
206
	 Format.fprintf fmt "_put_double(\"%s\", mpfr_get_d(%s, %s));@ " id var (Mpfr.mpfr_rnd ())
207
      | Types.Treal -> Format.fprintf fmt "_put_double(\"%s\", %s);@ " id var
208
      | _ -> Format.eprintf "Impossible to print the _put_xx for type %a@.@?" Types.print_ty typ; assert false
203
  scopes_vars
204

  
205
let pp_scopes_files basename mname fmt scopes =
206
  let scopes_vars = extract_scopes_defs scopes in
207
  List.iteri (fun idx _ (* (id, (var, typ)) *) ->
208
    Format.fprintf fmt "FILE *f_out_scopes_%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
209
    Format.fprintf fmt "f_out_scopes_%i = fopen(\"%s_%s_simu.scope%i\", \"w\");@ " (idx+1) basename mname (idx+1);
210
  ) scopes_vars
211

  
212
  
213
let pp_scopes fmt scopes = 
214
  let scopes_vars = extract_scopes_defs scopes in
215
  List.iteri (fun idx (id, (var, typ)) ->
216
    Format.fprintf fmt "@ %t;" 
217
      (fun fmt -> C_backend_common.print_put_var fmt ("_scopes_" ^ string_of_int (idx+1)) var typ var)
209 218
  ) scopes_vars
210 219

  
211 220
let update_machine machine =
......
235 244
struct
236 245
  let name = "scopes"
237 246
  let is_active () = 
238
    !option_scopes
247
    !option_scopes || !option_show_scopes || !option_all_scopes || !option_mem_scopes || !option_input_scopes
239 248
      
240 249
  let show_scopes () = 
241 250
    !option_show_scopes && (
......
315 324
    let machines = List.map update_machine machines in
316 325
     machines
317 326

  
318
  let pp fmt = pp_scopes fmt !scopes_map
327
  (* let pp fmt = pp_scopes fmt !scopes_map *)
319 328

  
320
  let check_force_stateful () = !option_scopes
329
  let check_force_stateful () = is_active()
321 330

  
322 331
  let refine_machine_code prog machine_code =
323 332
    if show_scopes () then
......
339 348
  let c_backend_main_loop_body_suffix fmt () =
340 349
    if is_active () then
341 350
      begin
342
	Format.fprintf fmt "@ %t" pp 
343
      end;    
344
 
351
	Format.fprintf fmt "@ %a" pp_scopes !scopes_map 
352
      end  
353

  
354
  let c_backend_main_loop_body_prefix basename mname fmt () =
355
    if is_active () then
356
      begin
357
	Format.fprintf fmt "@ %a" (pp_scopes_files basename mname) !scopes_map 
358
      end  
359

  
360

  
345 361
end
346 362
    
347 363
(* Local Variables: *)

Also available in: Unified diff