1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--           O C A R I N A . B E _ A A D L . C O M P O N E N T S            --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2008-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with Ocarina.Output;
34
with Ocarina.ME_AADL.AADL_Tree.Nodes;
35
with Ocarina.ME_AADL.AADL_Tree.Nutils;
36
with Ocarina.BE_AADL.Components.Features;
37
with Ocarina.BE_AADL.Components.Subcomponents;
38
with Ocarina.BE_AADL.Components.Connections;
39
with Ocarina.BE_AADL.Components.Flows;
40
with Ocarina.BE_AADL.Components.Modes;
41
with Ocarina.BE_AADL.Components.Subprogram_Calls;
42
with Ocarina.BE_AADL.Components.Prototypes;
43
with Ocarina.BE_AADL.Annexes;
44
with Ocarina.BE_AADL.Identifiers;
45
with Ocarina.BE_AADL.Properties;
46

47
package body Ocarina.BE_AADL.Components is
48

49
   use Ocarina.Output;
50
   use Ocarina.ME_AADL.AADL_Tree.Nodes;
51
   use Ocarina.ME_AADL.AADL_Tree.Nutils;
52
   use Ocarina.BE_AADL.Components.Features;
53
   use Ocarina.BE_AADL.Components.Subcomponents;
54
   use Ocarina.BE_AADL.Components.Connections;
55
   use Ocarina.BE_AADL.Components.Flows;
56
   use Ocarina.BE_AADL.Components.Modes;
57
   use Ocarina.BE_AADL.Components.Subprogram_Calls;
58
   use Ocarina.BE_AADL.Components.Prototypes;
59

60
   use Ocarina.BE_AADL.Annexes;
61
   use Ocarina.BE_AADL.Identifiers;
62
   use Ocarina.BE_AADL.Properties;
63

64
   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
65

66
   Bug_Str : constant String := "[BUG is HERE]";
67

68
   ------------------------------
69
   -- Print_Component_Category --
70
   ------------------------------
71

72 1
   procedure Print_Component_Category (Category : Byte) is
73
      use Ocarina.ME_AADL;
74
   begin
75
      case Component_Category'Val (Category) is
76 1
         when CC_Data =>
77 1
            Print_Token (T_Data);
78 1
         when CC_Subprogram =>
79 1
            Print_Token (T_Subprogram);
80 1
         when CC_Subprogram_Group =>
81 1
            Print_Tokens ((T_Subprogram, T_Group));
82 1
         when CC_Thread =>
83 1
            Print_Token (T_Thread);
84 1
         when CC_Thread_Group =>
85 1
            Print_Tokens ((T_Thread, T_Group));
86 1
         when CC_Process =>
87 1
            Print_Token (T_Process);
88 1
         when CC_Memory =>
89 1
            Print_Token (T_Memory);
90 1
         when CC_Processor =>
91 1
            Print_Token (T_Processor);
92 1
         when CC_Bus =>
93 1
            Print_Token (T_Bus);
94 1
         when CC_Device =>
95 1
            Print_Token (T_Device);
96 1
         when CC_System =>
97 1
            Print_Token (T_System);
98 1
         when CC_Virtual_Processor =>
99 1
            Print_Tokens ((T_Virtual, T_Processor));
100 1
         when CC_Virtual_Bus =>
101 1
            Print_Tokens ((T_Virtual, T_Bus));
102 1
         when CC_Abstract =>
103 1
            Print_Token (T_Abstract);
104

105 0
         when others =>
106 0
            Write_Line (Bug_Str);
107
      end case;
108 1
   end Print_Component_Category;
109

110
   --------------------------
111
   -- Print_Component_Type --
112
   --------------------------
113

114 1
   procedure Print_Component_Type (Node : Node_Id) is
115
      pragma Assert (Kind (Node) = K_Component_Type);
116

117 1
      Node_Parent : constant Node_Id := Parent (Node);
118 1
      Comp_Name   : constant Node_Id := Identifier (Node);
119 1
      List_Node   : Node_Id;
120

121
   begin
122 1
      Write_Indentation;
123 1
      Print_Component_Category (Category (Node));
124 1
      Write_Space;
125 1
      Print_Identifier (Comp_Name);
126

127 1
      if Present (Node_Parent) then
128 1
         Write_Space;
129 1
         Print_Token (T_Extends);
130 1
         Write_Space;
131 1
         Print_Entity_Reference (Node_Parent);
132
      end if;
133

134 1
      if not Is_Empty (ATN.Prototype_Bindings (Node)) then
