Project

General

Profile

Download (6.02 KB) Statistics
| Branch: | Tag: | Revision:
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 prototype of a machine procedure. The first parameter is always
149
the state, state_modifier specify the modifier applying to it. The next
150
parameters are inputs and the last parameters are the outputs.
151
   @param fmt the formater to print on
152
   @param name the name of the procedure
153
   @param state_mode the input/output mode for the state parameter
154
   @param input list of the input parameter of the procedure
155
   @param output list of the output parameter of the procedure
156
*)
157
let pp_simple_prototype fmt (name, state_mode, input, output) =
158
  fprintf fmt "procedure %s(@[<v>%a%t@[%a@]%t@[%a@])@]"
159
    name
160
    pp_state_var_decl state_mode
161
    (Utils.pp_final_char_if_non_empty ",@," input)
162
    (Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl In)) input
163
    (Utils.pp_final_char_if_non_empty ",@," output)
164
    (Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl Out)) output
165

    
166
(** Print the prototype of the init procedure of a machine.
167
   @param fmt the formater to print on
168
   @param m the machine
169
*)
170
let pp_init_prototype fmt m =
171
  pp_simple_prototype fmt ("init", Out, m.mstatic, [])
172

    
173
(** Print the prototype of the step procedure of a machine.
174
   @param fmt the formater to print on
175
   @param m the machine
176
*)
177
let pp_step_prototype fmt m =
178
  pp_simple_prototype fmt ("step", InOut, m.mstep.step_inputs, m.mstep.step_outputs)
179

    
180
(** Print the prototype of the reset procedure of a machine.
181
   @param fmt the formater to print on
182
   @param m the machine
183
*)
184
let pp_reset_prototype fmt m =
185
  pp_simple_prototype fmt ("reset", InOut, m.mstatic, [])
186

    
187
(** Print the prototype of the clear procedure of a machine.
188
   @param fmt the formater to print on
189
   @param m the machine
190
*)
191
let pp_clear_prototype fmt m =
192
  pp_simple_prototype fmt ("clear", InOut, m.mstatic, [])
(5-5/6)