ocarina-backends-ada_tree-nutils.ads 27.3 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--     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      --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
9
--    Copyright (C) 2006-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
33
34
35
--                                                                          --
------------------------------------------------------------------------------

with Ocarina.Backends.Ada_Tree.Nodes; use Ocarina.Backends.Ada_Tree.Nodes;

package Ocarina.Backends.Ada_Tree.Nutils is

36
37
   Int0_Val : Value_Id;
   Int1_Val : Value_Id;
38
39
40
41
42
43
44

   Output_Tree_Warnings : Boolean := False;
   Output_Unit_Withing  : Boolean := False;
   --  Control flags

   type Token_Type is
     (
yoogx's avatar
yoogx committed
45
46
47
   --   Token name      Token type
   --   Keywords
   Tok_Mod,             -- MOD   **** First Keyword
48
49
50
51
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
      Tok_Rem,             -- REM
      Tok_New,             -- NEW
      Tok_Abs,             -- ABS
      Tok_Others,          -- OTHERS
      Tok_Null,            -- NULL
      Tok_Delta,           -- DELTA
      Tok_Digits,          -- DIGITS
      Tok_Range,           -- RANGE
      Tok_And,             -- AND
      Tok_Or,              -- OR
      Tok_Xor,             -- XOR
      Tok_In,              -- IN
      Tok_Not,             -- NOT
      Tok_Abstract,        -- ABSTRACT
      Tok_Access,          -- ACCESS
      Tok_Aliased,         -- ALIASED
      Tok_All,             -- ALL
      Tok_Array,           -- ARRAY
      Tok_At,              -- AT
      Tok_Body,            -- BODY
      Tok_Constant,        -- CONSTANT
      Tok_Do,              -- DO
      Tok_Is,              -- IS
      Tok_Limited,         -- LIMITED
      Tok_Of,              -- OF
      Tok_Out,             -- OUT
      Tok_Record,          -- RECORD
      Tok_Renames,         -- RENAMES
      Tok_Reverse,         -- REVERSE
      Tok_Tagged,          -- TAGGED
      Tok_Then,            -- THEN
      Tok_Abort,           -- ABORT
      Tok_Accept,          -- ACCEPT
      Tok_Case,            -- CASE
      Tok_Delay,           -- DELAY
      Tok_Else,            -- ELSE
      Tok_Elsif,           -- ELSIF
      Tok_End,             -- END
      Tok_Exception,       -- EXCEPTION
      Tok_Exit,            -- EXIT
      Tok_Goto,            -- GOTO
      Tok_If,              -- IF
      Tok_Pragma,          -- PRAGMA
      Tok_Raise,           -- RAISE
      Tok_Requeue,         -- REQUEUE
      Tok_Return,          -- RETURN
      Tok_Select,          -- SELECT
      Tok_Terminate,       -- TERMINATE
      Tok_Until,           -- UNTIL
      Tok_When,            -- WHEN

      Tok_Begin,           -- BEGIN
      Tok_Declare,         -- DECLARE
      Tok_For,             -- FOR
      Tok_Loop,            -- LOOP
      Tok_While,           -- WHILE

      Tok_Entry,           -- ENTRY
      Tok_Protected,       -- PROTECTED
      Tok_Task,            -- TASK
      Tok_Type,            -- TYPE
      Tok_Subtype,         -- SUBTYPE
      Tok_Use,             -- USE

      Tok_Function,        -- FUNCTION
      Tok_Generic,         -- GENERIC
      Tok_Package,         -- PACKAGE
      Tok_Procedure,       -- PROCEDURE

      Tok_Private,         -- PRIVATE
      Tok_With,            -- WITH
      Tok_Separate,        -- SEPARATE **** Last Keyword

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

yoogx's avatar
yoogx committed
150
);
151
152
153

   Token_Image : array (Token_Type) of Name_Id;

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

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

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

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

   type Parameter_Id is
     (P_A,
194
      P_Activate_Entrypoint,
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
      P_Arg_List,
      P_Argument,
      P_C,
      P_Conflicts,
      P_Current_Entity,
      P_Data,
      P_Depends,
      P_Destinations,
      P_Dispatcher,
      P_Dispatch_Offset,
      P_E_Req,
      P_Elaboration_Check,
      P_Entity,
      P_Entity_Table,
      P_Entity_Image,
      P_Error,
      P_From,
      P_Global_Data_Queue_Size,
      P_Got_Data,
      P_Has_Event_Ports,
      P_Id,
      P_Implicit,
      P_Incoming_Message,
      P_Init,
      P_Initialize_Entrypoint,
      P_Index,
yoogx's avatar
yoogx committed
221
      P_Interrupt_Identifier,
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
      P_Item,
      P_Job,
      P_Key,
      P_Lane_R,
      P_Max_Node_Image_Size,
      P_Max_Entity_Image_Size,
      P_Max_Payload_Size,
      P_Max_Port_Image_Size,
      P_May_Exit,
      P_Message,
      P_Mode,
      P_Msg,
      P_My_Node,
      P_N_Destinations,
      P_Name,
      P_Naming_Table,
      P_Next_Start,
      P_Node,
      P_Node_Image,
      P_Null_Bounded_String,
      P_Null_Bounded_Wide_String,
      P_Obj,
      P_Operation,
      P_Period,
      P_Port,
      P_Port_Image,
      P_Port_Sized_String,
      P_Port_Table,
      P_PortName,
      P_Provides,
      P_Priority,
      P_Priority_Manager,
      P_Recover_Entrypoint,
      P_Ref,
      P_Req,
      P_Result,
      P_Self,
      P_Server_Entity_Table,
      P_Spg_Interface,
      P_Task_Deadline,
      P_Task_Period,
      P_Task_Priority,
      P_Task_Stack_Size,
      P_Thread_Port_Kinds,
      P_Thread_Overflow_Protocols,
      P_Thread_Port_Images,
      P_Thread_Fifo_Sizes,
      P_Thread_Fifo_Offsets,
      P_Thread_Interface,
      P_The_Partition_Source,
      P_Time_Stamp,
      P_Hybrid_Task_Set,
      P_Hybrid_Task_Driver,
      P_To,
      P_Tp,
      P_Type_Code,
      P_Size,
      P_Store,
      P_Source,
      P_Section,
      P_Shutdown,
      P_Storage_Size,
      P_Stack_Size,
      P_Status,
      P_System_Start_Time,
      P_Urgencies,
      P_Valid,
      P_Value);

   PN : array (Parameter_Id) of Name_Id;

   type Variable_Id is
     (V_Argument,
      V_Id,
      V_Index,
      V_Invalid_Server,
      V_Mutex,
      V_Name,
      V_Period_Event,
      V_Present,
      V_Temp,
      V_Req,
      V_Args,
      V_Status,
      V_Result,
      V_Time_Stamp,
      V_Thread_Interface,
      V_Threads_Array,
      V_Threads_Access,
      V_Error);

   VN : array (Variable_Id) of Name_Id;

   type Subprogram_Id is
     (S_Build,
      S_Catch,
      S_Change_Mode,
      S_R_Continue, --  FIXME : bad, but where put it ?
      S_Deferred_Initialization,
      S_Deliver,
      S_Emit_Message,
      S_Execute_Servant,
      S_Found,
      S_From_Any,
      S_Get_Count,
      S_Get_Next_Event,
      S_Get_Time_Stamp,
      S_Get_Value,
      S_Get_Sender,
      S_Initialize,
      S_Length,
      S_Marshall,
      S_Next_Deadline,
      S_Next_Value,
      S_Receive_Input,
      S_Send_Output,
      S_Put_Value,
      S_Send,
      S_Store_Received_Message,
      S_To_Any,
      S_To_Bounded_String,
      S_To_Bounded_Wide_String,
      S_To_String,
      S_To_Wide_String,
      S_True,         --  FIXME : bad, but where put it ?
      S_Unmarshall,
      S_Wait_For_Incoming_Events,
      S_Controller,
      S_Get_Conf,
      S_Process_Request,
      S_Register_Source,
      S_Init_Lane,
      S_Create);

   SN : array (Subprogram_Id) of Name_Id;

   type Component_Id is
     (C_Address,
      C_From,
      C_Los,
      C_Name,
      C_Pid,
      C_Port,
      C_Proc_Id,
      C_Switch,
      C_Conf_Table,
      C_Operation);

   CN : array (Component_Id) of Name_Id;

   type Attribute_Id is
     (A_Access,
      A_Address,
375
      A_Alignment,
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
415
416
417
418
419
420
421
      A_Class,
      A_First,
      A_Length,
      A_Max,
      A_Pos,
      A_Range,
      A_Size,
      A_Val,
      A_Identity,
      A_Last);

   AN : array (Attribute_Id) of Name_Id;

   type Type_Id is
     (T_Bounded_String,
      T_Bounded_Wide_String,
      T_Entity_Type,
      T_Address_Array,
      T_Integer,
      T_Integer_Array,
      T_Node_Type,
      T_Object,
      T_Operations,
      T_Overflow_Protocol_Array,
      T_Port_Kind_Array,
      T_Port_Image_Array,
      T_Ref,
      T_Request,
      T_Server_Entity_Type,
      T_Table,
      T_Thread_Interface_Type,
      T_Partition_Source,
      T_Parameter_Entry,
      T_Port_Type);

   TN : array (Type_Id) of Name_Id;

   type Pragma_Id is
     (Pragma_Debug,
      Pragma_Elaborate_Body,
      Pragma_Import,
      Pragma_Export,
      Pragma_Inline,
      Pragma_No_Return,
      Pragma_Preelaborate,
      Pragma_Priority,
422
      Pragma_SPARK_Mode,
423
424
425
426
427
428
429
      Pragma_Style_Checks,
      Pragma_Suppress,
      Pragma_Unreferenced,
      Pragma_Warnings);

   GN : array (Pragma_Id) of Name_Id;

