taste-parser_utils.ads 5.44 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
9
     Ada.Containers.Indefinite_Vectors,
     Ada.Strings.Unbounded,
10
     Ada.Strings.Equal_Case_Insensitive,
Maxime Perrotin's avatar
Maxime Perrotin committed
11
     Ada.Strings.Less_Case_Insensitive,
Maxime Perrotin's avatar
Maxime Perrotin committed
12
13
14
15
     Text_IO,
     GNAT.Strings,
     Interfaces.C_Streams,
     Ocarina,
Maxime Perrotin's avatar
Maxime Perrotin committed
16
17
18
19
     Ocarina.Types,
     Ocarina.Namet,
     Ocarina.ME_AADL.AADL_Tree.Nodes,
     Ocarina.ME_AADL.AADL_Instances.Nodes,
Maxime Perrotin's avatar
Maxime Perrotin committed
20
     Option_Type;
Maxime Perrotin's avatar
Maxime Perrotin committed
21
22
23
24
25
26
27

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

32
package TASTE.Parser_Utils is
Maxime Perrotin's avatar
Maxime Perrotin committed
33

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

66
67
   function Strip_String (Input_String : String) return String;

68
69
70
   procedure Put_Info  (Info  : String);
   procedure Put_Error (Error : String);

Maxime Perrotin's avatar
Maxime Perrotin committed
71
72
   procedure Banner;

73
74
   AADL_Parser_Error : exception;

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

77
78
   function Get_Interface_Name (D : Node_Id) return Name_Id;

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

Maxime Perrotin's avatar
Maxime Perrotin committed
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
   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);
   use Option_UString;
   subtype Optional_Unbounded_String is Option_UString.Option;
   package Option_ULL is new Option_Type (Unsigned_Long_Long);
   use Option_ULL;
   subtype Optional_Long_Long is Option_ULL.Option;

120
121
   procedure Initialize_Ocarina;

122
   type Taste_Configuration is tagged
123
      record
124
         Binary_Path      : GNAT.Strings.String_Access;
125
126
127
128
         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
129
         Check_Data_View  : aliased Boolean := False;
130
         Skeletons        : aliased Boolean := True;
Maxime Perrotin's avatar
Maxime Perrotin committed
131
132
133
134
135
         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
136
         Other_Files      : String_Vectors.Vector;
137
138
      end record;

Maxime Perrotin's avatar
Maxime Perrotin committed
139
   procedure Debug_Dump (Config : Taste_Configuration; Output : File_Type);
Maxime Perrotin's avatar
Maxime Perrotin committed
140
   procedure Parse_Command_Line (Result : out Taste_Configuration);
141
end TASTE.Parser_Utils;