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

32
with Ocarina.Output;
33
34
35
36
37
38
39
40
41
42

with Ocarina.ME_AADL_BA;
with Ocarina.ME_AADL_BA.BA_Tree.Nodes;
with Ocarina.ME_AADL_BA.BA_Tree.Nutils;

with Ocarina.BE_AADL_BA.Identifiers;
with Ocarina.BE_AADL_BA.Expressions;

package body Ocarina.BE_AADL_BA.Actions is

43
   use Ocarina.Output;
44
45
46
47
48
49
50
51
   use Ocarina.ME_AADL_BA;
   use Ocarina.ME_AADL_BA.BA_Tree.Nutils;
   use Ocarina.ME_AADL_BA.BA_Tree.Nodes;
   use Ocarina.BE_AADL_BA.Identifiers;
   use Ocarina.BE_AADL_BA.Expressions;

   package BAN renames Ocarina.ME_AADL_BA.BA_Tree.Nodes;

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
   procedure Print_Behavior_Actions          (Node         : Node_Id);
   procedure Print_Behavior_Action           (Node         : Node_Id);
   procedure Print_Conditional_Statement     (Node         : Node_Id);
   procedure Print_If_Cond_Struct            (Node         : Node_Id);
   procedure Print_For_Cond_Struct           (Node         : Node_Id);
   procedure Print_While_Cond_Struct         (Node         : Node_Id);
   procedure Print_Forall_Cond_Struct        (Node         : Node_Id);
   procedure Print_DoUntil_Cond_Struct       (Node         : Node_Id);
   procedure Print_Element_Values            (Node         : Node_Id);
   procedure Print_Assignment_Action         (Node         : Node_Id);
   procedure Print_Communication_Action      (Node         : Node_Id);
   procedure Print_Communication_Kind        (Comm_Kind    : Byte);
   procedure Print_Timed_Action              (Node         : Node_Id);
   procedure Print_Subprogram_Parameter_List (List         : List_Id);
   procedure Print_Parameter_Label           (Node         : Node_Id);

   ---------------------------------
   -- Print_Behavior_Action_Block --
   ---------------------------------

   procedure Print_Behavior_Action_Block (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Behavior_Action_Block);

   begin
      if Present (Behav_Acts (Node)) then
         Write_Space;
         Print_Token (T_Left_Curly_Bracket);
         Print_Behavior_Actions (Behav_Acts (Node));
         Write_Eol;
         Write_Indentation (+4);
         Print_Token (T_Right_Curly_Bracket);
      end if;

      if Present (Behavior_Time (Node)) then
         Write_Space;
         Print_Token (T_Timeout);
         Write_Space;
         Print_Behavior_Time (Behavior_Time (Node));
      end if;
   end Print_Behavior_Action_Block;
92
93
94
95
96

   ----------------------------
   -- Print_Behavior_Actions --
   ----------------------------

97
   procedure Print_Behavior_Actions (Node : Node_Id) is
98

99
100
      List_Node1 : Node_Id;
      List_Node2 : Node_Id;
101
102
103
104
   begin
      Write_Eol;
      Write_Indentation (+4);

105
106
107
      if not Is_Empty (Behavior_Action_Sequence (Node)) then
         List_Node1 := First_Node (Behavior_Action_Sequence (Node));
         Print_Behavior_Action (List_Node1);
108

109
110
111
112
113
         List_Node1 := Next_Node (List_Node1);
         while Present (List_Node1) loop
            Print_Token (T_Semicolon);
            Write_Eol;
            Write_Indentation (+4);
114

115
            Print_Behavior_Action (List_Node1);
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
            List_Node1 := Next_Node (List_Node1);
         end loop;
      end if;

      if not Is_Empty (Behavior_Action_Set (Node)) then
         List_Node2 := First_Node (Behavior_Action_Set (Node));
         Print_Behavior_Action (List_Node2);

         List_Node2 := Next_Node (List_Node2);
         while Present (List_Node2) loop
            Print_Token (T_Concat);
            Write_Eol;
            Write_Indentation (+4);

            Print_Behavior_Action (List_Node2);

            List_Node2 := Next_Node (List_Node2);
         end loop;
      end if;

      if Present (Behavior_Action (Node)) and then
         Is_Empty (Behavior_Action_Sequence (Node)) and then
         Is_Empty (Behavior_Action_Set (Node))
      then
         Print_Behavior_Action (Behavior_Action (Node));
      end if;