430
   type Error_Id is (E_Program_Error, E_Constraint_Error, E_NYI);
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449

   EN : array (Error_Id) of Name_Id;

   procedure Add_With_Package
     (E            : Node_Id;
      Used         : Boolean := False;
      Warnings_Off : Boolean := False;
      Elaborated   : Boolean := False);

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

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

   procedure Push_Entity (E : Node_Id);
   procedure Pop_Entity;
450
451
   function Current_Entity return Node_Id;
   function Current_Package return Node_Id;
452

453
   function Copy_Node (N : Node_Id) return Node_Id;
454

455
   function Create_Subtype_From_Range_Constraint (R : Node_Id) return Node_Id;
456
457
458
459
460
461
   --  This function takes a range_constraint, creates a node for
   --  the anonymous type of the range constraint and returns it.
   --  It's called only by Remove_Anonymous_Array_Type_Definition

   function New_Node
     (Kind : Node_Kind;
462
      From : Node_Id := No_Node) return Node_Id;
463
464
465

   function New_List
     (Kind : Node_Kind;
466
      From : Node_Id := No_Node) return List_Id;
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486

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

   procedure Initialize;
   procedure Reset;

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

   function Length (L : List_Id) return Natural;

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

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

   function Copy_Designator
     (Designator : Node_Id;
487
      Withed     : Boolean := True) return Node_Id;
