Project

General

Profile

Revision b12a91e0

View differences:

src/backends/Ada/ada_backend_ads.ml
18 18

  
19 19
open Ada_backend_common
20 20

  
21
(** Functions printing the .ads file **)
21 22
module Main =
22 23
struct
23 24

  
24
(** Print the name of a variable.
25
   @param fmt the formater to print on
26
   @param id the variable
27
*)
28
let pp_var_name fmt id =
29
  fprintf fmt "%s" id.var_id
30

  
31
(** Print the type of a variable.
32
   @param fmt the formater to print on
33
   @param id the variable
34
*)
35
let pp_var_type fmt id = fprintf fmt
36
  (match (Types.repr id.var_type).Types.tdesc with
37
    | Types.Tbasic Types.Basic.Tint -> "int"
38
    | Types.Tbasic Types.Basic.Treal -> "double"
39
    | Types.Tbasic Types.Basic.Tbool -> "bool"
40
    | _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
41
  )
42

  
43
type prototype_modifiers = In | Out
44

  
45
(** Print a prototype_modifiers.
46
   @param fmt the formater to print on
47
   @param modifier the modifier
48
*)
49
let pp_prototype_modifiers fmt modifier =
50
  fprintf fmt "%s" (match modifier with
51
                     | In  -> "in"
52
                     | Out -> "out")
53

  
54
(** Print a variable declaration.
55
   @param fmt the formater to print on
56
   @param id the variable
57
*)
58
let pp_var_decl fmt id =
59
  fprintf fmt "type %a is %a;"
60
    pp_var_name id
61
    pp_var_type id
62

  
63
(** Print the parameter of a prototype, a list of modifier(eg. in or out)
64
  can be given to specify the type.
65
   @param modifiers list of the modifiers for this parameter
66
   @param fmt the formater to print on
67
   @param id the variable
68
*)
69
let pp_parameter modifiers fmt id =
70
  fprintf fmt "%a: %a %a"
71
    pp_var_name id
72
    (Utils.fprintf_list ~sep:"@ " pp_prototype_modifiers) modifiers
73
    pp_var_type id
74

  
75
(** Print the prototype of a procedure
76
   @param fmt the formater to print on
77
   @param name the name of the procedure
78
   @param input list of the input parameter of the procedure
79
   @param output list of the output parameter of the procedure
80
*)
81
let pp_simple_prototype fmt (name, input, output) =
82
  fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]"
83
    name
