Revision fd834769 src/backends/Ada/ada_backend_ads.ml
| src/backends/Ada/ada_backend_ads.ml | ||
|---|---|---|
| 22 | 22 |
module Main = |
| 23 | 23 |
struct |
| 24 | 24 |
|
| 25 |
(** Print name of a node associated to an instance.
|
|
| 25 |
(** Print a with statement to include an instance.
|
|
| 26 | 26 |
@param fmt the formater to print on |
| 27 | 27 |
@param instance the instance |
| 28 | 28 |
**) |
| 29 |
let pp_instance_node_name fmt instance = |
|
| 30 |
let (_, (node, _)) = instance in |
|
| 31 |
let node = match node.top_decl_desc with |
|
| 32 |
| Node nd -> nd |
|
| 33 |
| _ -> assert false (*TODO*) in |
|
| 34 |
pp_package_name fmt node |
|
| 29 |
let pp_with_subinstance fmt instance = |
|
| 30 |
pp_with_node fmt (extract_node instance) |
|
| 35 | 31 |
|
| 36 | 32 |
(** Print the declaration of a state element of a subinstance of a machine. |
| 37 | 33 |
@param fmt the formater to print on |
| 38 | 34 |
@param instance the instance |
| 39 | 35 |
**) |
| 40 | 36 |
let pp_machine_subinstance_state_decl fmt instance = |
| 41 |
let (name, (node, static)) = instance in |
|
| 42 |
let pp_package fmt = pp_instance_node_name fmt instance in |
|
| 43 |
let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in |
|
| 44 |
let pp_name fmt = print_clean_ada_identifier fmt name in |
|
| 45 |
pp_var_decl fmt (NoMode, pp_name, pp_type) |
|
| 37 |
pp_node_state_decl (fst instance) fmt (extract_node instance) |
|
| 46 | 38 |
|
| 47 | 39 |
(** Print the state record for a machine. |
| 48 | 40 |
@param fmt the formater to print on |
| ... | ... | |
| 55 | 47 |
(Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list |
| 56 | 48 |
(Utils.pp_final_char_if_non_empty ";" var_list) |
| 57 | 49 |
|
| 58 |
(** Print a with statement to include an instance. |
|
| 59 |
@param fmt the formater to print on |
|
| 60 |
@param instance the instance |
|
| 61 |
**) |
|
| 62 |
let pp_with_subinstance fmt instance = |
|
| 63 |
fprintf fmt "private with %a" pp_instance_node_name instance |
|
| 64 |
|
|
| 65 | 50 |
(** Print the package declaration(ads) of a machine. |
| 66 | 51 |
@param fmt the formater to print on |
| 67 |
@param machine the machine
|
|
| 52 |
@param m the machine |
|
| 68 | 53 |
**) |
| 69 |
let print fmt machine =
|
|
| 54 |
let pp_file fmt m =
|
|
| 70 | 55 |
(* Take apart the arrow instance from the instance list and transform them |
| 71 | 56 |
into simple boolean variable *) |
| 72 | 57 |
let extract (instances, arrows) instance = |
| ... | ... | |
| 75 | 60 |
(instances, (dummy_var_decl name Type_predef.type_bool)::arrows) |
| 76 | 61 |
else |
| 77 | 62 |
(instance::instances, arrows) in |
| 78 |
let instances, arrows = List.fold_left extract ([], []) machine.minstances in
|
|
| 63 |
let instances, arrows = List.fold_left extract ([], []) m.minstances in |
|
| 79 | 64 |
(* Add the boolean variable reated for arrow instance to the list of all variable *) |
| 80 |
let var_list = arrows@machine.mmemory in
|
|
| 65 |
let var_list = arrows@m.mmemory in |
|
| 81 | 66 |
let pp_record fmt = pp_state_record_definition fmt (var_list, instances) in |
| 82 | 67 |
fprintf fmt "@[<v>%a%t@,%a@, @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,private@,@,%a;@,@]@,%a;@.@]" |
| 83 |
(Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances (* Include all the subinstance*) |
|
| 68 |
|
|
| 69 |
(* Include all the subinstance*) |
|
| 70 |
(Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances |
|
| 84 | 71 |
(Utils.pp_final_char_if_non_empty ";@," instances) |
| 85 |
(pp_begin_package false) machine (*Begin the package*) |
|
| 86 |
pp_private_type_decl pp_state_type (*Declare the state type*) |
|
| 87 |
pp_init_prototype machine (*Declare the init procedure*) |
|
| 88 |
pp_step_prototype machine (*Declare the step procedure*) |
|
| 89 |
pp_reset_prototype machine (*Declare the reset procedure*) |
|
| 90 |
pp_clear_prototype machine (*Declare the clear procedure*) |
|
| 91 |
pp_type_decl (pp_state_type, pp_record) (*Define the state type*) |
|
| 92 |
pp_end_package machine (*End the package*) |
|
| 72 |
|
|
| 73 |
(*Begin the package*) |
|
| 74 |
(pp_begin_package false) m |
|
| 75 |
|
|
| 76 |
(*Declare the state type*) |
|
| 77 |
pp_private_type_decl pp_state_type |
|
| 78 |
|
|
| 79 |
(*Declare the init procedure*) |
|
| 80 |
(pp_init_prototype m) pp_init_procedure_name |
|
| 81 |
|
|
| 82 |
(*Declare the step procedure*) |
|
| 83 |
(pp_step_prototype m) pp_step_procedure_name |
|
| 84 |
|
|
| 85 |
(*Declare the reset procedure*) |
|
| 86 |
(pp_reset_prototype m) pp_reset_procedure_name |
|
| 87 |
|
|
| 88 |
(*Declare the clear procedure*) |
|
| 89 |
(pp_clear_prototype m) pp_clear_procedure_name |
|
| 90 |
|
|
| 91 |
(*Define the state type*) |
|
| 92 |
pp_type_decl (pp_state_type, pp_record) |
|
| 93 |
|
|
| 94 |
(*End the package*) |
|
| 95 |
pp_end_package m |
|
| 93 | 96 |
|
| 94 | 97 |
end |
Also available in: Unified diff