1--  Semantic analysis.
2--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16with Logging; use Logging;
17with Tables;
18with Flags; use Flags;
19with Name_Table; -- use Name_Table;
20with Files_Map; use Files_Map;
21with Errorout; use Errorout;
22with Vhdl.Errors; use Vhdl.Errors;
23with Vhdl.Utils; use Vhdl.Utils;
24
25package body Vhdl.Sem_Scopes is
26   --  An interpretation cell is the element of the simply linked list
27   --  of interpretation for an identifier.
28   --  Interpretation cells are stored in table Interpretations.
29   type Interpretation_Cell is record
30      --  The declaration for this interpretation.
31      Decl: Iir;
32
33      --  If True, the declaration is potentially visible (ie visible via a
34      --  use clause).
35      Is_Potential : Boolean;
36
37      --  If True, previous declarations in PREV chain are hidden and shouldn't
38      --  be considered.
39      Prev_Hidden : Boolean;
40
41      --  Previous interpretation for this identifier.
42      --  If No_Name_Interpretation, this (not PREV) interpretation is the last
43      --  one. If Prev_Hidden is True, PREV must be ignored.  If Prev_Hidden is
44      --  false, the identifier is overloaded.
45      Prev: Name_Interpretation_Type;
46
47      --  Previous added identifier in the declarative region.  This forms a
48      --  linked list used to remove interpretations when a declarative
49      --  region is closed.
50      Prev_In_Region : Name_Id;
51   end record;
52   pragma Pack (Interpretation_Cell);
53
54   package Interpretations is new Tables
55     (Table_Component_Type => Interpretation_Cell,
56      Table_Index_Type => Name_Interpretation_Type,
57      Table_Low_Bound => First_Valid_Interpretation,
58      Table_Initial => 1024);
59
60   --  Cached value of Prev_In_Region of current region.
61   Last_In_Region : Name_Id := Null_Identifier;
62
63   --  First interpretation in the current declarative region.
64   Current_Region_Start : Name_Interpretation_Type :=
65     First_Valid_Interpretation;
66
67   --  First valid interpretation.  All interpretations smaller than this
68   --  value are part of a previous (and nested) analysis and must not be
69   --  considered.
70   First_Interpretation : Name_Interpretation_Type :=
71     First_Valid_Interpretation;
72
73   --  List of non-local hidden declarations.
74   type Hide_Index is new Nat32;
75   No_Hide_Index : constant Hide_Index := 0;
76
77   package Hidden_Decls is new Tables
78     (Table_Component_Type => Name_Interpretation_Type,
79      Table_Index_Type => Hide_Index,
80      Table_Low_Bound => No_Hide_Index + 1,
81      Table_Initial => 32);
82
83   --  First non-local hidden declarations.  In VHDL, it is possible to hide
84   --  an overloaded declaration (by declaring a subprogram with the same
85   --  profile).   If the overloaded declaration is local, the interpretation
86   --  can simply be modified.  But if it is not local, the interpretation is
87   --  removed from the chain and saved in the Hidden_Decls table.
88   First_Hide_Index : Hide_Index := No_Hide_Index;
89
90   -- To manage the list of interpretation and to add informations to this
91   -- list, a stack is used.
92   -- Elements of stack can be of kind:
93   -- Save_Cell:
94   --   the element contains the interpretation INTER for the indentifier ID
95   --   for the outer declarative region.
96   --   A save cell is always created each time a declaration is added to save
97   --   the previous interpretation.
98   -- Region_Start:
99   --   A new declarative region start at interpretation INTER.  Here, INTER
100   --   is used as an index in the interpretations stack (table).
101   --   ID is used as an index into the unidim_array stack.
102   -- Barrier_start, Barrier_end:
103   --   All currents interpretations are saved between both INTER, and
104   --   are cleared.  This is used to call semantic during another semantic.
105
106   type Scope_Cell_Kind_Type is (Scope_Start, Scope_Region);
107
108   type Scope_Cell is record
109      Kind: Scope_Cell_Kind_Type;
110
111      --  Values for the previous scope.
112      Saved_Last_In_Region : Name_Id;
113      Saved_Region_Start : Name_Interpretation_Type;
114      Saved_First_Hide_Index : Hide_Index;
115      Saved_First_Interpretation : Name_Interpretation_Type;
116   end record;
117
118   package Scopes is new Tables
119     (Table_Component_Type => Scope_Cell,
120      Table_Index_Type => Natural,
121      Table_Low_Bound => 1,
122      Table_Initial => 64);
123
124   function Valid_Interpretation (Inter : Name_Interpretation_Type)
125                                 return Boolean is
126   begin
127      return Inter >= First_Interpretation;
128   end Valid_Interpretation;
129
130   --  Return True iff NI means there is a conflict for the identifier: no
131   --  valid interpretation due to potentially visible homoraph.
132   function Is_Conflict_Declaration (Ni : Name_Interpretation_Type)
133                                    return Boolean is
134   begin
135      pragma Assert (Valid_Interpretation (Ni));
136      return Interpretations.Table (Ni).Decl = Null_Iir;
137   end Is_Conflict_Declaration;
138
139   --  Get the current interpretation for ID.  The result is raw: it may not
140   --  be valid.
141   function Get_Interpretation_Raw (Id : Name_Id)
142                                   return Name_Interpretation_Type is
143   begin
144      return Name_Interpretation_Type (Name_Table.Get_Name_Info (Id));
145   end Get_Interpretation_Raw;
146
147   procedure Set_Interpretation
148     (Id : Name_Id; Inter : Name_Interpretation_Type) is
149   begin
150      Name_Table.Set_Name_Info (Id, Int32 (Inter));
151   end Set_Interpretation;
152
153   function Get_Interpretation_From_Raw (Inter : Name_Interpretation_Type)
154                                        return Name_Interpretation_Type is
155   begin
156      if Valid_Interpretation (Inter)
157        and then not Is_Conflict_Declaration (Inter)
158      then
159         --  In the current scopes set and not a conflict.
160         return Inter;
161      else
162         return No_Name_Interpretation;
163      end if;
164   end Get_Interpretation_From_Raw;
165
166   function Get_Interpretation (Id : Name_Id)
167                               return Name_Interpretation_Type is
168   begin
169      return Get_Interpretation_From_Raw (Get_Interpretation_Raw (Id));
170   end Get_Interpretation;
171
172   procedure Check_Interpretations;
173   pragma Unreferenced (Check_Interpretations);
174
175   procedure Check_Interpretations
176   is
177      Inter: Name_Interpretation_Type;
178      Last : constant Name_Interpretation_Type := Interpretations.Last;
179      Err : Boolean;
180   begin
181      Err := False;
182      for I in 0 .. Name_Table.Last_Name_Id loop
183         Inter := Get_Interpretation (I);
184         if Inter > Last then
185            Log_Line ("bad interpretation for " & Name_Table.Image (I));
186            Err := True;
187         end if;
188      end loop;
189      if Err then
190         raise Internal_Error;
191      end if;
192   end Check_Interpretations;
193
194   procedure Push_Interpretations is
195   begin
196      Scopes.Append ((Kind => Scope_Start,
197                      Saved_Last_In_Region => Last_In_Region,
198                      Saved_Region_Start => Current_Region_Start,
199                      Saved_First_Hide_Index => First_Hide_Index,
200                      Saved_First_Interpretation => First_Interpretation));
201      Last_In_Region := Null_Identifier;
202      Current_Region_Start := Interpretations.Last + 1;
203      First_Hide_Index := Hidden_Decls.Last + 1;
204      First_Interpretation := Interpretations.Last + 1;
205   end Push_Interpretations;
206
207   procedure Pop_Interpretations
208   is
209      Cell : Scope_Cell renames Scopes.Table (Scopes.Last);
210   begin
211      pragma Assert (Scopes.Table (Scopes.Last).Kind = Scope_Start);
212
213      --  All the declarative regions must have been removed.
214      pragma Assert (Last_In_Region = Null_Identifier);
215      pragma Assert (Current_Region_Start = Interpretations.Last + 1);
216      pragma Assert (First_Hide_Index = Hidden_Decls.Last + 1);
217      pragma Assert (First_Interpretation = Interpretations.Last + 1);
218
219      Last_In_Region := Cell.Saved_Last_In_Region;
220      Current_Region_Start := Cell.Saved_Region_Start;
221      First_Hide_Index := Cell.Saved_First_Hide_Index;
222      First_Interpretation := Cell.Saved_First_Interpretation;
223
224      Scopes.Decrement_Last;
225   end Pop_Interpretations;
226
227   --  Create a new declarative region.
228   --  Simply push a region_start cell and update current_scope_start.
229   procedure Open_Declarative_Region is
230   begin
231      Scopes.Append ((Kind => Scope_Region,
232                      Saved_Last_In_Region => Last_In_Region,
233                      Saved_Region_Start => Current_Region_Start,
234                      Saved_First_Hide_Index => First_Hide_Index,
235                      Saved_First_Interpretation => No_Name_Interpretation));
236      Last_In_Region := Null_Identifier;
237      Current_Region_Start := Interpretations.Last + 1;
238      First_Hide_Index := Hidden_Decls.Last + 1;
239   end Open_Declarative_Region;
240
241   --  Close a declarative region.
242   --  Update interpretation of identifiers.
243   procedure Close_Declarative_Region
244   is
245      Cell : Scope_Cell renames Scopes.Table (Scopes.Last);
246      Id : Name_Id;
247   begin
248      pragma Assert (Cell.Kind = Scope_Region);
249
250      --  Restore hidden declarations.
251      for I in reverse First_Hide_Index .. Hidden_Decls.Last loop
252         declare
253            Inter : constant Name_Interpretation_Type :=
254              Hidden_Decls.Table (I);
255            Prev_Inter, Next_Inter : Name_Interpretation_Type;
256         begin
257            Prev_Inter := Interpretations.Table (Inter).Prev;
258            Next_Inter := Interpretations.Table (Prev_Inter).Prev;
259            Interpretations.Table (Inter).Prev := Next_Inter;
260            Interpretations.Table (Prev_Inter).Prev := Inter;
261         end;
262      end loop;
263      Hidden_Decls.Set_Last (First_Hide_Index - 1);
264
265      --  Remove interpretations of that region.
266      Id := Last_In_Region;
267      if Id /= Null_Identifier then
268         declare
269            Inter : Name_Interpretation_Type;
270         begin
271            loop
272               Inter := Get_Interpretation_Raw (Id);
273               pragma Assert (Inter >= Current_Region_Start);
274               Set_Interpretation (Id, Interpretations.Table (Inter).Prev);
275               Id := Interpretations.Table (Inter).Prev_In_Region;
276               exit when Id = Null_Identifier;
277            end loop;
278            pragma Assert (Inter = Current_Region_Start);
279         end;
280         Interpretations.Set_Last (Current_Region_Start - 1);
281      end if;
282
283      Last_In_Region := Cell.Saved_Last_In_Region;
284      Current_Region_Start := Cell.Saved_Region_Start;
285      First_Hide_Index := Cell.Saved_First_Hide_Index;
286
287      Scopes.Decrement_Last;
288   end Close_Declarative_Region;
289
290   procedure Open_Scope_Extension renames Open_Declarative_Region;
291   procedure Close_Scope_Extension renames Close_Declarative_Region;
292
293   function Get_Next_Interpretation (Ni : Name_Interpretation_Type)
294                                    return Name_Interpretation_Type
295   is
296      pragma Assert (Valid_Interpretation (Ni));
297      Cell : Interpretation_Cell renames Interpretations.Table (Ni);
298   begin
299      if Cell.Prev_Hidden
300        or else not Valid_Interpretation (Cell.Prev)
301      then
302         return No_Name_Interpretation;
303      else
304         return Cell.Prev;
305      end if;
306   end Get_Next_Interpretation;
307
308   function Get_Declaration (Ni : Name_Interpretation_Type) return Iir is
309   begin
310      pragma Assert (Valid_Interpretation (Ni));
311      return Interpretations.Table (Ni).Decl;
312   end Get_Declaration;
313
314   function Get_Under_Interpretation (Id : Name_Id)
315                                     return Name_Interpretation_Type
316   is
317      Inter : constant Name_Interpretation_Type := Get_Interpretation (Id);
318   begin
319      --  ID has no interpretation.
320      --  So, there is no 'under' interpretation (FIXME: prove it).
321      pragma Assert (Valid_Interpretation (Inter));
322
323      declare
324         Cell : Interpretation_Cell renames Interpretations.Table (Inter);
325         Prev : constant Name_Interpretation_Type := Cell.Prev;
326      begin
327         --  Get_Under_Interpretation can be used only to get a hidden
328         --  interpretation.
329         pragma Assert (Cell.Prev_Hidden);
330
331         if Valid_Interpretation (Prev)
332           --  Not a conflict one (use clauses).
333           and then Get_Declaration (Prev) /= Null_Iir
334         then
335            return Prev;
336         else
337            return No_Name_Interpretation;
338         end if;
339      end;
340   end Get_Under_Interpretation;
341
342   function Strip_Non_Object_Alias (Decl : Iir) return Iir
343   is
344      Res : Iir;
345   begin
346      Res := Decl;
347      if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then
348         Res := Get_Named_Entity (Get_Name (Res));
349      end if;
350      return Res;
351   end Strip_Non_Object_Alias;
352
353   function Get_Non_Alias_Declaration (Ni : Name_Interpretation_Type)
354                                      return Iir is
355   begin
356      return Strip_Non_Object_Alias (Get_Declaration (Ni));
357   end Get_Non_Alias_Declaration;
358
359   --  Return TRUE if INTER was made directly visible via a use clause.
360   function Is_Potentially_Visible (Inter : Name_Interpretation_Type)
361                                   return Boolean is
362   begin
363      return Interpretations.Table (Inter).Is_Potential;
364   end Is_Potentially_Visible;
365
366   --  Return TRUE iif DECL can be overloaded.
367   function Is_Overloadable (Decl : Iir) return Boolean is
368   begin
369      --  LRM93 10.3:
370      --  The overloaded declarations considered in this chapter are those for
371      --  subprograms and enumeration literals.
372      case Get_Kind (Decl) is
373         when Iir_Kind_Enumeration_Literal
374           | Iir_Kind_Function_Declaration
375           | Iir_Kind_Procedure_Declaration
376           | Iir_Kind_Interface_Function_Declaration
377           | Iir_Kind_Interface_Procedure_Declaration =>
378            return True;
379         when Iir_Kind_Non_Object_Alias_Declaration =>
380            case Get_Kind (Get_Named_Entity (Get_Name (Decl))) is
381               when Iir_Kind_Enumeration_Literal
382                 | Iir_Kind_Function_Declaration
383                 | Iir_Kind_Procedure_Declaration
384                 | Iir_Kind_Interface_Function_Declaration
385                 | Iir_Kind_Interface_Procedure_Declaration =>
386                  return True;
387               when Iir_Kind_Non_Object_Alias_Declaration =>
388                  raise Internal_Error;
389               when others =>
390                  return False;
391            end case;
392         when others =>
393            return False;
394      end case;
395   end Is_Overloadable;
396
397   --  Return TRUE if INTER was made direclty visible in the current
398   --  declarative region.
399   function Is_In_Current_Declarative_Region (Inter : Name_Interpretation_Type)
400                                             return Boolean is
401   begin
402      return Inter >= Current_Region_Start;
403   end Is_In_Current_Declarative_Region;
404
405   --  Emit a warning when DECL hides PREV_DECL.
406   procedure Warning_Hide (Decl : Iir; Prev_Decl : Iir)
407   is
408   begin
409      if Get_Kind (Decl) in Iir_Kinds_Interface_Declaration
410        and then Get_Kind (Get_Parent (Decl)) = Iir_Kind_Component_Declaration
411      then
412         --  Do not warn when an interface in a component hides a declaration.
413         --  This is a common case (eg: in testbenches), and there is no real
414         --  hiding.
415         return;
416      end if;
417
418      if Get_Kind (Decl) = Iir_Kind_Element_Declaration then
419         --  Do not warn for record elements.  They are used by selection.
420         return;
421      end if;
422
423      if Decl = Prev_Decl then
424         --  Can happen in configuration.  No real hidding.
425         return;
426      end if;
427
428      if Name_Table.Get_Name_Ptr (Get_Identifier (Decl))(1) = 'P' then
429         --  Do not warn for labels starting with 'P'.  These are canonicalized
430         --  process labels which are scoped.
431         --  This can happen as an architecture is canonicalized during
432         --  analysis and then its declarations are 'imported' by a
433         --  configuration.
434         return;
435      end if;
436
437      Warning_Msg_Sem (Warnid_Hide, +Decl,
438                       "declaration of %i hides %n", (+Decl, +Prev_Decl));
439   end Warning_Hide;
440
441   --  Add interpretation DECL to the identifier of DECL.
442   --  POTENTIALLY is true if the identifier comes from a use clause.
443   procedure Add_Name (Decl : Iir; Ident : Name_Id; Potentially : Boolean)
444   is
445      -- Current interpretation of ID.  This is the one before DECL is
446      -- added (if so).
447      Raw_Inter : constant Name_Interpretation_Type :=
448        Get_Interpretation_Raw (Ident);
449      Current_Inter : constant Name_Interpretation_Type :=
450        Get_Interpretation_From_Raw (Raw_Inter);
451      Current_Decl : Iir;
452
453      --  Add DECL in the chain of interpretation for the identifier.
454      procedure Add_New_Interpretation (Hid_Prev : Boolean; D : Iir := Decl) is
455      begin
456         Interpretations.Append ((Decl => D,
457                                  Prev => Raw_Inter,
458                                  Is_Potential => Potentially,
459                                  Prev_Hidden => Hid_Prev,
460                                  Prev_In_Region => Last_In_Region));
461         Set_Interpretation (Ident, Interpretations.Last);
462         Last_In_Region := Ident;
463      end Add_New_Interpretation;
464   begin
465      if Ident = Null_Identifier then
466         --  Missing identifier can happen only in case of parse error.
467         pragma Assert (Flags.Flag_Force_Analysis);
468         return;
469      end if;
470
471      if not Valid_Interpretation (Raw_Inter) then
472         --  Very simple: no hidding, no overloading.
473         Add_New_Interpretation (True);
474         return;
475      end if;
476
477      if Is_Conflict_Declaration (Raw_Inter) then
478         --  The current declaration for RAW_INTER is a conflict: there are
479         --  multiple *potentially* visible declarations for the identifier.
480         if Potentially then
481            --  Yet another conflicting interpretation.
482            return;
483         else
484            --  Very simple: no hidding, no overloading.
485            --  (current interpretation is Conflict_Interpretation if there is
486            --   only potentially visible declarations that are not made
487            --   directly visible).
488            --  Note: in case of conflict interpretation, it may be unnecessary
489            --  to keep the current interpretation (but it is simpler as is).
490            Add_New_Interpretation (True);
491            return;
492         end if;
493      end if;
494
495      if Potentially then
496         --  Do not re-add a potential decl.  This handles cases like:
497         --  'use p.all; use p.all;'.
498         --  FIXME: add a flag (or reuse Visible_Flag) to avoid walking all
499         --  the interpretations.
500         declare
501            Inter : Name_Interpretation_Type := Current_Inter;
502         begin
503            while Valid_Interpretation (Inter) loop
504               if Get_Declaration (Inter) = Decl then
505                  return;
506               end if;
507               Inter := Get_Next_Interpretation (Inter);
508            end loop;
509         end;
510      end if;
511
512      --  LRM 10.3 Visibility
513      --  Each of two declarations is said to be a homograph of the other if
514      --  both declarations have the same identifier, operator symbol, or
515      --  character literal, and overloading is allowed for at most one
516      --  of the two.
517      --
518      --  GHDL: the condition 'overloading is allowed for at most one of the
519      --  two' is false iff overloading is allowed for both; this is a nand.
520
521      --  Note: at this stage, current_inter is valid.
522      Current_Decl := Get_Declaration (Current_Inter);
523
524      if Is_Overloadable (Current_Decl) and then Is_Overloadable (Decl) then
525         --  Current_Inter and Decl overloads (well, they have the same
526         --  designator).
527
528         --  LRM 10.3 Visibility
529         --  If overloading is allowed for both declarations, then each of the
530         --  two is a homograph of the other if they have the same identifier,
531         --  operator symbol or character literal, as well as the same
532         --  parameter and result profile.
533
534         declare
535            Homograph : Name_Interpretation_Type;
536            Prev_Homograph : Name_Interpretation_Type;
537
538            --  Hide HOMOGRAPH (ie unlink it from the chain of interpretation).
539            procedure Hide_Homograph
540            is
541               S : Name_Interpretation_Type;
542            begin
543               if Prev_Homograph = No_Name_Interpretation then
544                  Prev_Homograph := Interpretations.Last;
545               end if;
546
547               --  PREV_HOMOGRAPH must be the interpretation just before
548               --  HOMOGRAPH.
549               pragma Assert
550                 (Interpretations.Table (Prev_Homograph).Prev = Homograph);
551
552               --  Hide previous interpretation.
553               Hidden_Decls.Append (Homograph);
554
555               S := Interpretations.Table (Homograph).Prev;
556               Interpretations.Table (Homograph).Prev := Prev_Homograph;
557               Interpretations.Table (Prev_Homograph).Prev := S;
558            end Hide_Homograph;
559
560            function Get_Hash_Non_Alias (D : Iir) return Iir_Int32 is
561            begin
562               return Get_Subprogram_Hash (Strip_Non_Object_Alias (D));
563            end Get_Hash_Non_Alias;
564
565            --  Return True iff D is an implicit declaration (either a
566            --  subprogram or an implicit alias).
567            function Is_Implicit_Declaration (D : Iir) return Boolean is
568            begin
569               case Get_Kind (D) is
570                  when Iir_Kind_Non_Object_Alias_Declaration =>
571                     return Get_Implicit_Alias_Flag (D);
572                  when Iir_Kind_Enumeration_Literal =>
573                     return False;
574                  when Iir_Kind_Procedure_Declaration
575                    | Iir_Kind_Function_Declaration =>
576                     return Is_Implicit_Subprogram (D);
577                  when others =>
578                     Error_Kind ("is_implicit_declaration", D);
579               end case;
580            end Is_Implicit_Declaration;
581
582            --  Return TRUE iff D is an implicit alias of an implicit
583            --  subprogram.
584            function Is_Implicit_Alias (D : Iir) return Boolean is
585            begin
586               --  FIXME: Is it possible to have an implicit alias of an
587               --  explicit subprogram ? Yes for enumeration literal and
588               --  physical units.
589               return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration
590                 and then Get_Implicit_Alias_Flag (D)
591                 and then Is_Implicit_Subprogram (Get_Named_Entity
592                                                    (Get_Name (D)));
593            end Is_Implicit_Alias;
594
595            --  Replace the homograph of DECL by DECL.
596            procedure Replace_Homograph is
597            begin
598               Interpretations.Table (Homograph).Decl := Decl;
599            end Replace_Homograph;
600
601            Decl_Hash : Iir_Int32;
602            Hash : Iir_Int32;
603         begin
604            Decl_Hash := Get_Hash_Non_Alias (Decl);
605            --  The hash must have been computed.
606            pragma Assert (Decl_Hash /= 0);
607
608            --  LRM02 10.3 Visibility
609            --  Each of two declarations is said to be a /homograph/ of the
610            --  other if both declarations have the same identifier, operator
611            --  symbol, or character literal, and if overloading is allowed for
612            --  at most one of the two.
613            --
614            --  LRM08 12.3 Visibility
615            --  Each of two declarations is said to be a /homograph/ of the
616            --  other if and only if both declarations have the same
617            --  designator, and they denote different named entities, and
618            --  either overloading is allows for at most one of the two, or
619            --  overloading is allowed for both declarations and they have the
620            --  same parameter and result type profile.
621
622            --  GHDL: here we are in the case when both declarations are
623            --  overloadable.  Also, always follow the LRM08 rules as they fix
624            --  issues.
625            --  GHDL: Special case for a second declaration with the same
626            --  designator and that denotes the same named entity than a
627            --  previous one (that would be an alias): according to the LRM,
628            --  they are both visible and there are no ambiguity as they
629            --  denotes the same named entity.  In GHDL, the new one hides the
630            --  previous one.  The behaviour should be the same.
631
632            --  Find an homograph of this declaration (and also keep the
633            --  interpretation just before it in the chain).
634            Homograph := Current_Inter;
635            Prev_Homograph := No_Name_Interpretation;
636            while Homograph /= No_Name_Interpretation loop
637               Current_Decl := Get_Declaration (Homograph);
638               Hash := Get_Hash_Non_Alias (Current_Decl);
639               exit when Decl_Hash = Hash
640                 and then Is_Same_Profile (Decl, Current_Decl);
641               Prev_Homograph := Homograph;
642               Homograph := Get_Next_Interpretation (Homograph);
643            end loop;
644
645            if Homograph = No_Name_Interpretation then
646               --  Simple case: no homograph.
647               Add_New_Interpretation (False);
648               return;
649            end if;
650
651            --  There is an homograph (or the named entity is the same).
652            if Potentially then
653               --  Added DECL would be made potentially visible.
654
655               --  LRM93 10.4 1) / LRM08 12.4 a) Use Clauses
656               --  1. A potentially visible declaration is not made
657               --     directly visible if the place considered is within the
658               --     immediate scope of a homograph of the declaration.
659               if not Is_Potentially_Visible (Homograph) then
660                  return;
661               end if;
662
663               --  LRM08 12.4 Use Clauses
664               --  b) If two potentially visible declarations are homograph
665               --     and one is explicitly declared and the other is
666               --     implicitly declared, then the implicit declaration is
667               --     not made directly visible.
668               if (Flags.Flag_Explicit or else Flags.Vhdl_Std >= Vhdl_08)
669                 and then Is_Potentially_Visible (Homograph)
670               then
671                  declare
672                     Implicit_Current_Decl : constant Boolean :=
673                       Is_Implicit_Declaration (Current_Decl);
674                     Implicit_Decl : constant Boolean :=
675                       Is_Implicit_Declaration (Decl);
676                  begin
677                     if Implicit_Current_Decl and then not Implicit_Decl then
678                        if Is_In_Current_Declarative_Region (Homograph) then
679                           Replace_Homograph;
680                        else
681                           --  Insert DECL and hide homograph.
682                           Add_New_Interpretation (False);
683                           Hide_Homograph;
684                        end if;
685                        return;
686                     elsif not Implicit_Current_Decl and then Implicit_Decl
687                     then
688                        --  Discard decl.
689                        return;
690                     elsif Strip_Non_Object_Alias (Decl)
691                       = Strip_Non_Object_Alias (Current_Decl)
692                     then
693                        --  This rule is not written clearly in the LRM, but
694                        --  if two designators denote the same named entity,
695                        --  no need to make both visible.
696                        return;
697                     end if;
698                  end;
699               end if;
700
701               --  GHDL: if the homograph is in the same declarative
702               --  region than DECL, it must be an implicit declaration
703               --  to be hidden.
704               --  FIXME: this rule is not in the LRM93, but it is necessary
705               --  so that explicit declaration hides the implicit one.
706               if Flags.Vhdl_Std < Vhdl_08
707                 and then not Flags.Flag_Explicit
708                 and then Get_Parent (Decl) = Get_Parent (Current_Decl)
709               then
710                  declare
711                     Implicit_Current_Decl : constant Boolean :=
712                       Is_Implicit_Subprogram (Current_Decl);
713                     Implicit_Decl : constant Boolean :=
714                       Is_Implicit_Subprogram (Decl);
715                  begin
716                     if Implicit_Current_Decl and not Implicit_Decl then
717                        --  Note: no need to save previous interpretation, as
718                        --  it is in the same declarative region.
719                        --  Replace the previous homograph with DECL.
720                        Replace_Homograph;
721                        return;
722                     elsif not Implicit_Current_Decl and Implicit_Decl then
723                        --  As we have replaced the homograph, it is possible
724                        --  than the implicit declaration is re-added (by
725                        --  a new use clause).  Discard it.
726                        return;
727                     end if;
728                  end;
729               end if;
730
731               --  The homograph was made visible in an outer declarative
732               --  region.  Therefore, it must not be hidden.
733               Add_New_Interpretation (False);
734
735               return;
736            else
737               --  Added DECL would be made directly visible.
738
739               if not Is_Potentially_Visible (Homograph) then
740                  --  The homograph was also declared in that declarative
741                  --  region or in an inner one.
742                  if Is_In_Current_Declarative_Region (Homograph) then
743                     --  ... and was declared in the same region
744
745                     --  To sum up: at this point both DECL and CURRENT_DECL
746                     --  are overloadable, have the same profile (but may be
747                     --  aliases) and are declared in the same declarative
748                     --  region.
749
750                     --  LRM08 12.3 Visibility
751                     --  LRM93 10.3 Visibility
752                     --  Two declarations that occur immediately within
753                     --  the same declarative regions [...] shall not be
754                     --  homograph, unless exactely one of them is the
755                     --  implicit declaration of a predefined operation,
756
757                     --  LRM08 12.3 Visibility
758                     --  or is an implicit alias of such implicit declaration.
759                     --
760                     --  GHDL: FIXME: 'implicit alias'
761
762                     --  LRM08 12.3 Visibility
763                     --  LRM93 10.3 Visibility
764                     --  Each of two declarations is said to be a
765                     --  homograph of the other if and only if both
766                     --  declarations have the same designator, [...]
767                     --
768                     --  LRM08 12.3 Visibility
769                     --  [...] and they denote different named entities,
770                     --  and [...]
771                     declare
772                        Is_Decl_Implicit : Boolean;
773                        Is_Current_Decl_Implicit : Boolean;
774                     begin
775                        if Flags.Vhdl_Std >= Vhdl_08 then
776                           Is_Current_Decl_Implicit :=
777                             Is_Implicit_Subprogram (Current_Decl)
778                             or else Is_Implicit_Alias (Current_Decl);
779                           Is_Decl_Implicit := Is_Implicit_Subprogram (Decl)
780                             or else Is_Implicit_Alias (Decl);
781
782                           --  If they denote the same entity, they aren't
783                           --  homograph.
784                           if Strip_Non_Object_Alias (Decl)
785                             = Strip_Non_Object_Alias (Current_Decl)
786                           then
787                              if Is_Current_Decl_Implicit
788                                and then not Is_Decl_Implicit
789                              then
790                                 --  They aren't homograph but DECL is stronger
791                                 --  (at it is not an implicit declaration)
792                                 --  than CURRENT_DECL
793                                 Replace_Homograph;
794                              end if;
795
796                              return;
797                           end if;
798
799                           if Is_Decl_Implicit
800                             and then not Is_Current_Decl_Implicit
801                           then
802                              --  Re-declaration of an implicit subprogram via
803                              --  an implicit alias is simply discarded.
804                              return;
805                           end if;
806                        else
807                           --  Can an implicit subprogram declaration appears
808                           --  after an explicit one in vhdl 93?  I don't
809                           --  think so.
810                           Is_Decl_Implicit := Is_Implicit_Subprogram (Decl);
811                           Is_Current_Decl_Implicit :=
812                             Is_Implicit_Subprogram (Current_Decl);
813                        end if;
814
815                        if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit)
816                        then
817                           Error_Msg_Sem
818                             (+Decl, "redeclaration of %n defined at %l",
819                              (+Current_Decl, +Current_Decl));
820                           return;
821                        end if;
822
823                        if not Is_Decl_Implicit and Is_Current_Decl_Implicit
824                        then
825                           --  DECL 'overrides' the predefined current
826                           --  declaration.
827
828                           --  LRM93 10.3 Visibility
829                           --  In such cases, a predefined operation is always
830                           --  hidden by the other homograph.  Where hidden in
831                           --  this manner, an implicit declaration is hidden
832                           --  within the entire scope of the other declaration
833                           --  (regardless of which declaration occurs first);
834                           --  the implicit declaration is visible neither by
835                           --  selection nor directly.
836                           Set_Visible_Flag (Current_Decl, False);
837                           if Get_Kind (Decl)
838                             in Iir_Kinds_Subprogram_Declaration
839                           then
840                              Set_Hide_Implicit_Flag (Decl, True);
841                           end if;
842                        end if;
843                     end;
844                  else
845                     --  GHDL: hide directly visible declaration declared in
846                     --  an outer region.
847                     null;
848                  end if;
849               else
850                  --  LRM 10.4 Use Clauses
851                  --  1. A potentially visible declaration is not made
852                  --  directly visible if the place considered is within the
853                  --  immediate scope of a homograph of the declaration.
854
855                  --  GHDL: hide the potentially visible declaration.
856                  null;
857               end if;
858               Add_New_Interpretation (False);
859
860               Hide_Homograph;
861               return;
862            end if;
863         end;
864      end if;
865
866      --  The current interpretation and the new one aren't overloadable, ie
867      --  they are homograph (well almost).
868
869      if Is_Potentially_Visible (Current_Inter) then
870         if Potentially then
871            --  LRM93 10.4 2) / LRM08 12.4 c) Use clauses
872            --  Potentially visible declarations that have the same
873            --  designator are not made directly visible unless each of
874            --  them is either an enumeration literal specification or
875            --  the declaration of a subprogram.
876            if Decl = Get_Declaration (Current_Inter) then
877               -- The rule applies only for distinct declaration.
878               -- This handles 'use p.all; use P.all;'.
879               -- FIXME: this should have been handled at the start of
880               -- this subprogram.
881               raise Internal_Error;
882               return;
883            end if;
884
885            --  LRM08 12.3 Visibility
886            --  Each of two declarations is said to be a homograph of the
887            --  other if and only if both declarations have the same
888            --  designator; and they denote different named entities, [...]
889            if Flags.Vhdl_Std >= Vhdl_08 then
890               if Strip_Non_Object_Alias (Decl)
891                 = Strip_Non_Object_Alias (Current_Decl)
892               then
893                  return;
894               end if;
895            end if;
896
897            --  Conflict.
898            Add_New_Interpretation (True, Null_Iir);
899            return;
900         else
901            --  LRM93 10.4 item #1
902            --  A potentially visible declaration is not made directly
903            --  visible if the place considered is within the immediate
904            --  scope of a homograph of the declaration.
905            --  GHDL: Could directly replace the previous interpretation
906            --  (added in same scope), but don't do that for entity
907            --  declarations, since it is used to find default binding.
908            Add_New_Interpretation (True);
909            return;
910         end if;
911      else
912         --  There is already a declaration in the current scope.
913         if Potentially then
914            -- LRM93 10.4 item #1
915            -- Discard the new and potentially visible declaration.
916            -- However, add the type.
917            -- FIXME: Add_In_Visible_List (Ident, Decl);
918            return;
919         else
920            if Is_In_Current_Declarative_Region (Current_Inter) then
921               --  They are perhaps visible in the same declarative region.
922
923               if Get_Kind (Current_Decl) = Iir_Kind_Library_Declaration then
924                  --  LRM93 11.2
925                  --  If two or more logical names having the same
926                  --  identifier appear in library clauses in the same
927                  --  context, the second and subsequent occurences of the
928                  --  logical name have no effect.  The same is true of
929                  --  logical names appearing both in the context clause
930                  --  of a primary unit and in the context clause of a
931                  --  corresponding secondary unit.
932                  --  GHDL: we apply this rule with VHDL-87, because of
933                  --  implicit library clauses STD and WORK.
934                  if Get_Kind (Decl) = Iir_Kind_Library_Declaration then
935                     return;
936                  end if;
937
938                  if Flag_Relaxed_Rules
939                    and then Get_Kind (Decl) in Iir_Kinds_Library_Unit
940                  then
941                     Warning_Msg_Sem
942                       (Warnid_Hide, +Decl,
943                        "unit %i hides library %i", (+Decl, +Decl));
944                     Interpretations.Table (Current_Inter).Decl := Decl;
945                     return;
946                  end if;
947               end if;
948
949               -- None of the two declarations are potentially visible, ie
950               -- both are visible.
951               -- LRM 10.3:
952               --  Two declarations that occur immediately within the same
953               --  declarative region must not be homographs,
954               -- FIXME: unless one of them is the implicit declaration of a
955               --  predefined operation.
956               Report_Start_Group;
957               Error_Msg_Sem
958                 (+Decl, "identifier %i already used for a declaration",
959                  +Ident);
960               Error_Msg_Sem
961                 (+Current_Decl, "previous declaration: %n", +Current_Decl);
962               Report_End_Group;
963               return;
964            else
965               --  Homograph, not in the same scope.
966               --  LRM93 10.3:
967               --  A declaration is said to be hidden within (part of) an inner
968               --  declarative region if the inner region contains an homograph
969               --  of this declaration; the outer declaration is the hidden
970               --  within the immediate scope of the inner homograph.
971               if Is_Warning_Enabled (Warnid_Hide)
972                 and then not Is_Potentially_Visible (Current_Inter)
973               then
974                  Warning_Hide (Decl, Current_Decl);
975               end if;
976
977               Add_New_Interpretation (True);
978               return;
979            end if;
980         end if;
981      end if;
982   end Add_Name;
983
984   procedure Add_Name (Decl: Iir) is
985   begin
986      Add_Name (Decl, Get_Identifier (Decl), False);
987   end Add_Name;
988
989   procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir)
990   is
991      Inter : Name_Interpretation_Type;
992   begin
993      Inter := Get_Interpretation (Id);
994      loop
995         exit when Get_Declaration (Inter) = Old;
996         Inter := Get_Next_Interpretation (Inter);
997         pragma Assert (Valid_Interpretation (Inter));
998      end loop;
999      Interpretations.Table (Inter).Decl := Decl;
1000      pragma Assert (Get_Next_Interpretation (Inter) = No_Name_Interpretation);
1001   end Replace_Name;
1002
1003   procedure Name_Visible (Decl : Iir) is
1004   begin
1005      --  A name can be made visible only once.
1006      pragma Assert (not Get_Visible_Flag (Decl));
1007      Set_Visible_Flag (Decl, True);
1008   end Name_Visible;
1009
1010   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type)
1011   is
1012   begin
1013      case Get_Kind (Decl) is
1014         when Iir_Kind_Subtype_Declaration
1015           | Iir_Kind_Enumeration_Literal --  By use clause
1016           | Iir_Kind_Constant_Declaration
1017           | Iir_Kind_Signal_Declaration
1018           | Iir_Kind_Variable_Declaration
1019           | Iir_Kind_File_Declaration
1020           | Iir_Kind_Object_Alias_Declaration
1021           | Iir_Kind_Non_Object_Alias_Declaration
1022           | Iir_Kinds_Interface_Object_Declaration
1023           | Iir_Kind_Interface_Package_Declaration
1024           | Iir_Kinds_Interface_Subprogram_Declaration
1025           | Iir_Kind_Component_Declaration
1026           | Iir_Kind_Attribute_Declaration
1027           | Iir_Kind_Group_Template_Declaration
1028           | Iir_Kind_Group_Declaration
1029           | Iir_Kind_Nature_Declaration
1030           | Iir_Kind_Subnature_Declaration
1031           | Iir_Kinds_Quantity_Declaration
1032           | Iir_Kind_Terminal_Declaration
1033           | Iir_Kind_Entity_Declaration
1034           | Iir_Kind_Package_Declaration
1035           | Iir_Kind_Package_Instantiation_Declaration
1036           | Iir_Kind_Configuration_Declaration
1037           | Iir_Kind_Context_Declaration
1038           | Iir_Kinds_Concurrent_Statement
1039           | Iir_Kinds_Sequential_Statement =>
1040            Handle_Decl (Decl, Arg);
1041         when Iir_Kind_Procedure_Declaration
1042           | Iir_Kind_Function_Declaration =>
1043            if not Is_Second_Subprogram_Specification (Decl) then
1044               Handle_Decl (Decl, Arg);
1045            end if;
1046         when Iir_Kind_Type_Declaration =>
1047            declare
1048               Def : constant Iir := Get_Type_Definition (Decl);
1049               List : Iir_Flist;
1050               El : Iir;
1051            begin
1052               -- Handle incomplete type declaration.
1053               if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
1054                  return;
1055               end if;
1056
1057               Handle_Decl (Decl, Arg);
1058
1059               if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then
1060                  List := Get_Enumeration_Literal_List (Def);
1061                  for I in Flist_First .. Flist_Last (List) loop
1062                     El := Get_Nth_Element (List, I);
1063                     Handle_Decl (El, Arg);
1064                  end loop;
1065               end if;
1066            end;
1067         when Iir_Kind_Anonymous_Type_Declaration =>
1068            Handle_Decl (Decl, Arg);
1069
1070            declare
1071               Def : constant Iir := Get_Type_Definition (Decl);
1072               El : Iir;
1073            begin
1074               if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
1075                  El := Get_Unit_Chain (Def);
1076                  while El /= Null_Iir loop
1077                     Handle_Decl (El, Arg);
1078                     El := Get_Chain (El);
1079                  end loop;
1080               end if;
1081            end;
1082         when Iir_Kind_Interface_Type_Declaration =>
1083            Handle_Decl (Decl, Arg);
1084            declare
1085               El : Iir;
1086            begin
1087               El := Get_Interface_Type_Subprograms (Decl);
1088               while El /= Null_Iir loop
1089                  Handle_Decl (El, Arg);
1090                  El := Get_Chain (El);
1091               end loop;
1092            end;
1093         when Iir_Kind_Use_Clause
1094           | Iir_Kind_Context_Reference =>
1095            Handle_Decl (Decl, Arg);
1096         when Iir_Kind_Library_Clause =>
1097            Handle_Decl (Decl, Arg);
1098--             El := Get_Library_Declaration (Decl);
1099--             if El /= Null_Iir then
1100--                --  May be empty.
1101--                Handle_Decl (El, Arg);
1102--             end if;
1103
1104         when Iir_Kind_Procedure_Body
1105           | Iir_Kind_Function_Body =>
1106            null;
1107
1108         when Iir_Kind_Package_Body =>
1109            null;
1110
1111         when Iir_Kind_Attribute_Specification
1112           | Iir_Kind_Configuration_Specification
1113           | Iir_Kind_Disconnection_Specification =>
1114            null;
1115         when Iir_Kinds_Signal_Attribute
1116           | Iir_Kind_Signal_Attribute_Declaration
1117           | Iir_Kind_Anonymous_Signal_Declaration =>
1118            null;
1119
1120         when Iir_Kind_Protected_Type_Body =>
1121            --  FIXME: allowed only in debugger (if the current scope is
1122            --  within a package body) ?
1123            null;
1124
1125         when others =>
1126            Error_Kind ("iterator_decl", Decl);
1127      end case;
1128   end Iterator_Decl;
1129
1130   --  Handle context_clause of context reference CTXT.
1131   procedure Add_One_Context_Reference (Ctxt : Iir)
1132   is
1133      Name : constant Iir := Get_Selected_Name (Ctxt);
1134      Ent : constant Iir := Get_Named_Entity (Name);
1135      Item : Iir;
1136   begin
1137      if Ent = Null_Iir or else Is_Error (Ent) then
1138         --  Stop now in case of error.
1139         return;
1140      end if;
1141      pragma Assert (Get_Kind (Ent) = Iir_Kind_Context_Declaration);
1142
1143      Item := Get_Context_Items (Ent);
1144      while Item /= Null_Iir loop
1145         case Get_Kind (Item) is
1146            when Iir_Kind_Use_Clause =>
1147               Add_Use_Clause (Item);
1148            when Iir_Kind_Library_Clause =>
1149               Add_Name (Get_Library_Declaration (Item),
1150                         Get_Identifier (Item), False);
1151            when Iir_Kind_Context_Reference =>
1152               Add_Context_Reference (Item);
1153            when others =>
1154               Error_Kind ("add_context_reference", Item);
1155         end case;
1156         Item := Get_Chain (Item);
1157      end loop;
1158   end Add_One_Context_Reference;
1159
1160   procedure Add_Context_Reference (Ref : Iir)
1161   is
1162      Ctxt : Iir;
1163   begin
1164      Ctxt := Ref;
1165      loop
1166         Add_One_Context_Reference (Ctxt);
1167         Ctxt := Get_Context_Reference_Chain (Ctxt);
1168         exit when Ctxt = Null_Iir;
1169      end loop;
1170   end Add_Context_Reference;
1171
1172   --  Make POTENTIALLY (or not) visible DECL.
1173   procedure Add_Name_Decl (Decl : Iir; Potentially : Boolean) is
1174   begin
1175      case Get_Kind (Decl) is
1176         when Iir_Kind_Use_Clause =>
1177            if not Potentially then
1178               Add_Use_Clause (Decl);
1179            end if;
1180         when Iir_Kind_Context_Reference =>
1181            pragma Assert (not Potentially);
1182            Add_Context_Reference (Decl);
1183         when Iir_Kind_Library_Clause =>
1184            Add_Name (Get_Library_Declaration (Decl),
1185                      Get_Identifier (Decl), Potentially);
1186         when Iir_Kind_Anonymous_Type_Declaration =>
1187            null;
1188         when others =>
1189            Add_Name (Decl, Get_Identifier (Decl), Potentially);
1190      end case;
1191   end Add_Name_Decl;
1192
1193   procedure Add_Declaration is
1194      new Iterator_Decl (Arg_Type => Boolean, Handle_Decl => Add_Name_Decl);
1195
1196   procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type)
1197   is
1198      Decl : Iir;
1199      It : List_Iterator;
1200   begin
1201      if Decl_List = Null_Iir_List then
1202         return;
1203      end if;
1204      It := List_Iterate (Decl_List);
1205      while Is_Valid (It) loop
1206         Decl := Get_Element (It);
1207         Handle_Decl (Decl, Arg);
1208         Next (It);
1209      end loop;
1210   end Iterator_Decl_List;
1211
1212   procedure Iterator_Decl_Chain (Chain_First : Iir; Arg : Arg_Type)
1213   is
1214      Decl: Iir;
1215   begin
1216      Decl := Chain_First;
1217      while Decl /= Null_Iir loop
1218         Handle_Decl (Decl, Arg);
1219         Decl := Get_Chain (Decl);
1220      end loop;
1221   end Iterator_Decl_Chain;
1222
1223   procedure Add_Declarations_1 is new Iterator_Decl_Chain
1224     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
1225
1226   procedure Add_Declarations (Chain : Iir; Potentially : Boolean := False)
1227     renames Add_Declarations_1;
1228
1229   procedure Add_Declarations_List is new Iterator_Decl_List
1230     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
1231
1232   procedure Add_Declarations_From_Interface_Chain (Chain : Iir)
1233   is
1234      El : Iir;
1235      Id : Name_Id;
1236   begin
1237      El := Chain;
1238      while El /= Null_Iir loop
1239         Id := Get_Identifier (El);
1240
1241         --  The chain may be from an implicitely declared subprograms, with
1242         --  anonymous identifiers.  In that case, all interfaces are
1243         --  anonymous and there is no need to iterate.
1244         exit when Id = Null_Identifier;
1245
1246         Add_Name (El, Id, False);
1247         El := Get_Chain (El);
1248      end loop;
1249   end Add_Declarations_From_Interface_Chain;
1250
1251   procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir)
1252   is
1253      El: Iir;
1254      Label: Name_Id;
1255   begin
1256      El := Get_Concurrent_Statement_Chain (Parent);
1257      while El /= Null_Iir loop
1258         Label := Get_Label (El);
1259         if Label /= Null_Identifier then
1260            Add_Name (El, Get_Identifier (El), False);
1261         end if;
1262         El := Get_Chain (El);
1263      end loop;
1264   end Add_Declarations_Of_Concurrent_Statement;
1265
1266   procedure Add_Context_Clauses (Unit : Iir_Design_Unit) is
1267   begin
1268      Add_Declarations (Get_Context_Items (Unit), False);
1269   end Add_Context_Clauses;
1270
1271   -- Add declarations from an entity into the current declarative region.
1272   -- This is needed when an architecture is analysed.
1273   procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration)
1274   is
1275      Prev_Hide : constant Boolean := Is_Warning_Enabled (Warnid_Hide);
1276   begin
1277      --  Temporarly disable hide warning to avoid spurious messages.
1278      Enable_Warning (Warnid_Hide, False);
1279
1280      Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Entity));
1281      Add_Declarations_From_Interface_Chain (Get_Port_Chain (Entity));
1282      Add_Declarations (Get_Declaration_Chain (Entity), False);
1283      Add_Declarations_Of_Concurrent_Statement (Entity);
1284
1285      --  Restore
1286      Enable_Warning (Warnid_Hide, Prev_Hide);
1287   end Add_Entity_Declarations;
1288
1289   --  Add declarations from a package into the current declarative region.
1290   --  (for a use clause or when a package body is analyzed)
1291   procedure Add_Package_Declarations
1292     (Decl: Iir_Package_Declaration; Potentially : Boolean)
1293   is
1294      Header : constant Iir := Get_Package_Header (Decl);
1295   begin
1296      --  LRM08 12.1 Declarative region
1297      --  d) A package declaration together with the corresponding body
1298      --
1299      --  GHDL: the formal generic declarations are considered to be in the
1300      --  same declarative region as the package declarations (and therefore
1301      --  in the same scope), even if they don't occur immediately within a
1302      --  package declaration.
1303      if Header /= Null_Iir then
1304         Add_Declarations (Get_Generic_Chain (Header), Potentially);
1305      end if;
1306
1307      Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
1308   end Add_Package_Declarations;
1309
1310   procedure Add_Package_Instantiation_Declarations
1311     (Decl: Iir; Potentially : Boolean) is
1312   begin
1313      --  LRM08 4.9 Package instantiation declarations
1314      --  The package instantiation declaration is equivalent to declaration of
1315      --  a generic-mapped package, consisting of a package declaration [...]
1316      Add_Declarations (Get_Generic_Chain (Decl), Potentially);
1317      Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
1318   end Add_Package_Instantiation_Declarations;
1319
1320   --  Add declarations from a package into the current declarative region.
1321   --  This is needed when a package body is analysed.
1322   procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is
1323   begin
1324      Add_Package_Declarations (Decl, False);
1325   end Add_Package_Declarations;
1326
1327   procedure Add_Component_Declarations (Component: Iir_Component_Declaration)
1328   is
1329   begin
1330      Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Component));
1331      Add_Declarations_From_Interface_Chain (Get_Port_Chain (Component));
1332   end Add_Component_Declarations;
1333
1334   procedure Add_Protected_Type_Declarations
1335     (Decl : Iir_Protected_Type_Declaration) is
1336   begin
1337      Add_Declarations (Get_Declaration_Chain (Decl), False);
1338   end Add_Protected_Type_Declarations;
1339
1340   procedure Extend_Scope_Of_Block_Declarations (Decl : Iir) is
1341   begin
1342      case Get_Kind (Decl) is
1343         when Iir_Kind_Architecture_Body =>
1344            Add_Context_Clauses (Get_Design_Unit (Decl));
1345         when Iir_Kind_Block_Statement
1346           | Iir_Kind_Generate_Statement_Body =>
1347            --  FIXME: formal, iterator ?
1348            null;
1349         when others =>
1350            Error_Kind ("extend_scope_of_block_declarations", Decl);
1351      end case;
1352      Add_Declarations (Get_Declaration_Chain (Decl), False);
1353      Add_Declarations_Of_Concurrent_Statement (Decl);
1354   end Extend_Scope_Of_Block_Declarations;
1355
1356   procedure Use_Library_All (Library : Iir_Library_Declaration)
1357   is
1358      Design_File : Iir_Design_File;
1359      Design_Unit : Iir_Design_Unit;
1360      Library_Unit : Iir;
1361   begin
1362      Design_File := Get_Design_File_Chain (Library);
1363      while Design_File /= Null_Iir loop
1364         Design_Unit := Get_First_Design_Unit (Design_File);
1365         while Design_Unit /= Null_Iir loop
1366            Library_Unit := Get_Library_Unit (Design_Unit);
1367            if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then
1368               Add_Name (Design_Unit, Get_Identifier (Design_Unit), True);
1369            end if;
1370            Design_Unit := Get_Chain (Design_Unit);
1371         end loop;
1372         Design_File := Get_Chain (Design_File);
1373      end loop;
1374   end Use_Library_All;
1375
1376   procedure Potentially_Add_Name (Name : Iir) is
1377   begin
1378      Add_Name (Name, Get_Identifier (Name), True);
1379   end Potentially_Add_Name;
1380
1381   --  LRM08 12.4 Use clauses
1382   --  Moreover, the following declarations, if any, that occurs immediately
1383   --  within the package denoted by the prefix of the selected name, are also
1384   --  identifier:
1385   procedure Use_Selected_Type_Name (Name : Iir)
1386   is
1387      Type_Def : constant Iir := Get_Type (Name);
1388      Base_Type : constant Iir := Get_Base_Type (Type_Def);
1389   begin
1390      case Get_Kind (Base_Type) is
1391         when Iir_Kind_Enumeration_Type_Definition =>
1392            --  LRM08 12.4 Use clauses
1393            --  - If the type mark denotes an enumeration type of a subtype of
1394            --    an enumeration type, the enumeration literals of the base
1395            --    type
1396            declare
1397               List : constant Iir_Flist :=
1398                 Get_Enumeration_Literal_List (Base_Type);
1399               El : Iir;
1400            begin
1401               for I in Flist_First .. Flist_Last (List) loop
1402                  El := Get_Nth_Element (List, I);
1403                  Potentially_Add_Name (El);
1404               end loop;
1405            end;
1406         when Iir_Kind_Physical_Type_Definition =>
1407            --  LRM08 12.4 Use clauses
1408            --  - If the type mark denotes a subtype of a physical type, the
1409            --    units of the base type
1410            declare
1411               El : Iir;
1412            begin
1413               El := Get_Unit_Chain (Base_Type);
1414               while El /= Null_Iir loop
1415                  Potentially_Add_Name (El);
1416                  El := Get_Chain (El);
1417               end loop;
1418            end;
1419         when others =>
1420            null;
1421      end case;
1422
1423      --  LRM08 12.4 Use clauses
1424      --  - The implicit declarations of predefined operations for the type
1425      --    that are not hidden by homographs explicitely declared immediately
1426      --    within the package denoted by the prefix of the selected name
1427      --  - The declarations of homographs, explicitely declared immediately
1428      --    within the package denotes by the prefix of the selected name,
1429      --    that hide implicit declarations of predefined operations for the
1430      --    type
1431      declare
1432         Type_Decl : constant Iir := Get_Type_Declarator (Base_Type);
1433         El : Iir;
1434         Has_Override : Boolean;
1435      begin
1436         Has_Override := False;
1437         El := Get_Chain (Type_Decl);
1438         while El /= Null_Iir loop
1439            if Is_Implicit_Subprogram (El)
1440              and then Is_Operation_For_Type (El, Base_Type)
1441            then
1442               if Get_Visible_Flag (El) then
1443                  --  Implicit declaration EL was overriden by a user
1444                  --  declaration.  Don't make it visible.
1445                  Potentially_Add_Name (El);
1446               else
1447                  Has_Override := True;
1448               end if;
1449               El := Get_Chain (El);
1450            else
1451               exit;
1452            end if;
1453         end loop;
1454
1455         --  Explicitely declared homograph.
1456         if Has_Override then
1457            while El /= Null_Iir loop
1458               if Get_Kind (El) in Iir_Kinds_Subprogram_Declaration
1459                 and then Get_Hide_Implicit_Flag (El)
1460                 and then Is_Operation_For_Type (El, Base_Type)
1461               then
1462                  Potentially_Add_Name (El);
1463               end if;
1464               El := Get_Chain (El);
1465            end loop;
1466         end if;
1467      end;
1468   end Use_Selected_Type_Name;
1469
1470   --  LRM02 10.4 Use clauses
1471   --  Each selected name in a use clause identifiers one or more declarations
1472   --  that will potentially become directly visible. If the suffix of the
1473   --  selected name is a simple name, a character literal, or operator
1474   --  symbol, then the selected name identifiers only the declarations(s) of
1475   --  that simple name, character literal, or operator symbol contained
1476   --  within the package or library denoted by the prefix of the selected
1477   --  name.
1478   procedure Use_Selected_Name (Name : Iir)
1479   is
1480      Nname : Iir;
1481   begin
1482      if Name = Null_Iir then
1483         return;
1484      end if;
1485
1486      case Get_Kind (Name) is
1487         when Iir_Kind_Overload_List =>
1488            Add_Declarations_List (Get_Overload_List (Name), True);
1489         when Iir_Kind_Error =>
1490            null;
1491         when others =>
1492            Potentially_Add_Name (Name);
1493
1494            --  LRM08 12.4 Use clauses
1495            --  If the suffix of the selected name is a type mark, then the
1496            --  declaration of the type or subtype denoted by the type mark
1497            --  is identified. Moreover [...]
1498            if (Vhdl_Std >= Vhdl_08 or else Flag_Relaxed_Rules) then
1499               Nname := Strip_Non_Object_Alias (Name);
1500               if Get_Kind (Nname) in Iir_Kinds_Type_Declaration then
1501                  Use_Selected_Type_Name (Nname);
1502               end if;
1503            end if;
1504      end case;
1505   end Use_Selected_Name;
1506
1507   --  LRM93 10.4 Use clauses
1508   --  If the suffix is the reserved word ALL, then all the selected name
1509   --  identifies all declaration that are contained within the package or
1510   --  library denotes by te prefix of the selected name.
1511   procedure Use_All_Names (Name: Iir) is
1512   begin
1513      case Get_Kind (Name) is
1514         when Iir_Kind_Library_Declaration =>
1515            Use_Library_All (Name);
1516         when Iir_Kind_Package_Declaration =>
1517            Add_Package_Declarations (Name, True);
1518         when Iir_Kind_Package_Instantiation_Declaration =>
1519            Add_Package_Instantiation_Declarations (Name, True);
1520         when Iir_Kind_Interface_Package_Declaration =>
1521            --  LRM08 6.5.5 Interface package declarations
1522            --  Within an entity declaration, an architecture body, a
1523            --  component declaration, or an uninstantiated subprogram or
1524            --  package declaration that declares a given interface package,
1525            --  the name of the given interface package denotes an undefined
1526            --  instance of the uninstantiated package.
1527            Add_Package_Instantiation_Declarations (Name, True);
1528         when Iir_Kind_Error =>
1529            null;
1530         when others =>
1531            raise Internal_Error;
1532      end case;
1533   end Use_All_Names;
1534
1535   procedure Add_Use_Clause (Clause : Iir_Use_Clause)
1536   is
1537      Name : Iir;
1538      Cl : Iir_Use_Clause;
1539   begin
1540      Cl := Clause;
1541      loop
1542         Name := Get_Selected_Name (Cl);
1543         if Name = Null_Iir then
1544            pragma Assert (Flags.Flag_Force_Analysis);
1545            null;
1546         else
1547            if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then
1548               Name := Get_Prefix (Name);
1549               if not Is_Error (Name) then
1550                  Use_All_Names (Get_Named_Entity (Name));
1551               end if;
1552            else
1553               if not Is_Error (Name) then
1554                  Use_Selected_Name (Get_Named_Entity (Name));
1555               end if;
1556            end if;
1557         end if;
1558         Cl := Get_Use_Clause_Chain (Cl);
1559         exit when Cl = Null_Iir;
1560      end loop;
1561   end Add_Use_Clause;
1562
1563   --  Debugging subprograms.
1564   procedure Disp_All_Names;
1565   pragma Unreferenced (Disp_All_Names);
1566
1567   procedure Disp_Scopes;
1568   pragma Unreferenced (Disp_Scopes);
1569
1570   procedure Disp_Detailed_Interpretations (Ident : Name_Id);
1571   pragma Unreferenced (Disp_Detailed_Interpretations);
1572
1573   procedure Dump_Current_Scope;
1574   pragma Unreferenced (Dump_Current_Scope);
1575
1576   procedure Disp_Detailed_Interpretations (Ident : Name_Id)
1577   is
1578      Inter: Name_Interpretation_Type;
1579      Decl : Iir;
1580   begin
1581      Log (Name_Table.Image (Ident));
1582      Log_Line (":");
1583
1584      Inter := Get_Interpretation (Ident);
1585      while Valid_Interpretation (Inter) loop
1586         Log (Name_Interpretation_Type'Image (Inter));
1587         if Is_Potentially_Visible (Inter) then
1588            Log (" (use)");
1589         end if;
1590         Log (":");
1591         Decl := Get_Declaration (Inter);
1592         Log (Iir'Image (Decl));
1593         Log (":");
1594         Log (Iir_Kind'Image (Get_Kind (Decl)));
1595         Log_Line (", loc: " & Image (Get_Location (Decl)));
1596         if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
1597            Log_Line ("   " & Disp_Subprg (Decl));
1598         end if;
1599         Inter := Get_Next_Interpretation (Inter);
1600      end loop;
1601   end Disp_Detailed_Interpretations;
1602
1603   procedure Disp_All_Interpretations
1604     (Interpretation : Name_Interpretation_Type)
1605   is
1606      Inter: Name_Interpretation_Type;
1607   begin
1608      Inter := Interpretation;
1609      while Valid_Interpretation (Inter) loop
1610         Log (Name_Interpretation_Type'Image (Inter));
1611         Log (".");
1612         Log (Iir_Kind'Image (Get_Kind (Get_Declaration (Inter))));
1613         Inter := Get_Next_Interpretation (Inter);
1614      end loop;
1615      Log_Line;
1616   end Disp_All_Interpretations;
1617
1618   procedure Disp_All_Names
1619   is
1620      Inter: Name_Interpretation_Type;
1621   begin
1622      for I in 0 .. Name_Table.Last_Name_Id loop
1623         Inter := Get_Interpretation (I);
1624         if Valid_Interpretation (Inter) then
1625            Log (Name_Table.Image (I));
1626            Log (Name_Id'Image (I));
1627            Log (":");
1628            Disp_All_Interpretations (Inter);
1629         end if;
1630      end loop;
1631      Log_Line ("interprations.last = "
1632                & Name_Interpretation_Type'Image (Interpretations.Last));
1633      Log_Line ("current_region_start ="
1634                & Name_Interpretation_Type'Image (Current_Region_Start));
1635   end Disp_All_Names;
1636
1637   procedure Dump_Interpretation (Inter : Name_Interpretation_Type)
1638   is
1639      Decl : Iir;
1640   begin
1641      Log (Name_Interpretation_Type'Image (Inter));
1642      if Is_Potentially_Visible (Inter) then
1643         Log (" (use)");
1644      end if;
1645      Log (": ");
1646      Decl := Get_Declaration (Inter);
1647      if Decl = Null_Iir then
1648         Log_Line ("null: conflict");
1649      else
1650         Log (Iir_Kind'Image (Get_Kind (Decl)));
1651         Log_Line (", loc: " & Image (Get_Location (Decl)));
1652         if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
1653            Log_Line ("   " & Disp_Subprg (Decl));
1654         end if;
1655      end if;
1656   end Dump_Interpretation;
1657
1658   procedure Dump_A_Scope (First, Last : Name_Interpretation_Type) is
1659   begin
1660      if First > Last then
1661         Log_Line ("scope is empty");
1662         return;
1663      end if;
1664
1665      for Inter in reverse First .. Last loop
1666         declare
1667            Cell : Interpretation_Cell renames Interpretations.Table (Inter);
1668         begin
1669            Dump_Interpretation (Inter);
1670            if Cell.Prev_Hidden then
1671               Log ("  [prev:");
1672               Log (Name_Interpretation_Type'Image (Cell.Prev));
1673               if Cell.Prev_Hidden then
1674                  Log (" hidden");
1675               end if;
1676               Log_Line ("]");
1677            else
1678               if Cell.Prev < First then
1679                  Log_Line (" [last in scope]");
1680               end if;
1681            end if;
1682         end;
1683      end loop;
1684   end Dump_A_Scope;
1685
1686   procedure Dump_Current_Scope is
1687   begin
1688      Dump_A_Scope (Current_Region_Start, Interpretations.Last);
1689   end Dump_Current_Scope;
1690
1691   procedure Disp_Scopes is
1692   begin
1693      for I in reverse Scopes.First .. Scopes.Last loop
1694         declare
1695            S : Scope_Cell renames Scopes.Table (I);
1696         begin
1697            case S.Kind is
1698               when Scope_Start =>
1699                  Log ("scope_start at");
1700               when Scope_Region =>
1701                  Log ("scope_region at");
1702            end case;
1703            Log_Line (Name_Interpretation_Type'Image (S.Saved_Region_Start));
1704         end;
1705      end loop;
1706   end Disp_Scopes;
1707end Vhdl.Sem_Scopes;
1708