488
489
490
491
492

   function Defining_Identifier_To_Designator
     (N                       : Node_Id;
      Copy                    : Boolean := False;
      Keep_Parent             : Boolean := True;
493
      Keep_Corresponding_Node : Boolean := True) return Node_Id;
494
495
496
497
498

   function Make_Access_Type_Definition
     (Subtype_Indication : Node_Id;
      Is_All             : Boolean := False;
      Is_Constant        : Boolean := False;
499
      Is_Not_Null        : Boolean := False) return Node_Id;
500
501
502

   function Make_Ada_Comment
     (N                 : Name_Id;
503
      Has_Header_Spaces : Boolean := True) return Node_Id;
504
505
506
507
508
509
510
511
512
513
   --  This function does only the fllowing thing: it creates a node
   --  whose name is the full text of the comment. It does not split
   --  the comment into many lines. This is done in the code
   --  generation phase

   function Make_Array_Aggregate (Elements : List_Id) return Node_Id;

   function Make_Array_Type_Definition
     (Range_Constraints    : List_Id;
      Component_Definition : Node_Id;
514
      Aliased_Present      : Boolean := False) return Node_Id;
515
516
517
518
   --  Usually used with Make_Full_Type_Declaration

   function Make_Assignment_Statement
     (Variable_Identifier : Node_Id;
519
      Expression          : Node_Id) return Node_Id;
520
521
522
523

   function Make_Attribute_Definition_Clause
     (Defining_Identifier  : Node_Id;
      Attribute_Designator : Attribute_Id;
524
      Expression           : Node_Id) return Node_Id;
525
526
527

   function Make_Attribute_Designator
     (Prefix    : Node_Id;
528
      Attribute : Attribute_Id) return Node_Id;
529
530
531
532
533

   function Make_Block_Statement
     (Statement_Identifier : Node_Id := No_Node;
      Declarative_Part     : List_Id;
      Statements           : List_Id;
534
      Exception_Handler    : List_Id := No_List) return Node_Id;
