Project

General

Profile

Revision ef34b4ae src/printers.ml

View differences:

src/printers.ml
40 40
    | Forall -> fprintf fmt "forall %a" (fprintf_list ~sep:"; " pp_var) vars 
41 41
    | Exists -> fprintf fmt "exists %a" (fprintf_list ~sep:"; " pp_var) vars 
42 42

  
43
(*
44
let pp_econst fmt c = 
45
  match c with
46
    | EConst_int i -> pp_print_int fmt i
47
    | EConst_real r -> pp_print_string fmt r
48
    | EConst_float r -> pp_print_float fmt r
49
    | EConst_tag  t -> pp_print_string fmt t
50
    | EConst_string s -> pp_print_string fmt ("\"" ^ s ^ "\"")
51

  
52

  
53
let rec pp_eexpr fmt eexpr = 
54
  match eexpr.eexpr_desc with
55
    | EExpr_const c -> pp_econst fmt c
56
    | EExpr_ident id -> pp_print_string fmt id
57
    | EExpr_tuple el -> fprintf_list ~sep:"," pp_eexpr fmt el
58
    | EExpr_arrow (e1, e2) -> fprintf fmt "%a -> %a" pp_eexpr e1 pp_eexpr e2
59
    | EExpr_fby (e1, e2) -> fprintf fmt "%a fby %a" pp_eexpr e1 pp_eexpr e2
60
    (* | EExpr_concat (e1, e2) -> fprintf fmt "%a::%a" pp_eexpr e1 pp_eexpr e2 *)
61
    (* | EExpr_tail e -> fprintf fmt "tail %a" pp_eexpr e *)
62
    | EExpr_pre e -> fprintf fmt "pre %a" pp_eexpr e
63
    | EExpr_when (e, id) -> fprintf fmt "%a when %s" pp_eexpr e id
64
    | EExpr_merge (id, e1, e2) -> 
65
      fprintf fmt "merge (%s, %a, %a)" id pp_eexpr e1 pp_eexpr e2
66
    | EExpr_appl (id, e, r) -> pp_eapp fmt id e r
67
    | EExpr_forall (vars, e) -> fprintf fmt "forall %a; %a" pp_node_args vars pp_eexpr e 
68
    | EExpr_exists (vars, e) -> fprintf fmt "exists %a; %a" pp_node_args vars pp_eexpr e 
69

  
70

  
71
    (* | EExpr_whennot _ *)
72
    (* | EExpr_uclock _ *)
73
    (* | EExpr_dclock _ *)
74
    (* | EExpr_phclock _ -> assert false *)
75
and pp_eapp fmt id e r =
76
  match r with
77
  | None ->
78
    (match id, e.eexpr_desc with
79
    | "+", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a + %a)" pp_eexpr e1 pp_eexpr e2
80
    | "uminus", _ -> fprintf fmt "(- %a)" pp_eexpr e
81
    | "-", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a - %a)" pp_eexpr e1 pp_eexpr e2
82
    | "*", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a * %a)" pp_eexpr e1 pp_eexpr e2
83
    | "/", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a / %a)" pp_eexpr e1 pp_eexpr e2
84
    | "mod", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a mod %a)" pp_eexpr e1 pp_eexpr e2
85
    | "&&", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a && %a)" pp_eexpr e1 pp_eexpr e2
86
    | "||", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a || %a)" pp_eexpr e1 pp_eexpr e2
87
    | "xor", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a ^^ %a)" pp_eexpr e1 pp_eexpr e2
88
    | "impl", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a ==> %a)" pp_eexpr e1 pp_eexpr e2
89
    | "<", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a < %a)" pp_eexpr e1 pp_eexpr e2
90
    | "<=", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a <= %a)" pp_eexpr e1 pp_eexpr e2
91
    | ">", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a > %a)" pp_eexpr e1 pp_eexpr e2
92
    | ">=", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a >= %a)" pp_eexpr e1 pp_eexpr e2
93
    | "!=", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a != %a)" pp_eexpr e1 pp_eexpr e2
94
    | "=", EExpr_tuple([e1;e2]) -> fprintf fmt "(%a == %a)" pp_eexpr e1 pp_eexpr e2
95
    | "not", _ -> fprintf fmt "(! %a)" pp_eexpr e
96
    | "ite", EExpr_tuple([e1;e2;e3]) -> fprintf fmt "(if %a then %a else %a)" pp_eexpr e1 pp_eexpr e2 pp_eexpr e3
97
    | _ -> fprintf fmt "%s (%a)" id pp_eexpr e)
98
  | Some x -> fprintf fmt "%s (%a) every %s" id pp_eexpr e x 
99
*)
100

  
101

  
102 43
let rec pp_struct_const_field fmt (label, c) =
103 44
  fprintf fmt "%a = %a;" pp_print_string label pp_const c
104 45
and pp_const fmt c = 
......
211 152
let pp_var_type_dec fmt ty =
212 153
  pp_var_type_dec_desc fmt ty.ty_dec_desc
213 154

  
214
let pp_type_def fmt ty =
215
  fprintf fmt "type %s = %a;@ " ty.ty_def_id pp_var_type_dec_desc ty.ty_def_desc
