taste-parser_utils.adb 13.3 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
6
7
8
with Ada.Characters.Latin_1,
     Ada.Strings.Maps,
     Ada.Strings.Fixed,
     Ada.Strings,
9
10
11
     Ada.Directories,
     Ada.Command_Line,
     Ada.Environment_Variables,
12
     GNAT.OS_Lib,
13
     GNAT.Strings,
14
     GNAT.Command_Line,
15
     Templates_Parser.Utils,
Maxime Perrotin's avatar
Maxime Perrotin committed
16
     Ocarina.AADL_Values,
17
18
     Ocarina.Configuration,
     Ocarina.FE_AADL.Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
19
     Ocarina.Instances.Queries,
20
     TASTE.Parser_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
21

22
package body TASTE.Parser_Utils is
Maxime Perrotin's avatar
Maxime Perrotin committed
23

Maxime Perrotin's avatar
Maxime Perrotin committed
24
   use GNAT.OS_Lib,
25
       GNAT.Command_Line,
26
       Templates_Parser.Utils,
27
       Ocarina.Instances.Queries;
Maxime Perrotin's avatar
Maxime Perrotin committed
28

29
30
31
32
33
34
35
36
37
38
   procedure Put_Info (Info : String) is
   begin
      Put_Line (Yellow_Bold & "[INFO] " & No_Color & Info & No_Color);
   end Put_Info;

   procedure Put_Error (Error : String) is
   begin
      Put_Line (Red_Bold & "[ERROR] " & White_Bold & Error & No_Color);
   end Put_Error;

39
40
41
42
43
44
45
   procedure Put_Debug (Debug : String) is
   begin
      if Debug_Mode then
         Put_Line (White_Bold & "[DEBUG] " & No_Color & Debug & No_Color);
      end if;
   end Put_Debug;

Maxime Perrotin's avatar
Maxime Perrotin committed
46
47
   procedure Banner is
      The_Banner : constant String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
48
        Yellow_Bold & "TASTE/Kazoo" & No_Color & " (Version "
49
50
        & TASTE.Parser_Version.Parser_Release & ")"
        & ASCII.LF & ASCII.CR & White_Bold
Maxime Perrotin's avatar
Maxime Perrotin committed
51
        & "Copyright (C) Maxime Perrotin / European Space Agency"
Maxime Perrotin's avatar
Maxime Perrotin committed
52
        & ASCII.LF & ASCII.CR & No_Color
53
        & "Based on " & TASTE.Parser_Version.Ocarina_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
54
55
   begin
      Put_Line (The_Banner);
56
      New_Line;
Maxime Perrotin's avatar
Maxime Perrotin committed
57
58
   end Banner;

59
60
61
62
63
64
65
66
67
68
   --  Strip function as in Python
   function Strip_String (Input_String : String) return String is
      use Ada.Characters.Latin_1;
      Strip_Set : constant Ada.Strings.Maps.Character_Set :=
           Ada.Strings.Maps.To_Set
              (" " & HT & VT & NUL & LF & CR & BS & EOT & FF);
   begin
      return Ada.Strings.Fixed.Trim (Input_String, Strip_Set, Strip_Set);
   end Strip_String;

Maxime Perrotin's avatar
Maxime Perrotin committed
69
   procedure Parse_Command_Line (Result : out Taste_Configuration) is
Maxime Perrotin's avatar
Maxime Perrotin committed
70
71
      Config  : Command_Line_Configuration;
      Version : aliased Boolean := False;
72
      Command : constant String := Ada.Command_Line.Command_Name;
73
74
75
      use String_Holders;

      IV, DeplV, DataV, OutDir : aliased GNAT.Strings.String_Access := null;