535
536
537
538
539

   function Make_Case_Label (Value : Value_Id) return Node_Id;

   function Make_Case_Statement
     (Expression                  : Node_Id;
540
      Case_Statement_Alternatives : List_Id) return Node_Id;
541
542
543

   function Make_Case_Statement_Alternative
     (Discret_Choice_List : List_Id;
544
      Statements          : List_Id) return Node_Id;
545
546
547

   function Make_Component_Association
     (Selector_Name : Node_Id;
548
      Expression    : Node_Id) return Node_Id;
549
550
551
552
553

   function Make_Component_Declaration
     (Defining_Identifier : Node_Id;
      Subtype_Indication  : Node_Id;
      Expression          : Node_Id := No_Node;
554
      Aliased_Present     : Boolean := False) return Node_Id;
555
556
557

   function Make_Decimal_Type_Definition
     (D_Digits : Unsigned_Long_Long;
558
      D_Scale  : Unsigned_Long_Long) return Node_Id;
559

560
   function Make_Defining_Identifier (Name : Name_Id) return Node_Id;
561
562
563

   function Make_Delay_Statement
     (Expression : Node_Id;
564
      Is_Until   : Boolean := False) return Node_Id;
565
566
567
568
569
570

   function Make_Derived_Type_Definition
     (Subtype_Indication    : Node_Id;
      Record_Extension_Part : Node_Id := No_Node;
      Is_Abstract_Type      : Boolean := False;
      Is_Private_Extention  : Boolean := False;
571
      Is_Subtype            : Boolean := False) return Node_Id;
572
573
574
575

   function Make_Designator
     (Designator : Name_Id;
      Parent     : Name_Id := No_Name;
576
      Is_All     : Boolean := False) return Node_Id;
577
578
579

   function Make_Elsif_Statement
     (Condition       : Node_Id;
580
      Then_Statements : List_Id) return Node_Id;
581
582
583

   function Make_Element_Association
     (Index      : Node_Id;
584
      Expression : Node_Id) return Node_Id;
585
586
587
588
   --  If 'Index' is No_Node, then 'others => <Expression>' will be
   --  generated

   function Make_Enumeration_Type_Definition
589
     (Enumeration_Literals : List_Id) return Node_Id;
590
591
592

   function Make_Enumeration_Representation_Clause
     (Defining_Identifier : Node_Id;
593
      Array_Aggregate     : Node_Id) return Node_Id;
594
595
596

   function Make_Exception_Declaration
     (Defining_Identifier : Node_Id;
597
      Renamed_Exception   : Node_Id := No_Node) return Node_Id;
598

599
   function Make_Explicit_Dereference (Prefix : Node_Id) return Node_Id;
600
601
602
603

   function Make_Expression
     (Left_Expr  : Node_Id;
      Operator   : Operator_Type := Op_None;
604
      Right_Expr : Node_Id       := No_Node) return Node_Id;
605
606
607
608

   function Make_For_Statement
     (Defining_Identifier : Node_Id;
      Range_Constraint    : Node_Id;
609
      Statements          : List_Id) return Node_Id;
610

611
   function Make_Loop_Statement (Statements : List_Id) return Node_Id;
612
613
614
615
616
617

   function Make_Full_Type_Declaration
     (Defining_Identifier : Node_Id;
      Type_Definition     : Node_Id;
      Discriminant_Spec   : Node_Id := No_Node;
      Parent              : Node_Id := No_Node;
618
      Is_Subtype          : Boolean := False) return Node_Id;
619
620
621
622
623
624
625
   --  No_Node as Type_Definition made type declaration without actual
   --  definition (eg. "type X;").

   function Make_If_Statement
     (Condition        : Node_Id;
      Then_Statements  : List_Id;
      Elsif_Statements : List_Id := No_List;
626
      Else_Statements  : List_Id := No_List) return Node_Id;
627
628
629

   function Make_Indexed_Component
     (Prefix      : Node_Id;
630
      Expressions : List_Id) return Node_Id;
631
632
633
634
635

   function Make_List_Id
     (N1 : Node_Id;
      N2 : Node_Id := No_Node;
      N3 : Node_Id := No_Node;
636
      N4 : Node_Id := No_Node) return List_Id;
637
638
639

   function Make_Literal
     (Value             : Value_Id;
640
      Parent_Designator : Node_Id := No_Node) return Node_Id;
641
642
643
644

   function Make_Main_Subprogram_Implementation
     (Identifier : Node_Id;
      Build_Spec : Boolean := False;
645
      Build_Body : Boolean := True) return Node_Id;
