taste-aadl_parser.adb 6.49 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
--  ************************ TASTE AADL Parser **************************  --
--  Based on Ocarina ****************************************************  --
--  (c) 2017 European Space Agency - maxime.perrotin@esa.int
--  LGPL license, see LICENSE file

with GNAT.Command_Line,
     Ada.Exceptions,
     Ada.Text_IO,
     Errors,
     Locations,
     Ocarina.Namet,
     Ocarina.Configuration,
     Ocarina.Files,
14
15
     Ocarina.Parser,
     TASTE.Backend.Build_Script;
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

use Ada.Text_IO,
    Ada.Exceptions,
    Locations,
    Ocarina.Namet,
    Ocarina;

package body TASTE.AADL_Parser is

   function Initialize return Taste_Configuration is
      File_Name      : Name_Id;
      File_Descr     : Location;
      Current_Config : Taste_Configuration;
   begin
      Banner;
      --  Parse arguments before initializing Ocarina, otherwise Ocarina eats
      --  some arguments (all file parameters).
      Parse_Command_Line (Current_Config);
      Initialize_Ocarina;

      AADL_Language := Get_String_Name ("aadl");

      if Current_Config.Interface_View.all'Length = 0 then
         Current_Config.Interface_View := Default_Interface_View'Access;
      end if;

      Set_Str_To_Name_Buffer (Current_Config.Interface_View.all);

      File_Name := Ocarina.Files.Search_File (Name_Find);
      if File_Name = No_Name then
         raise AADL_Parser_Error
           with "File not found : " & Current_Config.Interface_View.all;
      end if;

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

      Interface_Root := Ocarina.Parser.Parse
        (AADL_Language, Interface_Root, File_Descr);

      if Current_Config.Glue then
         if Current_Config.Deployment_View.all'Length = 0 then
            Current_Config.Deployment_View := Default_Deployment_View'Access;
         end if;

         Set_Str_To_Name_Buffer (Current_Config.Deployment_View.all);

         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error
              with "File not found : " & Current_Config.Deployment_View.all;
         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;

      for Each of Current_Config.Other_Files loop
         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);

         --  Add other files to the Interface and (if any) deployment roots
         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;

      --  Missing data view is actually not an error.
      --  Systems can live with parameterless messages
      if Current_Config.Data_View.all'Length > 0 then
         Set_Str_To_Name_Buffer (Current_Config.Data_View.all);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name = No_Name then
            raise AADL_Parser_Error with "Cannot find the Data View file";
         end if;
      else
         --  Try with default name
         Set_Str_To_Name_Buffer (Default_Data_View);
         File_Name := Ocarina.Files.Search_File (Name_Find);
         if File_Name /= No_Name then
            Current_Config.Data_View := Default_Data_View'Access;
         end if;
      end if;

      if File_Name /= No_Name then
         File_Descr := Ocarina.Files.Load_File (File_Name);

         --  Add the Data View to the Interface View root
         Interface_Root := Ocarina.Parser.Parse
           (AADL_Language, Interface_Root, File_Descr);

         --  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;
         Dataview_root := Ocarina.Parser.Parse
                            (AADL_Language, Dataview_root, File_Descr);
      end if;
      return Current_Config;
   end Initialize;

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

      Result.Interface_View := Parse_Interface_View (Interface_Root);

      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;

      Ocarina.Configuration.Reset_Modules;
      Ocarina.Reset;

      return Result;
   exception
      when Error : AADL_Parser_Error
         | Interface_Error
         | Function_Error
         | No_RCM_Error
         | Deployment_View_Error
         | Device_Driver_Error =>
         Put (Red_Bold & "[ERROR] " & White_Bold);
         Put_Line (Exception_Message (Error) & No_Color);
         raise Quit_Taste;
      when GNAT.Command_Line.Exit_From_Command_Line =>
         New_Line;
         Put (Yellow_Bold & "[INFO] " & No_Color);
         Put ("For more information, visit " & Underline & White_Bold);
         Put_Line ("https://taste.tools" & No_Color);
         raise Quit_Taste;
      when GNAT.Command_Line.Invalid_Switch
         | GNAT.Command_Line.Invalid_Parameter
         | GNAT.Command_Line.Invalid_Section =>
         Put (Red_Bold & "[ERROR] " & White_Bold);
         Put_Line ("Invalid switch or parameter (try --help)" & No_Color);
         raise Quit_Taste;
      when E : others =>
         Errors.Display_Bug_Box (E);
         raise Quit_Taste;
   end Parse_Project;

   procedure Dump (Model : TASTE_Model) is
   begin
      Put_Line ("==== Dump of the Interface View ====");
      Model.Interface_View.Debug_Dump;
      if Model.Configuration.Deployment_View.all'Length > 0 then
         Put_Line ("==== Dump of the Deployment View ====");
         Model.Deployment_View.Debug_Dump;
      end if;
      Put_Line ("==== Dump of the Command Line ====");
      Model.Configuration.Debug_Dump;
   end Dump;

184
185
186
187
188
   procedure Generate_Build_Script (Model : TASTE_Model) is
   begin
      TASTE.Backend.Build_Script.Generate (Model);
   end Generate_Build_Script;

189
end TASTE.AADL_Parser;