143
144
145
146
147
148
149
150
   end Print_Behavior_Actions;

   ---------------------------
   -- Print_Behavior_Action --
   ---------------------------

   procedure Print_Behavior_Action (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Behavior_Action);
151
152
153
154
155
156
157
158
      pragma Assert (Kind (Action (Node)) = K_If_Cond_Struct
                       or else Kind (Action (Node)) = K_For_Cond_Structure
                       or else Kind (Action (Node)) = K_While_Cond_Structure
                       or else Kind (Action (Node)) = K_ForAll_Cond_Structure
                       or else Kind (Action (Node)) = K_DoUntil_Cond_Structure
                       or else Kind (Action (Node)) = K_Assignment_Action
                       or else Kind (Action (Node)) = K_Communication_Action
                       or else Kind (Action (Node)) = K_Timed_Act);
159
160
161
162

      Action_Node : constant Node_Id := Action (Node);
   begin
      case Kind (Action_Node) is
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
         when K_If_Cond_Struct         => Print_If_Cond_Struct   (Action_Node);
         when K_For_Cond_Structure     => Print_For_Cond_Struct  (Action_Node);
         when K_While_Cond_Structure   => Print_While_Cond_Struct
                                                                 (Action_Node);
         when K_ForAll_Cond_Structure  => Print_Forall_Cond_Struct
                                                                 (Action_Node);
         when K_DoUntil_Cond_Structure => Print_DoUntil_Cond_Struct
                                                                 (Action_Node);
         when K_Assignment_Action      => Print_Assignment_Action
                                                                 (Action_Node);
         when K_Communication_Action   => Print_Communication_Action
                                                                 (Action_Node);
         when K_Timed_Act           => Print_Timed_Action     (Action_Node);

         when others                   => Write_Line (Bug_Str);
178
179
180
181
182
183
184
185
      end case;
   end Print_Behavior_Action;

   ---------------------------------
   -- Print_Conditional_Statement --
   ---------------------------------

   procedure Print_Conditional_Statement
186
     (Node     : Node_Id)
187
188
189
190
191
192
193
194
195
196
   is
      pragma Assert (Kind (Node) = K_Conditional_Statement);

   begin
      if Present (Logical_Expr (Node)) then
         Print_Token (T_Left_Parenthesis);
         Print_Value_Expression (Logical_Expr (Node));
         Print_Token (T_Right_Parenthesis);
      end if;

197
      Print_Behavior_Actions (Behav_Acts (Node));
198
199
200
201
202
203
204
205
206
207
208
209
   end Print_Conditional_Statement;

   --------------------------
   -- Print_If_Cond_Struct --
   --------------------------

   procedure Print_If_Cond_Struct (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_If_Cond_Struct);

   begin
      Print_Token (T_If);
      Write_Space;
210
      Print_Conditional_Statement (If_Statement (Node));
211
212
213

      if Present (Elsif_Statement (Node)) then
         Write_Eol;
214
215
216
217
         Write_Indentation (+4);
         Print_Token (T_Elsif);
         Write_Space;
         Print_Conditional_Statement (Elsif_Statement (Node));
218
219
220
221
      end if;

      if Present (Else_Statement (Node)) then
         Write_Eol;
222
223
224
225
         Write_Indentation (+4);
         Print_Token (T_Else);
         Write_Eol;
         Print_Conditional_Statement (Else_Statement (Node));
226
      end if;
227
228
229
      Write_Eol;
      Write_Indentation (+4);
      Print_Tokens ((T_End, T_if));
230
231
232
233
234
235
236
   end Print_If_Cond_Struct;

   --------------------------
   -- Print_For_Cond_Struct --
   --------------------------

   procedure Print_For_Cond_Struct (Node : Node_Id) is
