taste-parser_utils.ads 5.8 KB
Newer Older
1
--  *************************** taste aadl parser ***********************  --
Maxime Perrotin's avatar
Maxime Perrotin committed
2
--  (c) 2008-2018 European Space Agency - maxime.perrotin@esa.int
Maxime Perrotin's avatar
Maxime Perrotin committed
3
4
--  LGPL license, see LICENSE file

5
--  Set of helper functions for the parser
Maxime Perrotin's avatar
Maxime Perrotin committed
6
with Ada.Containers.Indefinite_Ordered_Maps,
7
     Ada.Containers.Indefinite_Ordered_Sets,
Maxime Perrotin's avatar
Maxime Perrotin committed
8
     Ada.Containers.Indefinite_Vectors,
9
     Ada.Containers.Indefinite_Holders,
Maxime Perrotin's avatar
Maxime Perrotin committed
10
     Ada.Strings.Unbounded,
11
     Ada.Strings.Equal_Case_Insensitive,
Maxime Perrotin's avatar
Maxime Perrotin committed
12
     Ada.Strings.Less_Case_Insensitive,
Maxime Perrotin's avatar
Maxime Perrotin committed
13
14
     Text_IO,
     Interfaces.C_Streams,
15
     Templates_Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
16
     Ocarina,
Maxime Perrotin's avatar
Maxime Perrotin committed
17
18
19
20
     Ocarina.Types,
     Ocarina.Namet,
     Ocarina.ME_AADL.AADL_Tree.Nodes,
     Ocarina.ME_AADL.AADL_Instances.Nodes,
Maxime Perrotin's avatar
Maxime Perrotin committed
21
     Option_Type;
Maxime Perrotin's avatar
Maxime Perrotin committed
22
23
24
25
26
27
28

use Ocarina,
    Ocarina.Types,
    Ocarina.Namet,
    Ocarina.ME_AADL.AADL_Tree.Nodes,
    Ocarina.ME_AADL.AADL_Instances.Nodes,
    Ada.Containers,
Maxime Perrotin's avatar
Maxime Perrotin committed
29
    Ada.Strings.Unbounded,
Maxime Perrotin's avatar
Maxime Perrotin committed
30
    Text_IO,
31
32
    Interfaces.C_Streams,
    Templates_Parser;
Maxime Perrotin's avatar
Maxime Perrotin committed
33

34
package TASTE.Parser_Utils is
Maxime Perrotin's avatar
Maxime Perrotin committed
35

Maxime Perrotin's avatar
Maxime Perrotin committed
36
   AADL_Language           : Name_Id;
37
38
39
   Default_Interface_View  : constant String := "InterfaceView.aadl";
   Default_Deployment_View : constant String := "DeploymentView.aadl";
   Default_Data_View       : constant String := "DataView.aadl";
Maxime Perrotin's avatar
Maxime Perrotin committed
40

Maxime Perrotin's avatar
Maxime Perrotin committed
41
42
43
44
45
46
47
   --  Create a case insensitive string type, that can be used as keys for maps
   subtype Case_Insensitive_String is String;
   function "="(Left, Right : Case_Insensitive_String) return Boolean
      renames Ada.Strings.Equal_Case_Insensitive;
   function "<"(Left, Right : Case_Insensitive_String) return Boolean
      renames Ada.Strings.Less_Case_Insensitive;

Maxime Perrotin's avatar
Maxime Perrotin committed
48
49
50
51
52
   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
   function US (Source : String) return Unbounded_String renames
       To_Unbounded_String;

Maxime Perrotin's avatar
Maxime Perrotin committed
53
   Yellow      : constant String := ASCII.ESC & "[33m";
Maxime Perrotin's avatar
Maxime Perrotin committed
54
   White       : constant String := ASCII.ESC & "[37m";
Maxime Perrotin's avatar
Maxime Perrotin committed
55
56
57
58
59
60
61
62
63
   Red         : constant String := ASCII.ESC & "[31m";
   Bold        : constant String := ASCII.ESC & "[1m";

   function Is_Tty return Boolean is (Isatty (Fileno (Stdout)) /= 0);
   function Red_Bold return String is (if Is_Tty then Red & Bold else "");
   function Yellow_Bold return String is
     (if Is_Tty then Yellow & Bold else "");
   function No_Color return String is
     (if Is_Tty then ASCII.ESC & "[0m" else "");
Maxime Perrotin's avatar
Maxime Perrotin committed
64
   function Underline return String is
Maxime Perrotin's avatar
Maxime Perrotin committed
65
66
     (if Is_Tty then ASCII.ESC & "[4m" else "");
   function White_Bold return String is (if Is_Tty then White & Bold else "");
