Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / EMF / EMF_common.ml @ 2823bc51

History | View | Annotate | Download (2.79 KB)

1
open LustreSpec
2
open Format
3
open Machine_code 
4

    
5
(* Matlab starting counting from 1.
6
   simple function to extract the element id in the list. Starts from 1. *)
7
let rec get_idx x l =
8
  match l with
9
  | hd::tl -> if hd = x then 1 else 1+(get_idx x tl)
10
  | [] -> assert false
11

    
12
let rec get_expr_vars v =
13
  match v.value_desc with
14
  | Cst c -> VSet.empty
15
  | LocalVar v | StateVar v -> VSet.singleton v
16
  | Fun (_, args) -> List.fold_left (fun accu v -> VSet.union accu (get_expr_vars v)) VSet.empty args
17
  | _ -> assert false (* Invalid argument *)
18

    
19
let is_imported_node f m =
20
  let (decl, _) = List.assoc f m.mcalls in
21
  Corelang.is_imported_node decl
22

    
23
(* Handling of enumerated types: for the moment each of such type is transformed
24
   into an int: the idx number of the constant in the typedef. This is not so
25
   nice but is compatible with basic Simulink types: int, real, bools) *)
26
(*
27
let recorded_enums = ref []
28
let record_types prog =
29
  let typedefs = Corelang.get_typedefs prog in
30
  List.iter (fun top ->
31
    let consts = consts_of_enum_type top in
32
  ) prog
33
*)
34
    
35
(* Basic printing functions *)
36
    
37
let pp_var_string fmt v = fprintf fmt "\"%s\"" v
38
(*let pp_var_name fmt v = fprintf fmt "\"%a\"" Printers.pp_var_name v*)
39
(*let pp_node_args = fprintf_list ~sep:", " pp_var_name*)
40

    
41
let pp_emf_var_decl fmt v =
42
  fprintf fmt "@[{\"name\": \"%a\", \"type\":\"%a\"}@]"
43
    Printers.pp_var_name v
44
    Printers.pp_var_type v
45
    
46
let pp_emf_vars_decl fmt vl =
47
  fprintf fmt "@[";
48
  Utils.fprintf_list ~sep:",@ " pp_emf_var_decl fmt vl;
49
  fprintf fmt "@]"
50
  
51
let reset_name id =
52
  "reset_" ^ id
53
  
54
let pp_tag_id fmt t =
55
  let typ = (Corelang.typedef_of_top (Hashtbl.find Corelang.tag_table t)) in
56
  if typ.tydef_id = "bool" then
57
    pp_print_string fmt t
58
  else
59
    let const_list = match typ.tydef_desc with Tydec_enum tl -> tl | _ -> assert false in
60
    fprintf fmt "%i" (get_idx t const_list)
61
     
62
let pp_emf_cst_or_var fmt v =
63
  match v.value_desc with
64
  | Cst ((Const_tag t) as c)->
65
     let typ = (Corelang.typedef_of_top (Hashtbl.find Corelang.tag_table t)) in
66
     if typ.tydef_id = "bool" then
67
       fprintf fmt "{@[\"type\": \"constant\",@ \"value\": \"%a\"@ @]}"
68
	 Printers.pp_const c
69
     else (
70
       fprintf fmt "{@[\"type\": \"constant\",@ \"value\": \"%a\",@ " 
71
	 pp_tag_id t;
72
       fprintf fmt "\"origin_type\": \"%s\",@ \"origin_value\": \"%s\"@ "
73
	 typ.tydef_id t;
74
       fprintf fmt "@]}"
75
     )
76
  | Cst c ->
77
     fprintf fmt "{@[\"type\": \"constant\",@ \"value\": \"%a\"@ @]}"
78
       Printers.pp_const c
79
  | LocalVar v
80
  | StateVar v ->
81
     fprintf fmt "{@[\"type\": \"variable\",@ \"value\": \"%a\"@ @]}"
82
       Printers.pp_var_name v
83
  | _ -> assert false (* Invalid argument *)
84

    
85

    
86
let pp_emf_cst_or_var_list =
87
  Utils.fprintf_list ~sep:",@ " pp_emf_cst_or_var
88

    
89

    
90
(* Local Variables: *)
91
(* compile-command: "make -C ../.." *)
92
(* End: *)