76
   begin
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
      --  Retrieve the path of the kazoo binary, to have a base prefix
      --  to find the templates folder
      if Command /= "kazoo" then
         --  Command used a explicit path to call kazoo - use it
         Result.Binary_Path := To_Holder (Get_Program_Directory);
      else
         --  We must find kazoo in the PATH
         --  This will work only on Linux because the PATH separator is ":"
         --  while on Windows it is ";"
         declare
            Path : constant String := Ada.Environment_Variables.Value ("PATH");
            Nb   : constant Natural := Ada.Strings.Fixed.Count (Path, ":");
            From : Natural := Path'First;
            To   : Natural;
         begin
            if Nb = 0 then
               To   := Path'Last;
            end if;
            for I in 0 .. Nb loop
               To := Ada.Strings.Fixed.Index (Path, ":", From => From);
               if To = 0 then
                  To := Path'Last + 1;
               end if;
               if Ada.Directories.Exists
                 (Path (From .. To - 1) & "/" & "kazoo")
               then
                  --  Found the folder containing the kazoo binary
                  Result.Binary_Path := To_Holder
                    (Path (From .. To - 1) & "/");
                  exit;
               end if;
               From := To + 1;
            end loop;
         end;
      end if;

113
      Define_Switch (Config, Output => IV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
114
115
116
117
                     Switch         => "-i:",
                     Long_Switch    => "--interfaceview=",
                     Help           => "Mandatory interface view (AADL model)",
                     Argument       => "InterfaceView.aadl");
118
      Define_Switch (Config, Output => DeplV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
119
120
121
122
                     Switch         => "-c:",
                     Long_Switch    => "--deploymentview=",
                     Help           => "Optional deployment view (AADL model)",
                     Argument       => "DeploymentView.aadl");
123
      Define_Switch (Config, Output => DataV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
124
125
126
127
128
129
130
131
                     Switch         => "-d:",
                     Long_Switch    => "--dataview=",
                     Help           => "Optional data view (AADL model)",
                     Argument       => "DataView.aadl");
      Define_Switch (Config, Output => Result.Check_Data_View'Access,
                     Switch         => "-y",
                     Long_Switch    => "--check-dataview",
                     Help           => "Check Data View");
132
      Define_Switch (Config, Output => OutDir'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
133
134
135
136
                     Switch         => "-o:",
                     Long_Switch    => "--output=",
                     Help           => "Output directory (created if absent)",
                     Argument       => "Folder");
Maxime Perrotin's avatar
Maxime Perrotin committed
137
      Define_Switch (Config, Output => Result.Skeletons'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
138
139
140
                     Switch         => "-w",
                     Long_Switch    => "--gw",
                     Help           => "Generate models and code skeletons");
Maxime Perrotin's avatar
Maxime Perrotin committed
141
      Define_Switch (Config, Output => Result.Glue'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
142
143
144
                     Switch         => "-l",
                     Long_Switch    => "--glue",
                     Help           => "Generate glue code");
Maxime Perrotin's avatar
Maxime Perrotin committed
145
      Define_Switch (Config, Output => Result.Use_POHIC'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
146
147
148
                     Switch         => "-p",
                     Long_Switch    => "--polyorb-hi-c",
                     Help           => "Use PolyORB-HI-C runtime");
Maxime Perrotin's avatar
Maxime Perrotin committed
149
      Define_Switch (Config, Output => Result.Timer_Resolution'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
150
151
152
153
                     Switch         => "-x:",
                     Long_Switch    => "--timer=",
                     Initial        => 100,
                     Help           => "Timer resolution (default 100 ms)");
Maxime Perrotin's avatar
Maxime Perrotin committed
154
      Define_Switch (Config, Output => Result.Debug_Flag'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
155
156
157
                     Switch         => "-g",
                     Long_Switch    => "--debug",
                     Help           => "Set debug mode");
158
159
160
161
      Define_Switch (Config, Output => Result.No_Stdlib'Access,
                     Switch         => "-s",
                     Long_Switch    => "--no-stdlib",
                     Help           => "Don't use ocarina_components.aadl");
Maxime Perrotin's avatar
Maxime Perrotin committed
162
      Define_Switch (Config, Output => Version'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
163
164
165
                     Switch         => "-v",
                     Long_Switch    => "--version",
                     Help           => "Display tool version");
166
      Getopt (Config);
Maxime Perrotin's avatar
Maxime Perrotin committed
167