84
    (Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input
85
    (Utils.pp_final_char_if_non_empty ",@," input)
86
    (Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output
87

  
88
(** Print the prototype of the init procedure of a machine.
89
   @param fmt the formater to print on
90
   @param m the machine
91
*)
92
let pp_init_prototype fmt m =
93
  pp_simple_prototype fmt ("init", m.mstatic, [])
94

  
95
(** Print the prototype of the step procedure of a machine.
96
   @param fmt the formater to print on
97
   @param m the machine
98
*)
99
let pp_step_prototype fmt m =
100
  pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs)
101

  
102
(** Print the prototype of the reset procedure of a machine.
103
   @param fmt the formater to print on
104
   @param m the machine
105
*)
106
let pp_reset_prototype fmt m =
107
  pp_simple_prototype fmt ("reset", m.mstatic, [])
108

  
109
(** Print the prototype of the clear procedure of a machine.
110
   @param fmt the formater to print on
111
   @param m the machine
112
*)
113
let pp_clear_prototype fmt m =
114
  pp_simple_prototype fmt ("clear", m.mstatic, [])
115

  
116 25
(** Print the package declaration(ads) of a lustre node.
117 26
   @param fmt the formater to print on
118 27
   @param machine the machine
src/backends/Ada/ada_backend_common.ml
5 5
open Corelang
6 6
open Machine_code_common
7 7

  
8
(** All the pretty print functions common to the ada backend **)
9

  
10
(* Package pretty print functions *)
11

  
8 12
(** Print the name of a package associated to a machine.
9 13
   @param fmt the formater to print on
10 14
   @param machine the machine
......
12 16
let pp_package_name fmt machine =
13 17
  fprintf fmt "%s" machine.mname.node_id
14 18

  
15

  
16 19
(** Print the ada package introduction sentence it can be used for body and
17 20
declaration. Boolean parameter body should be true if it is a body delcaration.
18 21
   @param fmt the formater to print on
......
30 33
*)
31 34
let pp_end_package fmt machine =
32 35
  fprintf fmt "end %a;" pp_package_name machine
36

  
37

  
38
(* Variable pretty print functions *)
39

  
40
(** Print the name of a variable.
41
   @param fmt the formater to print on
42
   @param id the variable
43
*)
44
let pp_var_name fmt id =
45
  fprintf fmt "%s" id.var_id
46

  
47
(** Print the type of a variable.
48
   @param fmt the formater to print on
49
   @param id the variable
50
*)
51
let pp_var_type fmt id = fprintf fmt
52
  (match (Types.repr id.var_type).Types.tdesc with
53
    | Types.Tbasic Types.Basic.Tint -> "int"
54
    | Types.Tbasic Types.Basic.Treal -> "double"
55
    | Types.Tbasic Types.Basic.Tbool -> "bool"
56
    | _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
57
  )
58

  
59

  
60
(* Prototype pretty print functions *)
61

  
62
type prototype_modifiers = In | Out
63

  
64
(** Print a prototype_modifiers.
65
   @param fmt the formater to print on
66
   @param modifier the modifier
67
*)
68
let pp_prototype_modifiers fmt modifier =
69
  fprintf fmt "%s" (match modifier with
70
                     | In  -> "in"
71
                     | Out -> "out")
72

  
73
(** Print a variable declaration.
74
   @param fmt the formater to print on
75
   @param id the variable
76
*)
77
let pp_var_decl fmt id =
78
  fprintf fmt "type %a is %a;"
79
    pp_var_name id
80
    pp_var_type id
81

  
82
(** Print the parameter of a prototype, a list of modifier(eg. in or out)
83
  can be given to specify the type.
84
   @param modifiers list of the modifiers for this parameter
85
   @param fmt the formater to print on
86
   @param id the variable
87
*)
88
let pp_parameter modifiers fmt id =
89
  fprintf fmt "%a: %a %a"
90
    pp_var_name id
91
    (Utils.fprintf_list ~sep:"@ " pp_prototype_modifiers) modifiers
92
    pp_var_type id
93

  
94
(** Print the prototype of a procedure
95
   @param fmt the formater to print on
96
   @param name the name of the procedure
97
   @param input list of the input parameter of the procedure
98
   @param output list of the output parameter of the procedure
99
*)
100
let pp_simple_prototype fmt (name, input, output) =
101
  fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]"
102
    name
103
    (Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input
104
    (Utils.pp_final_char_if_non_empty ",@," input)
105
    (Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output
106

  
107
(** Print the prototype of the init procedure of a machine.
108
   @param fmt the formater to print on
109
   @param m the machine
110
*)
111
let pp_init_prototype fmt m =
112
  pp_simple_prototype fmt ("init", m.mstatic, [])
113

  
114
(** Print the prototype of the step procedure of a machine.
115
   @param fmt the formater to print on
116
   @param m the machine
117
*)
118
let pp_step_prototype fmt m =
119
  pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs)
120

  
121
(** Print the prototype of the reset procedure of a machine.
122
   @param fmt the formater to print on
123
   @param m the machine
124
*)
125
let pp_reset_prototype fmt m =
126
  pp_simple_prototype fmt ("reset", m.mstatic, [])
127

  
128
(** Print the prototype of the clear procedure of a machine.
129
   @param fmt the formater to print on
130
   @param m the machine
131
*)
132
let pp_clear_prototype fmt m =
133
  pp_simple_prototype fmt ("clear", m.mstatic, [])

Also available in: Unified diff