646
647
648
649
650
651
652
653
654
655
656
657
658
   --  If Build_Body is false generate only the spec of a main
   --  subprogram

   function Make_Null_Statement return Node_Id;

   function Make_Object_Declaration
     (Defining_Identifier : Node_Id;
      Constant_Present    : Boolean := False;
      Object_Definition   : Node_Id;
      Expression          : Node_Id := No_Node;
      Parent              : Node_Id := No_Node;
      Renamed_Object      : Node_Id := No_Node;
      Aliased_Present     : Boolean := False;
659
      Discriminant_Spec   : Node_Id := No_Node) return Node_Id;
660
661

   function Make_Object_Instantiation
662
     (Qualified_Expression : Node_Id) return Node_Id;
663

664
   function Make_Package_Declaration (Identifier : Node_Id) return Node_Id;
665
666
667
668

   function Make_Package_Instantiation
     (Defining_Identifier : Node_Id;
      Generic_Package     : Node_Id;
669
      Parameter_List      : List_Id := No_List) return Node_Id;
670
671
672
673
674

   function Make_Private_Type_Definition return Node_Id;

   function Make_Parameter_Association
     (Selector_Name    : Node_Id;
675
      Actual_Parameter : Node_Id) return Node_Id;
676
677
678
679
680

   function Make_Parameter_Specification
     (Defining_Identifier : Node_Id;
      Subtype_Mark        : Node_Id;
      Parameter_Mode      : Mode_Id := Mode_In;
681
      Expression          : Node_Id := No_Node) return Node_Id;
682
683
684

   function Make_Pragma_Statement
     (The_Pragma    : Pragma_Id;
685
      Argument_List : List_Id := No_List) return Node_Id;
686
687
688
689
690
691

   function Make_Protected_Object_Spec
     (Defining_Identifier : Node_Id;
      Visible_Part        : List_Id;
      Private_Part        : List_Id;
      Parent              : Node_Id := Current_Package;
692
      Is_Type             : Boolean := False) return Node_Id;
693
694
695

   function Make_Protected_Object_Body
     (Defining_Identifier : Node_Id;
696
      Statements          : List_Id) return Node_Id;
697
698

   function Make_Qualified_Expression
699
700
     (Subtype_Mark : Node_Id;
      Aggregate    : Node_Id) return Node_Id;
701
702

   function Make_Raise_Statement
703
     (Raised_Error : Node_Id := No_Node) return Node_Id;
704
705
706
707

   function Make_Range_Constraint
     (First      : Node_Id;
      Last       : Node_Id;
708
      Index_Type : Node_Id := No_Node) return Node_Id;
709

710
   function Make_Record_Aggregate (L : List_Id) return Node_Id;
711

712
   function Make_Record_Definition (Component_List : List_Id) return Node_Id;
713
714
715
716
717

   function Make_Record_Type_Definition
     (Record_Definition : Node_Id;
      Is_Abstract_Type  : Boolean := False;
      Is_Tagged_Type    : Boolean := False;
718
      Is_Limited_Type   : Boolean := False) return Node_Id;
719

720
   function Make_Return_Statement (Expression : Node_Id) return Node_Id;
721
722
723

   function Make_Subprogram_Call
     (Defining_Identifier   : Node_Id;
724
      Actual_Parameter_Part : List_Id := No_List) return Node_Id;
725
726
727

   function Make_Selected_Component
     (Prefix        : Node_Id;
728
      Selector_Name : Node_Id) return Node_Id;
729
730
731
732

   function Make_Subprogram_Implementation
     (Specification : Node_Id;
      Declarations  : List_Id;
733
      Statements    : List_Id) return Node_Id;
734
735
736
737
738
739
740

   function Make_Subprogram_Specification
     (Defining_Identifier     : Node_Id;
      Parameter_Profile       : List_Id;
      Return_Type             : Node_Id := No_Node;
      Parent                  : Node_Id := Current_Package;
      Renamed_Subprogram      : Node_Id := No_Node;
741
      Instantiated_Subprogram : Node_Id := No_Node) return Node_Id;
742
743
744

   function Make_Type_Attribute
     (Designator : Node_Id;
745
      Attribute  : Attribute_Id) return Node_Id;
746
747
748

   function Make_Type_Conversion
     (Subtype_Mark : Node_Id;
749
      Expression   : Node_Id) return Node_Id;
