Revision fd834769
Added by Guillaume DAVY over 5 years ago
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
Ada: Add the generation of the wrapper file : the main ada file and the project. It is called
only if the main node option is given to lustrec. This feature implied some refactoring. Also
added some OCaml Doc to undocummented functions.