237
      pragma Assert (Kind (Node) = K_For_Cond_Structure);
238
239
240
241
242
243
244

   begin
      Write_Space;
      Print_Token (T_For);
      Write_Space;

      Print_Token (T_Left_Parenthesis);
245
246
247
248
249
      Print_Identifier (Element_Idt (Node));
      Write_Space;
      Print_Token (T_Colon);
      Write_Space;
      Print_Component_Classifier_Ref (Classifier_Ref (Node));
250
251
252
      Write_Space;
      Print_Token (T_In);
      Write_Space;
253
      Print_Element_Values (In_Element_Values (Node));
254
255
256
      Print_Token (T_Right_Parenthesis);

      Write_Eol;
257
      Write_Indentation (+4);
258
      Print_Token (T_Left_Curly_Bracket);
259
260
261
      Print_Behavior_Actions (Behav_Acts (Node));
      Write_Eol;
      Write_Indentation (+4);
262
263
264
      Print_Token (T_Right_Curly_Bracket);
   end Print_For_Cond_Struct;

265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
   ------------------------------
   -- Print_Forall_Cond_Struct --
   ------------------------------

   procedure Print_Forall_Cond_Struct (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_ForAll_Cond_Structure);

   begin
      Write_Space;
      Print_Token (T_Forall);
      Write_Space;

      Print_Token (T_Left_Parenthesis);
      Print_Identifier (Element_Idt (Node));
      Write_Space;
      Print_Token (T_Colon);
      Write_Space;
      Print_Component_Classifier_Ref (Classifier_Ref (Node));
      Write_Space;
      Print_Token (T_In);
      Write_Space;
      Print_Element_Values (In_Element_Values (Node));
      Print_Token (T_Right_Parenthesis);

      Write_Eol;
      Write_Indentation (+4);
      Print_Token (T_Left_Curly_Bracket);
      Print_Behavior_Actions (Behav_Acts (Node));
      Write_Eol;
      Write_Indentation (+4);
      Print_Token (T_Right_Curly_Bracket);
   end Print_Forall_Cond_Struct;

298
299
300
301
302
   -----------------------------
   -- Print_While_Cond_Struct --
   -----------------------------

   procedure Print_While_Cond_Struct (Node : Node_Id) is
303
      pragma Assert (Kind (Node) = K_While_Cond_Structure);
304
305
306
307

   begin
      Print_Token (T_While);
      Write_Space;
308
309
310
311
312
313
314
315
316
317
318
      Print_Token (T_Left_Parenthesis);
      Print_Value_Expression (Logical_Expr (Node));
      Print_Token (T_Right_Parenthesis);

      Write_Eol;
      Write_Indentation (+4);
      Print_Token (T_Left_Curly_Bracket);
      Print_Behavior_Actions (Behav_Acts (Node));
      Write_Eol;
      Write_Indentation (+4);
      Print_Token (T_Right_Curly_Bracket);
319
320
   end Print_While_Cond_Struct;

321
322
323
   -------------------------------
   -- Print_DoUntil_Cond_Struct --
   -------------------------------
324

325
326
   procedure Print_DoUntil_Cond_Struct (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_DoUntil_Cond_Structure);
327
328

   begin
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
      Print_Token (T_Do);

      Write_Eol;
      Write_Indentation (+4);
      Print_Token (T_Left_Curly_Bracket);
      Print_Behavior_Actions (Behav_Acts (Node));
      Write_Eol;
      Write_Indentation (+4);
      Print_Token (T_Right_Curly_Bracket);
      Write_Space;
      Print_Token (T_Until);
      Write_Space;
      Print_Token (T_Left_Parenthesis);
      Print_Value_Expression (Logical_Expr (Node));
      Print_Token (T_Right_Parenthesis);
   end Print_DoUntil_Cond_Struct;
345

346
347
348
349
350
351
352
353
354
   --------------------------
   -- Print_Element_Values --
   --------------------------

   procedure Print_Element_Values (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Integer_Range
                       or else Kind (Node) = K_Data_Component_Reference);
   begin
      case Kind (Node) is
