taste-parser_utils.adb 16.4 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
     Ocarina.ME_AADL.AADL_Tree.Entities.Properties,
21
     TASTE.Parser_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
22

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

Maxime Perrotin's avatar
Maxime Perrotin committed
25
   use GNAT.OS_Lib,
26
       GNAT.Command_Line,
27
       Templates_Parser.Utils,
28
       Ocarina.ME_AADL.AADL_Tree.Entities.Properties,
29
       Ocarina.Instances.Queries;
Maxime Perrotin's avatar
Maxime Perrotin committed
30

31
32
33
34
35
36
37
38
39
40
   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;

41
42
43
44
45
46
47
   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
48
49
   procedure Banner is
      The_Banner : constant String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
50
        Yellow_Bold & "TASTE/Kazoo" & No_Color & " (Version "
51
52
        & TASTE.Parser_Version.Parser_Release & ")"
        & ASCII.LF & ASCII.CR & White_Bold
Maxime Perrotin's avatar
Maxime Perrotin committed
53
        & "Copyright (C) Maxime Perrotin / European Space Agency"
Maxime Perrotin's avatar
Maxime Perrotin committed
54
        & ASCII.LF & ASCII.CR & No_Color
55
        & "Based on " & TASTE.Parser_Version.Ocarina_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
56
57
   begin
      Put_Line (The_Banner);
58
      New_Line;
Maxime Perrotin's avatar
Maxime Perrotin committed
59
60
   end Banner;

Maxime Perrotin's avatar
Maxime Perrotin committed
61
   --  Generate documentation for a translate set (TODO..)
Maxime Perrotin's avatar
Maxime Perrotin committed
62
63
64
65
   procedure Document_Template (Source_Folder, Template_Name : String;
                                T : Translate_Set)
   is
      procedure Action (Item : Association; Quit : in out Boolean) is
Maxime Perrotin's avatar
Maxime Perrotin committed
66
         pragma Unreferenced (Item);
Maxime Perrotin's avatar
Maxime Perrotin committed
67
      begin
