taste-parser_utils.adb 17.8 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
     Ada.Characters.Handling,
10
11
12
     Ada.Directories,
     Ada.Command_Line,
     Ada.Environment_Variables,
13
     GNAT.OS_Lib,
14
     GNAT.Strings,
15
     GNAT.Command_Line,
16
     Templates_Parser.Utils,
17
     Templates_Parser.Query,
Maxime Perrotin's avatar
Maxime Perrotin committed
18
     Ocarina.AADL_Values,
19
20
     Ocarina.Configuration,
     Ocarina.FE_AADL.Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
21
     Ocarina.Instances.Queries,
22
     Ocarina.ME_AADL.AADL_Tree.Entities.Properties,
23
     TASTE.Parser_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
24

25
package body TASTE.Parser_Utils is
Maxime Perrotin's avatar
Maxime Perrotin committed
26

27
28
   use Ada.Characters.Handling,
       GNAT.OS_Lib,
29
       GNAT.Command_Line,
30
       Ada.Directories,
31
       Templates_Parser.Utils,
32
       Ocarina.ME_AADL.AADL_Tree.Entities.Properties,
33
       Ocarina.Instances.Queries;
Maxime Perrotin's avatar
Maxime Perrotin committed
34

35
36
37
38
39
40
41
42
43
44
   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;

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

65
66
67
   --  Generate documentation for a translate set
   procedure Document_Template (Category : Template_Category;
                                Tags     : Translate_Set)
Maxime Perrotin's avatar
Maxime Perrotin committed
68
   is
69
70
71
72
73
74
      Result : Unbounded_String :=
        "{| class=""wikitable""" & ASCII.LF
        & "!Parameter name" & ASCII.LF
        & "!Description" & ASCII.LF
        & US ("|-");

Maxime Perrotin's avatar
Maxime Perrotin committed
75
76
      procedure Action (Item : Association; Quit : in out Boolean) is
      begin
77
         Result :=
78
79
80
81
           Result & ASCII.LF
           & "|" & US (Templates_Parser.Query.Variable (Item)) & ASCII.LF
           & "|@@ADD DESCRIPTION@@" & ASCII.LF
           & "|-";
Maxime Perrotin's avatar
Maxime Perrotin committed
82
         --          & Templates_Parser.Query.Kind (Item)'Img);
Maxime Perrotin's avatar
Maxime Perrotin committed
83
84
85
86
         Quit := False;
      end Action;
      procedure Iterate is new For_Every_Association (Action);
   begin
