taste-parser_utils.ads 5.87 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
15
     Text_IO,
     GNAT.Strings,
     Interfaces.C_Streams,
16
     Templates_Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
17
     Ocarina,
Maxime Perrotin's avatar
Maxime Perrotin committed
18
19
20
21
     Ocarina.Types,
     Ocarina.Namet,
     Ocarina.ME_AADL.AADL_Tree.Nodes,
     Ocarina.ME_AADL.AADL_Instances.Nodes,
Maxime Perrotin's avatar
Maxime Perrotin committed
22
     Option_Type;
Maxime Perrotin's avatar
Maxime Perrotin committed
23
24
25
26
27
28
29

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
30
    Ada.Strings.Unbounded,
Maxime Perrotin's avatar
Maxime Perrotin committed
31
    Text_IO,
32
33
    Interfaces.C_Streams,
    Templates_Parser;
Maxime Perrotin's avatar
Maxime Perrotin committed
34

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

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

Maxime Perrotin's avatar
Maxime Perrotin committed
42
43
44
45
46
47
48
   --  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
49
50
51
52
53
   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
54
   Yellow      : constant String := ASCII.ESC & "[33m";
Maxime Perrotin's avatar
Maxime Perrotin committed
55
   White       : constant String := ASCII.ESC & "[37m";
Maxime Perrotin's avatar
Maxime Perrotin committed
56
57
58
59
60
61
62
63
64
   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
65
   function Underline return String is
Maxime Perrotin's avatar
Maxime Perrotin committed
66
67
     (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
68

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

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

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

76
77
   package String_Holders is new Indefinite_Holders (String);

78
79
   AADL_Parser_Error : exception;

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

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

84
   --  Record to store properties
85
86
87
88
89
90
91
   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
92
   use Property_Maps;
93
94
   package String_Vectors is new Indefinite_Vectors (Natural, String,
                                           Ada.Strings.Equal_Case_Insensitive);
95
96
97
98
99
   package String_Sets is new Indefinite_Ordered_Sets
      (Element_Type => String,
       "<"          => Ada.Strings.Less_Case_Insensitive,
       "="          => Ada.Strings.Equal_Case_Insensitive);

100
101
102
   --  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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
   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);
122
   --  use Option_UString;
Maxime Perrotin's avatar
Maxime Perrotin committed
123
   --  subtype Optional_Unbounded_String is Option_UString.Option;
Maxime Perrotin's avatar
Maxime Perrotin committed
124
   package Option_ULL is new Option_Type (Unsigned_Long_Long);
125
   --  use Option_ULL;
Maxime Perrotin's avatar
Maxime Perrotin committed
126
   --  subtype Optional_Long_Long is Option_ULL.Option;
Maxime Perrotin's avatar
Maxime Perrotin committed
127

128
129
   procedure Initialize_Ocarina;

130
   type Taste_Configuration is tagged
131
      record
132
         Binary_Path      : GNAT.Strings.String_Access;
133
134
135
136
         Interface_View   : aliased GNAT.Strings.String_Access;
         Deployment_View  : aliased GNAT.Strings.String_Access;
         Data_View        : aliased GNAT.Strings.String_Access;
         Output_Dir       : aliased GNAT.Strings.String_Access;
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
143
         Glue             : aliased Boolean := False;
         Use_POHIC        : aliased Boolean := False;
         Timer_Resolution : aliased Integer := 100;
         Debug_Flag       : aliased Boolean := False;
         Version          : aliased Boolean := False;
Maxime Perrotin's avatar
Maxime Perrotin committed
144
         Other_Files      : String_Vectors.Vector;
145
146
      end record;

Maxime Perrotin's avatar
Maxime Perrotin committed
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;