taste-aadl_parser.adb 11 KB
Newer Older
1
2
--  ************************ TASTE AADL Parser **************************  --
--  Based on Ocarina ****************************************************  --
3
--  (c) 2018 European Space Agency - maxime.perrotin@esa.int
4
5
--  LGPL license, see LICENSE file

6
with System.Assertions,
7
8
     Ada.Exceptions,
     Ada.Text_IO,
9
     Ada.Directories,
10
     Ada.Strings.Equal_Case_Insensitive,
11
     GNAT.Command_Line,
12
13
14
15
16
     Errors,
     Locations,
     Ocarina.Namet,
     Ocarina.Configuration,
     Ocarina.Files,
17
     Ocarina.Parser,
18
     Ocarina.FE_AADL.Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
19
     TASTE.Backend.Build_Script,
Maxime Perrotin's avatar
Maxime Perrotin committed
20
     TASTE.Backend.Code_Generators,
21
     TASTE.Semantic_Check;
22
23
24

use Ada.Text_IO,
    Ada.Exceptions,
25
    Ada.Directories,
26
27
28
29
30
31
32
    Locations,
    Ocarina.Namet,
    Ocarina;

package body TASTE.AADL_Parser is

   function Initialize return Taste_Configuration is
Maxime Perrotin's avatar
Maxime Perrotin committed
33
34
35
      File_Name  : Name_Id;
      File_Descr : Location;
      Cfg        : Taste_Configuration;
36
37
38
39
   begin
      Banner;
      --  Parse arguments before initializing Ocarina, otherwise Ocarina eats
      --  some arguments (all file parameters).
Maxime Perrotin's avatar
Maxime Perrotin committed
40
      Parse_Command_Line (Cfg);
41
42
43
44
      Initialize_Ocarina;

      AADL_Language := Get_String_Name ("aadl");

Maxime Perrotin's avatar
Maxime Perrotin committed
45
      if Cfg.Interface_View.all'Length = 0 and not Cfg.Check_Data_View then
Maxime Perrotin's avatar
Maxime Perrotin committed
46
47
48
         --  Use "InterfaceView.aadl" by default, if nothing else is specified
         --  and if the tool is not only called to check the data view
         Cfg.Interface_View := Default_Interface_View'Access;
49
50
      end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
51
52
53
      --  An interface view is expected, look for it and parse it
      if Cfg.Interface_View.all'Length > 0 then
         Set_Str_To_Name_Buffer (Cfg.Interface_View.all);
54

Maxime Perrotin's avatar
Maxime Perrotin committed
55
56
57
58
59
60
61
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
              with "File not found : " & Cfg.Interface_View.all;
         end if;

         File_Descr := Ocarina.Files.Load_File (File_Name);
62

Maxime Perrotin's avatar
Maxime Perrotin committed
63
64
         Interface_Root := Ocarina.Parser.Parse
           (AADL_Language, Interface_Root, File_Descr);
65

Maxime Perrotin's avatar
Maxime Perrotin committed
66
67
68
69
70
71
72
         --  Parse TASTE_IV_Properties.aadl
         Set_Str_To_Name_Buffer ("TASTE_IV_Properties.aadl");
         File_Name  := Ocarina.Files.Search_File (Name_Find);
         File_Descr := Ocarina.Files.Load_File (File_Name);
         Interface_Root := Ocarina.Parser.Parse (AADL_Language,
                                                 Interface_Root, File_Descr);
      end if;
73

Maxime Perrotin's avatar
Maxime Perrotin committed
74
75
76
77
78
      if Cfg.Glue then
         --  Look for a deployment view (or DeploymentView.aadl by default)
         --  if the glue generation is requested. Not needed for skeletons.
         if Cfg.Deployment_View.all'Length = 0 then
            Cfg.Deployment_View := Default_Deployment_View'Access;
79
80
         end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
81
         Set_Str_To_Name_Buffer (Cfg.Deployment_View.all);
82
83
84
85

         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
Maxime Perrotin's avatar
Maxime Perrotin committed
86
              with "File not found : " & Cfg.Deployment_View.all;
87
88
89
90
91
92
93
94
95
96
97
         end if;

         File_Descr := Ocarina.Files.Load_File (File_Name);
         Deployment_Root := Ocarina.Parser.Parse
           (AADL_Language, Deployment_Root, File_Descr);

         if Deployment_Root = No_Node then
            raise AADL_Parser_Error with "Deployment View is incorrect";
         end if;
      end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