Maxime Perrotin's avatar
Maxime Perrotin committed
67

68
69
   function Strip_String (Input_String : String) return String;

70
71
72
   procedure Put_Info  (Info  : String);
   procedure Put_Error (Error : String);

Maxime Perrotin's avatar
Maxime Perrotin committed
73
74
   procedure Banner;

75
76
   package String_Holders is new Indefinite_Holders (String);

77
78
   AADL_Parser_Error : exception;

Maxime Perrotin's avatar
Maxime Perrotin committed
79
80
   function Get_APLC_Binding (E : Node_Id) return List_Id;

81
82
   function Get_Interface_Name (D : Node_Id) return Name_Id;

83
   --  Record to store properties
84
85
86
87
88
89
90
   type User_Property is
      record
         Name  : Unbounded_String;
         Value : Unbounded_String;
      end record;
   package Property_Maps is new Indefinite_Ordered_Maps (String,
                                                         User_Property);
Maxime Perrotin's avatar
Maxime Perrotin committed
91
   use Property_Maps;
92
93
   package String_Vectors is new Indefinite_Vectors (Natural, String,
                                           Ada.Strings.Equal_Case_Insensitive);
94
95
96
97
98
   package String_Sets is new Indefinite_Ordered_Sets
      (Element_Type => String,
       "<"          => Ada.Strings.Less_Case_Insensitive,
       "="          => Ada.Strings.Equal_Case_Insensitive);

99
100
101
   --  Helper function translating directly a string set to a templates Tag
   function To_Template_Tag (SS : String_Sets.Set) return Tag;

Maxime Perrotin's avatar
Maxime Perrotin committed
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
   function Get_Properties_Map (D : Node_Id) return Property_Maps.Map;

   --  Shortcut to read an identifier from the parser, in lowercase
   function ATN_Lower (N : Node_Id) return String is
       (Get_Name_String (ATN.Name (ATN.Identifier (N))));

   --  Shortcut to read an identifier from the parser, with original case
   function ATN_Case (N : Node_Id) return String is
       (Get_Name_String (ATN.Display_Name (ATN.Identifier (N))));

   --  Shortcut to read an identifier from the parser, in lowercase
   function AIN_Lower (N : Node_Id) return String is
       (Get_Name_String (AIN.Name (AIN.Identifier (N))));

   --  Shortcut to read an identifier from the parser, with original case
   function AIN_Case (N : Node_Id) return String is
       (Get_Name_String (AIN.Display_Name (AIN.Identifier (N))));

   package Option_UString is new Option_Type (Unbounded_String);
121
   --  use Option_UString;
Maxime Perrotin's avatar
Maxime Perrotin committed
122
   --  subtype Optional_Unbounded_String is Option_UString.Option;
Maxime Perrotin's avatar
Maxime Perrotin committed
123
   package Option_ULL is new Option_Type (Unsigned_Long_Long);
124
   --  use Option_ULL;
Maxime Perrotin's avatar
Maxime Perrotin committed
125
   --  subtype Optional_Long_Long is Option_ULL.Option;
Maxime Perrotin's avatar
Maxime Perrotin committed
126

127
128
   procedure Initialize_Ocarina;

129
   subtype String_Holder is String_Holders.Holder;
130
   type Taste_Configuration is tagged
131
      record
132
133
134
135
136
         Binary_Path      : String_Holder;
         Interface_View   : String_Holder;
         Deployment_View  : String_Holder;
         Data_View        : String_Holder;
         Output_Dir       : String_Holder;
Maxime Perrotin's avatar
Maxime Perrotin committed
137
         Check_Data_View  : aliased Boolean := False;
138
         Skeletons        : aliased Boolean := True;
Maxime Perrotin's avatar
Maxime Perrotin committed
139
140
141
142
         Glue             : aliased Boolean := False;
         Use_POHIC        : aliased Boolean := False;
         Timer_Resolution : aliased Integer := 100;
         Debug_Flag       : aliased Boolean := False;
Maxime Perrotin's avatar
Maxime Perrotin committed
143
         Other_Files      : String_Vectors.Vector;
144
145
      end record;

Maxime Perrotin's avatar
Maxime Perrotin committed
146
147
   procedure Debug_Dump         (Config :     Taste_Configuration;
                                 Output :     File_Type);
Maxime Perrotin's avatar
Maxime Perrotin committed
148
   procedure Parse_Command_Line (Result : out Taste_Configuration);
149
150
151
152

   --  Define a vector for template_parser translate sets
   package Translate_Sets is new Indefinite_Vectors (Natural, Translate_Set);

153
end TASTE.Parser_Utils;