Project

General

Profile

Revision ef8a361a

View differences:

src/backends/EMF/EMF_common.ml
38 38
(*let pp_var_name fmt v = fprintf fmt "\"%a\"" Printers.pp_var_name v*)
39 39
(*let pp_node_args = fprintf_list ~sep:", " pp_var_name*)
40 40

  
41
(********* Printing types ***********)
42
(* Two cases:
43
   - printing a variable definition:
44
     -  we look at the declared type if available
45
     - if not, we print the inferred type
46

  
47
   - printing a constant definion
48
*)
49
  
50
  
51
let pp_tag_type fmt typ =
52
  let const_list = match typ.tydef_desc with Tydec_enum tl -> tl | _ -> assert false in
53
  let size = List.length const_list in
54
  if size < 255 then
55
    fprintf fmt "uint8"
56
  else if size < 65535 then
57
fprintf fmt "uint16"
58
  else
59
    assert false (* Too much states. This not reasonable *)
60
      
61
   
62
     
63
let pp_cst_type c infered_typ fmt =
64
  match c with
65
  | Const_tag t ->
66
     let typ = (Corelang.typedef_of_top (Hashtbl.find Corelang.tag_table t)) in
67
     if typ.tydef_id = "bool" then
68
       fprintf fmt "bool"
69
     else
70
       pp_tag_type fmt typ
71
  | Const_int _ -> fprintf fmt "%s" !Options.int_type
72
  | Const_real _ -> fprintf fmt "%s" !Options.real_type
73
  | _ -> Format.eprintf "cst: %a@." Printers.pp_const c; assert false
74

  
75
let rec pp_infered_type fmt t =
76
  let open Types in
77
  match t.tdesc with
78
  | Tint ->
79
     fprintf fmt "%s" !Options.int_type
80
  | Treal ->
81
     fprintf fmt "%s" !Options.real_type
82
  | Tbool ->
83
     fprintf fmt "bool"
84
  | Tclock t ->
85
     pp_infered_type fmt t
86
  | Tstatic (_, t) ->
87
     fprintf fmt "%a" pp_infered_type t
88
  | Tconst id ->
89
    (* This is a type id for a enumerated type, eg. introduced by automata *)
90
     let typ =
91
       (Corelang.typedef_of_top (Hashtbl.find Corelang.type_table (Tydec_const id)))
92
     in
93
     pp_tag_type fmt typ
94
   | Tlink ty -> 
95
       pp_infered_type fmt ty 
96
  | _ -> Format.eprintf "unhandled type: %a@." Types.print_node_ty t; assert false
97
let rec pp_concrete_type dec_t infered_t fmt =
98
  match dec_t with
99
  | Tydec_int -> fprintf fmt "%s" !Options.int_type
100
  | Tydec_real -> fprintf fmt "%s" !Options.real_type
101
  (* TODO we could add more concrete types here if they were available in
102
     dec_t *)
103
  | Tydec_bool -> fprintf fmt "bool"
104
  | Tydec_clock t -> pp_concrete_type t infered_t fmt
105
  | Tydec_const id -> (
106
    (* This is a type id for a enumerated type, eg. introduced by automata *)
107
    let typ = (Corelang.typedef_of_top (Hashtbl.find Corelang.type_table dec_t)) in
108
    pp_tag_type fmt typ
109
  )
110
  | Tydec_any -> pp_infered_type fmt infered_t 
111
  | _ -> Format.eprintf
112
     "unhandled construct in type printing for EMF backend: %a@."
113
     Printers.pp_var_type_dec_desc dec_t; raise (Failure "var")
114
       
115

  
116
let pp_cst_type fmt v =
117
  match v.value_desc with
118
  | Cst c-> pp_cst_type c v.value_type fmt (* constants do not have declared type (yet) *)
119
  | _ -> assert false
120
     
121
let pp_var_type fmt v =
122
  try
123
  pp_concrete_type v.var_dec_type.ty_dec_desc v.var_type fmt
124
  with Failure _ -> Format.eprintf "failed var: %a@." Printers.pp_var v; assert false