98
99
100
      for Each of Cfg.Other_Files loop
         --  Add other files to the Interface and (if any) deployment roots
         --  (List of files specified in the command line)
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
         Set_Str_To_Name_Buffer (Each);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error with "File not found: " & Each;
         end if;
         File_Descr := Ocarina.Files.Load_File (File_Name);

         Interface_Root := Ocarina.Parser.Parse
           (AADL_Language, Interface_Root, File_Descr);
         if Deployment_Root /= No_Node then
            Deployment_Root := Ocarina.Parser.Parse
              (AADL_Language, Deployment_Root, File_Descr);
         end if;
      end loop;

Maxime Perrotin's avatar
Maxime Perrotin committed
116
117
      if Cfg.Data_View.all'Length > 0 then
         Set_Str_To_Name_Buffer (Cfg.Data_View.all);
118
119
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
120
            raise AADL_Parser_Error with "Could not find " & Cfg.Data_View.all;
121
122
         end if;
      else
Maxime Perrotin's avatar
Maxime Perrotin committed
123
         --  Try with default name (DataView.aadl)
124
125
126
         Set_Str_To_Name_Buffer (Default_Data_View);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name /= No_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
127
128
129
130
            Cfg.Data_View := Default_Data_View'Access;
         elsif Cfg.Check_Data_View then
            --  No dataview found, while user asked explicitly for a check
            raise AADL_Parser_Error with "Could not find DataView.aadl";
131
132
133
134
         end if;
      end if;

      if File_Name /= No_Name then
Maxime Perrotin's avatar
Maxime Perrotin committed
135
136
         Put_Info ("Parsing " & Cfg.Data_View.all);

137
138
         File_Descr := Ocarina.Files.Load_File (File_Name);

Maxime Perrotin's avatar
Maxime Perrotin committed
139
140
141
142
143
         --  Add the Data View to the Interface View root, if any
         if Interface_Root /= No_Node then
            Interface_Root := Ocarina.Parser.Parse
              (AADL_Language, Interface_Root, File_Descr);
         end if;
144
145
146
147
148
149

         --  Add the Data View to the Deployment View root, if any
         if Deployment_Root /= No_Node then
            Deployment_Root := Ocarina.Parser.Parse
               (AADL_Language, Deployment_Root, File_Descr);
         end if;
150
         --  Also parse the data view as a root component
151
         Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := False;
152
153
154
         Dataview_root := Ocarina.Parser.Parse
                            (AADL_Language, Dataview_root, File_Descr);
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
155
      return Cfg;
156
157
158
159
160
161
162
   end Initialize;

   function Parse_Project return TASTE_Model is
      Result : TASTE_Model;
   begin
      Result.Configuration := Initialize;

Maxime Perrotin's avatar
Maxime Perrotin committed
163
164
165
166
167
168
169
170
      if Interface_Root /= No_Node then
         --  Parse Interface and Deployment View
         begin
            Result.Interface_View := Parse_Interface_View (Interface_Root);
         exception
            when System.Assertions.Assert_Failure =>
               raise AADL_Parser_Error with "Interface view parsing error";
         end;
171

Maxime Perrotin's avatar
Maxime Perrotin committed
172
173
174
175
         if Result.Configuration.Deployment_View.all'Length > 0 then
            AADL_Lib.Append (Result.Configuration.Interface_View.all);
            Result.Deployment_View := Parse_Deployment_View (Deployment_Root);
         end if;
176
177
      end if;

178
179
180
      if Result.Configuration.Data_View.all'Length > 0 then
         begin
            Result.Data_View := Parse_Data_View (Dataview_root);
181
            Result.Data_View.Check_Files;
182
183
184
185
186
         exception
            when Constraint_Error =>
               raise Data_View_Error with "Update your data view!";
         end;
      end if;
187

188
189
190
      Ocarina.Configuration.Reset_Modules;
      Ocarina.Reset;

Maxime Perrotin's avatar
Maxime Perrotin committed
191
192
193
194
      if Result.Configuration.Check_Data_View then
         raise Quit_Taste;
      end if;

195
196
      Semantic_Check.Check_Model (Result);

197
198
199
200
201
202
203
      return Result;
   exception
      when Error : AADL_Parser_Error
         | Interface_Error
         | Function_Error
         | No_RCM_Error
         | Deployment_View_Error
204
         | Data_View_Error
205
         | Semantic_Check.Semantic_Error
206
         | Device_Driver_Error =>
207
         Put_Error (Exception_Message (Error));