168
169
170
171
172
      loop
         declare
            S : constant String := Get_Argument;
         begin
            exit when S'Length = 0;
Maxime Perrotin's avatar
Maxime Perrotin committed
173
            Result.Other_Files.Append (S);
174
175
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
176

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
      --  We must set the values in the holders based on the parsed strings
      Result.Interface_View :=
        (if IV /= null and then IV.all'Length > 0
         then To_Holder (IV.all) else Empty_Holder);

      Result.Deployment_View :=
        (if DeplV /= null and then DeplV.all'Length > 0
         then To_Holder (DeplV.all) else Empty_Holder);

      Result.Data_View :=
        (if DataV /= null and then DataV.all'Length > 0
         then To_Holder (DataV.all) else Empty_Holder);

      Result.Output_Dir :=
        (if OutDir /= null and then OutDir.all'Length > 0
         then To_Holder (OutDir.all)
         else To_Holder ("."));

Maxime Perrotin's avatar
Maxime Perrotin committed
195
      if Version then
Maxime Perrotin's avatar
Maxime Perrotin committed
196
197
         raise Exit_From_Command_Line;
      end if;
198
      Debug_Mode := Result.Debug_Flag;
199

200
201
   end Parse_Command_Line;

202
203
204
205
206
207
208
209
210
   function To_Template_Tag (SS : String_Sets.Set) return Tag is
      Result : Tag;
   begin
      for Each of SS loop
         Result := Result & Each;
      end loop;
      return Result;
   end To_Template_Tag;

Maxime Perrotin's avatar
Maxime Perrotin committed
211
212
   function To_Template (Config : Taste_Configuration) return Translate_Set is
      Vec    : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
213
   begin
214
215
216
      for Each of Config.Other_Files loop
         Vec := Vec & Each;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

      return (+Assoc  ("Interface_View", Config.Interface_View.Element)
              & Assoc ("Deployment_View",
                (if Config.Deployment_View.Is_Empty
                 then "<none>"
                 else Config.Deployment_View.Element))
              & Assoc ("Data_View",        Config.Data_View.Element)
              & Assoc ("Binary_Path",      Config.Binary_Path.Element)
              & Assoc ("Check_Data_View",  Config.Check_Data_View)
              & Assoc ("Output_Dir",       Config.Output_Dir.Element)
              & Assoc ("Skeletons",        Config.Skeletons)
              & Assoc ("Glue",             Config.Glue)
              & Assoc ("Use_POHIC",        Config.Use_POHIC)
              & Assoc ("Timer_Resolution", Config.Timer_Resolution)
              & Assoc ("Debug_Flag",       Config.Debug_Flag)
Maxime Perrotin's avatar
Maxime Perrotin committed
232
              & Assoc ("No_Stdlib_Flag",   Config.No_Stdlib)
Maxime Perrotin's avatar
Maxime Perrotin committed
233
234
235
236
237
238
239
              & Assoc ("Timer_Resolution", Config.Timer_Resolution)
              & Assoc ("Other_Files", Vec));
   end To_Template;

   procedure Debug_Dump (Config : Taste_Configuration; Output : File_Type) is
      Template : constant Translate_Set := Config.To_Template;
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
240
      Put_Line (Output,
241
        Parse (Config.Binary_Path.Element & "templates/configuration.tmplt",
242
         Template));
243
   end Debug_Dump;
Maxime Perrotin's avatar
Maxime Perrotin committed
244

Maxime Perrotin's avatar
Maxime Perrotin committed
245
246
247
248
249
250
   -----------------------
   -- Get_APLC_Binding --
   -----------------------

   function Get_APLC_Binding (E : Node_Id) return List_Id is
      APLC_Binding : constant Name_Id :=
Maxime Perrotin's avatar
Maxime Perrotin committed
251
        Get_String_Name ("taste::aplc_binding");
Maxime Perrotin's avatar
Maxime Perrotin committed
252
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
253
254
255
      return (if Is_Defined_Property (E, APLC_Binding)
              then Get_List_Property (E, APLC_Binding)
              else No_List);