Maxime Perrotin's avatar
Maxime Perrotin committed
68
69
         --  Put_Debug ("  " & Templates_Parser.Query.Variable (Item) & " - "
         --          & Templates_Parser.Query.Kind (Item)'Img);
Maxime Perrotin's avatar
Maxime Perrotin committed
70
71
72
73
74
75
76
77
         Quit := False;
      end Action;
      procedure Iterate is new For_Every_Association (Action);
   begin
      Put_Debug (Template_Name & " (subfolder " & Source_Folder & ")");
      Iterate (T);
   end Document_Template;

78
79
80
81
82
83
84
85
86
87
   --  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;

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
   --  str.join as in Python - join string arrays with a separator
   function Join_Strings (Str_Set : String_Sets.Set;
                          Sep     : String             := ", ";
                          C       : String_Sets.Cursor :=
                            String_Sets.No_Element)
                          return String
   is
      use String_Sets;
   begin
      return
       (if C = String_Sets.No_Element then "" else
       (if C /= Str_Set.First then Sep else "")
        & String_Sets.Element (C)
        & Join_Strings
          (Str_Set => Str_Set,
           C => String_Sets.Next (C),
           Sep => Sep));
   end Join_Strings;

   function Filter_Uniq
Maxime Perrotin's avatar
Maxime Perrotin committed
108
     (Value, Parameters : String;
109
110
111
112
113
114
115
116
117
      unused_Context    : Filter_Context) return String
   --  Value is the tag name (list ), and Parameter must be a separator
   is
      use String_Sets, Ada.Strings.Fixed;
      Unique_Set : String_Sets.Set;
      Nb         : constant Natural :=
        Ada.Strings.Fixed.Count (Value, Parameters);
      From : Natural := Value'First;
      To   : Natural;
Maxime Perrotin's avatar
Maxime Perrotin committed
118
   begin
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
      if Nb = 0 then
         Unique_Set.Insert (Value);
      else
         for I in 0 .. Nb loop
            To := Index (Value, Parameters, From => From);
            if To = 0 then
               To := Value'Last + 1;
            end if;
            Unique_Set.Union (To_Set (Strip_String (Value (From .. To - 1))));
            From := To + 1;
         end loop;
      end if;
      return Join_Strings
        (Unique_Set, Sep => Parameters, C => Unique_Set.First);
   end Filter_Uniq;
Maxime Perrotin's avatar
Maxime Perrotin committed
134

Maxime Perrotin's avatar
Maxime Perrotin committed
135
   procedure Parse_Command_Line (Result : out Taste_Configuration) is
Maxime Perrotin's avatar
Maxime Perrotin committed
136
137
      Config  : Command_Line_Configuration;
      Version : aliased Boolean := False;
138
      Command : constant String := Ada.Command_Line.Command_Name;
139
140
141
      use String_Holders;

      IV, DeplV, DataV, OutDir : aliased GNAT.Strings.String_Access := null;
142
   begin
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
      --  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;

179
      Define_Switch (Config, Output => IV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
180
181
182
183
                     Switch         => "-i:",
                     Long_Switch    => "--interfaceview=",
                     Help           => "Mandatory interface view (AADL model)",
                     Argument       => "InterfaceView.aadl");
184
      Define_Switch (Config, Output => DeplV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
185
186
187
188
                     Switch         => "-c:",
                     Long_Switch    => "--deploymentview=",
                     Help           => "Optional deployment view (AADL model)",
                     Argument       => "DeploymentView.aadl");
189
      Define_Switch (Config, Output => DataV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
190
191
192
193
194
195
196
197
                     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");
198
      Define_Switch (Config, Output => OutDir'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
199
200
201
202
                     Switch         => "-o:",
                     Long_Switch    => "--output=",
                     Help           => "Output directory (created if absent)",
                     Argument       => "Folder");
Maxime Perrotin's avatar
Maxime Perrotin committed
203
      Define_Switch (Config, Output => Result.Skeletons'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
204
205
206
                     Switch         => "-w",
                     Long_Switch    => "--gw",
                     Help           => "Generate models and code skeletons");
Maxime Perrotin's avatar
Maxime Perrotin committed
207
      Define_Switch (Config, Output => Result.Glue'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
208
209
210
                     Switch         => "-l",
                     Long_Switch    => "--glue",
                     Help           => "Generate glue code");
Maxime Perrotin's avatar
Maxime Perrotin committed
211
      Define_Switch (Config, Output => Result.Use_POHIC'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
212
213
214
                     Switch         => "-p",
                     Long_Switch    => "--polyorb-hi-c",
                     Help           => "Use PolyORB-HI-C runtime");
Maxime Perrotin's avatar
Maxime Perrotin committed
215
      Define_Switch (Config, Output => Result.Timer_Resolution'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
216
217
218
219
                     Switch         => "-x:",
                     Long_Switch    => "--timer=",
                     Initial        => 100,
                     Help           => "Timer resolution (default 100 ms)");
Maxime Perrotin's avatar
Maxime Perrotin committed
220
      Define_Switch (Config, Output => Result.Debug_Flag'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
221
222
223
                     Switch         => "-g",
                     Long_Switch    => "--debug",
                     Help           => "Set debug mode");
224
225
226
227
      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
228
      Define_Switch (Config, Output => Version'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
229
230
231
                     Switch         => "-v",
                     Long_Switch    => "--version",
                     Help           => "Display tool version");
232
      Getopt (Config);
Maxime Perrotin's avatar
Maxime Perrotin committed
233

234
235
236
237
238
      loop
         declare
            S : constant String := Get_Argument;
         begin
            exit when S'Length = 0;
Maxime Perrotin's avatar
Maxime Perrotin committed
239
            Result.Other_Files.Append (S);
240
241
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
242

243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
      --  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
261
      if Version then
Maxime Perrotin's avatar
Maxime Perrotin committed
262
263
         raise Exit_From_Command_Line;
      end if;
264
      Debug_Mode := Result.Debug_Flag;
265

266
267
   end Parse_Command_Line;

268
269
270
271
272
273
274
275
276
   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
277
278
   function To_Template (Config : Taste_Configuration) return Translate_Set is
      Vec    : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
279
   begin
280
281
282
      for Each of Config.Other_Files loop
         Vec := Vec & Each;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

      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
298
              & Assoc ("No_Stdlib_Flag",   Config.No_Stdlib)
Maxime Perrotin's avatar
Maxime Perrotin committed
299
300
301
302
303
304
305
              & 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
306
      Put_Line (Output,
307
        Parse (Config.Binary_Path.Element & "templates/configuration.tmplt",
308
         Template));
309
   end Debug_Dump;
Maxime Perrotin's avatar
Maxime Perrotin committed
310

Maxime Perrotin's avatar
Maxime Perrotin committed
311
312
313
314
315
316
   -----------------------
   -- 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
317
        Get_String_Name ("taste::aplc_binding");
Maxime Perrotin's avatar
Maxime Perrotin committed
318
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
319
320
321
      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
322
323
   end Get_APLC_Binding;

324
325
326
327
328
   ------------------------
   -- Get_Interface_Name --
   ------------------------

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

Maxime Perrotin's avatar
Maxime Perrotin committed
331
332
333
334
335
   --------------------------------------------
   -- 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
336
337
338
339
340
      Properties : constant List_Id  := AIN.Properties (D);
      Result     : Property_Maps.Map := Property_Maps.Empty_Map;
      Property   : Node_Id           := AIN.First_Node (properties);
      Prop_Value,
      Single_Val : Node_Id;
Maxime Perrotin's avatar
Maxime Perrotin committed
341
342
343
344
345
   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
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
            Single_Val := ATN.Single_Value (Prop_Value);

            Result.Insert
              (Key      => AIN_Case (property),
               New_Item =>
                 (Name => US (AIN_Case (property)),
                  Value =>
                    US (case ATN.Kind (single_val) is
                         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 ATN.K_Component_Classifier_Term =>
                         --  When property is "classifier (...)" the following
                         --  returns the name of the component (e.g. foo.other)
                        Get_Name_String
                          (AIN.Display_Name
                               (AIN.Identifier
                                  (Get_Classifier_Of_Property_Value
                                     (ATN.Expanded_Single_Value
                                          (Prop_Value))))),
                         when others => "ERROR! Kazoo does not support Kind: "
                      & ATN.Kind (single_val)'Img)));
Maxime Perrotin's avatar
Maxime Perrotin committed
387
         end if;
388
         Property := AIN.Next_Node (Property);
Maxime Perrotin's avatar
Maxime Perrotin committed
389
      end loop;
390
      return Result;
Maxime Perrotin's avatar
Maxime Perrotin committed
391
392
   end Get_Properties_Map;

393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
   --  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;
408
      --  Following is needed to parse the interface view
409
410
      Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := True;
   end Initialize_Ocarina;
411

Maxime Perrotin's avatar
Maxime Perrotin committed
412
413
414
415
416
417
418
   --  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;
419
420
begin
   Register_Filter ("UNIQ", Filter_Uniq'Access);
421
end TASTE.Parser_Utils;