OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--     O C A R I N A . B A C K E N D S . A D A _ T R E E . N U T I L S      --
6
--                                                                          --
7
--                                 S p e c                                  --
8
--                                                                          --
9
--               Copyright (C) 2006-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.Backends.Ada_Tree.Nodes; use Ocarina.Backends.Ada_Tree.Nodes;
34

35 1
package Ocarina.Backends.Ada_Tree.Nutils is
36

37 1
   Int0_Val : Value_Id;
38 1
   Int1_Val : Value_Id;
39

40
   Output_Tree_Warnings : Boolean := False;
41
   Output_Unit_Withing  : Boolean := False;
42
   --  Control flags
43

44
   type Token_Type is
45
     (
46
      --   Token name      Token type
47
      --   Keywords
48
      Tok_Mod,             -- MOD   **** First Keyword
49
      Tok_Rem,             -- REM
50
      Tok_New,             -- NEW
51
      Tok_Abs,             -- ABS
52
      Tok_Others,          -- OTHERS
53
      Tok_Null,            -- NULL
54
      Tok_Delta,           -- DELTA
55
      Tok_Digits,          -- DIGITS
56
      Tok_Range,           -- RANGE
57
      Tok_And,             -- AND
58
      Tok_Or,              -- OR
59
      Tok_Xor,             -- XOR
60
      Tok_In,              -- IN
61
      Tok_Not,             -- NOT
62
      Tok_Abstract,        -- ABSTRACT
63
      Tok_Access,          -- ACCESS
64
      Tok_Aliased,         -- ALIASED
65
      Tok_All,             -- ALL
66
      Tok_Array,           -- ARRAY
67
      Tok_At,              -- AT
68
      Tok_Body,            -- BODY
69
      Tok_Constant,        -- CONSTANT
70
      Tok_Do,              -- DO
71
      Tok_Is,              -- IS
72
      Tok_Limited,         -- LIMITED
73
      Tok_Of,              -- OF
74
      Tok_Out,             -- OUT
75
      Tok_Record,          -- RECORD
76
      Tok_Renames,         -- RENAMES
77
      Tok_Reverse,         -- REVERSE
78
      Tok_Tagged,          -- TAGGED
79
      Tok_Then,            -- THEN
80
      Tok_Abort,           -- ABORT
81
      Tok_Accept,          -- ACCEPT
82
      Tok_Case,            -- CASE
83
      Tok_Delay,           -- DELAY
84
      Tok_Else,            -- ELSE
85
      Tok_Elsif,           -- ELSIF
86
      Tok_End,             -- END
87
      Tok_Exception,       -- EXCEPTION
88
      Tok_Exit,            -- EXIT
89
      Tok_Goto,            -- GOTO
90
      Tok_If,              -- IF
91
      Tok_Pragma,          -- PRAGMA
92
      Tok_Raise,           -- RAISE
93
      Tok_Requeue,         -- REQUEUE
94
      Tok_Return,          -- RETURN
95
      Tok_Select,          -- SELECT
96
      Tok_Terminate,       -- TERMINATE
97
      Tok_Until,           -- UNTIL
98
      Tok_When,            -- WHEN
99

100
      Tok_Begin,           -- BEGIN
101
      Tok_Declare,         -- DECLARE
102
      Tok_For,             -- FOR
103
      Tok_Loop,            -- LOOP
104
      Tok_While,           -- WHILE
105

106
      Tok_Entry,           -- ENTRY
107
      Tok_Protected,       -- PROTECTED
108
      Tok_Task,            -- TASK
109
      Tok_Type,            -- TYPE
110
      Tok_Subtype,         -- SUBTYPE
111
      Tok_Use,             -- USE
112

113
      Tok_Function,        -- FUNCTION
114
      Tok_Generic,         -- GENERIC
115
      Tok_Package,         -- PACKAGE
116
      Tok_Procedure,       -- PROCEDURE
117

118
      Tok_Private,         -- PRIVATE
119
      Tok_With,            -- WITH
120
      Tok_Separate,        -- SEPARATE **** Last Keyword
121

122
      --  Graphic Characters
123
      Tok_Double_Asterisk, -- **
124
      Tok_Ampersand,       -- &
125
      Tok_Minus,           -- -
126
      Tok_Plus,            -- +
127
      Tok_Asterisk,        -- *
128
      Tok_Slash,           -- /
129
      Tok_Dot,             -- .
130
      Tok_Apostrophe,      -- '
131
      Tok_Left_Paren,      -- (
132
      Tok_Right_Paren,     -- )
133
      Tok_Comma,           -- ,
134
      Tok_Less,            -- <
135
      Tok_Equal,           -- =
136
      Tok_Greater,         -- >
137
      Tok_Not_Equal,       -- /=
138
      Tok_Greater_Equal,   -- >=
139
      Tok_Less_Equal,      -- <=
140
      Tok_Box,             -- <>
141
      Tok_Colon_Equal,     -- :=
142
      Tok_Colon,           -- :
143
      Tok_Greater_Greater, -- >>
144
      Tok_Less_Less,       -- <<
145
      Tok_Semicolon,       -- ;
146
      Tok_Arrow,           -- =>
147
      Tok_Vertical_Bar,    -- |
148
      Tok_Dot_Dot,         -- ..
149
      Tok_Minus_Minus      -- --
150
     );