Maxime Perrotin's avatar
Maxime Perrotin committed
256
257
   end Get_APLC_Binding;

258
259
260
261
262
   ------------------------
   -- Get_Interface_Name --
   ------------------------

   function Get_Interface_Name (D : Node_Id) return Name_Id is
Maxime Perrotin's avatar
Maxime Perrotin committed
263
     (Get_String_Property (D, Get_String_Name ("taste::interfacename")));
264

Maxime Perrotin's avatar
Maxime Perrotin committed
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
   --------------------------------------------
   -- Get all properties as a Map Key/String --
   -- Input parameter is an AADL instance    --
   --------------------------------------------
   function Get_Properties_Map (D : Node_Id) return Property_Maps.Map is
      properties : constant List_Id  := AIN.Properties (D);
      result     : Property_Maps.Map := Property_Maps.Empty_Map;
      property   : Node_Id           := AIN.First_Node (properties);
      prop_value : Node_Id;
      single_val : Node_Id;
   begin
      while Present (property) loop
         prop_value := AIN.Property_Association_Value (property);
         if Present (ATN.Single_Value (prop_value)) then
            --  Only support single-value properties for now
            single_val := ATN.Single_Value (prop_value);
            result.Insert (Key => AIN_Case (property),
282
283
284
                           New_Item => (Name  => US (AIN_Case (property)),
                                        Value =>
              US (case ATN.Kind (single_val) is
Maxime Perrotin's avatar
Maxime Perrotin committed
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
                 when ATN.K_Signed_AADLNumber =>
                   Ocarina.AADL_Values.Image
                      (ATN.Value (ATN.Number_Value (single_val))) &
                      (if Present (ATN.Unit_Identifier (single_val)) then " " &
                      Get_Name_String
                          (ATN.Display_Name (ATN.Unit_Identifier (single_val)))
                      else ""),
                 when ATN.K_Literal =>
                    Ocarina.AADL_Values.Image (ATN.Value (single_val),
                                               Quoted => False),
                 when ATN.K_Reference_Term =>
                    Get_Name_String
                       (ATN.Display_Name (ATN.First_Node --  XXX must iterate
                          (ATN.List_Items (ATN.Reference_Term (single_val))))),
                 when ATN.K_Enumeration_Term =>
                    Get_Name_String
                       (ATN.Display_Name (ATN.Identifier (single_val))),
                 when ATN.K_Number_Range_Term =>
                    "RANGE NOT SUPPORTED!",
                 when others => "ERROR! Unsupported kind: "
305
                                & ATN.Kind (single_val)'Img)));
Maxime Perrotin's avatar
Maxime Perrotin committed
306
307
308
309
310
311
         end if;
         property := AIN.Next_Node (property);
      end loop;
      return result;
   end Get_Properties_Map;

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
   --  Initialization step: we look for ocarina on path to define
   --  OCARINA_PATH env. variable. This will indicate Ocarina librrary
   --  where to find AADL default property sets, and Ocarina specific
   --  packages and property sets.
   procedure Initialize_Ocarina is
      S : constant GNAT.OS_Lib.String_Access :=
        GNAT.OS_Lib.Locate_Exec_On_Path ("ocarina");
   begin
      if S = null then
         raise AADL_Parser_Error with "Ocarina is not in your PATH";
      end if;
      GNAT.OS_Lib.Setenv ("OCARINA_PATH", S.all (S'First .. S'Last - 12));
      Ocarina.Initialize;
      Ocarina.AADL_Version := Ocarina.AADL_V2;
      Ocarina.Configuration.Init_Modules;
327
      --  Following is needed to parse the interface view
328
329
      Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := True;
   end Initialize_Ocarina;
330

Maxime Perrotin's avatar
Maxime Perrotin committed
331
332
333
334
335
336
337
338
   --  There is no "&" operator for Translate sets...
   function Join_Sets (S1, S2 : Translate_Set) return Translate_Set is
      Result : Translate_Set := S1;
   begin
      Insert (Result, S2);
      return Result;
   end Join_Sets;

339
end TASTE.Parser_Utils;