155
let pp_typedef fmt ty =
156
  fprintf fmt "type %s = %a;@ " ty.tydef_id pp_var_type_dec_desc ty.tydef_desc
157

  
158
let pp_typedec fmt ty =
159
  fprintf fmt "type %s;@ " ty.tydec_id
216 160

  
217 161
(* let rec pp_var_type fmt ty =  *)
218 162
(*   fprintf fmt "%a" (match ty.tdesc with  *)
......
279 223
(*fprintf fmt "@ /* Scheduling: %a */ @ " (fprintf_list ~sep:", " pp_print_string) (Scheduling.schedule_node nd)*)
280 224

  
281 225
let pp_imported_node fmt ind = 
282
  fprintf fmt "@[<v>%s %s (%a) returns (%a) %t@]"
226
  fprintf fmt "@[<v>%s %s (%a) returns (%a)@]"
283 227
    (if ind.nodei_stateless then "function" else "node")
284 228
    ind.nodei_id
285 229
    pp_node_args ind.nodei_inputs
286 230
    pp_node_args ind.nodei_outputs
287
    (fun fmt -> if ind.nodei_stateless then Format.fprintf fmt "stateless") 
288 231

  
289
let pp_const_list fmt clist = 
290
  fprintf_list ~sep:"@ " (fun fmt cdecl ->
291
    fprintf fmt "%s = %a;"
292
      cdecl.const_id pp_const cdecl.const_value) fmt clist
232
let pp_const_decl fmt cdecl =
233
  fprintf fmt "%s = %a;" cdecl.const_id pp_const cdecl.const_value
234

  
235
let pp_const_decl_list fmt clist = 
236
  fprintf_list ~sep:"@ " pp_const_decl fmt clist
293 237

  
294 238
let pp_decl fmt decl =
295 239
  match decl.top_decl_desc with
296 240
  | Node nd -> fprintf fmt "%a@ " pp_node nd
297 241
  | ImportedNode ind ->
298 242
    fprintf fmt "imported %a;@ " pp_imported_node ind
299
  | Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist)
300
  | Open (local, s) -> if local then fprintf fmt "open \"%s\"@ " s else fprintf fmt "open <%s>@ " s
301
  | Type tdef -> fprintf fmt "%a@ " pp_type_def tdef
243
  | Const c -> fprintf fmt "const %a@ " pp_const_decl c
244
  | Open (local, s) -> if local then fprintf fmt "#open \"%s\"@ " s else fprintf fmt "#open <%s>@ " s
245
  | TypeDef tdef -> fprintf fmt "%a@ " pp_typedef tdef
302 246

  
303 247
let pp_prog fmt prog = 
304 248
  fprintf_list ~sep:"@ " pp_decl fmt prog
......
307 251
  match decl.top_decl_desc with
308 252
  | Node nd -> fprintf fmt "node %s@ " nd.node_id
309 253
  | ImportedNode ind -> fprintf fmt "imported node %s" ind.nodei_id
310
  | Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist)
311
  | Open (local, s) -> if local then fprintf fmt "open \"%s\"@ " s else fprintf fmt "open <%s>@ " s
312
  | Type tdef -> fprintf fmt "type %s;@ " tdef.ty_def_id
254
  | Const c -> fprintf fmt "const %a@ " pp_const_decl c
255
  | Open (local, s) -> if local then fprintf fmt "#open \"%s\"@ " s else fprintf fmt "#open <%s>@ " s
256
  | TypeDef tdef -> fprintf fmt "type %s;@ " tdef.tydef_id
313 257

  
314 258
let pp_lusi fmt decl = 
315 259
  match decl.top_decl_desc with
316
  | Node nd ->  
317
    fprintf fmt 
318
      "@[<v>%s %s (%a) returns (%a);@ @]@ "
319
      (if nd.node_dec_stateless then "function" else "node")
320
      nd.node_id
321
      pp_node_args nd.node_inputs
322
      pp_node_args nd.node_outputs
323
| Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist)
324
| Open (local, s) -> if local then fprintf fmt "open \"%s\"@ " s else fprintf fmt "open <%s>@ " s
325
| Type tdef -> fprintf fmt "%a@ " pp_type_def tdef
326
| ImportedNode _ -> ()
327

  
328
let pp_lusi_header fmt filename prog =
329
  fprintf fmt "(* Generated Lustre Interface file from %s *)@." filename;
260
  | ImportedNode ind -> fprintf fmt "%a;@ " pp_imported_node ind
261
  | Const c -> fprintf fmt "const %a@ " pp_const_decl c
262
  | Open (local, s) -> if local then fprintf fmt "#open \"%s\"@ " s else fprintf fmt "#open <%s>@ " s
263
  | TypeDef tdef -> fprintf fmt "%a@ " pp_typedef tdef
264
  | Node _ -> assert false
265

  
266
let pp_lusi_header fmt basename prog =
267
  fprintf fmt "(* Generated Lustre Interface file from %s.lus *)@." basename;
330 268
  fprintf fmt "(* by Lustre-C compiler version %s, %a *)@." Version.number pp_date (Unix.gmtime (Unix.time ()));
331 269
  fprintf fmt "(* Feel free to mask some of the definitions by removing them from this file. *)@.@.";
332 270
  List.iter (fprintf fmt "%a@." pp_lusi) prog    

Also available in: Unified diff