151

152 1
   Token_Image : array (Token_Type) of Name_Id;
153

154
   subtype Keyword_Type is Token_Type range Tok_Mod .. Tok_Separate;
155

156
   type Operator_Type is
157
     (Op_Not,             -- not
158
      Op_And,             -- and
159
      Op_In,              -- in
160
      Op_And_Then,        -- and then
161
      Op_Or,              -- or
162
      Op_Or_Else,         -- or else
163
      Op_And_Symbol,      -- &
164
      Op_Double_Asterisk, -- **
165
      Op_Minus,           -- -
166
      Op_Plus,            -- +
167
      Op_Asterisk,        -- *
168
      Op_Slash,           -- /
169
      Op_Less,            -- <
170
      Op_Equal,           -- =
171
      Op_Greater,         -- >
172
      Op_Not_Equal,       -- /=
173
      Op_Greater_Equal,   -- >=
174
      Op_Less_Equal,      -- <=
175
      Op_Box,             -- <>
176
      Op_Colon_Equal,     -- :=
177
      Op_Colon,           -- :
178
      Op_Greater_Greater, -- >>
179
      Op_Less_Less,       -- <<
180
      Op_Semicolon,       -- ;
181
      Op_Arrow,           -- =>
182
      Op_Vertical_Bar,    -- |
183
      Op_None);           -- No operation
184

185 1
   Operator_Image : array
