taste-parser_utils.adb 17.5 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,
16
     Templates_Parser.Query,
Maxime Perrotin's avatar
Maxime Perrotin committed
17
     Ocarina.AADL_Values,
18
19
     Ocarina.Configuration,
     Ocarina.FE_AADL.Parser,
Maxime Perrotin's avatar
Maxime Perrotin committed
20
     Ocarina.Instances.Queries,
21
     Ocarina.ME_AADL.AADL_Tree.Entities.Properties,
22
     TASTE.Parser_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
23

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

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

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

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

63
64
65
   --  Generate documentation for a translate set
   procedure Document_Template (Category : Template_Category;
                                Tags     : Translate_Set)
Maxime Perrotin's avatar
Maxime Perrotin committed
66
   is
67
      Result : Unbounded_String := "# Tags for " & US (Category'Img);
Maxime Perrotin's avatar
Maxime Perrotin committed
68
69
      procedure Action (Item : Association; Quit : in out Boolean) is
      begin
70
71
         Result :=
           Result & ASCII.LF & US (Templates_Parser.Query.Variable (Item));
Maxime Perrotin's avatar
Maxime Perrotin committed
72
         --          & Templates_Parser.Query.Kind (Item)'Img);
Maxime Perrotin's avatar
Maxime Perrotin committed
73
74
75
76
         Quit := False;
      end Action;
      procedure Iterate is new For_Every_Association (Action);
   begin
77
78
79
80
81
82
83
84
      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);
      Doc_Map.Insert (Key => Category, New_Item => To_String (Result));
Maxime Perrotin's avatar
Maxime Perrotin committed
85
86
   end Document_Template;

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
   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,
                 Name => Output_Folder & "/" & Key (Each)'Img & ".tmplt_doc");
         Put_Line (Output_File, Element (Each));
         Close (Output_File);
      end loop;
   end Dump_Documentation;

102
103
104
105
106
107
108
109
110
111
   --  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;

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
   --  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
132
     (Value, Parameters : String;
133
134
135
136
137
138
139
140
141
      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
142
   begin
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
      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
158

Maxime Perrotin's avatar
Maxime Perrotin committed
159
   procedure Parse_Command_Line (Result : out Taste_Configuration) is
Maxime Perrotin's avatar
Maxime Perrotin committed
160
161
      Config  : Command_Line_Configuration;
      Version : aliased Boolean := False;
162
      Command : constant String := Ada.Command_Line.Command_Name;
163
164
165
      use String_Holders;

      IV, DeplV, DataV, OutDir : aliased GNAT.Strings.String_Access := null;
166
   begin
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      --  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;

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

262
263
264
265
266
      loop
         declare
            S : constant String := Get_Argument;
         begin
            exit when S'Length = 0;
Maxime Perrotin's avatar
Maxime Perrotin committed
267
            Result.Other_Files.Append (S);
268
269
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
      --  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
289
      if Version then
Maxime Perrotin's avatar
Maxime Perrotin committed
290
291
         raise Exit_From_Command_Line;
      end if;
292
      Debug_Mode := Result.Debug_Flag;
293

294
295
   end Parse_Command_Line;

296
297
298
299
300
301
302
303
304
   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
305
306
   function To_Template (Config : Taste_Configuration) return Translate_Set is
      Vec    : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
307
   begin
308
309
310
      for Each of Config.Other_Files loop
         Vec := Vec & Each;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325

      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
326
              & Assoc ("No_Stdlib_Flag",   Config.No_Stdlib)
Maxime Perrotin's avatar
Maxime Perrotin committed
327
328
329
330
331
332
333
              & 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
334
      Put_Line (Output,
335
        Parse (Config.Binary_Path.Element & "templates/configuration.tmplt",
336
         Template));
337
   end Debug_Dump;
Maxime Perrotin's avatar
Maxime Perrotin committed
338

Maxime Perrotin's avatar
Maxime Perrotin committed
339
340
341
342
343
344
   -----------------------
   -- 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
345
        Get_String_Name ("taste::aplc_binding");
Maxime Perrotin's avatar
Maxime Perrotin committed
346
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
347
348
349
      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
350
351
   end Get_APLC_Binding;

352
353
354
355
356
   ------------------------
   -- Get_Interface_Name --
   ------------------------

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

Maxime Perrotin's avatar
Maxime Perrotin committed
359
360
361
362
363
   --------------------------------------------
   -- 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
364
365
366
367
368
      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
369
370
371
372
373
   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
374
375
376
377
378
379
380
381
382
383
384
385
386
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
            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
415
         end if;
416
         Property := AIN.Next_Node (Property);
Maxime Perrotin's avatar
Maxime Perrotin committed
417
      end loop;
418
      return Result;
Maxime Perrotin's avatar
Maxime Perrotin committed
419
420
   end Get_Properties_Map;

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
   --  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;
436
      --  Following is needed to parse the interface view
437
438
      Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := True;
   end Initialize_Ocarina;
439

Maxime Perrotin's avatar
Maxime Perrotin committed
440
441
442
443
444
445
446
   --  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;
447
448
begin
   Register_Filter ("UNIQ", Filter_Uniq'Access);
449
end TASTE.Parser_Utils;