750
751
752
753
754

   function Make_Withed_Package
     (Defining_Identifier : Node_Id;
      Used                : Boolean := False;
      Warnings_Off        : Boolean := False;
755
      Elaborated          : Boolean := False) return Node_Id;
756

757
   function Make_Exit_When_Statement (Condition : Node_Id) return Node_Id;
758

759
   function Make_Used_Package (The_Used_Package : Node_Id) return Node_Id;
760

761
   function Make_Used_Type (The_Used_Type : Node_Id) return Node_Id;
762
763

   function Make_Variant_Part
764
765
     (Discriminant : Node_Id;
      Variant_List : List_Id) return Node_Id;
766

767
   procedure Make_Comment_Header (Package_Header : List_Id);
768
769
770
771
772
773
774
775
776
777
778
   --  This procedure generates a comment header for the generated
   --  packages.

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

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

779
   function Qualified_Designator (P : Node_Id) return Node_Id;
780
781
782
783
784
785

   function Remove_Anonymous_Array_Type_Definition
     (Range_Constraints    : List_Id;
      Component_Definition : Node_Id;
      Aliased_Present      : Boolean := False;
      Variable_Name        : Node_Id;
786
      Is_Full_Type         : Boolean := False) return Node_Id;
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
   --  This function removes the anonymous arrays type definition
   --  by creating subtypes, and returns the identifier of type
   --  replacing the anonymous type. Only Make_Full_Type_Declaration
   --  and Make_Object_Declaration use it.

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

   --  * K_Defining_Identifier : the parent unit name is also a
   --  K_Defining_Identifier

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

   --  Units setters for the PolyORB-QoS Module

   procedure Set_Main_Body (N : Node_Id := No_Node);

   procedure Set_Helpers_Body (N : Node_Id := No_Node);
   procedure Set_Helpers_Spec (N : Node_Id := No_Node);

   procedure Set_Servants_Body (N : Node_Id := No_Node);
   procedure Set_Servants_Spec (N : Node_Id := No_Node);

   procedure Set_Parameters_Body (N : Node_Id := No_Node);
   procedure Set_Parameters_Spec (N : Node_Id := No_Node);

   procedure Set_Setup_Body (N : Node_Id := No_Node);
   procedure Set_Setup_Spec (N : Node_Id := No_Node);

   procedure Set_Namespaces_Body (N : Node_Id := No_Node);
   procedure Set_Namespaces_Spec (N : Node_Id := No_Node);

   procedure Set_Obj_Adapters_Spec (N : Node_Id := No_Node);

   --  Units Setters for the PolyORB-HI module

   procedure Set_Main_Spec (N : Node_Id := No_Node);

   procedure Set_Marshallers_Spec (N : Node_Id := No_Node);
   procedure Set_Marshallers_Body (N : Node_Id := No_Node);

   procedure Set_Activity_Spec (N : Node_Id := No_Node);
   procedure Set_Activity_Body (N : Node_Id := No_Node);

   procedure Set_Transport_Spec (N : Node_Id := No_Node);
   procedure Set_Transport_Body (N : Node_Id := No_Node);

   procedure Set_Types_Spec (N : Node_Id := No_Node);
   procedure Set_Types_Body (N : Node_Id := No_Node);

   procedure Set_Subprograms_Spec (N : Node_Id := No_Node);
   procedure Set_Subprograms_Body (N : Node_Id := No_Node);

   procedure Set_Deployment_Spec (N : Node_Id := No_Node);

   procedure Set_Naming_Spec (N : Node_Id := No_Node);

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

   function Unit_Name (N : Name_Id) return Name_Id;
   --  Given an ENTITY fully qualified name A.B.C.D, returns A.B.C
854
855
   --  Raises an error if the name does not contains any dot.
   --  Return No_Name is unit name is Standard
856
857
858
859
860
861
862
863
864
865
866

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

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

   function Fully_Qualified_Name (N : Node_Id) return Name_Id;

   function Extract_Designator
     (N               : Node_Id;
867
      Add_With_Clause : Boolean := True) return Node_Id;
868
869
870
871
872
873
874
875
876
877
   --  Extracts the designator of the *Ada* entity N and return a copy
   --  of it after adding the proper 'with' clause to the current
   --  package if 'Add_With_Clause' is True. N may be:
   --  * a type declaration
   --  * a subprogram specification
   --  * an object declaration
   --  * a package specification
   --  * a package declaration

end Ocarina.Backends.Ada_Tree.Nutils;