Revision 09d7b39f
Added by Guillaume DAVY about 4 years ago
| src/backends/Ada/ada_backend_ads.ml | ||
|---|---|---|
| 38 | 38 |
@param typed_instances list typed instances |
| 39 | 39 |
**) |
| 40 | 40 |
let pp_state_record_definition fmt (var_list, typed_instances) = |
| 41 |
fprintf fmt "@, @[<v>record@, @[<v>%a%t%a%t@]@,end record@]" |
|
| 41 |
fprintf fmt "@, @[<v>record@, @[<v>%a%t%t%a%t@]@,end record@]"
|
|
| 42 | 42 |
(Utils.fprintf_list ~sep:";@;" pp_machine_subinstance_state_decl) |
| 43 | 43 |
typed_instances |
| 44 |
(Utils.pp_final_char_if_non_empty ";@," typed_instances) |
|
| 44 |
(Utils.pp_final_char_if_non_empty ";" typed_instances) |
|
| 45 |
(fun fmt -> if var_list!=[] && typed_instances!= [] then fprintf fmt "@,@," else fprintf fmt "") |
|
| 45 | 46 |
(Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) |
| 46 | 47 |
var_list |
| 47 | 48 |
(Utils.pp_final_char_if_non_empty ";" var_list) |
| ... | ... | |
| 139 | 140 |
|
| 140 | 141 |
(** Print the package declaration(ads) of a machine. |
| 141 | 142 |
It requires the list of all typed instance. |
| 142 |
A typed submachine instance is (ident, type_machine) with ident |
|
| 143 |
the instance name and typed_machine is (substitution, machine) with machine |
|
| 144 |
the machine associated to the instance and substitution the instanciation of |
|
| 145 |
all its polymorphic types. |
|
| 143 |
A typed submachine is a (ident, typed_machine) with |
|
| 144 |
- ident: the name |
|
| 145 |
- typed_machine: a (substitution, machine) with |
|
| 146 |
- machine: the submachine struct |
|
| 147 |
- substitution the instanciation of all its polymorphic types. |
|
| 146 | 148 |
@param fmt the formater to print on |
| 147 |
@param typed_instances list of all typed machine instances of this machine
|
|
| 149 |
@param typed_submachines list of all typed submachines of this machine
|
|
| 148 | 150 |
@param m the machine |
| 149 | 151 |
**) |
| 150 |
let pp_file fmt (typed_instances, m) =
|
|
| 151 |
let typed_machines = snd (List.split typed_instances) in
|
|
| 152 |
let pp_file fmt (typed_submachines, m) =
|
|
| 153 |
let typed_machines = snd (List.split typed_submachines) in
|
|
| 152 | 154 |
let typed_machines_set = remove_duplicates eq_typed_machine typed_machines in |
| 153 | 155 |
|
| 154 | 156 |
let machines_to_import = snd (List.split typed_machines_set) in |
| ... | ... | |
| 157 | 159 |
|
| 158 | 160 |
let typed_machines_to_instanciate = |
| 159 | 161 |
List.filter (fun (l, _) -> l != []) typed_machines_set in |
| 162 |
|
|
| 163 |
let typed_instances = List.filter is_submachine_statefull typed_submachines in |
|
| 160 | 164 |
|
| 161 | 165 |
let pp_record fmt = |
| 162 | 166 |
pp_state_record_definition fmt (m.mmemory, typed_instances) in |
| 167 |
|
|
| 168 |
let pp_state_decl_and_reset fmt = fprintf fmt "%a;@,@,%t;@,@," |
|
| 169 |
(*Declare the state type*) |
|
| 170 |
pp_private_limited_type_decl pp_state_type |
|
| 171 |
(*Declare the reset procedure*) |
|
| 172 |
(pp_reset_prototype m) |
|
| 173 |
in |
|
| 174 |
|
|
| 175 |
let pp_private_section fmt = fprintf fmt "@,private@,@,%a%t%a;@," |
|
| 176 |
(*Instantiate the polymorphic type that need to be instantiated*) |
|
| 177 |
(Utils.fprintf_list ~sep:";@," pp_new_package) typed_machines_to_instanciate |
|
| 178 |
(Utils.pp_final_char_if_non_empty ";@,@," typed_machines_to_instanciate) |
|
| 179 |
(*Define the state type*) |
|
| 180 |
pp_type_decl (pp_state_type, pp_record) |
|
| 181 |
in |
|
| 163 | 182 |
|
| 183 |
let pp_ifstatefull fmt pp = |
|
| 184 |
if is_machine_statefull m then |
|
| 185 |
fprintf fmt "%t" pp |
|
| 186 |
else |
|
| 187 |
fprintf fmt "" |
|
| 188 |
in |
|
| 164 | 189 |
|
| 165 |
fprintf fmt "@[<v>%a%t%a%a@, @[<v>@,%a;@,@,%t;@,@,%a;@,@,private@,@,%a%t%a;@,@]@,%a;@.@]"
|
|
| 190 |
fprintf fmt "@[<v>%a%t%a%a@, @[<v>@,%a%a;@,%a@]@,%a;@.@]"
|
|
| 166 | 191 |
|
| 167 |
(* Include all the subinstance*) |
|
| 192 |
(* Include all the subinstance package*)
|
|
| 168 | 193 |
(Utils.fprintf_list ~sep:";@," pp_with_machine) machines_to_import |
| 169 | 194 |
(Utils.pp_final_char_if_non_empty ";@,@," machines_to_import) |
| 170 | 195 |
|
| ... | ... | |
| 172 | 197 |
|
| 173 | 198 |
(*Begin the package*) |
| 174 | 199 |
(pp_begin_package false) m |
| 175 |
|
|
| 176 |
(*Declare the state type*) |
|
| 177 |
pp_private_limited_type_decl pp_state_type |
|
| 178 |
|
|
| 179 |
(*Declare the reset procedure*) |
|
| 180 |
(pp_reset_prototype m) |
|
| 200 |
|
|
| 201 |
pp_ifstatefull pp_state_decl_and_reset |
|
| 181 | 202 |
|
| 182 | 203 |
(*Declare the step procedure*) |
| 183 | 204 |
pp_step_prototype_contract m |
| 184 | 205 |
|
| 185 |
(*Instantiate the polymorphic type that need to be instantiated*) |
|
| 186 |
(Utils.fprintf_list ~sep:";@," pp_new_package) typed_machines_to_instanciate |
|
| 187 |
(Utils.pp_final_char_if_non_empty ";@,@," typed_machines_to_instanciate) |
|
| 188 |
|
|
| 189 |
(*Define the state type*) |
|
| 190 |
pp_type_decl (pp_state_type, pp_record) |
|
| 206 |
(*Print the private section*) |
|
| 207 |
pp_ifstatefull pp_private_section |
|
| 191 | 208 |
|
| 192 | 209 |
(*End the package*) |
| 193 | 210 |
pp_end_package m |
Also available in: Unified diff
Ada: Add generation of step calls and refactor prototypes and ads printing to handle staless
instance.