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

18
package body TASTE.Parser_Utils is
Maxime Perrotin's avatar
Maxime Perrotin committed
19

Maxime Perrotin's avatar
Maxime Perrotin committed
20
   use GNAT.OS_Lib,
21
       GNAT.Command_Line,
22
       Templates_Parser.Utils,
23
       Ocarina.Instances.Queries;
Maxime Perrotin's avatar
Maxime Perrotin committed
24

25
26
27
28
29
30
31
32
33
34
   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;

Maxime Perrotin's avatar
Maxime Perrotin committed
35
36
   procedure Banner is
      The_Banner : constant String :=
Maxime Perrotin's avatar
Maxime Perrotin committed
37
        Yellow_Bold & "TASTE AADL Parser" & No_Color & " (Version "
38
39
40
        & TASTE.Parser_Version.Parser_Release & ")"
        & ASCII.LF & ASCII.CR & White_Bold
        & "Copyright (C) European Space Agency"
Maxime Perrotin's avatar
Maxime Perrotin committed
41
        & ASCII.LF & ASCII.CR & No_Color
42
        & "Based on " & TASTE.Parser_Version.Ocarina_Version;
Maxime Perrotin's avatar
Maxime Perrotin committed
43
44
   begin
      Put_Line (The_Banner);
45
      New_Line;
Maxime Perrotin's avatar
Maxime Perrotin committed
46
47
   end Banner;

48
49
50
51
52
53
54
55
56
57
   --  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
58
   procedure Parse_Command_Line (Result : out Taste_Configuration) is
59
60
      Config : Command_Line_Configuration;
   begin
61
      Result.Binary_Path := new String'(Get_Program_Directory);
62
      Define_Switch (Config, Output => Result.Interface_View'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
63
64
65
66
                     Switch         => "-i:",
                     Long_Switch    => "--interfaceview=",
                     Help           => "Mandatory interface view (AADL model)",
                     Argument       => "InterfaceView.aadl");
67
      Define_Switch (Config, Output => Result.Deployment_View'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
68
69
70
71
                     Switch         => "-c:",
                     Long_Switch    => "--deploymentview=",
                     Help           => "Optional deployment view (AADL model)",
                     Argument       => "DeploymentView.aadl");