135 1
         List_Node := First_Node (ATN.Prototype_Bindings (Node));
136 1
         Write_Eol;
137 1
         Write_Indentation;
138 1
         Increment_Indentation;
139

140 1
         Print_Token (T_Left_Parenthesis);
141 1
         Write_Space;
142

143 1
         while Present (List_Node) loop
144 1
            if List_Node /= First_Node (Prototype_Bindings (Node)) then
145 0
               Print_Token (T_Comma);
146 0
               Write_Eol;
147 0
               Write_Indentation;
148
            end if;
149

150 1
            Print_Prototype_Bindings (List_Node);
151 1
            List_Node := Next_Node (List_Node);
152 1
         end loop;
153

154 1
         Write_Space;
155 1
         Print_Token (T_Right_Parenthesis);
156 1
         Decrement_Indentation;
157 1
         Write_Eol;
158
      end if;
159

160 1
      Write_Eol;
161

162 1
      if not Is_Empty (ATN.Prototypes (Node)) then
163 1
         List_Node := First_Node (ATN.Prototypes (Node));
164 1
         Write_Indentation;
165 1
         Print_Token (T_Prototypes);
166 1
         Write_Eol;
167 1
         Increment_Indentation;
168

169 1
         while Present (List_Node) loop
170 1
            Print_Prototype (List_Node);
171 1
            List_Node := Next_Node (List_Node);
172 1
         end loop;
173

174 1
         Decrement_Indentation;
175 1
         Write_Eol;
176
      end if;
177

178 1
      if not Is_Empty (ATN.Features (Node)) then
179 1
         List_Node := First_Node (ATN.Features (Node));
180 1
         Write_Indentation;
181 1
         Print_Token (T_Features);
182 1
         Write_Eol;
183 1
         Increment_Indentation;
184

185 1
         while Present (List_Node) loop
186 1
            Print_Feature (List_Node);
187 1
            List_Node := Next_Node (List_Node);
188 1
         end loop;
189

190 1
         Decrement_Indentation;
191 1
         Write_Eol;
192
      end if;
193

194 1
      if not Is_Empty (ATN.Flows (Node)) then
195 1
         List_Node := First_Node (ATN.Flows (Node));
196 1
         Write_Indentation;
197 1
         Print_Token (T_Flows);
198 1
         Write_Eol;
199 1
         Increment_Indentation;
200

201 1
         while Present (List_Node) loop
202 1
            Print_Flow_Spec (List_Node);
203 1
            List_Node := Next_Node (List_Node);
204 1
         end loop;
205

206 1
         Decrement_Indentation;
207 1
         Write_Eol;
208
      end if;
209

210 1
      if not Is_Empty (ATN.Modes (Node)) then
211 1
         List_Node := First_Node (ATN.Modes (Node));
212 1
         Write_Indentation;
213 1
         if Kind (List_Node) = K_Mode and then Is_Requires (List_Node) then
214 0
            Print_Token (T_Requires);
215 0
            Write_Space;
216
         end if;
217 1
         Print_Token (T_Modes);
218 1
         Write_Eol;
219 1
         Increment_Indentation;
220

221 1
         while Present (List_Node) loop
222
            case Kind (List_Node) is
223 1
               when K_Mode =>
224 1
                  Print_Mode (List_Node);
225 0
               when K_Mode_Transition =>
226 0
                  Print_Mode_Transition (List_Node);
227 0
               when others =>
228 0
                  raise Program_Error;
229
            end case;
230

231 1
            List_Node := Next_Node (List_Node);
232 1
         end loop;
233

234 1
         Decrement_Indentation;
235 1
         Write_Eol;
236
      end if;
237

238 1
      if not Is_Empty (ATN.Properties (Node)) then
239 1
         List_Node := First_Node (ATN.Properties (Node));
240 1
         Write_Indentation;
241 1
         Print_Token (T_Properties);
242 1
         Write_Eol;
243 1
         Increment_Indentation;
244

245 1
         while Present (List_Node) loop
246 1
            Print_Property_Association (List_Node);
247 1
            List_Node := Next_Node (List_Node);
248 1
         end loop;
249

250 1
         Decrement_Indentation;
251 1
         Write_Eol;
252
      end if;
253

254 1
      if not Is_Empty (ATN.Annexes (Node)) then
255 1
         Increment_Indentation;
256 1
         List_Node := First_Node (ATN.Annexes (Node));
257

258 1
         while Present (List_Node) loop