208
209
210
         raise Quit_Taste;
      when GNAT.Command_Line.Exit_From_Command_Line =>
         New_Line;
211
212
         Put_Info ("For more information, visit " & Underline & White_Bold
                   & "https://taste.tools");
213
214
215
216
         raise Quit_Taste;
      when GNAT.Command_Line.Invalid_Switch
         | GNAT.Command_Line.Invalid_Parameter
         | GNAT.Command_Line.Invalid_Section =>
217
         Put_Error ("Invalid switch or parameter (try --help)" & No_Color);
218
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
219
220
      when Quit_Taste =>
         raise;
221
222
223
224
225
      when E : others =>
         Errors.Display_Bug_Box (E);
         raise Quit_Taste;
   end Parse_Project;

226
227
228
229
   function Find_Binding (Model : TASTE_Model;
                          F     : Unbounded_String)
                          return Option_Partition.Option is
      use Option_Partition;
230
231
      function Is_Equal (Left, Right : String) return Boolean
         renames Ada.Strings.Equal_Case_Insensitive;
232
233
234
235
236
      Function_Name : constant String := To_String (F);
   begin
      for Node of Model.Deployment_View.Nodes loop
         for Each of Node.Partitions loop
            for Binding of Each.Bound_Functions loop
237
               if Is_Equal (Binding, Function_Name) then
238
239
240
241
242
243
244
245
                  return Just (Each);
               end if;
            end loop;
         end loop;
      end loop;
      return Nothing;
   end Find_Binding;

246
247
248
249
250
251
   procedure Add_Concurrency_View (Model : in out TASTE_Model) is
      Result : Taste_Concurrency_View;
   begin
      Model.Concurrency_View := Result;
   end Add_Concurrency_View;

252
   procedure Dump (Model : TASTE_Model) is
253
254
255
      Output_Path : constant String := Model.Configuration.Output_Dir.all
                      & "/Debug";
      Output  : File_Type;
256
   begin
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
      if Model.Configuration.Debug_Flag then
         Create_Path (Output_Path);
         Create (File => Output,
                 Mode => Out_File,
                 Name => Output_Path & "/InterfaceView.dump");
         Put_Info ("Dump of the Interface View");
         Model.Interface_View.Debug_Dump (Output);
         Close (Output);

         if Model.Configuration.Deployment_View.all'Length > 0 then
            Create (File => Output,
                    Mode => Out_File,
                    Name => Output_Path & "/DeploymentView.dump");
            Put_Info ("Dump of the Deployment View");
            Model.Deployment_View.Debug_Dump (Output);
            Close (Output);
         end if;
         Create (File => Output,
                 Mode => Out_File,
                 Name => Output_Path & "/DataView.dump");
         Put_Info ("Dump of the Data View");
Maxime Perrotin's avatar
Maxime Perrotin committed
278
         Model.Data_View.Debug_Dump (Output);
279
280
281
282
283
         Close (Output);
         Create (File => Output,
                 Mode => Out_File,
                 Name => Output_Path & "/commandline.dump");
         Put_Info ("Dump of the Command Line");
Maxime Perrotin's avatar
Maxime Perrotin committed
284
         Model.Configuration.Debug_Dump (Output);
285
         Close (Output);
286
287
288
289

         Put_Info ("Make a local copy of ASN.1 files for export");
         Create_Path (Output_Path & "/Export");
         Model.Data_View.Export_ASN1_Files (Output_Path & "/Export/");
290
      end if;
291
292
293
294
   exception
      when Error : others =>
         Put_Error ("Debug Dump : " & Exception_Message (Error));
         raise Quit_Taste;
295
296
   end Dump;

297
298
299
300
301
   procedure Generate_Build_Script (Model : TASTE_Model) is
   begin
      TASTE.Backend.Build_Script.Generate (Model);
   end Generate_Build_Script;

Maxime Perrotin's avatar
Maxime Perrotin committed
302
   procedure Generate_Code (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
303
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
304
      TASTE.Backend.Code_Generators.Generate (Model);
305
   exception
Maxime Perrotin's avatar
Maxime Perrotin committed
306
      when Error : TASTE.Backend.Code_Generators.ACG_Error =>
307
308
         Put_Error (Exception_Message (Error));
         raise Quit_Taste;
309
310
      when Error : others =>
         Errors.Display_Bug_Box (Error);
311
         raise Quit_Taste;
Maxime Perrotin's avatar
Maxime Perrotin committed
312
   end Generate_Code;
313
end TASTE.AADL_Parser;