Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_ads.ml @ fd834769

History | View | Annotate | Download (3.48 KB)

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;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,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_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
96

    
97
end