87
88
89
90
91
92
93
      if Doc_Map.Contains (Category) then
         --  Already documented from a previous call - ignore
         --  (Skeleton and Glue folders share the same template structures)
         return;
      end if;
      Put_Debug ("Documenting template category: " & Category'Img);
      Iterate (Tags);
94
95
96
      Result :=
        Result & ASCII.LF
        & "|}";
97
      Doc_Map.Insert (Key => Category, New_Item => To_String (Result));
Maxime Perrotin's avatar
Maxime Perrotin committed
98
99
   end Document_Template;

100
101
102
103
104
105
106
107
108
   procedure Dump_Documentation (Output_Folder : String) is
      use Template_Doc_Maps;
      Output_File   : File_Type;
   begin
      Create_Path (Output_Folder);
      for Each in Doc_Map.Iterate loop
         Put_Debug ("Dump documentation of " & Key (Each)'Img);
         Create (File => Output_File,
                 Mode => Out_File,
109
                 Name => Output_Folder & "/" & To_Lower (Key (Each)'Img));
110
111
112
113
114
         Put_Line (Output_File, Element (Each));
         Close (Output_File);
      end loop;
   end Dump_Documentation;

115
116
117
118
119
120
121
122
123
124
   --  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;

125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
   --  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
145
     (Value, Parameters : String;
146
147
148
149
150
151
152
153
154
      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
155
   begin
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
      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
171

Maxime Perrotin's avatar
Maxime Perrotin committed
172
   procedure Parse_Command_Line (Result : out Taste_Configuration) is
Maxime Perrotin's avatar
Maxime Perrotin committed
173
174
      Config  : Command_Line_Configuration;
      Version : aliased Boolean := False;
175
      Command : constant String := Ada.Command_Line.Command_Name;
176
177
178
      use String_Holders;

      IV, DeplV, DataV, OutDir : aliased GNAT.Strings.String_Access := null;
179
   begin
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
      --  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;

216
      Define_Switch (Config, Output => IV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
217
218
219
220
                     Switch         => "-i:",
                     Long_Switch    => "--interfaceview=",
                     Help           => "Mandatory interface view (AADL model)",
                     Argument       => "InterfaceView.aadl");
221
      Define_Switch (Config, Output => DeplV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
222
223
224
225
                     Switch         => "-c:",
                     Long_Switch    => "--deploymentview=",
                     Help           => "Optional deployment view (AADL model)",
                     Argument       => "DeploymentView.aadl");
226
      Define_Switch (Config, Output => DataV'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
227
228
229
230
231
232
233
234
                     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");
235
      Define_Switch (Config, Output => OutDir'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
236
237
238
239
                     Switch         => "-o:",
                     Long_Switch    => "--output=",
                     Help           => "Output directory (created if absent)",
                     Argument       => "Folder");
Maxime Perrotin's avatar
Maxime Perrotin committed
240
      Define_Switch (Config, Output => Result.Skeletons'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
241
242
243
                     Switch         => "-w",
                     Long_Switch    => "--gw",
                     Help           => "Generate models and code skeletons");
Maxime Perrotin's avatar
Maxime Perrotin committed
244
      Define_Switch (Config, Output => Result.Glue'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
245
246
247
                     Switch         => "-l",
                     Long_Switch    => "--glue",
                     Help           => "Generate glue code");
Maxime Perrotin's avatar
Maxime Perrotin committed
248
      Define_Switch (Config, Output => Result.Use_POHIC'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
249
250
251
                     Switch         => "-p",
                     Long_Switch    => "--polyorb-hi-c",
                     Help           => "Use PolyORB-HI-C runtime");
Maxime Perrotin's avatar
Maxime Perrotin committed
252
      Define_Switch (Config, Output => Result.Timer_Resolution'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
253
254
255
256
                     Switch         => "-x:",
                     Long_Switch    => "--timer=",
                     Initial        => 100,
                     Help           => "Timer resolution (default 100 ms)");
Maxime Perrotin's avatar
Maxime Perrotin committed
257
      Define_Switch (Config, Output => Result.Debug_Flag'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
258
259
260
                     Switch         => "-g",
                     Long_Switch    => "--debug",
                     Help           => "Set debug mode");
261
262
263
264
      Define_Switch (Config, Output => Result.No_Stdlib'Access,
                     Switch         => "-s",
                     Long_Switch    => "--no-stdlib",
                     Help           => "Don't use ocarina_components.aadl");
265
266
267
268
      Define_Switch (Config, Output => Result.Generate_Doc'Access,
                     Switch         => "-k",
                     Long_Switch    => "--doc",
                     Help           => "Generate templates documentation");
Maxime Perrotin's avatar
Maxime Perrotin committed
269
      Define_Switch (Config, Output => Version'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
270
271
272
                     Switch         => "-v",
                     Long_Switch    => "--version",
                     Help           => "Display tool version");
273
      Getopt (Config);
Maxime Perrotin's avatar
Maxime Perrotin committed
274

275
276
277
278
279
      loop
         declare
            S : constant String := Get_Argument;
         begin
            exit when S'Length = 0;
Maxime Perrotin's avatar
Maxime Perrotin committed
280
            Result.Other_Files.Append (S);
281
282
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
283

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
      --  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
302
      if Version then
Maxime Perrotin's avatar
Maxime Perrotin committed
303
304
         raise Exit_From_Command_Line;
      end if;
305
      Debug_Mode := Result.Debug_Flag;
306

307
308
   end Parse_Command_Line;

309
310
311
312
313
314
315
316
317
   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
318
319
   function To_Template (Config : Taste_Configuration) return Translate_Set is
      Vec    : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
320
   begin
321
322
323
      for Each of Config.Other_Files loop
         Vec := Vec & Each;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338

      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
339
              & Assoc ("No_Stdlib_Flag",   Config.No_Stdlib)
Maxime Perrotin's avatar
Maxime Perrotin committed
340
341
342
343
344
345
346
              & 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
347
      Put_Line (Output,
348
        Parse (Config.Binary_Path.Element & "templates/configuration.tmplt",
349
         Template));
350
   end Debug_Dump;
Maxime Perrotin's avatar
Maxime Perrotin committed
351

Maxime Perrotin's avatar
Maxime Perrotin committed
352
353
354
355
356
357
   -----------------------
   -- 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
358
        Get_String_Name ("taste::aplc_binding");
Maxime Perrotin's avatar
Maxime Perrotin committed
359
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
360
361
362
      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
363
364
   end Get_APLC_Binding;

365
366
367
368
369
   ------------------------
   -- Get_Interface_Name --
   ------------------------

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

Maxime Perrotin's avatar
Maxime Perrotin committed
372
373
374
375
376
   --------------------------------------------
   -- 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
377
378
379
380
381
      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
382
383
384
385
386
   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
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
            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
428
         end if;
429
         Property := AIN.Next_Node (Property);
Maxime Perrotin's avatar
Maxime Perrotin committed
430
      end loop;
431
      return Result;
Maxime Perrotin's avatar
Maxime Perrotin committed
432
433
   end Get_Properties_Map;

434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
   --  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;
449
      --  Following is needed to parse the interface view
450
451
      Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := True;
   end Initialize_Ocarina;
452

Maxime Perrotin's avatar
Maxime Perrotin committed
453
454
455
456
457
458
459
   --  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;
460
461
begin
   Register_Filter ("UNIQ", Filter_Uniq'Access);
462
end TASTE.Parser_Utils;