355
         when K_Integer_Range =>
356
            Print_Integer_Range (Node);
357
358

         when K_Data_Component_Reference =>
359
            Print_Data_Component_Reference (Node);
360
361
362
363

         when others =>
            Write_Line (Bug_Str);
      end case;
364
   end Print_Element_Values;
365
366
367
368
369
370
371
372
373

   -----------------------------
   -- Print_Assignment_Action --
   -----------------------------

   procedure Print_Assignment_Action (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Assignment_Action);

   begin
374
375
376
377
378
      if Kind (Target (Node)) = K_Name then
         Print_Name (Target (Node));
      else
         Print_Data_Component_Reference (Target (Node));
      end if;
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
      Write_Space;
      Print_Token (T_Assignment);
      Write_Space;

      if Present (Value_Expression (Node)) then
         Print_Value_Expression (Value_Expression (Node));
      end if;

      if Is_Any (Node) then
         Print_Token (T_Any);
      end if;
   end Print_Assignment_Action;

   --------------------------------
   -- Print_Communication_Action --
   --------------------------------

   procedure Print_Communication_Action (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Communication_Action);

   begin
      Write_Space;
401
402
403
404
405
      if Kind (BAN.Identifier (Node)) = K_Name then
         Print_Name (BAN.Identifier (Node));
      else
         Print_Data_Component_Reference (BAN.Identifier (Node));
      end if;
406
407
408
409
410
411
412
413
414
415
416
417

      Print_Communication_Kind (Comm_Kind (Node));

      if not Is_Empty (Subprogram_Parameter_List (Node)) then
         Print_Token (T_Left_Parenthesis);
         Print_Subprogram_Parameter_List (Subprogram_Parameter_List (Node));
         Print_Token (T_Right_Parenthesis);
      end if;

      if Present (Target (Node)) then
         Write_Space;
         Print_Token (T_Left_Parenthesis);
418
419
420
421
422
         if Kind (Target (Node)) = K_Name then
            Print_Name (Target (Node));
         else
            Print_Data_Component_Reference (Target (Node));
         end if;
423
424
425
426
427
428
429
430
431
432
433
         Print_Token (T_Right_Parenthesis);
      end if;
   end Print_Communication_Action;

   ------------------------------
   -- Print_Communication_Kind --
   ------------------------------

   procedure Print_Communication_Kind (Comm_Kind : Byte) is
   begin
      case Communication_Kind'Val (Comm_Kind) is
434
435
436
437
438
439
         when CK_Exclamation      => Print_Token (T_Exclamation);
         when CK_Interrogative    => Print_Token (T_Interrogative);
         when CK_Greater_Greater  => Print_Token (T_Greater_Greater_Than);
         when CK_Exclamation_Greater  => Print_Token (T_Exclamation_Greater);
         when CK_Exclamation_Lesser  => Print_Token (T_Exclamation_Lesser);
         when others              => Write_Line  (Bug_Str);
440
441
442
443
444
445
446
447
      end case;
   end Print_Communication_Kind;

   ------------------------
   -- Print_Timed_Action --
   ------------------------

   procedure Print_Timed_Action (Node : Node_Id) is
448
449
      pragma Assert (Kind (Node) = K_Timed_Act);
      List_Node : Node_Id;
450
451
   begin
      Write_Space;
452
      Print_Token (T_Computation);
453
454
455
456
457
458
459

      Write_Space;
      Print_Token (T_Left_Parenthesis);

      Print_Behavior_Time (Fst_Behavior_Time (Node));

      if Present (Scd_Behavior_Time (Node)) then
460
461
         Write_Space;
         Print_Token (T_Interval);
462
463
464
         Write_Space;
         Print_Behavior_Time (Scd_Behavior_Time (Node));
      end if;
465
466
467
      Write_Space;
      Print_Token (T_Right_Parenthesis);
      Write_Space;
468

469
470
      if not Is_Empty (Processor_Idt (Node)) then
         Print_Tokens ((T_In, T_Binding));
471
         Write_Space;