259 1
            Print_Annex_Subclause (List_Node);
260 1
            List_Node := Next_Node (List_Node);
261 1
         end loop;
262

263 1
         Decrement_Indentation;
264 1
         Write_Eol;
265
      end if;
266

267 1
      Write_Indentation;
268 1
      Print_Token (T_End);
269 1
      Write_Space;
270 1
      Print_Identifier (Comp_Name);
271 1
      Print_Token (T_Semicolon);
272 1
      Write_Eol;
273 1
   end Print_Component_Type;
274

275
   ------------------------------------
276
   -- Print_Component_Implementation --
277
   ------------------------------------
278

279 1
   procedure Print_Component_Implementation (Node : Node_Id) is
280 1
      Node_Parent : constant Node_Id := Parent (Node);
281 1
      Impl_Ident  : constant Node_Id := Identifier (Node);
282 1
      List_Node   : Node_Id;
283

284
   begin
285 1
      Write_Indentation;
286 1
      Print_Component_Category (Category (Node));
287 1
      Write_Space;
288 1
      Print_Token (T_Implementation);
289 1
      Write_Space;
290 1
      Print_Identifier (Impl_Ident);
291

292 1
      if Present (Node_Parent) then
293 1
         Write_Space;
294 1
         Print_Token (T_Extends);
295 1
         Write_Space;
296 1
         Print_Entity_Reference (Node_Parent);
297
      end if;
298

299 1
      Write_Eol;
300

301 1
      if not Is_Empty (ATN.Prototype_Bindings (Node)) then
302 1
         List_Node := First_Node (ATN.Prototype_Bindings (Node));
303 1
         Write_Indentation;
304 1
         Increment_Indentation;
305

306 1
         Print_Token (T_Left_Parenthesis);
307 1
         Write_Space;
308

309 1
         while Present (List_Node) loop
310 1
            if List_Node /= First_Node (ATN.Prototype_Bindings (Node)) then
311 1
               Print_Token (T_Comma);
312 1
               Write_Eol;
313 1
               Write_Indentation;
314
            end if;
315

316 1
            Print_Prototype_Bindings (List_Node);
317 1
            List_Node := Next_Node (List_Node);
318 1
         end loop;
319

320 1
         Write_Space;
321 1
         Print_Token (T_Right_Parenthesis);
322 1
         Decrement_Indentation;
323 1
         Write_Eol;
324
      end if;
325

326 1
      if not Is_Empty (ATN.Refines_Type (Node)) then
327 1
         Write_Indentation;
328 1
         Print_Tokens ((T_Refines, T_Type));
329 1
         Write_Eol;
330 1
         Increment_Indentation;
331 1
         List_Node := First_Node (ATN.Refines_Type (Node));
332

333 1
         while Present (List_Node) loop
334 1
            Print_Feature (List_Node);
335 1
            List_Node := Next_Node (List_Node);
336 1
         end loop;
337

338 1
         Decrement_Indentation;
339 1
         Write_Eol;
340
      end if;
341

342 1
      if not Is_Empty (ATN.Prototypes (Node)) then
343 1
         Write_Indentation;
344 1
         Print_Token (T_Prototypes);
345 1
         Write_Eol;
346 1
         Increment_Indentation;
347 1
         List_Node := First_Node (ATN.Prototypes (Node));
348

349 1
         while Present (List_Node) loop
350 1
            Print_Prototype (List_Node);
351 1
            List_Node := Next_Node (List_Node);
352 1
         end loop;
353

354 1
         Decrement_Indentation;
355 1
         Write_Eol;
356
      end if;
357

358 1
      if not Is_Empty (ATN.Subcomponents (Node)) then
359 1
         Write_Indentation;
360 1
         Print_Token (T_Subcomponents);
361 1
         Write_Eol;
362 1
         Increment_Indentation;
363 1
         List_Node := First_Node (ATN.Subcomponents (Node));
364

365 1
         while Present (List_Node) loop
366 1
            Print_Subcomponent (List_Node);
367 1
            List_Node := Next_Node (List_Node);
368 1
         end loop;
369

370 1
         Decrement_Indentation;
371 1
         Write_Eol;
372
      end if;
373

374 1
      if not Is_Empty (ATN.Calls (Node)) then
375 1
         Write_Indentation;
376 1
         Print_Token (T_Calls);
377 1
         Write_Eol;
378 1
         Increment_Indentation;
379 1
         List_Node := First_Node (ATN.Calls (Node));
380

381 1
         while Present (List_Node) loop
