source: trunk/ada-2012/src/semantic/gela-pass_utils.adb@ 383

Last change on this file since 383 was 383, checked in by Maxim Reznik, 5 years ago

Improve def_name test to print each name

If def_name is started with last argument in form "+hash" then
traverse all elements for given compilation unit and print
Corresponding_Name_Definition where appropriate.

File size: 24.6 KB
Line 
1------------------------------------------------------------------------------
2-- G E L A A S I S --
3-- ASIS implementation for Gela project, a portable Ada compiler --
4-- a portable Ada compiler --
5-- http://gela.ada-ru.org/ --
6-- - - - - - - - - - - - - - - - --
7-- Read copyright and license in gela.ads file --
8------------------------------------------------------------------------------
9
10with League.Strings;
11
12with Gela.Element_Factories;
13with Gela.Element_Visiters;
14with Gela.Elements.Compilation_Unit_Bodies;
15with Gela.Elements.Context_Items;
16with Gela.Elements.Defining_Designators;
17with Gela.Elements.Enumeration_Type_Definitions;
18with Gela.Elements.Full_Type_Declarations;
19with Gela.Elements.Function_Declarations;
20with Gela.Elements.Identifiers;
21with Gela.Elements.Package_Declarations;
22with Gela.Elements.Parameter_Specifications;
23with Gela.Elements.Procedure_Bodies;
24with Gela.Elements.Program_Unit_Names;
25with Gela.Elements.Selected_Identifiers;
26with Gela.Elements.Selector_Names;
27with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
28with Gela.Elements.Type_Definitions;
29with Gela.Elements.Use_Package_Clauses;
30with Gela.Elements.With_Clauses;
31with Gela.Environments;
32with Gela.Nodes;
33with Gela.Plain_Type_Managers;
34with Gela.Symbol_Sets;
35with Gela.Elements.Defining_Operator_Symbols;
36with Gela.Defining_Name_Cursors;
37
38package body Gela.Pass_Utils is
39
40 procedure Preprocess_Standard
41 (Comp : Gela.Compilations.Compilation_Access;
42 Unit : Gela.Elements.Element_Access);
43
44 procedure Postprocess_Standard
45 (Comp : Gela.Compilations.Compilation_Access;
46 Unit : Gela.Elements.Compilation_Unit_Declarations.
47 Compilation_Unit_Declaration_Access;
48 Env : in out Gela.Semantic_Types.Env_Index);
49
50 function Is_Enumeration
51 (Decl : Gela.Elements.Element_Access) return Boolean;
52
53 procedure Add_Library_Level_Use_Clauses
54 (Comp : Gela.Compilations.Compilation_Access;
55 Decl : Gela.Elements.Element_Access;
56 Env : in out Gela.Semantic_Types.Env_Index);
57
58 procedure Add_Library_Level_Use_Clauses
59 (Comp : Gela.Compilations.Compilation_Access;
60 Decl : Gela.Elements.Element_Access;
61 Env : in out Gela.Semantic_Types.Env_Index)
62 is
63
64 package Get is
65
66 type Visiter is new Gela.Element_Visiters.Visiter with record
67 Name : Gela.Elements.Defining_Names.Defining_Name_Access;
68 end record;
69
70 overriding procedure Compilation_Unit_Body
71 (Self : in out Visiter;
72 Node : not null Gela.Elements.Compilation_Unit_Bodies.
73 Compilation_Unit_Body_Access);
74
75 overriding procedure Compilation_Unit_Declaration
76 (Self : in out Visiter;
77 Node : not null Gela.Elements.Compilation_Unit_Declarations.
78 Compilation_Unit_Declaration_Access);
79
80 overriding procedure Identifier
81 (Self : in out Visiter;
82 Node : not null Gela.Elements.Identifiers.Identifier_Access);
83
84 overriding procedure Package_Declaration
85 (Self : in out Visiter;
86 Node : not null Gela.Elements.Package_Declarations.
87 Package_Declaration_Access);
88
89 overriding procedure Procedure_Body
90 (Self : in out Visiter;
91 Node : not null Gela.Elements.Procedure_Bodies.
92 Procedure_Body_Access);
93
94 overriding procedure Selected_Identifier
95 (Self : in out Visiter;
96 Node : not null Gela.Elements.Selected_Identifiers.
97 Selected_Identifier_Access);
98
99 overriding procedure Use_Package_Clause
100 (Self : in out Visiter;
101 Node : not null Gela.Elements.Use_Package_Clauses.
102 Use_Package_Clause_Access);
103
104 overriding procedure With_Clause -- Use env.out instead
105 (Self : in out Visiter;
106 Node : not null Gela.Elements.With_Clauses.With_Clause_Access);
107 end Get;
108
109 package body Get is
110
111 overriding procedure Compilation_Unit_Body
112 (Self : in out Visiter;
113 Node : not null Gela.Elements.Compilation_Unit_Bodies.
114 Compilation_Unit_Body_Access)
115 is
116 List : constant Gela.Elements.Context_Items.
117 Context_Item_Sequence_Access := Node.Context_Clause_Elements;
118
119 Cursor : Gela.Elements.Element_Sequence_Cursor'Class := List.First;
120 begin
121 while Cursor.Has_Element loop
122 Cursor.Element.Visit (Self);
123 Cursor.Next;
124 end loop;
125 end Compilation_Unit_Body;
126
127 overriding procedure Compilation_Unit_Declaration
128 (Self : in out Visiter;
129 Node : not null Gela.Elements.Compilation_Unit_Declarations.
130 Compilation_Unit_Declaration_Access)
131 is
132 List : constant Gela.Elements.Context_Items.
133 Context_Item_Sequence_Access := Node.Context_Clause_Elements;
134
135 Cursor : Gela.Elements.Element_Sequence_Cursor'Class := List.First;
136 begin
137 while Cursor.Has_Element loop
138 Cursor.Element.Visit (Self);
139 Cursor.Next;
140 end loop;
141 end Compilation_Unit_Declaration;
142
143 overriding procedure Identifier
144 (Self : in out Visiter;
145 Node : not null Gela.Elements.Identifiers.Identifier_Access) is
146 begin
147 Self.Name := Node.Defining_Name;
148 end Identifier;
149
150 overriding procedure Package_Declaration
151 (Self : in out Visiter;
152 Node : not null Gela.Elements.Package_Declarations.
153 Package_Declaration_Access) is
154 begin
155 Node.Enclosing_Element.Visit (Self);
156 end Package_Declaration;
157
158 overriding procedure Procedure_Body
159 (Self : in out Visiter;
160 Node : not null Gela.Elements.Procedure_Bodies.
161 Procedure_Body_Access) is
162 begin
163 Node.Enclosing_Element.Visit (Self);
164 end Procedure_Body;
165
166 overriding procedure Selected_Identifier
167 (Self : in out Visiter;
168 Node : not null Gela.Elements.Selected_Identifiers.
169 Selected_Identifier_Access)
170 is
171 Selector : constant Gela.Elements.Selector_Names.
172 Selector_Name_Access := Node.Selector;
173 begin
174 Selector.Visit (Self);
175 end Selected_Identifier;
176
177 overriding procedure Use_Package_Clause
178 (Self : in out Visiter;
179 Node : not null Gela.Elements.Use_Package_Clauses.
180 Use_Package_Clause_Access)
181 is
182 Set : constant Gela.Environments.Environment_Set_Access :=
183 Comp.Context.Environment_Set;
184 List : constant Gela.Elements.Program_Unit_Names.
185 Program_Unit_Name_Sequence_Access := Node.Clause_Names;
186 Cursor : Gela.Elements.Element_Sequence_Cursor'Class := List.First;
187 begin
188 while Cursor.Has_Element loop
189 Cursor.Element.Visit (Self);
190
191 Env := Set.Add_Use_Package
192 (Index => Env,
193 Name => Self.Name);
194
195 Cursor.Next;
196 end loop;
197 end Use_Package_Clause;
198
199 overriding procedure With_Clause -- Use env.out instead
200 (Self : in out Visiter;
201 Node : not null Gela.Elements.With_Clauses.With_Clause_Access)
202 is
203 pragma Unreferenced (Self);
204 use type Gela.Lexical_Types.Symbol_List;
205
206 List : Gela.Lexical_Types.Symbol_List := Node.With_List;
207 Set : constant Gela.Environments.Environment_Set_Access :=
208 Comp.Context.Environment_Set;
209 begin
210 while List /= Gela.Lexical_Types.Empty_Symbol_List loop
211 Env := Set.Add_With_Clause
212 (Index => Env,
213 Symbol => Comp.Context.Symbols.Head (List));
214 List := Comp.Context.Symbols.Tail (List);
215 end loop;
216 end With_Clause;
217
218 end Get;
219
220 V : Get.Visiter;
221 begin
222 Decl.Visit (V);
223 end Add_Library_Level_Use_Clauses;
224
225 ----------------------------
226 -- Add_Name_Create_Region --
227 ----------------------------
228
229 function Add_Name_Create_Region
230 (Comp : Gela.Compilations.Compilation_Access;
231 Env : Gela.Semantic_Types.Env_Index;
232 Symbol : Gela.Lexical_Types.Symbol;
233 Name : Gela.Elements.Defining_Names.Defining_Name_Access;
234 Decl : Gela.Elements.Element_Access)
235 return Gela.Semantic_Types.Env_Index
236 is
237 use type Gela.Semantic_Types.Env_Index;
238 use type Gela.Lexical_Types.Symbol;
239
240 Library_Level : constant Boolean :=
241 Env = Comp.Context.Environment_Set.Library_Level_Environment;
242
243 Env_0 : Gela.Semantic_Types.Env_Index;
244 Env_1 : Gela.Semantic_Types.Env_Index;
245 Env_2 : Gela.Semantic_Types.Env_Index;
246 begin
247 if Library_Level then
248 Env_0 := Parents_Declarative_Region (Comp, Symbol);
249
250 if Symbol = Gela.Lexical_Types.Predefined_Symbols.Standard then
251 Preprocess_Standard (Comp, Decl);
252 end if;
253
254 else
255 Env_0 := Env;
256 end if;
257
258 Env_1 := Comp.Context.Environment_Set.Add_Defining_Name
259 (Index => Env_0,
260 Symbol => Symbol,
261 Name => Name);
262
263 if Is_Enumeration (Decl) then
264 return Env_1;
265 end if;
266
267 Env_2 := Comp.Context.Environment_Set.Enter_Declarative_Region
268 (Index => Env_1,
269 Region => Name);
270
271 if Library_Level then
272 Add_Library_Level_Use_Clauses (Comp, Decl, Env_2);
273 end if;
274
275 return Env_2;
276 end Add_Name_Create_Region;
277
278 ---------------
279 -- Add_Names --
280 ---------------
281
282 function Add_Names
283 (Comp : Gela.Compilations.Compilation_Access;
284 Env : Gela.Semantic_Types.Env_Index;
285 List : Gela.Lexical_Types.Symbol_List;
286 Names : Gela.Elements.Defining_Identifiers
287 .Defining_Identifier_Sequence_Access)
288 return Gela.Semantic_Types.Env_Index
289 is
290 Tail : Gela.Lexical_Types.Symbol_List := List;
291 Env_1 : Gela.Semantic_Types.Env_Index := Env;
292 Symbol : Gela.Lexical_Types.Symbol;
293 Name : Gela.Elements.Defining_Identifiers.Defining_Identifier_Access;
294 Cursor : Gela.Elements.Defining_Identifiers
295 .Defining_Identifier_Sequence_Cursor := Names.First;
296 Set : constant Gela.Symbol_Sets.Symbol_Set_Access :=
297 Comp.Context.Symbols;
298 begin
299 while Cursor.Has_Element loop
300 Name := Cursor.Element;
301 Symbol := Set.Head (Tail);
302 Tail := Set.Tail (Tail);
303 Cursor.Next;
304
305 Env_1 := Comp.Context.Environment_Set.Add_Defining_Name
306 (Index => Env_1,
307 Symbol => Symbol,
308 Name => Gela.Elements.Defining_Names
309 .Defining_Name_Access (Name));
310 end loop;
311
312 return Env_1;
313 end Add_Names;
314
315 -----------------------------
316 -- Add_Names_Create_Region --
317 -----------------------------
318
319 function Add_Names_Create_Region
320 (Comp : Gela.Compilations.Compilation_Access;
321 Env : Gela.Semantic_Types.Env_Index;
322 List : Gela.Lexical_Types.Symbol_List;
323 Names : Gela.Elements.Defining_Identifiers
324 .Defining_Identifier_Sequence_Access)
325 return Gela.Semantic_Types.Env_Index
326 is
327 Env_1 : Gela.Semantic_Types.Env_Index;
328 Env_2 : Gela.Semantic_Types.Env_Index;
329 Name : Gela.Elements.Defining_Identifiers.Defining_Identifier_Access;
330 Cursor : constant Gela.Elements.Defining_Identifiers
331 .Defining_Identifier_Sequence_Cursor := Names.First;
332 begin
333 Name := Cursor.Element;
334 Env_1 := Add_Names (Comp, Env, List, Names);
335
336 Env_2 := Comp.Context.Environment_Set.Enter_Declarative_Region
337 (Index => Env_1,
338 Region => Gela.Elements.Defining_Names.Defining_Name_Access (Name));
339
340 return Env_2;
341 end Add_Names_Create_Region;
342
343 --------------------------------
344 -- Create_Function_Call_Value --
345 --------------------------------
346
347 function Create_Function_Call_Value
348 (Comp : Gela.Compilations.Compilation_Access;
349 Name : Gela.Semantic_Types.Value_Index;
350 Arguments : Gela.Semantic_Types.Value_Index)
351 return Gela.Semantic_Types.Value_Index
352 is
353 Result : Gela.Semantic_Types.Value_Index;
354 begin
355 Comp.Context.Values.Apply
356 (Name => Name,
357 Args => Arguments,
358 Value => Result);
359
360 return Result;
361 end Create_Function_Call_Value;
362
363 function Create_Numeric_Value
364 (Comp : Gela.Compilations.Compilation_Access;
365 Value : Gela.Lexical_Types.Token_Index)
366 return Gela.Semantic_Types.Value_Index
367 is
368 Token : constant Gela.Lexical_Types.Token := Comp.Get_Token (Value);
369 Source : constant League.Strings.Universal_String := Comp.Source;
370 Image : constant League.Strings.Universal_String :=
371 Source.Slice (Token.First, Token.Last);
372 Result : Gela.Semantic_Types.Value_Index;
373 begin
374 Comp.Context.Values.Numeric_Literal (Image, Result);
375
376 return Result;
377 end Create_Numeric_Value;
378
379 -------------------------
380 -- Create_String_Value --
381 -------------------------
382
383 function Create_String_Value
384 (Comp : Gela.Compilations.Compilation_Access;
385 Full_Name : Gela.Lexical_Types.Token_Index)
386 return Gela.Semantic_Types.Value_Index
387 is
388 Token : constant Gela.Lexical_Types.Token := Comp.Get_Token (Full_Name);
389 Source : constant League.Strings.Universal_String := Comp.Source;
390 Image : constant League.Strings.Universal_String :=
391 Source.Slice (Token.First, Token.Last);
392 Result : Gela.Semantic_Types.Value_Index;
393 begin
394 Comp.Context.Values.String_Literal
395 (Image.Slice (2, Image.Length - 1), Result);
396
397 return Result;
398 end Create_String_Value;
399
400 procedure End_Of_Compilation_Unit_Declaration
401 (Comp : Gela.Compilations.Compilation_Access;
402 Unit : Gela.Elements.Compilation_Unit_Declarations.
403 Compilation_Unit_Declaration_Access;
404 Symbol : Gela.Lexical_Types.Symbol;
405 Env : in out Gela.Semantic_Types.Env_Index)
406 is
407 use type Gela.Lexical_Types.Symbol;
408 begin
409 if Symbol = Gela.Lexical_Types.Predefined_Symbols.Standard then
410 Postprocess_Standard (Comp, Unit, Env);
411 end if;
412 end End_Of_Compilation_Unit_Declaration;
413
414 --------------------
415 -- Is_Enumeration --
416 --------------------
417
418 function Is_Enumeration
419 (Decl : Gela.Elements.Element_Access) return Boolean
420 is
421 package Get is
422
423 type Visiter is new Gela.Element_Visiters.Visiter with record
424 Result : Boolean := False;
425 end record;
426
427 overriding procedure Full_Type_Declaration
428 (Self : in out Visiter;
429 Node : not null Gela.Elements.Full_Type_Declarations.
430 Full_Type_Declaration_Access);
431
432 overriding procedure Enumeration_Type_Definition
433 (Self : in out Visiter;
434 Node : not null Gela.Elements.Enumeration_Type_Definitions.
435 Enumeration_Type_Definition_Access);
436
437 end Get;
438
439 package body Get is
440
441 overriding procedure Full_Type_Declaration
442 (Self : in out Visiter;
443 Node : not null Gela.Elements.Full_Type_Declarations.
444 Full_Type_Declaration_Access)
445 is
446 View : constant Gela.Elements.Type_Definitions.
447 Type_Definition_Access := Node.Type_Declaration_View;
448 begin
449 View.Visit (Self);
450 end Full_Type_Declaration;
451
452 overriding procedure Enumeration_Type_Definition
453 (Self : in out Visiter;
454 Node : not null Gela.Elements.Enumeration_Type_Definitions.
455 Enumeration_Type_Definition_Access)
456 is
457 pragma Unreferenced (Node);
458 begin
459 Self.Result := True;
460 end Enumeration_Type_Definition;
461
462 end Get;
463
464 use type Gela.Elements.Element_Access;
465 V : Get.Visiter;
466 begin
467 if Decl /= null then
468 Decl.Visit (V);
469 end if;
470
471 return V.Result;
472 end Is_Enumeration;
473
474 ------------------------------
475 -- Leave_Declarative_Region --
476 ------------------------------
477
478 function Leave_Declarative_Region
479 (Comp : Gela.Compilations.Compilation_Access;
480 Index : Gela.Semantic_Types.Env_Index;
481 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
482 return Gela.Semantic_Types.Env_Index is
483 begin
484 if Is_Enumeration (Name.Enclosing_Element) then
485 return Index;
486 else
487 return Comp.Context.Environment_Set.Leave_Declarative_Region (Index);
488 end if;
489 end Leave_Declarative_Region;
490
491 --------------------------------
492 -- Parents_Declarative_Region --
493 --------------------------------
494
495 function Parents_Declarative_Region
496 (Comp : Gela.Compilations.Compilation_Access;
497 Full_Name : Gela.Lexical_Types.Symbol)
498 return Gela.Semantic_Types.Env_Index
499 is
500 use type Gela.Lexical_Types.Symbol;
501
502 Set : constant Gela.Symbol_Sets.Symbol_Set_Access :=
503 Comp.Context.Symbols;
504 Parent : constant Gela.Lexical_Types.Symbol := Set.Parent (Full_Name);
505 Result : Gela.Semantic_Types.Env_Index;
506 begin
507 if Parent = Gela.Lexical_Types.No_Symbol then
508 return 0;
509 end if;
510
511 Result := Comp.Context.Environment_Set.Library_Unit_Environment (Parent);
512
513 return Result;
514 end Parents_Declarative_Region;
515
516 --------------------------
517 -- Postprocess_Standard --
518 --------------------------
519
520 procedure Postprocess_Standard
521 (Comp : Gela.Compilations.Compilation_Access;
522 Unit : Gela.Elements.Compilation_Unit_Declarations.
523 Compilation_Unit_Declaration_Access;
524 Env : in out Gela.Semantic_Types.Env_Index)
525 is
526 pragma Unreferenced (Unit);
527
528 function Create_Operator
529 (Operator_Symbol : Gela.Lexical_Types.Symbol;
530 Type_Symbol : Gela.Lexical_Types.Symbol)
531 return Gela.Elements.Function_Declarations.
532 Function_Declaration_Access;
533
534 function Create_Subtype
535 (Type_Symbol : Gela.Lexical_Types.Symbol)
536 return Gela.Elements.Subtype_Mark_Or_Access_Definitions.
537 Subtype_Mark_Or_Access_Definition_Access;
538
539 function Get_Type
540 (Type_Symbol : Gela.Lexical_Types.Symbol)
541 return Gela.Elements.Defining_Names.Defining_Name_Access;
542
543 procedure Set_Part_Of_Implicit
544 (Element : access Gela.Elements.Element'Class);
545
546 Env_Set : constant Gela.Environments.Environment_Set_Access :=
547 Comp.Context.Environment_Set;
548
549 Factory : constant Gela.Element_Factories.Element_Factory_Access :=
550 Comp.Factory;
551
552 ---------------------
553 -- Create_Operator --
554 ---------------------
555
556 function Create_Operator
557 (Operator_Symbol : Gela.Lexical_Types.Symbol;
558 Type_Symbol : Gela.Lexical_Types.Symbol)
559 return Gela.Elements.Function_Declarations.
560 Function_Declaration_Access
561 is
562 FD : Gela.Elements.Function_Declarations.Function_Declaration_Access;
563
564 Oper : constant Gela.Elements.Defining_Operator_Symbols.
565 Defining_Operator_Symbol_Access :=
566 Factory.Defining_Operator_Symbol
567 (Operator_Symbol_Token => 0);
568
569 Name : Gela.Elements.Defining_Designators.Defining_Designator_Access;
570
571 Param : Gela.Elements.Parameter_Specifications.
572 Parameter_Specification_Access;
573
574 Params : constant Gela.Elements.Parameter_Specifications.
575 Parameter_Specification_Sequence_Access :=
576 Factory.Parameter_Specification_Sequence;
577
578 Mark : Gela.Elements.Subtype_Mark_Or_Access_Definitions.
579 Subtype_Mark_Or_Access_Definition_Access;
580 begin
581 Oper.Set_Full_Name (Operator_Symbol);
582 Set_Part_Of_Implicit (Oper);
583
584 Name := Gela.Elements.Defining_Designators.Defining_Designator_Access
585 (Oper);
586
587 for J in 1 .. 2 loop
588 Mark := Create_Subtype (Type_Symbol);
589
590 Param := Factory.Parameter_Specification
591 (Names =>
592 Factory.Defining_Identifier_Sequence,
593 Colon_Token => 0,
594 Aliased_Token => 0,
595 In_Token => 0,
596 Out_Token => 0,
597 Not_Token => 0,
598 Null_Token => 0,
599 Object_Declaration_Subtype => Mark,
600 Assignment_Token => 0,
601 Initialization_Expression => null);
602 Params.Append (Param);
603
604 Set_Part_Of_Implicit (Param);
605 end loop;
606
607 Mark := Create_Subtype (Type_Symbol);
608
609 FD := Factory.Function_Declaration
610 (Not_Token => 0,
611 Overriding_Token => 0,
612 Function_Token => 0,
613 Names => Name,
614 Lp_Token => 0,
615 Parameter_Profile => Params,
616 Rp_Token => 0,
617 Return_Token => 0,
618 Return_Not_Token => 0,
619 Return_Null_Token => 0,
620 Result_Subtype => Mark,
621 Is_Token => 0,
622 Abstract_Token => 0,
623 Result_Expression => null,
624 Renames_Token => 0,
625 Renamed_Entity => null,
626 Separate_Token => 0,
627 Aspect_Specifications => Factory.Aspect_Specification_Sequence,
628 Semicolon_Token => 0);
629
630 Set_Part_Of_Implicit (FD);
631 FD.Set_Corresponding_Type (Get_Type (Type_Symbol).Enclosing_Element);
632
633 Env := Env_Set.Add_Defining_Name
634 (Index => Env,
635 Symbol => Operator_Symbol,
636 Name => Gela.Elements.Defining_Names.Defining_Name_Access
637 (Name));
638
639 return FD;
640 end Create_Operator;
641
642 --------------------
643 -- Create_Subtype --
644 --------------------
645
646 function Create_Subtype
647 (Type_Symbol : Gela.Lexical_Types.Symbol)
648 return Gela.Elements.Subtype_Mark_Or_Access_Definitions.
649 Subtype_Mark_Or_Access_Definition_Access
650 is
651 Identifier : Gela.Elements.Identifiers.Identifier_Access;
652
653 Mark : Gela.Elements.Subtype_Mark_Or_Access_Definitions.
654 Subtype_Mark_Or_Access_Definition_Access;
655 begin
656 Identifier := Factory.Identifier (Identifier_Token => 0);
657 Identifier.Set_Full_Name (Type_Symbol);
658 Identifier.Set_Defining_Name (Get_Type (Type_Symbol));
659 Set_Part_Of_Implicit (Identifier);
660
661 Mark := Gela.Elements.Subtype_Mark_Or_Access_Definitions.
662 Subtype_Mark_Or_Access_Definition_Access (Identifier);
663
664 return Mark;
665 end Create_Subtype;
666
667 --------------
668 -- Get_Type --
669 --------------
670
671 function Get_Type
672 (Type_Symbol : Gela.Lexical_Types.Symbol)
673 return Gela.Elements.Defining_Names.Defining_Name_Access
674 is
675 Pos : constant Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class
676 := Env_Set.Direct_Visible (Env, Type_Symbol);
677 begin
678 if Pos.Has_Element then
679 return Pos.Element;
680 else
681 raise Constraint_Error;
682 end if;
683 end Get_Type;
684
685 --------------------------
686 -- Set_Part_Of_Implicit --
687 --------------------------
688
689 procedure Set_Part_Of_Implicit
690 (Element : access Gela.Elements.Element'Class)
691 is
692 Node : constant Gela.Nodes.Node_Access :=
693 Gela.Nodes.Node_Access (Element);
694 begin
695 Node.Set_Part_Of_Implicit;
696 end Set_Part_Of_Implicit;
697
698 FD : Gela.Elements.Function_Declarations.Function_Declaration_Access;
699 pragma Unreferenced (FD);
700 begin
701 FD := Create_Operator
702 (Operator_Symbol => Gela.Lexical_Types.Operators.Hyphen_Operator,
703 Type_Symbol => Gela.Lexical_Types.Predefined_Symbols.Integer);
704
705 FD := Create_Operator
706 (Operator_Symbol => Gela.Lexical_Types.Operators.Ampersand_Operator,
707 Type_Symbol => Gela.Lexical_Types.Predefined_Symbols.String);
708 end Postprocess_Standard;
709
710 -------------------------
711 -- Preprocess_Standard --
712 -------------------------
713
714 procedure Preprocess_Standard
715 (Comp : Gela.Compilations.Compilation_Access;
716 Unit : Gela.Elements.Element_Access) is
717 begin
718 Gela.Plain_Type_Managers.Type_Manager_Access
719 (Comp.Context.Types).Initialize (Unit);
720 end Preprocess_Standard;
721
722end Gela.Pass_Utils;
Note: See TracBrowser for help on using the repository browser.