472
473
474
         Print_Token (T_Left_Parenthesis);
         List_Node := First_Node (Processor_Idt (Node));
         Print_Identifier (List_Node);
475

476
477
478
479
480
         List_Node := Next_Node (List_Node);
         while Present (List_Node) loop
            Print_Token (T_Comma);
            Write_Space;
            Print_Identifier (List_Node);
481

482
483
484
485
486
            List_Node := Next_Node (List_Node);
         end loop;
         Write_Space;
         Print_Token (T_Right_Parenthesis);
      end if;
487

488
   end Print_Timed_Action;
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521

   ------------------------------------
   -- Print_Suprogram_Parameter_List --
   ------------------------------------

   procedure Print_Subprogram_Parameter_List (List : List_Id) is
      pragma Assert (not Is_Empty (List));

      List_Node : Node_Id;
   begin
      List_Node := First_Node (List);
      Print_Parameter_Label (List_Node);

      List_Node := Next_Node (List_Node);
      while Present (List_Node) loop
         Print_Token (T_Comma);
         Write_Space;
         Print_Parameter_Label (List_Node);

         List_Node := Next_Node (List_Node);
      end loop;
   end Print_Subprogram_Parameter_List;

   ---------------------------
   -- Print_Parameter_Label --
   ---------------------------

   procedure Print_Parameter_Label (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Parameter_Label);

      Param_Node : constant Node_Id := Parameter (Node);
   begin
      case Kind (Param_Node) is
522
523
524
525
526
         when K_Value_Expression       => Print_Value_Expression (Param_Node);
         when K_Name                     => Print_Name (Param_Node);
         when K_Data_Component_Reference => Print_Data_Component_Reference
                                                           (Param_Node);
         when others                     => Write_Line  (Bug_Str);
527
528
529
530
531
532
533
534
535
536
537
538
539
540
      end case;
   end Print_Parameter_Label;

   ------------------------------------
   -- Print_Data_Component_Reference --
   ------------------------------------

   procedure Print_Data_Component_Reference (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Data_Component_Reference);
      pragma Assert (not Is_Empty (BAN.Identifiers (Node)));

      List_Node : Node_Id;
   begin
      List_Node := First_Node (BAN.Identifiers (Node));
541
      Print_Name (List_Node);
542
543
544
545

      List_Node := Next_Node (List_Node);
      while Present (List_Node) loop
         Print_Token (T_Dot);
546
         Print_Name (List_Node);
547
548
549
550
551

         List_Node := Next_Node (List_Node);
      end loop;
   end Print_Data_Component_Reference;

552
553
554
   ----------------
   -- Print_Name --
   ----------------
555

556
557
558
559
   procedure Print_Name (Node : Node_Id) is
      pragma Assert (Kind (Node) = K_Name);
      List_Node1 : Node_Id;
      List_Node2 : Node_Id;
560
   begin
561
562
      List_Node1 := First_Node (Idt (Node));
      Print_Identifier (List_Node1);
563

564
565
566
      List_Node1 := Next_Node (List_Node1);
      while Present (List_Node1) loop
         Print_Token (T_Dot);
567
         Write_Space;
568
569
570
571
572
573
574
         Print_Identifier (List_Node1);

         List_Node1 := Next_Node (List_Node1);
      end loop;
      Write_Space;
      if not Is_Empty (Array_Index (Node)) then
         List_Node2 := First_Node (Array_Index (Node));
575
         Print_Token (T_Left_Square_Bracket);
576
577
578
         Write_Space;
         Print_Integer_Value (List_Node2);
         Write_Space;
579
         Print_Token (T_Right_Square_Bracket);
580
581
582
583
584
585
586
587
588
589
590

         List_Node2 := Next_Node (List_Node2);
         while Present (List_Node2) loop
            Print_Token (T_Left_Square_Bracket);
            Write_Space;
            Print_Integer_Value (List_Node2);
            Write_Space;
            Print_Token (T_Right_Square_Bracket);

            List_Node2 := Next_Node (List_Node2);
         end loop;
591
      end if;
592
593

   end Print_Name;
594
595

end Ocarina.BE_AADL_BA.Actions;