382 1
            Print_Subprogram_Call_Sequence (List_Node);
383 1
            List_Node := Next_Node (List_Node);
384 1
         end loop;
385

386 1
         Decrement_Indentation;
387 1
         Write_Eol;
388
      end if;
389

390 1
      if not Is_Empty (ATN.Connections (Node)) then
391 1
         Write_Indentation;
392 1
         Print_Token (T_Connections);
393 1
         Write_Eol;
394 1
         Increment_Indentation;
395 1
         List_Node := First_Node (ATN.Connections (Node));
396

397 1
         while Present (List_Node) loop
398 1
            Print_Connection (List_Node);
399 1
            List_Node := Next_Node (List_Node);
400 1
         end loop;
401

402 1
         Decrement_Indentation;
403 1
         Write_Eol;
404
      end if;
405

406 1
      if not Is_Empty (ATN.Flows (Node)) then
407 1
         Write_Indentation;
408 1
         Print_Token (T_Flows);
409 1
         Write_Eol;
410 1
         Increment_Indentation;
411 1
         List_Node := First_Node (ATN.Flows (Node));
412

413 1
         while Present (List_Node) loop
414 1
            Print_Flow_Implementation (List_Node);
415 1
            List_Node := Next_Node (List_Node);
416 1
         end loop;
417

418 1
         Decrement_Indentation;
419 1
         Write_Eol;
420
      end if;
421

422 1
      if not Is_Empty (ATN.Modes (Node)) then
423 1
         Write_Indentation;
424 1
         Print_Token (T_Modes);
425 1
         Write_Eol;
426 1
         Increment_Indentation;
427 1
         List_Node := First_Node (ATN.Modes (Node));
428

429 1
         while Present (List_Node) loop
430
            case Kind (List_Node) is
431 1
               when K_Mode =>
432 1
                  Print_Mode (List_Node);
433 1
               when K_Mode_Transition =>
434 1
                  Print_Mode_Transition (List_Node);
435 0
               when others =>
436 0
                  raise Program_Error;
437 1
            end case;
438

439 1
            List_Node := Next_Node (List_Node);
440 1
         end loop;
441

442 1
         Decrement_Indentation;
443 1
         Write_Eol;
444
      end if;
445

446 1
      if not Is_Empty (ATN.Properties (Node)) then
447 1
         Write_Indentation;
448 1
         Print_Token (T_Properties);
449 1
         Write_Eol;
450 1
         Increment_Indentation;
451 1
         List_Node := First_Node (ATN.Properties (Node));
452

453 1
         while Present (List_Node) loop
454 1
            Print_Property_Association (List_Node);
455 1
            List_Node := Next_Node (List_Node);
456 1
         end loop;
457

458 1
         Decrement_Indentation;
459 1
         Write_Eol;
460
      end if;
461

462 1
      if not Is_Empty (ATN.Annexes (Node)) then
463 1
         Increment_Indentation;
464 1
         List_Node := First_Node (ATN.Annexes (Node));
465

466 1
         while Present (List_Node) loop
467 1
            Print_Annex_Subclause (List_Node);
468 1
            List_Node := Next_Node (List_Node);
469 1
         end loop;
470

471 1
         Decrement_Indentation;
472 1
         Write_Eol;
473
      end if;
474

475 1
      Write_Indentation;
476 1
      Print_Token (T_End);
477 1
      Write_Space;
478 1
      Print_Identifier (Impl_Ident);
479 1
      Print_Token (T_Semicolon);
480 1
      Write_Eol;
481 1
   end Print_Component_Implementation;
482

483
   ------------------------------
484
   -- Print_Feature_Group_Type --
485
   ------------------------------
486

487 1
   procedure Print_Feature_Group_Type (Node : Node_Id) is
488 1
      Port_Ident  : constant Node_Id := Identifier (Node);
489 1
      Node_Parent : constant Node_Id := Parent (Node);
490 1
      Inverse_Ref : constant Node_Id := Inverse_Of (Node);
491 1
      List_Node   : Node_Id;
492

493
   begin
494 1
      Write_Indentation;
495

496
      case AADL_Version is
497
         when AADL_V1 =>
498 1
            Print_Tokens ((T_Port, T_Group));
499
         when AADL_V2 =>
500 1
            Print_Tokens ((T_Feature, T_Group));
501
      end case;
502

503 1
      Write_Space;
504 1
      Print_Identifier (Port_Ident);
505

506 1
      if Present (Node_Parent) then
