source: trunk/ada-2012/src/semantic/gela-plain_environments.adb@ 552

Last change on this file since 552 was 550, checked in by Maxim Reznik, 4 years ago

Keep package_renaming_declaration in Env

to be able expand selected names in Visible call.

  • Property svn:keywords set to Author Date Revision
File size: 28.6 KB
Line 
1-- with Gela.Plain_Environments.Debug;
2
3package body Gela.Plain_Environments is
4
5 function Name_To_Region
6 (Self : access Environment_Set'Class;
7 Index : Gela.Semantic_Types.Env_Index;
8 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
9 return Region_Item_List;
10
11 package Visible_Cursors is
12 -- Cursor over names in Local
13 type Defining_Name_Cursor is
14 new Gela.Defining_Name_Cursors.Defining_Name_Cursor with
15 record
16 Set : Plain_Environment_Set_Access;
17 Current : Gela.Name_List_Managers.Defining_Name_Cursor;
18 end record;
19
20 overriding function Has_Element
21 (Self : Defining_Name_Cursor) return Boolean;
22
23 overriding function Element
24 (Self : Defining_Name_Cursor)
25 return Gela.Elements.Defining_Names.Defining_Name_Access;
26
27 overriding procedure Next
28 (Self : in out Defining_Name_Cursor);
29
30 procedure Initialize
31 (Self : in out Defining_Name_Cursor'Class;
32 Symbol : Gela.Lexical_Types.Symbol;
33 Region : Region_Item_List);
34 end Visible_Cursors;
35
36 package body Visible_Cursors is
37
38 overriding function Has_Element
39 (Self : Defining_Name_Cursor) return Boolean is
40 begin
41 return Self.Current.Has_Element;
42 end Has_Element;
43
44 overriding function Element
45 (Self : Defining_Name_Cursor)
46 return Gela.Elements.Defining_Names.Defining_Name_Access is
47 begin
48 return Self.Current.Element;
49 end Element;
50
51 overriding procedure Next (Self : in out Defining_Name_Cursor) is
52 begin
53 Self.Current.Next;
54 end Next;
55
56 procedure Initialize
57 (Self : in out Defining_Name_Cursor'Class;
58 Symbol : Gela.Lexical_Types.Symbol;
59 Region : Region_Item_List)
60 is
61 Local : constant Gela.Name_List_Managers.List :=
62 Self.Set.Region.Head (Region).Local;
63 begin
64 Self.Current := Self.Set.Names.Find (Local, Symbol);
65 end Initialize;
66
67 end Visible_Cursors;
68
69 package Direct_Visible_Cursors is
70 -- Cursor over names in Local then go to enclosing region, etc
71 type Defining_Name_Cursor is
72 new Visible_Cursors.Defining_Name_Cursor with
73 record
74 Region : Region_Item_List;
75 end record;
76
77 overriding procedure Next
78 (Self : in out Defining_Name_Cursor);
79
80 procedure Initialize
81 (Self : in out Defining_Name_Cursor;
82 Symbol : Gela.Lexical_Types.Symbol);
83 end Direct_Visible_Cursors;
84
85 ----------------------------
86 -- Direct_Visible_Cursors --
87 ----------------------------
88
89 package body Direct_Visible_Cursors is
90
91 overriding procedure Next (Self : in out Defining_Name_Cursor) is
92 use type Region_Item_List;
93 Symbol : constant Gela.Lexical_Types.Symbol := Self.Current.Symbol;
94 Region : Region_Item_List;
95 begin
96 Visible_Cursors.Defining_Name_Cursor (Self).Next;
97
98 while not Self.Has_Element loop
99 Region := Self.Set.Region.Tail (Self.Region);
100
101 if Region /= Region_Item_Lists.Empty then
102 Self.Region := Region;
103 Visible_Cursors.Initialize (Self, Symbol, Region);
104 else
105 return;
106 end if;
107 end loop;
108 end Next;
109
110 ----------------
111 -- Initialize --
112 ----------------
113
114 procedure Initialize
115 (Self : in out Defining_Name_Cursor;
116 Symbol : Gela.Lexical_Types.Symbol)
117 is
118 use type Region_Item_List;
119 Region : Region_Item_List := Self.Region;
120 begin
121 while Region /= Region_Item_Lists.Empty loop
122 Self.Region := Region;
123 Visible_Cursors.Initialize (Self, Symbol, Region);
124
125 exit when Self.Has_Element;
126 Region := Self.Set.Region.Tail (Self.Region);
127 end loop;
128 end Initialize;
129
130 end Direct_Visible_Cursors;
131
132 package Use_Package_Cursors is
133 -- Cursor over names in each used package
134 type Defining_Name_Cursor is
135 new Visible_Cursors.Defining_Name_Cursor with
136 record
137 Env : Env_Item_Index;
138 Region : Region_Item_List;
139 -- Position in Env_Item.Nested_Region_List list
140 Use_Name : Defining_Name_List;
141 -- Position in Region.Use_Package list
142 end record;
143
144 overriding procedure Next
145 (Self : in out Defining_Name_Cursor);
146
147 function Name_To_Region
148 (Self : Defining_Name_Cursor;
149 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
150 return Region_Item_List;
151
152 procedure Initialize
153 (Self : in out Defining_Name_Cursor;
154 Symbol : Gela.Lexical_Types.Symbol);
155
156 end Use_Package_Cursors;
157
158 -------------------------
159 -- Use_Package_Cursors --
160 -------------------------
161
162 package body Use_Package_Cursors is
163
164 overriding procedure Next (Self : in out Defining_Name_Cursor) is
165 use type Region_Item_List;
166 use type Defining_Name_List;
167
168 Symbol : constant Gela.Lexical_Types.Symbol := Self.Current.Symbol;
169 Region : Region_Item_List;
170 begin
171 Visible_Cursors.Defining_Name_Cursor (Self).Next;
172
173 while not Self.Current.Has_Element loop
174 Region := Region_Item_Lists.Empty;
175
176 while Region = Region_Item_Lists.Empty loop
177 -- Next name in use clauses of Region
178 Self.Use_Name := Self.Set.Use_Package.Tail (Self.Use_Name);
179
180 while Self.Use_Name = Defining_Name_Lists.Empty loop
181 Self.Region := Self.Set.Region.Tail (Self.Region);
182
183 if Self.Region = Region_Item_Lists.Empty then
184 return;
185 end if;
186
187 Self.Use_Name :=
188 Self.Set.Region.Head (Self.Region).Use_Package;
189 end loop;
190
191 Region := Self.Name_To_Region
192 (Self.Set.Use_Package.Head (Self.Use_Name));
193 end loop;
194
195 Visible_Cursors.Initialize (Self, Symbol, Region);
196 end loop;
197 end Next;
198
199 --------------------
200 -- Name_To_Region --
201 --------------------
202
203 function Name_To_Region
204 (Self : Defining_Name_Cursor;
205 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
206 return Region_Item_List is
207 begin
208 return Name_To_Region (Self.Set, Self.Env, Name);
209 end Name_To_Region;
210
211 ----------------
212 -- Initialize --
213 ----------------
214
215 procedure Initialize
216 (Self : in out Defining_Name_Cursor;
217 Symbol : Gela.Lexical_Types.Symbol)
218 is
219 use type Region_Item_List;
220 use type Defining_Name_List;
221
222 Env : constant Env_Item := Self.Set.Env.Element (Self.Env);
223 Target : Region_Item_List;
224 Local : Gela.Name_List_Managers.List;
225 begin
226 Self.Region := Env.Region_List (Nested);
227
228 while Self.Region /= Region_Item_Lists.Empty loop
229 Self.Use_Name := Self.Set.Region.Head (Self.Region).Use_Package;
230
231 while Self.Use_Name /= Defining_Name_Lists.Empty loop
232 Target := Self.Name_To_Region
233 (Self.Set.Use_Package.Head (Self.Use_Name));
234
235 if Target /= Region_Item_Lists.Empty then
236 Local := Self.Set.Region.Head (Target).Local;
237 Self.Current := Self.Set.Names.Find (Local, Symbol);
238
239 if Self.Has_Element then
240 return;
241 end if;
242 end if;
243
244 Self.Use_Name := Self.Set.Use_Package.Tail (Self.Use_Name);
245 end loop;
246
247 Self.Region := Self.Set.Region.Tail (Self.Region);
248 end loop;
249 end Initialize;
250
251 end Use_Package_Cursors;
252
253 overriding function Add_Completion
254 (Self : in out Environment_Set;
255 Index : Gela.Semantic_Types.Env_Index;
256 Name : Gela.Elements.Defining_Names.Defining_Name_Access;
257 Completion : Gela.Elements.Defining_Names.Defining_Name_Access)
258 return Gela.Semantic_Types.Env_Index
259 is
260 Env_Index : Gela.Semantic_Types.Env_Index;
261 Env : Env_Item;
262 Reg : Region_Item;
263 begin
264 if Index in 0 | Self.Library_Level_Environment then
265 -- Fix constraint_error because library_bodies doesn have env yet
266 return Index;
267 end if;
268
269 Env := Self.Env.Element (Index);
270 Reg := Self.Region.Head (Env.Region_List (Nested));
271
272 Self.Use_Package.Prepend
273 (Value => Name,
274 Input => Reg.Completion,
275 Output => Reg.Completion);
276
277 Self.Use_Package.Prepend
278 (Value => Completion,
279 Input => Reg.Completion,
280 Output => Reg.Completion);
281
282 -- Replace head of Nested_Region_List with Reg
283 Self.Region.Prepend
284 (Value => Reg,
285 Input => Self.Region.Tail (Env.Region_List (Nested)),
286 Output => Env.Region_List (Nested));
287
288 Env_Index := Self.Env.Find_Index (Env);
289
290 if Env_Index = 0 then
291 Self.Env.Append (Env);
292 Env_Index := Self.Env.Last_Index;
293 end if;
294
295 return Env_Index;
296 end Add_Completion;
297
298 -----------------
299 -- Completions --
300 -----------------
301
302 overriding function Completions
303 (Self : in out Environment_Set;
304 Index : Gela.Semantic_Types.Env_Index;
305 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
306 return Gela.Environments.Completion_List
307 is
308 use type Region_Item_List;
309 use type Gela.Elements.Defining_Names.Defining_Name_Access;
310
311 procedure Find_Completion
312 (List : Defining_Name_List;
313 Result : out Gela.Elements.Defining_Names.Defining_Name_Access;
314 Restart : in out Boolean);
315
316 ---------------------
317 -- Find_Completion --
318 ---------------------
319
320 procedure Find_Completion
321 (List : Defining_Name_List;
322 Result : out Gela.Elements.Defining_Names.Defining_Name_Access;
323 Restart : in out Boolean)
324 is
325 use type Defining_Name_List;
326 Next : Defining_Name_List := List;
327 Completion : Gela.Elements.Defining_Names.Defining_Name_Access;
328 begin
329 while Next /= Defining_Name_Lists.Empty loop
330 Result := Self.Use_Package.Head (Next);
331 Next := Self.Use_Package.Tail (Next);
332 Completion := Self.Use_Package.Head (Next);
333
334 if Completion = Name then
335 return;
336 elsif Result = Name then
337 Result := Completion;
338 Restart := True;
339 end if;
340
341 Next := Self.Use_Package.Tail (Next);
342 end loop;
343
344 Result := null;
345 end Find_Completion;
346
347 Env : Env_Item;
348 Next : Region_Item_List;
349 Result : Gela.Elements.Defining_Names.Defining_Name_Access;
350 Data : Gela.Environments.Completion_Array
351 (1 .. Gela.Environments.Completion_Index'Last);
352 Last : Gela.Environments.Completion_Index := 0;
353 Restart : Boolean := False;
354 begin
355 if Index = Gela.Library_Environments.Library_Env then
356 return Self.Lib.Completions (Index, Name);
357 else
358 Env := Self.Env.Element (Index);
359 end if;
360
361 for J of Env.Region_List loop
362 Next := J;
363 while Next /= Region_Item_Lists.Empty loop
364 Find_Completion
365 (Self.Region.Head (Next).Completion, Result, Restart);
366
367 if Restart then
368 return Completions (Self, Index, Result);
369 elsif Result.Assigned then
370 Last := Last + 1;
371 Data (Last) := Result;
372 end if;
373
374 Next := Self.Region.Tail (Next);
375 end loop;
376 end loop;
377
378 return (Last, Data (1 .. Last));
379 end Completions;
380
381 -----------------------
382 -- Add_Defining_Name --
383 -----------------------
384
385 overriding function Add_Defining_Name
386 (Self : in out Environment_Set;
387 Index : Gela.Semantic_Types.Env_Index;
388 Symbol : Gela.Lexical_Types.Symbol;
389 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
390 return Gela.Semantic_Types.Env_Index
391 is
392 use type Region_Item_List;
393
394 procedure Update_Lib_Unit_Env
395 (Old_Env : Gela.Semantic_Types.Env_Index;
396 New_Env : Env_Item_Index);
397
398 -------------------------
399 -- Update_Lib_Unit_Env --
400 -------------------------
401
402 procedure Update_Lib_Unit_Env
403 (Old_Env : Gela.Semantic_Types.Env_Index;
404 New_Env : Env_Item_Index)
405 is
406 Cursor : Env_Maps.Cursor := Self.Lib_Env.Find (Old_Env);
407 Symbol : Gela.Lexical_Types.Symbol;
408 begin
409 if Env_Maps.Has_Element (Cursor) then
410 Symbol := Env_Maps.Element (Cursor);
411 Self.Lib_Env.Delete (Cursor);
412 Self.Lib_Env.Insert (New_Env, Symbol);
413 Self.Units_Env.Replace (Symbol, New_Env);
414 end if;
415 end Update_Lib_Unit_Env;
416
417 Env : Env_Item;
418 Env_Index : Gela.Semantic_Types.Env_Index;
419 Reg : Region_Item;
420 begin
421 if Index in Env_Item_Index then
422 Env := Self.Env.Element (Index);
423 else
424 Env := (Region_List =>
425 (Nested | Other | Withed => Region_Item_Lists.Empty));
426 end if;
427
428 if Env.Region_List (Nested) = Region_Item_Lists.Empty then
429 Reg := (Name => null,
430 Local => Self.Names.Empty_List,
431 Rename => Self.Names.Empty_List,
432 Use_Package | Completion => Defining_Name_Lists.Empty);
433 else
434 Reg := Self.Region.Head (Env.Region_List (Nested));
435 end if;
436
437 Self.Names.Append
438 (Symbol => Symbol,
439 Name => Name,
440 Input => Reg.Local,
441 Output => Reg.Local);
442
443 if Env.Region_List (Nested) = Region_Item_Lists.Empty then
444 -- Create Nested_Region_List as (Reg)
445 Self.Region.Prepend
446 (Value => Reg,
447 Input => Region_Item_Lists.Empty,
448 Output => Env.Region_List (Nested));
449 else
450 -- Replace head of Nested_Region_List with Reg
451 Self.Region.Prepend
452 (Value => Reg,
453 Input => Self.Region.Tail (Env.Region_List (Nested)),
454 Output => Env.Region_List (Nested));
455 end if;
456
457 Env_Index := Self.Env.Find_Index (Env);
458
459 if Env_Index = 0 then
460 Self.Env.Append (Env);
461 Env_Index := Self.Env.Last_Index;
462 end if;
463
464 Update_Lib_Unit_Env (Index, Env_Index);
465
466 return Env_Index;
467 end Add_Defining_Name;
468
469 ------------------------
470 -- Add_Rename_Package --
471 ------------------------
472
473 overriding function Add_Rename_Package
474 (Self : in out Environment_Set;
475 Index : Gela.Semantic_Types.Env_Index;
476 Region : Gela.Elements.Defining_Names.Defining_Name_Access;
477 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
478 return Gela.Semantic_Types.Env_Index
479 is
480 Env_Index : Gela.Semantic_Types.Env_Index;
481 Env : Env_Item;
482 Reg : Region_Item;
483 begin
484 if Index in 0 | Self.Library_Level_Environment then
485 -- Fix constraint_error because library_bodies doesn have env yet
486 return Index;
487 end if;
488
489 Env := Self.Env.Element (Index);
490 Reg := Self.Region.Head (Env.Region_List (Nested));
491
492 Self.Names.Append
493 (Symbol => Region.Full_Name,
494 Name => Name,
495 Input => Reg.Rename,
496 Output => Reg.Rename);
497
498 -- Replace head of Nested_Region_List with Reg
499 Self.Region.Prepend
500 (Value => Reg,
501 Input => Self.Region.Tail (Env.Region_List (Nested)),
502 Output => Env.Region_List (Nested));
503
504 Env_Index := Self.Env.Find_Index (Env);
505
506 if Env_Index = 0 then
507 Self.Env.Append (Env);
508 Env_Index := Self.Env.Last_Index;
509 end if;
510
511 return Env_Index;
512 end Add_Rename_Package;
513
514 ---------------------
515 -- Add_Use_Package --
516 ---------------------
517
518 overriding function Add_Use_Package
519 (Self : in out Environment_Set;
520 Index : Gela.Semantic_Types.Env_Index;
521 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
522 return Gela.Semantic_Types.Env_Index
523 is
524
525 Env_Index : Gela.Semantic_Types.Env_Index;
526 Env : Env_Item;
527 Reg : Region_Item;
528 begin
529 if Index in 0 | Self.Library_Level_Environment then
530 -- Fix constraint_error because library_bodies doesn have env yet
531 return Index;
532 end if;
533
534 Env := Self.Env.Element (Index);
535 Reg := Self.Region.Head (Env.Region_List (Nested));
536
537 Self.Use_Package.Prepend
538 (Value => Name,
539 Input => Reg.Use_Package,
540 Output => Reg.Use_Package);
541
542 -- Replace head of Nested_Region_List with Reg
543 Self.Region.Prepend
544 (Value => Reg,
545 Input => Self.Region.Tail (Env.Region_List (Nested)),
546 Output => Env.Region_List (Nested));
547
548 Env_Index := Self.Env.Find_Index (Env);
549
550 if Env_Index = 0 then
551 Self.Env.Append (Env);
552 Env_Index := Self.Env.Last_Index;
553 end if;
554
555 return Env_Index;
556 end Add_Use_Package;
557
558 ---------------------
559 -- Add_With_Clause --
560 ---------------------
561
562 overriding function Add_With_Clause
563 (Self : in out Environment_Set;
564 Index : Gela.Semantic_Types.Env_Index;
565 Symbol : Gela.Lexical_Types.Symbol)
566 return Gela.Semantic_Types.Env_Index
567 is
568 procedure Append (Item : Region_Item);
569
570 Env_Index : Gela.Semantic_Types.Env_Index;
571 Env : Env_Item := Self.Env.Element (Index);
572 Target : Gela.Semantic_Types.Env_Index :=
573 Self.Library_Unit_Environment (Symbol);
574 Target_Env : Env_Item;
575 List : Region_Item_List;
576
577 procedure Append (Item : Region_Item) is
578 begin
579 Self.Region.Prepend
580 (Value => Item,
581 Input => Env.Region_List (Withed),
582 Output => Env.Region_List (Withed));
583 end Append;
584
585 begin
586 if Target in 0 | Self.Library_Level_Environment then
587 -- Fix constraint_error because library_bodies doesn have env yet
588 return Index;
589 end if;
590
591 Target := Self.Leave_Declarative_Region (Target);
592 Target_Env := Self.Env.Element (Target);
593 List := Target_Env.Region_List (Other);
594
595-- Gela.Plain_Environments.Debug
596-- (Self => Self'Access,
597-- Index => Target);
598--
599 Self.Region.For_Each (List, Append'Access);
600
601 Env_Index := Self.Env.Find_Index (Env);
602
603 if Env_Index = 0 then
604 Self.Env.Append (Env);
605 Env_Index := Self.Env.Last_Index;
606 end if;
607
608 return Env_Index;
609 end Add_With_Clause;
610
611 --------------------
612 -- Direct_Visible --
613 --------------------
614
615 overriding function Direct_Visible
616 (Self : access Environment_Set;
617 Index : Gela.Semantic_Types.Env_Index;
618 Symbol : Gela.Lexical_Types.Symbol)
619 return Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class
620 is
621 Env : Env_Item;
622 begin
623 if Index = Gela.Library_Environments.Library_Env then
624 return Self.Lib.Direct_Visible (Index, Symbol);
625 elsif Index not in Env_Item_Index then
626 return None : constant Direct_Visible_Cursors.Defining_Name_Cursor :=
627 (others => <>);
628 end if;
629
630 Env := Self.Env.Element (Index);
631
632 return Result : Direct_Visible_Cursors.Defining_Name_Cursor :=
633 (Set => Plain_Environment_Set_Access (Self),
634 Region => Env.Region_List (Nested),
635 others => <>)
636 do
637 Result.Initialize (Symbol);
638 end return;
639 end Direct_Visible;
640
641 -----------------------
642 -- Empty_Environment --
643 -----------------------
644
645 overriding function Empty_Environment
646 (Self : Environment_Set)
647 return Gela.Semantic_Types.Env_Index is
648 begin
649 return Self.Lib.Empty_Environment;
650 end Empty_Environment;
651
652 -----------------------------
653 -- Enter_Completion_Region --
654 -----------------------------
655
656 overriding function Enter_Completion_Region
657 (Self : access Environment_Set;
658 Index : Gela.Semantic_Types.Env_Index;
659 Region : Gela.Elements.Defining_Names.Defining_Name_Access)
660 return Gela.Semantic_Types.Env_Index
661 is
662 use type Region_Item_List;
663 Env : Env_Item;
664 Found : Gela.Semantic_Types.Env_Index;
665 Spec : constant Region_Item_List :=
666 Name_To_Region (Self, Index, Region);
667 Next : Region_Item :=
668 (Name => Region,
669 Local => Self.Names.Empty_List,
670 Use_Package => Defining_Name_Lists.Empty,
671 Completion => Defining_Name_Lists.Empty,
672 Rename => Self.Names.Empty_List);
673 begin
674 if Index in Env_Item_Index then
675 Env := Self.Env.Element (Index);
676 else
677 Env := (Region_List =>
678 (Nested | Other | Withed => Region_Item_Lists.Empty));
679 end if;
680
681 if Spec /= Region_Item_Lists.Empty then
682 Next := Self.Region.Head (Spec);
683 end if;
684
685-- Shall we delete region with the same Name from Other_Region_List?
686
687 Self.Region.Prepend
688 (Value => Next,
689 Input => Env.Region_List (Nested),
690 Output => Env.Region_List (Nested));
691
692 Found := Self.Env.Find_Index (Env);
693
694 if Found not in Env_Item_Index then
695 Self.Env.Append (Env);
696 Found := Self.Env.Last_Index;
697 end if;
698
699 return Found;
700 end Enter_Completion_Region;
701
702 ------------------------------
703 -- Enter_Declarative_Region --
704 ------------------------------
705
706 overriding function Enter_Declarative_Region
707 (Self : access Environment_Set;
708 Index : Gela.Semantic_Types.Env_Index;
709 Region : Gela.Elements.Defining_Names.Defining_Name_Access)
710 return Gela.Semantic_Types.Env_Index
711 is
712 Env : Env_Item;
713 Found : Gela.Semantic_Types.Env_Index;
714 Next : constant Region_Item :=
715 (Name => Region,
716 Local => Self.Names.Empty_List,
717 Use_Package => Defining_Name_Lists.Empty,
718 Completion => Defining_Name_Lists.Empty,
719 Rename => Self.Names.Empty_List);
720 begin
721 if Index in Env_Item_Index then
722 Env := Self.Env.Element (Index);
723 else
724 Env := (Region_List =>
725 (Nested | Other | Withed => Region_Item_Lists.Empty));
726 end if;
727
728 Self.Region.Prepend
729 (Value => Next,
730 Input => Env.Region_List (Nested),
731 Output => Env.Region_List (Nested));
732
733-- Shall we delete region with the same Name from Other_Region_List?
734-- Self.Region.Delete
735-- (Input => Env.Other_Region_List,
736-- Value => Next,
737-- Output => Env.Other_Region_List);
738
739 Found := Self.Env.Find_Index (Env);
740
741 if Found not in Env_Item_Index then
742 Self.Env.Append (Env);
743 Found := Self.Env.Last_Index;
744 end if;
745
746 return Found;
747 end Enter_Declarative_Region;
748
749 ----------
750 -- Hash --
751 ----------
752
753 function Hash
754 (X : Gela.Lexical_Types.Symbol) return Ada.Containers.Hash_Type is
755 begin
756 return Ada.Containers.Hash_Type (X);
757 end Hash;
758
759 ----------
760 -- Hash --
761 ----------
762
763 function Hash
764 (X : Gela.Semantic_Types.Env_Index) return Ada.Containers.Hash_Type is
765 begin
766 return Ada.Containers.Hash_Type (X);
767 end Hash;
768
769 ------------------------------
770 -- Leave_Declarative_Region --
771 ------------------------------
772
773 overriding function Leave_Declarative_Region
774 (Self : access Environment_Set;
775 Index : Gela.Semantic_Types.Env_Index)
776 return Gela.Semantic_Types.Env_Index
777 is
778 Found : Gela.Semantic_Types.Env_Index;
779 Env : Env_Item := Self.Env.Element (Index);
780 Region : constant Region_Item :=
781 Self.Region.Head (Env.Region_List (Nested));
782 begin
783 -- Push top region to Other_Region_List
784 Self.Region.Prepend
785 (Value => Region,
786 Input => Env.Region_List (Other),
787 Output => Env.Region_List (Other));
788
789 -- Pop top region from Nested_Region_List
790 Env.Region_List (Nested) := Self.Region.Tail (Env.Region_List (Nested));
791
792 Found := Self.Env.Find_Index (Env);
793
794 if Found not in Env_Item_Index then
795 Self.Env.Append (Env);
796 Found := Self.Env.Last_Index;
797 end if;
798
799 return Found;
800 end Leave_Declarative_Region;
801
802 -------------------------------
803 -- Library_Level_Environment --
804 -------------------------------
805
806 overriding function Library_Level_Environment
807 (Self : Environment_Set)
808 return Gela.Semantic_Types.Env_Index is
809 begin
810 return Self.Lib.Library_Level_Environment;
811 end Library_Level_Environment;
812
813 ------------------------------
814 -- Library_Unit_Environment --
815 ------------------------------
816
817 overriding function Library_Unit_Environment
818 (Self : access Environment_Set;
819 Symbol : Gela.Lexical_Types.Symbol)
820 return Gela.Semantic_Types.Env_Index
821 is
822 use type Gela.Lexical_Types.Symbol;
823 begin
824 if Symbol = 0 then
825 return 0;
826 else
827 return Self.Units_Env.Element (Symbol);
828 end if;
829 end Library_Unit_Environment;
830
831 --------------------
832 -- Name_To_Region --
833 --------------------
834
835 function Name_To_Region
836 (Self : access Environment_Set'Class;
837 Index : Gela.Semantic_Types.Env_Index;
838 Name : Gela.Elements.Defining_Names.Defining_Name_Access)
839 return Region_Item_List
840 is
841 use type Region_Item_List;
842 use type Gela.Elements.Defining_Names.Defining_Name_Access;
843
844 Env : constant Env_Item := Self.Env.Element (Index);
845 Next : Region_Item_List;
846 begin
847 for J of Env.Region_List loop
848 Next := J;
849 while Next /= Region_Item_Lists.Empty loop
850 if Self.Region.Head (Next).Name = Name then
851 return Next;
852 elsif Name.Assigned then
853 declare
854 Pos : constant Gela.Name_List_Managers.Defining_Name_Cursor
855 := Self.Names.Find
856 (Self.Region.Head (Next).Rename, Name.Full_Name);
857 begin
858 if Pos.Has_Element then
859 return Name_To_Region (Self, Index, Pos.Element);
860 end if;
861 end;
862 end if;
863
864 Next := Self.Region.Tail (Next);
865 end loop;
866 end loop;
867
868 return Region_Item_Lists.Empty;
869 end Name_To_Region;
870
871 ----------------------------------
872 -- Set_Library_Unit_Environment --
873 ----------------------------------
874
875 overriding procedure Set_Library_Unit_Environment
876 (Self : access Environment_Set;
877 Symbol : Gela.Lexical_Types.Symbol;
878 Value : Gela.Semantic_Types.Env_Index) is
879 begin
880 Self.Units_Env.Include (Symbol, Value);
881 Self.Lib_Env.Include (Value, Symbol);
882 end Set_Library_Unit_Environment;
883
884 -----------------
885 -- Use_Visible --
886 -----------------
887
888 overriding function Use_Visible
889 (Self : access Environment_Set;
890 Index : Gela.Semantic_Types.Env_Index;
891 Symbol : Gela.Lexical_Types.Symbol)
892 return Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class is
893 begin
894 if Index = Gela.Library_Environments.Library_Env then
895 return Self.Lib.Use_Visible (Index, Symbol);
896 end if;
897
898 return Result : Use_Package_Cursors.Defining_Name_Cursor :=
899 (Set => Plain_Environment_Set_Access (Self),
900 Env => Index,
901 Region => Region_Item_Lists.Empty,
902 Use_Name => Defining_Name_Lists.Empty,
903 others => <>)
904 do
905 Result.Initialize (Symbol);
906 end return;
907 end Use_Visible;
908
909 -------------
910 -- Visible --
911 -------------
912
913 overriding function Visible
914 (Self : access Environment_Set;
915 Index : Gela.Semantic_Types.Env_Index;
916 Region : Gela.Elements.Defining_Names.Defining_Name_Access;
917 Symbol : Gela.Lexical_Types.Symbol;
918 Found : access Boolean)
919 return Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class
920 is
921 use type Region_Item_List;
922
923 Item : Region_Item_List;
924 begin
925 Found.all := False;
926
927 if Index = Gela.Library_Environments.Library_Env then
928 return Self.Lib.Visible (Index, Region, Symbol, Found);
929 elsif Index not in Env_Item_Index then
930 return None : constant Visible_Cursors.Defining_Name_Cursor :=
931 (others => <>);
932 end if;
933
934 if Region.Assigned then
935 Item := Name_To_Region (Self, Index, Region);
936 else
937 declare
938 Env : constant Env_Item := Self.Env.Element (Index);
939 begin
940 Item := Env.Region_List (Nested);
941 end;
942 end if;
943
944 if Item = Region_Item_Lists.Empty then
945 return None : constant Visible_Cursors.Defining_Name_Cursor :=
946 (others => <>);
947 end if;
948
949 Found.all := True;
950
951 return Result : Visible_Cursors.Defining_Name_Cursor :=
952 (Set => Plain_Environment_Set_Access (Self),
953 others => <>)
954 do
955 Result.Initialize (Symbol, Item);
956 end return;
957 end Visible;
958
959end Gela.Plain_Environments;
Note: See TracBrowser for help on using the repository browser.