72
      Define_Switch (Config, Output => Result.Data_View'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
73
74
75
76
77
78
79
80
                     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");
Maxime Perrotin's avatar
Maxime Perrotin committed
81
      Define_Switch (Config, Output => Result.Output_Dir'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
82
83
84
85
                     Switch         => "-o:",
                     Long_Switch    => "--output=",
                     Help           => "Output directory (created if absent)",
                     Argument       => "Folder");
Maxime Perrotin's avatar
Maxime Perrotin committed
86
      Define_Switch (Config, Output => Result.Skeletons'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
87
88
89
                     Switch         => "-w",
                     Long_Switch    => "--gw",
                     Help           => "Generate models and code skeletons");
Maxime Perrotin's avatar
Maxime Perrotin committed
90
      Define_Switch (Config, Output => Result.Glue'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
91
92
93
                     Switch         => "-l",
                     Long_Switch    => "--glue",
                     Help           => "Generate glue code");
Maxime Perrotin's avatar
Maxime Perrotin committed
94
      Define_Switch (Config, Output => Result.Use_POHIC'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
95
96
97
                     Switch         => "-p",
                     Long_Switch    => "--polyorb-hi-c",
                     Help           => "Use PolyORB-HI-C runtime");
Maxime Perrotin's avatar
Maxime Perrotin committed
98
      Define_Switch (Config, Output => Result.Timer_Resolution'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
99
100
101
102
                     Switch         => "-x:",
                     Long_Switch    => "--timer=",
                     Initial        => 100,
                     Help           => "Timer resolution (default 100 ms)");
Maxime Perrotin's avatar
Maxime Perrotin committed
103
      Define_Switch (Config, Output => Result.Debug_Flag'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
104
105
106
                     Switch         => "-g",
                     Long_Switch    => "--debug",
                     Help           => "Set debug mode");
Maxime Perrotin's avatar
Maxime Perrotin committed
107
      Define_Switch (Config, Output => Result.Version'Access,
Maxime Perrotin's avatar
Maxime Perrotin committed
108
109
110
                     Switch         => "-v",
                     Long_Switch    => "--version",
                     Help           => "Display tool version");
111
      Getopt (Config);
Maxime Perrotin's avatar
Maxime Perrotin committed
112

113
114
115
116
117
      loop
         declare
            S : constant String := Get_Argument;
         begin
            exit when S'Length = 0;
Maxime Perrotin's avatar
Maxime Perrotin committed
118
            Result.Other_Files.Append (S);
119
120
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
121

Maxime Perrotin's avatar
Maxime Perrotin committed
122
123
124
      if Result.Version then
         raise Exit_From_Command_Line;
      end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
125
      if Result.Output_Dir = null or else Result.Output_Dir.all'Length = 0 then
126
127
         Result.Output_Dir := new String'(".");
      end if;
128
129
   end Parse_Command_Line;

Maxime Perrotin's avatar
Maxime Perrotin committed
130
   procedure Debug_Dump (Config : Taste_Configuration; Output : File_Type) is
131
132
      Vec      : Tag;
      Template : Translate_Set;
Maxime Perrotin's avatar
Maxime Perrotin committed
133
   begin
134
135
136
137
138
139
140
141
142
143
      Template := +Assoc ("Interface_View",  Config.Interface_View.all)
        & Assoc ("Deployment_View",  Config.Deployment_View.all)
        & Assoc ("Data_View",        Config.Data_View.all)
        & Assoc ("Output_Dir",       Config.Output_Dir.all)
        & Assoc ("Skeletons",        Config.Skeletons)
        & Assoc ("Glue",             Config.Glue)
        & Assoc ("Use_POHIC",        Config.Use_POHIC)
        & Assoc ("Debug_Flag",       Config.Debug_Flag)
        & Assoc ("Version",          Config.Version)
        & Assoc ("Timer_Resolution", Config.Timer_Resolution);
144
145
146
      for Each of Config.Other_Files loop
         Vec := Vec & Each;
      end loop;
147
      Template := Template & Assoc ("Other_Files", Vec);
Maxime Perrotin's avatar
Maxime Perrotin committed
148
149
      Put_Line (Output,
        Parse (Config.Binary_Path.all & "templates/configuration.tmplt",
150
         Template));
151
   end Debug_Dump;
Maxime Perrotin's avatar
Maxime Perrotin committed
152

Maxime Perrotin's avatar
Maxime Perrotin committed
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
   -----------------------
   -- Get_APLC_Binding --
   -----------------------

   function Get_APLC_Binding (E : Node_Id) return List_Id is
      APLC_Binding : constant Name_Id :=
          Get_String_Name ("taste::aplc_binding");
   begin
      if Is_Defined_Property (E, APLC_Binding) then
         return Get_List_Property (E, APLC_Binding);
      else
         return No_List;
      end if;
   end Get_APLC_Binding;

168
169
170
171
172
173
174
175
176
177
178
   ------------------------
   -- Get_Interface_Name --
   ------------------------

   function Get_Interface_Name (D : Node_Id) return Name_Id is
      Interface_Name : constant Name_id :=
         Get_String_Name ("taste::interfacename");
   begin
      return Get_String_Property (D, Interface_Name);
   end Get_Interface_Name;

Maxime Perrotin's avatar
Maxime Perrotin committed
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
   --------------------------------------------
   -- 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),
196
197
198
                           New_Item => (Name  => US (AIN_Case (property)),
                                        Value =>
              US (case ATN.Kind (single_val) is
Maxime Perrotin's avatar
Maxime Perrotin committed
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
                 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: "
219
                                & ATN.Kind (single_val)'Img)));
Maxime Perrotin's avatar
Maxime Perrotin committed
220
221
222
223
224
225
         end if;
         property := AIN.Next_Node (property);
      end loop;
      return result;
   end Get_Properties_Map;

226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
   --  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;
241
      --  Following is needed to parse the interface view
242
243
      Ocarina.FE_AADL.Parser.Add_Pre_Prop_Sets := True;
   end Initialize_Ocarina;
244
end TASTE.Parser_Utils;