507 1
         Write_Space;
508 1
         Print_Token (T_Extends);
509 1
         Write_Space;
510 1
         Print_Entity_Reference (Node_Parent);
511
      end if;
512

513 1
      Write_Eol;
514

515 1
      if not Is_Empty (Prototype_Bindings (Node)) then
516 1
         List_Node := First_Node (Prototype_Bindings (Node));
517 1
         Write_Indentation;
518 1
         Increment_Indentation;
519

520 1
         Print_Token (T_Left_Parenthesis);
521 1
         Write_Space;
522

523 1
         while Present (List_Node) loop
524 1
            if List_Node /= First_Node (Prototype_Bindings (Node)) then
525 0
               Print_Token (T_Comma);
526 0
               Write_Eol;
527 0
               Write_Indentation;
528
            end if;
529

530 1
            Print_Prototype_Bindings (List_Node);
531 1
            List_Node := Next_Node (List_Node);
532 1
         end loop;
533

534 1
         Write_Space;
535 1
         Print_Token (T_Right_Parenthesis);
536 1
         Decrement_Indentation;
537 1
         Write_Eol;
538
      end if;
539

540 1
      if not Is_Empty (ATN.Prototypes (Node)) then
541 1
         List_Node := First_Node (ATN.Prototypes (Node));
542 1
         Write_Indentation;
543 1
         Print_Token (T_Prototypes);
544 1
         Write_Eol;
545 1
         Increment_Indentation;
546

547 1
         while Present (List_Node) loop
548 1
            Print_Prototype (List_Node);
549 1
            List_Node := Next_Node (List_Node);
550 1
         end loop;
551

552 1
         Decrement_Indentation;
553 1
         Write_Eol;
554
      end if;
555

556 1
      if Is_Empty (ATN.Features (Node)) and then not Present (Inverse_Ref) then
557 1
         if AADL_Version = AADL_V1 then
558 1
            Write_Indentation;
559 1
            Print_Token (T_Features);
560 1
            Write_Eol;
561
         end if;
562

563
      else
564 1
         if not Is_Empty (ATN.Features (Node)) then
565 1
            Write_Indentation;
566 1
            Print_Token (T_Features);
567 1
            Write_Eol;
568 1
            Increment_Indentation;
569 1
            List_Node := First_Node (ATN.Features (Node));
570

571 1
            while Present (List_Node) loop
572 1
               if not Is_Implicit_Inverse (List_Node) then
573
                  --  Implicit features come from 'inverse of'
574
                  --  statements. Hence they should not be displayed.
575

576 1
                  Print_Feature (List_Node);
577
               end if;
578

579 1
               List_Node := Next_Node (List_Node);
580 1
            end loop;
581

582 1
            Decrement_Indentation;
583 1
            Write_Eol;
584
         end if;
585

586 1
         if Present (Inverse_Ref) then
587 1
            Write_Indentation;
588 1
            Print_Tokens ((T_Inverse, T_Of));
589 1
            Write_Space;
590 1
            Print_Entity_Reference (Inverse_Ref);
591 1
            Write_Eol;
592
         end if;
593
      end if;
594

595 1
      if not Is_Empty (ATN.Properties (Node)) then
596 1
         Write_Indentation;
597 1
         Print_Token (T_Properties);
598 1
         Write_Eol;
599 1
         Increment_Indentation;
600 1
         List_Node := First_Node (ATN.Properties (Node));
601

602 1
         while Present (List_Node) loop
603 1
            Print_Property_Association (List_Node);
604 1
            List_Node := Next_Node (List_Node);
605 1
         end loop;
606

607 1
         Decrement_Indentation;
608 1
         Write_Eol;
609
      end if;
610

611 1
      if not Is_Empty (ATN.Annexes (Node)) then
612 0
         Increment_Indentation;
613 0
         List_Node := First_Node (ATN.Annexes (Node));
614

615 0
         while Present (List_Node) loop
616 0
            Print_Annex_Subclause (List_Node);
617 0
            List_Node := Next_Node (List_Node);
618 0
         end loop;
619

620 0
         Write_Eol;
621
      end if;
622

623 1
      Write_Indentation;
624 1
      Print_Token (T_End);
625 1
      Write_Space;
626 1
      Print_Identifier (Port_Ident);
627 1
      Print_Token (T_Semicolon);
628 1
      Write_Eol;
629 1
   end Print_Feature_Group_Type;
630

631
end Ocarina.BE_AADL.Components;

Read our documentation on viewing source code .

Loading