|
1
|
(********************************************************************)
|
|
2
|
(* *)
|
|
3
|
(* The LustreC compiler toolset / The LustreC Development Team *)
|
|
4
|
(* Copyright 2012 - -- ONERA - CNRS - INPT - ISAE-SUPAERO *)
|
|
5
|
(* *)
|
|
6
|
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *)
|
|
7
|
(* under the terms of the GNU Lesser General Public License *)
|
|
8
|
(* version 2.1. *)
|
|
9
|
(* *)
|
|
10
|
(********************************************************************)
|
|
11
|
|
|
12
|
open Format
|
|
13
|
|
|
14
|
open Machine_code_types
|
|
15
|
open Lustre_types
|
|
16
|
open Corelang
|
|
17
|
open Machine_code_common
|
|
18
|
|
|
19
|
open Ada_backend_common
|
|
20
|
|
|
21
|
(** Functions printing the .ads file **)
|
|
22
|
module Main =
|
|
23
|
struct
|
|
24
|
|
|
25
|
(** Print a with statement to include an instance.
|
|
26
|
@param fmt the formater to print on
|
|
27
|
@param instance the instance
|
|
28
|
**)
|
|
29
|
let pp_with_subinstance fmt instance =
|
|
30
|
pp_with_node fmt (extract_node instance)
|
|
31
|
|
|
32
|
(** Print the declaration of a state element of a subinstance of a machine.
|
|
33
|
@param fmt the formater to print on
|
|
34
|
@param instance the instance
|
|
35
|
**)
|
|
36
|
let pp_machine_subinstance_state_decl fmt instance =
|
|
37
|
pp_node_state_decl (fst instance) fmt (extract_node instance)
|
|
38
|
|
|
39
|
(** Print the state record for a machine.
|
|
40
|
@param fmt the formater to print on
|
|
41
|
@param machine the machine
|
|
42
|
**)
|
|
43
|
let pp_state_record_definition fmt (var_list, instances) =
|
|
44
|
fprintf fmt "@, @[<v>record@, @[<v>%a%t%a%t@]@,end record@]"
|
|
45
|
(Utils.fprintf_list ~sep:";@;" pp_machine_subinstance_state_decl) instances
|
|
46
|
(Utils.pp_final_char_if_non_empty ";@," instances)
|
|
47
|
(Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
|
|
48
|
(Utils.pp_final_char_if_non_empty ";" var_list)
|
|
49
|
|
|
50
|
(** Print the package declaration(ads) of a machine.
|
|
51
|
@param fmt the formater to print on
|
|
52
|
@param m the machine
|
|
53
|
**)
|
|
54
|
let pp_file fmt m =
|
|
55
|
(* Take apart the arrow instance from the instance list and transform them
|
|
56
|
into simple boolean variable *)
|
|
57
|
let extract (instances, arrows) instance =
|
|
58
|
let (name, (node, static)) = instance in
|
|
59
|
if String.equal (node_name node) Arrow.arrow_id then
|
|
60
|
(instances, (dummy_var_decl name Type_predef.type_bool)::arrows)
|
|
61
|
else
|
|
62
|
(instance::instances, arrows) in
|
|
63
|
let instances, arrows = List.fold_left extract ([], []) m.minstances in
|
|
64
|
(* Add the boolean variable reated for arrow instance to the list of all variable *)
|
|
65
|
let var_list = arrows@m.mmemory in
|
|
66
|
let pp_record fmt = pp_state_record_definition fmt (var_list, instances) in
|
|
67
|
fprintf fmt "@[<v>%a%t@,%a@, @[<v>@,%a;@,@,%t;@,@,%t;@,@,private@,@,%a;@,@]@,%a;@.@]"
|
|
68
|
|
|
69
|
(* Include all the subinstance*)
|
|
70
|
(Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances
|
|
71
|
(Utils.pp_final_char_if_non_empty ";@," instances)
|
|
72
|
|
|
73
|
(*Begin the package*)
|
|
74
|
(pp_begin_package false) m
|
|
75
|
|
|
76
|
(*Declare the state type*)
|
|
77
|
pp_private_limited_type_decl pp_state_type
|
|
78
|
|
|
79
|
(*Declare the reset procedure*)
|
|
80
|
(pp_reset_prototype m)
|
|
81
|
|
|
82
|
(*Declare the step procedure*)
|
|
83
|
(pp_step_prototype m)
|
|
84
|
|
|
85
|
(*Define the state type*)
|
|
86
|
pp_type_decl (pp_state_type, pp_record)
|
|
87
|
|
|
88
|
(*End the package*)
|
|
89
|
pp_end_package m
|
|
90
|
|
|
91
|
end
|