125
(******** Other print functions *)
126
    
41 127
let pp_emf_var_decl fmt v =
42
  fprintf fmt "@[{\"name\": \"%a\", \"type\":\"%a\"}@]"
128
  fprintf fmt "@[{\"name\": \"%a\", \"datatype\":\"%a\"}@]"
43 129
    Printers.pp_var_name v
44
    Printers.pp_var_type v
130
    pp_var_type v
45 131
    
46 132
let pp_emf_vars_decl fmt vl =
47 133
  fprintf fmt "@[";
......
63 149
  match v.value_desc with
64 150
  | Cst ((Const_tag t) as c)->
65 151
     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
152
     if typ.tydef_id = "bool" then (
153
       fprintf fmt "{@[\"type\": \"constant\",@ ";
154
       fprintf fmt"\"value\": \"%a\",@ "
155
	 Printers.pp_const c;
156
       fprintf fmt "\"datatype\": \"%a\"@ " pp_cst_type v;
157
       fprintf fmt "@]}"
158
     )
69 159
     else (
70 160
       fprintf fmt "{@[\"type\": \"constant\",@ \"value\": \"%a\",@ " 
71 161
	 pp_tag_id t;
72
       fprintf fmt "\"origin_type\": \"%s\",@ \"origin_value\": \"%s\"@ "
162
       fprintf fmt "\"origin_type\": \"%s\",@ \"origin_value\": \"%s\",@ "
73 163
	 typ.tydef_id t;
164
       fprintf fmt "\"datatype\": \"%a\"@ " pp_cst_type v;
74 165
       fprintf fmt "@]}"
75 166
     )
76
  | Cst c ->
77
     fprintf fmt "{@[\"type\": \"constant\",@ \"value\": \"%a\"@ @]}"
78
       Printers.pp_const c
167
  | Cst c -> (
168
    fprintf fmt "{@[\"type\": \"constant\",@ \"value\": \"%a\",@ "
169
      Printers.pp_const c;
170
    fprintf fmt "\"datatype\": \"%a\"@ " pp_cst_type v;
171
    fprintf fmt "@]}"
172
  )
79 173
  | LocalVar v
80
  | StateVar v ->
81
     fprintf fmt "{@[\"type\": \"variable\",@ \"value\": \"%a\"@ @]}"
82
       Printers.pp_var_name v
174
  | StateVar v -> (
175
    fprintf fmt "{@[\"type\": \"variable\",@ \"value\": \"%a\",@ "
176
      Printers.pp_var_name v;
177
    fprintf fmt "\"datatype\": \"%a\"@ " pp_var_type v;
178
    fprintf fmt "@]}"
179
  )
83 180
  | _ -> Format.eprintf "Not of cst or var: %a@." Machine_code.pp_val v ; assert false (* Invalid argument *)
84 181

  
85 182

  
src/backends/backends.ml
3 3

  
4 4
let setup () =
5 5
  match !Options.output with
6
  (* | "emf" -> *)
7
  (*    join_guards := true; (\* guards should not be joined, in order to have only *)
8
  (* 			      if c then x = e1 else x = e2 to ease *)
9
  (* 			      reconstruction of flows. *\) *)
10
  (*   Options.optimization := 0; (\* Optimization=0 prevents expression *)
11
  (* 				  elimination. This simplifies largely the *)
12
  (* 				  association of lustre expression to *)
13
  (* 				  instructions *\) *)
6
  | "emf" ->
7
     (* In case of a default "int" type, substitute it with the legal int32 value *)
8
     if !Options.int_type = "int" then
9
       Options.int_type := "int32"
14 10
  | _ -> ()
15 11

  
16 12
let is_functional () = 
......
18 14
  | "horn" | "lustre" | "acsl" | "emf" -> true
19 15
  | _ -> false
20 16

  
21
  
17

  
22 18
(* Local Variables: *)
23 19
(* compile-command: "make -k -C .." *)
24 20
(* End: *)

Also available in: Unified diff