186
   (Operator_Type'Pos (Op_And) ..
187
        Operator_Type'Pos (Op_Vertical_Bar)) of Name_Id;
188

189
   subtype Keyword_Operator is
190
     Operator_Type range Operator_Type'First .. Op_Or_Else;
191

192
   type Parameter_Id is
193
     (P_A,
194
      P_Activate_Entrypoint,
195
      P_Arg_List,
196
      P_Argument,
197
      P_C,
198
      P_Conflicts,
199
      P_Current_Entity,
200
      P_Data,
201
      P_Depends,
202
      P_Destinations,
203
      P_Dispatcher,
204
      P_Dispatch_Offset,
205
      P_E_Req,
206
      P_Elaboration_Check,
207
      P_Elaborated_Variables,
208
      P_Entity,
209
      P_Entity_Table,
210
      P_Entity_Image,
211
      P_Error,
212
      P_From,
213
      P_Global_Data_Queue_Size,
214
      P_Got_Data,
215
      P_Has_Event_Ports,
216
      P_Id,
217
      P_Implicit,
218
      P_Incoming_Message,
219
      P_Init,
220
      P_Initialize_Entrypoint,
221
      P_Index,
222
      P_Interrupt_Identifier,
223
      P_Item,
224
      P_Job,
225
      P_Key,
226
      P_Lane_R,
227
      P_Max_Node_Image_Size,
228
      P_Max_Entity_Image_Size,
229
      P_Max_Payload_Size,
230
      P_Max_Port_Image_Size,
231
      P_May_Exit,
232
      P_Message,
233
      P_Mode,
234
      P_Msg,
235
      P_My_Node,
236
      P_N_Destinations,
237
      P_Name,
238
      P_Naming_Table,
239
      P_Next_Start,
240
      P_Node,
241
      P_Node_Image,
242
      P_Null_Bounded_String,
243
      P_Null_Bounded_Wide_String,
244
      P_Obj,
245
      P_Operation,
246
      P_Period,
247
      P_Port,
248
      P_Port_Image,
249
      P_Port_Sized_String,
250
      P_Port_Table,
251
      P_PortName,
252
      P_Provides,
253
      P_Priority,
254
      P_Priority_Manager,
255
      P_Recover_Entrypoint,
256
      P_Ref,
257
      P_Req,
258
      P_Result,
259
      P_Self,
260
      P_Server_Entity_Table,
261
      P_Spg_Interface,
262
      P_Task_Deadline,
263
      P_Task_Period,
264
      P_Task_Priority,
265
      P_Task_Stack_Size,
266
      P_Thread_Port_Kinds,
267
      P_Thread_Overflow_Protocols,
268
      P_Thread_Port_Images,
269
      P_Thread_Fifo_Sizes,
270
      P_Thread_Fifo_Offsets,
271
      P_Thread_Interface,
272
      P_The_Partition_Source,
273
      P_Time_Stamp,
274
      P_Hybrid_Task_Set,
275
      P_Hybrid_Task_Driver,
276
      P_To,
277
      P_Tp,
278
      P_Type_Code,
279
      P_Size,
280
      P_Store,
281
      P_Source,
282
      P_Section,
283
      P_Shutdown,
284
      P_Storage_Size,
285
      P_Stack_Size,
286
      P_Status,
287
      P_System_Start_Time,
288
      P_Urgencies,
289
      P_Valid,
290
      P_Value);
291

292 1
   PN : array (Parameter_Id) of Name_Id;
293

294
   type Variable_Id is
295
     (V_Argument,
296
      V_Id,
297
      V_Index,
298
      V_Invalid_Server,
299
      V_Mutex,
300
      V_Name,
301
      V_Period_Event,
302
      V_Present,
303
      V_Temp,
304
      V_Req,
305
      V_Args,
306
      V_Status,
307
      V_Result,
308
      V_Time_Stamp,
309
      V_Thread_Interface,
310
      V_Threads_Array,
311
      V_Threads_Access,
312
      V_Error);
313

314 1
   VN : array (Variable_Id) of Name_Id;
315

316
   type Subprogram_Id is
317
     (S_Build,
318
      S_Catch,
319
      S_Change_Mode,
320
      S_R_Continue, --  FIXME : bad, but where put it ?
321
      S_Deferred_Initialization,
322
      S_Deliver,
323
      S_Emit_Message,
324
      S_Execute_Servant,
325
      S_Found,
326
      S_From_Any,
327
      S_Get_Count,
328
      S_Get_Next_Event,
329
      S_Get_Time_Stamp,
330
      S_Get_Value,
331
      S_Get_Sender,
332
      S_Initialize,
333
      S_Length,
334
      S_Marshall,
335
      S_Next_Deadline,
336
      S_Next_Value,
337
      S_Receive_Input,
338
      S_Send_Output,
339
      S_Put_Value,
340
      S_Send,
341
      S_Store_Received_Message,
342
      S_To_Any,
343
      S_To_Bounded_String,
344
      S_To_Bounded_Wide_String,
345
      S_To_String,
346
      S_To_Wide_String,
347
      S_True,         --  FIXME : bad, but where put it ?
348
      S_Unmarshall,
349
      S_Wait_For_Incoming_Events,
350
      S_Controller,
351
      S_Get_Conf,
352
      S_Process_Request,
353
      S_Register_Source,
354
      S_Init_Lane,
355
      S_Create);
356

357 1
   SN : array (Subprogram_Id) of Name_Id;
358

359
   type Component_Id is
360
     (C_Address,
361
      C_From,
362
      C_Los,
363
      C_Name,
364
      C_Pid,
365
      C_Port,
366
      C_Proc_Id,
367
      C_Switch,
368
      C_Conf_Table,
369
      C_Operation);
370

371 1
   CN : array (Component_Id) of Name_Id;
372

373
   type Attribute_Id is
374
     (A_Access,
375
      A_Address,
376
      A_Alignment,
377
      A_Class,
378
      A_First,
379
      A_Length,
380
      A_Max,
381
      A_Pos,
382
      A_Range,
383
      A_Size,
384
      A_Val,
385
      A_Identity,
386
      A_Last);
387

388 1
   AN : array (Attribute_Id) of Name_Id;
389

390
   type Type_Id is
391
     (T_Bounded_String,
392
      T_Bounded_Wide_String,
393
      T_Entity_Type,
394
      T_Address_Array,
395
      T_Integer,
396
      T_Integer_Array,
397
      T_Node_Type,
398
      T_Object,
399
      T_Operations,
400
      T_Overflow_Protocol_Array,
401
      T_Port_Kind_Array,
402
      T_Port_Image_Array,
403
      T_Ref,
404
      T_Request,
405
      T_Server_Entity_Type,
406
      T_Table,
407
      T_Thread_Interface_Type,
408
      T_Partition_Source,
409
      T_Parameter_Entry,
410
      T_Port_Type);
411

412 1
   TN : array (Type_Id) of Name_Id;
413

414
   type Pragma_Id is
415
     (Pragma_Debug,
416
      Pragma_Elaborate_Body,
417
      Pragma_Import,
418
      Pragma_Export,
419
      Pragma_Inline,
420
      Pragma_No_Return,
421
      Pragma_Preelaborate,
422
      Pragma_Priority,
423
      Pragma_SPARK_Mode,
424
      Pragma_Style_Checks,
425
      Pragma_Suppress,
426
      Pragma_Unreferenced,
427
      Pragma_Warnings);
428

429 1
   GN : array (Pragma_Id) of Name_Id;
430

431
   type Error_Id is (E_Program_Error, E_Constraint_Error, E_NYI);
432

433 1
   EN : array (Error_Id) of Name_Id;
434

435
   type Aspect_Id is
436
     (A_Abstract_State,
437
      A_Global,
438
      A_Initializes,
439
      A_Pre,
440
      A_Refined_Global,
441
      A_Refined_State,
442
      A_Volatile_Function
443
     );
444

445 1
   ASN : array (Aspect_Id) of Name_Id;
446

447
   procedure Add_With_Package
448
     (E            : Node_Id;
449
      Used         : Boolean := False;
450
      Warnings_Off : Boolean := False;
451
      Elaborated   : Boolean := False);
452

453
   procedure Append_Node_To_List (E : Node_Id; L : List_Id);
454
   procedure Append_Node_To_Current_Package (N : Node_Id);
455
   --  Append Node to the current package statements of package
456
   --  implementation or to the visible part of package specification
457

458
   procedure Insert_After_Node (E : Node_Id; N : Node_Id);
459
   procedure Insert_Before_Node (E : Node_Id; N : Node_Id; L : List_Id);
460

461
   procedure Push_Entity (E : Node_Id);
462
   procedure Pop_Entity;
463
   function Current_Entity return Node_Id;
464
   function Current_Package return Node_Id;
465

466
   function Copy_Node (N : Node_Id) return Node_Id;
467

468
   function Create_Subtype_From_Range_Constraint (R : Node_Id) return Node_Id;
469
   --  This function takes a range_constraint, creates a node for
470
   --  the anonymous type of the range constraint and returns it.
471
   --  It's called only by Remove_Anonymous_Array_Type_Definition
472

473
   function New_Node
474
     (Kind : Node_Kind;
475
      From : Node_Id := No_Node) return Node_Id;
476

477
   function New_List
478
     (Kind : Node_Kind;
479
      From : Node_Id := No_Node) return List_Id;
480

481
   function Image (T : Token_Type) return String;
482
   function Image (O : Operator_Type) return String;
483

484
   procedure Initialize;
485
   procedure Reset;
486

487
   procedure New_Token (T : Token_Type; I : String := "");
488

489
   function Length (L : List_Id) return Natural;
490

491
   procedure Remove_Node_From_List (E : Node_Id; L : List_Id);
492
   --  Remove node N to list L.
493

494
   function Is_Empty (L : List_Id) return Boolean;
495
   pragma Inline (Is_Empty);
496
   --  Return True when L is empty
497

498
   function Copy_Designator
499
     (Designator : Node_Id;
500
      Withed     : Boolean := True) return Node_Id;
501

502
   function Defining_Identifier_To_Designator
503
     (N                       : Node_Id;
504
      Copy                    : Boolean := False;
505
      Keep_Parent             : Boolean := True;
506
      Keep_Corresponding_Node : Boolean := True) return Node_Id;
507

508
   function Make_Access_Type_Definition
509
     (Subtype_Indication : Node_Id;
510
      Is_All             : Boolean := False;
511
      Is_Constant        : Boolean := False;
512
      Is_Not_Null        : Boolean := False) return Node_Id;
513

514
   function Make_Ada_Comment
515
     (N                 : Name_Id;
516
      Has_Header_Spaces : Boolean := True) return Node_Id;
517
   --  This function does only the fllowing thing: it creates a node
518
   --  whose name is the full text of the comment. It does not split
519
   --  the comment into many lines. This is done in the code
520
   --  generation phase
521

522
   function Make_Array_Aggregate (Elements : List_Id) return Node_Id;
523

524
   function Make_Array_Type_Definition
525
     (Range_Constraints    : List_Id;
526
      Component_Definition : Node_Id;
527
      Aliased_Present      : Boolean := False) return Node_Id;
528
   --  Usually used with Make_Full_Type_Declaration
529

530
   function Make_Aspect_Specification
531
     (Aspects : List_Id) return Node_Id;
532

533
   function Make_Aspect
534
     (Aspect_Mark : Name_Id;
535
      Aspect_Definition : Node_Id := No_Node) return Node_Id;
536

537
   function Make_Pre
538
     (Subprogram_Call : Node_Id) return Node_Id;
539

540
   function Make_Global_Specification
541
     (Moded_Global_List : List_Id) return Node_Id;
542

543
   function Make_Moded_Global_List
544
     (Mode : Mode_Id; Identifier : Node_Id) return Node_Id;
545

546
   function Make_Initialization_Spec
547
     (Initialization_List : List_Id) return Node_Id;
548

549
   function Make_Abstract_State_List
550
     (State_Name_With_Option : List_Id) return Node_Id;
551

552
   function Make_State_Name_With_Option
553
     (Defining_Identifier : Node_Id;
554
      Synchronous : Boolean;
555
      External : Boolean) return Node_Id;
556

557
   function Make_Refinement_List
558
     (Refinement_Clause : List_Id) return Node_Id;
559

560
   function Make_Refinement_Clause
561
     (State_Name : Node_Id;
562
      Constituent : List_Id) return Node_Id;
563

564
   function Make_Assignment_Statement
565
     (Variable_Identifier : Node_Id;
566
      Expression          : Node_Id) return Node_Id;
567

568
   function Make_Attribute_Definition_Clause
569
     (Defining_Identifier  : Node_Id;
570
      Attribute_Designator : Attribute_Id;
571
      Expression           : Node_Id) return Node_Id;
572

573
   function Make_Attribute_Designator
574
     (Prefix    : Node_Id;
575
      Attribute : Attribute_Id) return Node_Id;
576

577
   function Make_Block_Statement
578
     (Statement_Identifier : Node_Id := No_Node;
579
      Declarative_Part     : List_Id;
580
      Statements           : List_Id;
581
      Exception_Handler    : List_Id := No_List) return Node_Id;
582

583
   function Make_Case_Label (Value : Value_Id) return Node_Id;
584

585
   function Make_Case_Statement
586
     (Expression                  : Node_Id;
587
      Case_Statement_Alternatives : List_Id) return Node_Id;
588

589
   function Make_Case_Statement_Alternative
590
     (Discret_Choice_List : List_Id;
591
      Statements          : List_Id) return Node_Id;
592

593
   function Make_Component_Association
594
     (Selector_Name : Node_Id;
595
      Expression    : Node_Id) return Node_Id;
596

597
   function Make_Component_Declaration
598
     (Defining_Identifier : Node_Id;
599
      Subtype_Indication  : Node_Id;
600
      Expression          : Node_Id := No_Node;
601
      Aliased_Present     : Boolean := False) return Node_Id;
602

603
   function Make_Decimal_Type_Definition
604
     (D_Digits : Unsigned_Long_Long;
605
      D_Scale  : Unsigned_Long_Long) return Node_Id;
606

607
   function Make_Defining_Identifier
608
     (Name : Name_Id; Normalize : Boolean := True) return Node_Id;
609

610
   function Make_Delay_Statement
611
     (Expression : Node_Id;
612
      Is_Until   : Boolean := False) return Node_Id;
613

614
   function Make_Derived_Type_Definition
615
     (Subtype_Indication    : Node_Id;
616
      Record_Extension_Part : Node_Id := No_Node;
617
      Is_Abstract_Type      : Boolean := False;
618
      Is_Private_Extention  : Boolean := False;
619
      Is_Subtype            : Boolean := False) return Node_Id;
620

621
   function Make_Designator
622
     (Designator : Name_Id;
623
      Parent     : Name_Id := No_Name;
624
      Is_All     : Boolean := False) return Node_Id;
625

626
   function Make_Elsif_Statement
627
     (Condition       : Node_Id;
628
      Then_Statements : List_Id) return Node_Id;
629

630
   function Make_Element_Association
631
     (Index      : Node_Id;
632
      Expression : Node_Id) return Node_Id;
633
   --  If 'Index' is No_Node, then 'others => <Expression>' will be
634
   --  generated
635

636
   function Make_Enumeration_Type_Definition
637
     (Enumeration_Literals : List_Id) return Node_Id;
638

639
   function Make_Enumeration_Representation_Clause
640
     (Defining_Identifier : Node_Id;
641
      Array_Aggregate     : Node_Id) return Node_Id;
642

643
   function Make_Exception_Declaration
644
     (Defining_Identifier : Node_Id;
645
      Renamed_Exception   : Node_Id := No_Node) return Node_Id;
646

647
   function Make_Explicit_Dereference (Prefix : Node_Id) return Node_Id;
648

649
   function Make_Expression
650
     (Left_Expr  : Node_Id;
651
      Operator   : Operator_Type := Op_None;
652
      Right_Expr : Node_Id       := No_Node) return Node_Id;
653

654
   function Make_For_Statement
655
     (Defining_Identifier : Node_Id;
656
      Range_Constraint    : Node_Id;
657
      Statements          : List_Id) return Node_Id;
658

659
   function Make_Loop_Statement (Statements : List_Id) return Node_Id;
660

661
   function Make_Full_Type_Declaration
662
     (Defining_Identifier : Node_Id;
663
      Type_Definition     : Node_Id;
664
      Discriminant_Spec   : Node_Id := No_Node;
665
      Parent              : Node_Id := No_Node;
666
      Is_Subtype          : Boolean := False) return Node_Id;
667
   --  No_Node as Type_Definition made type declaration without actual
668
   --  definition (eg. "type X;").
669

670
   function Make_If_Statement
671
     (Condition        : Node_Id;
672
      Then_Statements  : List_Id;
673
      Elsif_Statements : List_Id := No_List;
674
      Else_Statements  : List_Id := No_List) return Node_Id;
675

676
   function Make_Indexed_Component
677
     (Prefix      : Node_Id;
678
      Expressions : List_Id) return Node_Id;
679

680
   function Make_List_Id
681
     (N1 : Node_Id;
682
      N2 : Node_Id := No_Node;
683
      N3 : Node_Id := No_Node;
684
      N4 : Node_Id := No_Node) return List_Id;
685

686
   function Make_Literal
687
     (Value             : Value_Id;
688
      Parent_Designator : Node_Id := No_Node) return Node_Id;
689

690
   function Make_Main_Subprogram_Implementation
691
     (Identifier : Node_Id;
692
      Build_Spec : Boolean := False;
693
      Build_Body : Boolean := True) return Node_Id;
694
   --  If Build_Body is false generate only the spec of a main
695
   --  subprogram
696

697
   function Make_Null_Statement return Node_Id;
698

699
   function Make_Object_Declaration
700
     (Defining_Identifier : Node_Id;
701
      Constant_Present    : Boolean := False;
702
      Object_Definition   : Node_Id;
703
      Expression          : Node_Id := No_Node;
704
      Parent              : Node_Id := No_Node;
705
      Renamed_Object      : Node_Id := No_Node;
706
      Aliased_Present     : Boolean := False;
707
      Discriminant_Spec   : Node_Id := No_Node) return Node_Id;
708

709
   function Make_Object_Instantiation
710
     (Qualified_Expression : Node_Id) return Node_Id;
711

712
   function Make_Package_Declaration (Identifier : Node_Id) return Node_Id;
713

714
   function Make_Package_Instantiation
715
     (Defining_Identifier : Node_Id;
716
      Generic_Package     : Node_Id;
717
      Parameter_List      : List_Id := No_List) return Node_Id;
718

719
   function Make_Private_Type_Definition return Node_Id;
720

721
   function Make_Parameter_Association
722
     (Selector_Name    : Node_Id;
723
      Actual_Parameter : Node_Id) return Node_Id;
724

725
   function Make_Parameter_Specification
726
     (Defining_Identifier : Node_Id;
727
      Subtype_Mark        : Node_Id;
728
      Parameter_Mode      : Mode_Id := Mode_In;
729
      Expression          : Node_Id := No_Node) return Node_Id;
730

731
   function Make_Pragma_Statement
732
     (The_Pragma    : Pragma_Id;
733
      Argument_List : List_Id := No_List) return Node_Id;
734

735
   function Make_Protected_Object_Spec
736
     (Defining_Identifier : Node_Id;
737
      Visible_Part        : List_Id;
738
      Private_Part        : List_Id;
739
      Parent              : Node_Id := Current_Package;
740
      Is_Type             : Boolean := False) return Node_Id;
741

742
   function Make_Protected_Object_Body
743
     (Defining_Identifier : Node_Id;
744
      Statements          : List_Id) return Node_Id;
745

746
   function Make_Qualified_Expression
747
     (Subtype_Mark : Node_Id;
748
      Aggregate    : Node_Id) return Node_Id;
749

750
   function Make_Raise_Statement
751
     (Raised_Error : Node_Id := No_Node) return Node_Id;
752

753
   function Make_Range_Constraint
754
     (First      : Node_Id;
755
      Last       : Node_Id;
756
      Index_Type : Node_Id := No_Node) return Node_Id;
757

758
   function Make_Record_Aggregate (L : List_Id) return Node_Id;
759

760
   function Make_Record_Definition (Component_List : List_Id) return Node_Id;
761

762
   function Make_Record_Type_Definition
763
     (Record_Definition : Node_Id;
764
      Is_Abstract_Type  : Boolean := False;
765
      Is_Tagged_Type    : Boolean := False;
766
      Is_Limited_Type   : Boolean := False) return Node_Id;
767

768
   function Make_Return_Statement (Expression : Node_Id) return Node_Id;
769

770
   function Make_Subprogram_Call
771
     (Defining_Identifier   : Node_Id;
772
      Actual_Parameter_Part : List_Id := No_List) return Node_Id;
773

774
   function Make_Selected_Component
775
     (Prefix        : Node_Id;
776
      Selector_Name : Node_Id) return Node_Id;
777

778
   function Make_Subprogram_Implementation
779
     (Specification        : Node_Id;
780
      Declarations         : List_Id;
781
      Statements           : List_Id;
782
      Aspect_Specification : Node_Id := No_Node) return Node_Id;
783

784
   function Make_Subprogram_Specification
785
     (Defining_Identifier     : Node_Id;
786
      Parameter_Profile       : List_Id;
787
      Return_Type             : Node_Id := No_Node;
788
      Aspect_Specification    : Node_Id := No_Node;
789
      Parent                  : Node_Id := Current_Package;
790
      Renamed_Subprogram      : Node_Id := No_Node;
791
      Instantiated_Subprogram : Node_Id := No_Node) return Node_Id;
792

793
   function Make_Type_Attribute
794
     (Designator : Node_Id;
795
      Attribute  : Attribute_Id) return Node_Id;
796

797
   function Make_Type_Conversion
798
     (Subtype_Mark : Node_Id;
799
      Expression   : Node_Id) return Node_Id;
800

801
   function Make_Withed_Package
802
     (Defining_Identifier : Node_Id;
803
      Used                : Boolean := False;
804
      Warnings_Off        : Boolean := False;
805
      Elaborated          : Boolean := False) return Node_Id;
806

807
   function Make_Exit_When_Statement (Condition : Node_Id) return Node_Id;
808

809
   function Make_Used_Package (The_Used_Package : Node_Id) return Node_Id;
810

811
   function Make_Used_Type (The_Used_Type : Node_Id) return Node_Id;
812

813
   function Make_Variant_Part
814
     (Discriminant : Node_Id;
815
      Variant_List : List_Id) return Node_Id;
816

817
   procedure Make_Comment_Header (Package_Header : List_Id);
818
   --  This procedure generates a comment header for the generated
819
   --  packages.
820

821
   function Next_N_Node (N : Node_Id; Num : Natural) return Node_Id;
822
   --  This function executes Next_Node Num times
823

824
   function Message_Comment (M : Name_Id) return Node_Id;
825
   function Message_Comment (M : String) return Node_Id;
826
   --  Return a comment message. Used by all the tree
827
   --  converters
828

829
   function Qualified_Designator (P : Node_Id) return Node_Id;
830

831
   function Remove_Anonymous_Array_Type_Definition
832
     (Range_Constraints    : List_Id;
833
      Component_Definition : Node_Id;
834
      Aliased_Present      : Boolean := False;
835
      Variable_Name        : Node_Id;
836
      Is_Full_Type         : Boolean := False) return Node_Id;
837
   --  This function removes the anonymous arrays type definition
838
   --  by creating subtypes, and returns the identifier of type
839
   --  replacing the anonymous type. Only Make_Full_Type_Declaration
840
   --  and Make_Object_Declaration use it.
841

842
   procedure Set_Homogeneous_Parent_Unit_Name
843
     (Child  : Node_Id;
844
      Parent : Node_Id);
845
   --  This procedure sets correctly the parent unit name of a node
846
   --  depending on its kind :
847

848
   --  * K_Defining_Identifier : the parent unit name is also a
849
   --  K_Defining_Identifier
850

851
   --  * K_Designator : The parent unit name is a K_Designator and the
852
   --  parent unit name of its defining identifier is also set up.
853

854
   --  Units Setters for the PolyORB-HI module
855

856
   procedure Set_Main_Spec (N : Node_Id := No_Node);
857
   procedure Set_Main_Body (N : Node_Id := No_Node);
858

859
   procedure Set_Marshallers_Spec (N : Node_Id := No_Node);
860
   procedure Set_Marshallers_Body (N : Node_Id := No_Node);
861

862
   procedure Set_Activity_Spec (N : Node_Id := No_Node);
863
   procedure Set_Activity_Body (N : Node_Id := No_Node);
864

865
   procedure Set_Job_Spec (N : Node_Id := No_Node);
866
   procedure Set_Job_Body (N : Node_Id := No_Node);
867

868
   procedure Set_Transport_Spec (N : Node_Id := No_Node);
869
   procedure Set_Transport_Body (N : Node_Id := No_Node);
870

871
   procedure Set_Types_Spec (N : Node_Id := No_Node);
872
   procedure Set_Types_Body (N : Node_Id := No_Node);
873

874
   procedure Set_Subprograms_Spec (N : Node_Id := No_Node);
875
   procedure Set_Subprograms_Body (N : Node_Id := No_Node);
876

877
   procedure Set_Deployment_Spec (N : Node_Id := No_Node);
878

879
   procedure Set_Naming_Spec (N : Node_Id := No_Node);
880

881
   function To_Ada_Name (N : Name_Id) return Name_Id;
882
   --  Convert N to a valid Ada identifier (no clashing with keywords,
883
   --  no consecutive '_', no heading '_'...).
884

885
   function Unit_Name (N : Name_Id) return Name_Id;
886
   --  Given an ENTITY fully qualified name A.B.C.D, returns A.B.C
887
   --  Raises an error if the name does not contains any dot.
888
   --  Return No_Name is unit name is Standard
889

890
   function Local_Name (N : Name_Id) return Name_Id;
891
   --  Given an ENTITY fully qualified name A.B.C.D, returns D
892

893
   function Conventional_Base_Name (N : Name_Id) return Name_Id;
894
   --  Given a UNIT fully qualified name A.D.C, returns a-b-c
895

896
   function Fully_Qualified_Name (N : Node_Id) return Name_Id;
897

898
   function Extract_Designator
899
     (N               : Node_Id;
900
      Add_With_Clause : Boolean := True) return Node_Id;
901
   --  Extracts the designator of the *Ada* entity N and return a copy
902
   --  of it after adding the proper 'with' clause to the current
903
   --  package if 'Add_With_Clause' is True. N may be:
904
   --  * a type declaration
905
   --  * a subprogram specification
906
   --  * an object declaration
907
   --  * a package specification
908
   --  * a package declaration
909

910 1
end Ocarina.Backends.Ada_Tree.Nutils;

Read our documentation on viewing source code .

Loading