Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_common.ml @ 3d85297f

History | View | Annotate | Download (6.48 KB)

1
open Format
2

    
3
open Machine_code_types
4
open Lustre_types
5
open Corelang
6
open Machine_code_common
7

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

    
10
(* Package pretty print functions *)
11

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

    
19
(** Print the ada package introduction sentence it can be used for body and
20
declaration. Boolean parameter body should be true if it is a body delcaration.
21
   @param fmt the formater to print on
22
   @param fmt the formater to print on
23
   @param machine the machine
24
*)
25
let pp_begin_package body fmt machine =
26
  fprintf fmt "package %s %a is"
27
    (if body then "body" else "")
28
    pp_package_name machine
29

    
30
(** Print the ada package conclusion sentence.
31
   @param fmt the formater to print on
32
   @param machine the machine
33
*)
34
let pp_end_package fmt machine =
35
  fprintf fmt "end %a" pp_package_name machine
36

    
37

    
38
(* Type pretty print functions *)
39

    
40
(** Print a type declaration
41
   @param fmt the formater to print on
42
   @param pp_name a format printer which print the type name
43
   @param pp_value a format printer which print the type definition
44
*)
45
let pp_type_decl fmt (pp_name, pp_definition) =
46
  fprintf fmt "type %t is %t" pp_name pp_definition
47

    
48
(** Print a private type declaration
49
   @param fmt the formater to print on
50
   @param pp_name a format printer which print the type name
51
*)
52
let pp_private_type_decl fmt pp_name =
53
  let pp_definition fmt = fprintf fmt "private" in
54
  pp_type_decl fmt (pp_name, pp_definition)
55

    
56
(** Print the type of the state variable.
57
   @param fmt the formater to print on
58
*)
59
let pp_state_type fmt =
60
  fprintf fmt "State"
61

    
62
(** Print the type of a variable.
63
   @param fmt the formater to print on
64
   @param id the variable
65
*)
66
let pp_var_type fmt id = fprintf fmt
67
  (match (Types.repr id.var_type).Types.tdesc with
68
    | Types.Tbasic Types.Basic.Tint -> "Integer"
69
    | Types.Tbasic Types.Basic.Treal -> "Float"
70
    | Types.Tbasic Types.Basic.Tbool -> "Boolean"
71
    | _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
72
  )
73
  
74

    
75
(* Variable pretty print functions *)
76

    
77
(** Represent the possible mode for a type of a procedure parameter **)
78
type parameter_mode = NoMode | In | Out | InOut
79

    
80
(** Print a parameter_mode.
81
   @param fmt the formater to print on
82
   @param mode the modifier
83
*)
84
let pp_parameter_mode fmt mode =
85
  fprintf fmt "%s" (match mode with
86
                     | NoMode -> ""
87
                     | In     -> "in"
88
                     | Out    -> "out"
89
                     | InOut  -> "in out")
90

    
91
(** Print the name of the state variable.
92
   @param fmt the formater to print on
93
*)
94
let pp_state_name fmt =
95
  fprintf fmt "state"
96

    
97
(** Print the name of a variable.
98
   @param fmt the formater to print on
99
   @param id the variable
100
*)
101
let pp_var_name fmt id =
102
  fprintf fmt "%s" id.var_id
103

    
104
(** Print a variable declaration
105
   @param mode input/output mode of the parameter
106
   @param pp_name a format printer wich print the variable name
107
   @param pp_type a format printer wich print the variable type
108
   @param fmt the formater to print on
109
   @param id the variable
110
*)
111
let pp_var_decl fmt (mode, pp_name, pp_type) =
112
  fprintf fmt "%t: %a %t"
113
    pp_name
114
    pp_parameter_mode mode
115
    pp_type
116

    
117
(** Print variable declaration for machine variable
118
   @param mode input/output mode of the parameter
119
   @param fmt the formater to print on
120
   @param id the variable
121
*)
122
let pp_machine_var_decl mode fmt id =
123
  let pp_name = function fmt -> pp_var_name fmt id in
124
  let pp_type = function fmt -> pp_var_type fmt id in
125
  pp_var_decl fmt (mode, pp_name, pp_type)
126

    
127
(** Print variable declaration for state variable
128
   @param fmt the formater to print on
129
   @param mode input/output mode of the parameter
130
*)
131
let pp_state_var_decl fmt mode =
132
  let pp_name = pp_state_name in
133
  let pp_type = pp_state_type in
134
  pp_var_decl fmt (mode, pp_name, pp_type)
135

    
136
(** Print a record definition.
137
   @param fmt the formater to print on
138
   @param var_list list of machine variable
139
*)
140
let pp_record_definition fmt var_list =
141
  fprintf fmt "@,  @[<v>record@,  @[<v>%a%t@]@,end record@]"
142
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
143
    (Utils.pp_final_char_if_non_empty "," var_list)
144

    
145

    
146
(* Prototype pretty print functions *)
147

    
148
(** Print the name of the init procedure **)
149
let pp_init_procedure_name fmt = fprintf fmt "init"
150

    
151
(** Print the step of the init procedure **)
152
let pp_step_procedure_name fmt = fprintf fmt "step"
153

    
154
(** Print the reset of the init procedure **)
155
let pp_reset_procedure_name fmt = fprintf fmt "reset"
156

    
157
(** Print the clear of the init procedure **)
158
let pp_clear_procedure_name fmt = fprintf fmt "clear"
159

    
160
(** Print the prototype of a machine procedure. The first parameter is always
161
the state, state_modifier specify the modifier applying to it. The next
162
parameters are inputs and the last parameters are the outputs.
163
   @param fmt the formater to print on
164
   @param name the name of the procedure
165
   @param state_mode the input/output mode for the state parameter
166
   @param input list of the input parameter of the procedure
167
   @param output list of the output parameter of the procedure
168
*)
169
let pp_simple_prototype fmt (pp_name, state_mode, input, output) =
170
  fprintf fmt "procedure %t(@[<v>%a%t@[%a@]%t@[%a@])@]"
171
    pp_name
172
    pp_state_var_decl state_mode
173
    (Utils.pp_final_char_if_non_empty ",@," input)
174
    (Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl In)) input
175
    (Utils.pp_final_char_if_non_empty ",@," output)
176
    (Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl Out)) output
177

    
178
(** Print the prototype of the init procedure of a machine.
179
   @param fmt the formater to print on
180
   @param m the machine
181
*)
182
let pp_init_prototype fmt m =
183
  pp_simple_prototype fmt (pp_init_procedure_name, Out, m.mstatic, [])
184

    
185
(** Print the prototype of the step procedure of a machine.
186
   @param fmt the formater to print on
187
   @param m the machine
188
*)
189
let pp_step_prototype fmt m =
190
  pp_simple_prototype fmt (pp_step_procedure_name, InOut, m.mstep.step_inputs, m.mstep.step_outputs)
191

    
192
(** Print the prototype of the reset procedure of a machine.
193
   @param fmt the formater to print on
194
   @param m the machine
195
*)
196
let pp_reset_prototype fmt m =
197
  pp_simple_prototype fmt (pp_reset_procedure_name, InOut, m.mstatic, [])
198

    
199
(** Print the prototype of the clear procedure of a machine.
200
   @param fmt the formater to print on
201
   @param m the machine
202
*)
203
let pp_clear_prototype fmt m =
204
  pp_simple_prototype fmt (pp_clear_procedure_name, InOut, m.mstatic, [])