diff options
Diffstat (limited to 'src/vhdl/vhdl-sem_scopes.adb')
| -rw-r--r-- | src/vhdl/vhdl-sem_scopes.adb | 1672 |
1 files changed, 1672 insertions, 0 deletions
diff --git a/src/vhdl/vhdl-sem_scopes.adb b/src/vhdl/vhdl-sem_scopes.adb new file mode 100644 index 000000000..8e616bd4b --- /dev/null +++ b/src/vhdl/vhdl-sem_scopes.adb @@ -0,0 +1,1672 @@ +-- Semantic analysis. +-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Logging; use Logging; +with Tables; +with Flags; use Flags; +with Name_Table; -- use Name_Table; +with Files_Map; use Files_Map; +with Errorout; use Errorout; +with Iirs_Utils; use Iirs_Utils; + +package body Vhdl.Sem_Scopes is + -- An interpretation cell is the element of the simply linked list + -- of interpretation for an identifier. + -- Interpretation cells are stored in table Interpretations. + type Interpretation_Cell is record + -- The declaration for this interpretation. + Decl: Iir; + + -- If True, the declaration is potentially visible (ie visible via a + -- use clause). + Is_Potential : Boolean; + + -- If True, previous declarations in PREV chain are hidden and shouldn't + -- be considered. + Prev_Hidden : Boolean; + + -- Previous interpretation for this identifier. + -- If No_Name_Interpretation, this (not PREV) interpretation is the last + -- one. If Prev_Hidden is True, PREV must be ignored. If Prev_Hidden is + -- false, the identifier is overloaded. + Prev: Name_Interpretation_Type; + + -- Previous added identifier in the declarative region. This forms a + -- linked list used to remove interpretations when a declarative + -- region is closed. + Prev_In_Region : Name_Id; + end record; + pragma Pack (Interpretation_Cell); + + package Interpretations is new Tables + (Table_Component_Type => Interpretation_Cell, + Table_Index_Type => Name_Interpretation_Type, + Table_Low_Bound => First_Valid_Interpretation, + Table_Initial => 1024); + + -- Cached value of Prev_In_Region of current region. + Last_In_Region : Name_Id := Null_Identifier; + + -- First interpretation in the current declarative region. + Current_Region_Start : Name_Interpretation_Type := + First_Valid_Interpretation; + + -- First valid interpretation. All interpretations smaller than this + -- value are part of a previous (and nested) analysis and must not be + -- considered. + First_Interpretation : Name_Interpretation_Type := + First_Valid_Interpretation; + + -- List of non-local hidden declarations. + type Hide_Index is new Nat32; + No_Hide_Index : constant Hide_Index := 0; + + package Hidden_Decls is new Tables + (Table_Component_Type => Name_Interpretation_Type, + Table_Index_Type => Hide_Index, + Table_Low_Bound => No_Hide_Index + 1, + Table_Initial => 32); + + -- First non-local hidden declarations. In VHDL, it is possible to hide + -- an overloaded declaration (by declaring a subprogram with the same + -- profile). If the overloaded declaration is local, the interpretation + -- can simply be modified. But if it is not local, the interpretation is + -- removed from the chain and saved in the Hidden_Decls table. + First_Hide_Index : Hide_Index := No_Hide_Index; + + -- To manage the list of interpretation and to add informations to this + -- list, a stack is used. + -- Elements of stack can be of kind: + -- Save_Cell: + -- the element contains the interpretation INTER for the indentifier ID + -- for the outer declarative region. + -- A save cell is always created each time a declaration is added to save + -- the previous interpretation. + -- Region_Start: + -- A new declarative region start at interpretation INTER. Here, INTER + -- is used as an index in the interpretations stack (table). + -- ID is used as an index into the unidim_array stack. + -- Barrier_start, Barrier_end: + -- All currents interpretations are saved between both INTER, and + -- are cleared. This is used to call semantic during another semantic. + + type Scope_Cell_Kind_Type is (Scope_Start, Scope_Region); + + type Scope_Cell is record + Kind: Scope_Cell_Kind_Type; + + -- Values for the previous scope. + Saved_Last_In_Region : Name_Id; + Saved_Region_Start : Name_Interpretation_Type; + Saved_First_Hide_Index : Hide_Index; + Saved_First_Interpretation : Name_Interpretation_Type; + end record; + + package Scopes is new Tables + (Table_Component_Type => Scope_Cell, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 64); + + function Valid_Interpretation (Inter : Name_Interpretation_Type) + return Boolean is + begin + return Inter >= First_Interpretation; + end Valid_Interpretation; + + -- Return True iff NI means there is a conflict for the identifier: no + -- valid interpretation due to potentially visible homoraph. + function Is_Conflict_Declaration (Ni : Name_Interpretation_Type) + return Boolean is + begin + pragma Assert (Valid_Interpretation (Ni)); + return Interpretations.Table (Ni).Decl = Null_Iir; + end Is_Conflict_Declaration; + + -- Get the current interpretation for ID. The result is raw: it may not + -- be valid. + function Get_Interpretation_Raw (Id : Name_Id) + return Name_Interpretation_Type is + begin + return Name_Interpretation_Type (Name_Table.Get_Name_Info (Id)); + end Get_Interpretation_Raw; + + procedure Set_Interpretation + (Id : Name_Id; Inter : Name_Interpretation_Type) is + begin + Name_Table.Set_Name_Info (Id, Int32 (Inter)); + end Set_Interpretation; + + function Get_Interpretation_From_Raw (Inter : Name_Interpretation_Type) + return Name_Interpretation_Type is + begin + if Valid_Interpretation (Inter) + and then not Is_Conflict_Declaration (Inter) + then + -- In the current scopes set and not a conflict. + return Inter; + else + return No_Name_Interpretation; + end if; + end Get_Interpretation_From_Raw; + + function Get_Interpretation (Id : Name_Id) + return Name_Interpretation_Type is + begin + return Get_Interpretation_From_Raw (Get_Interpretation_Raw (Id)); + end Get_Interpretation; + + procedure Check_Interpretations; + pragma Unreferenced (Check_Interpretations); + + procedure Check_Interpretations + is + Inter: Name_Interpretation_Type; + Last : constant Name_Interpretation_Type := Interpretations.Last; + Err : Boolean; + begin + Err := False; + for I in 0 .. Name_Table.Last_Name_Id loop + Inter := Get_Interpretation (I); + if Inter > Last then + Log_Line ("bad interpretation for " & Name_Table.Image (I)); + Err := True; + end if; + end loop; + if Err then + raise Internal_Error; + end if; + end Check_Interpretations; + + procedure Push_Interpretations is + begin + Scopes.Append ((Kind => Scope_Start, + Saved_Last_In_Region => Last_In_Region, + Saved_Region_Start => Current_Region_Start, + Saved_First_Hide_Index => First_Hide_Index, + Saved_First_Interpretation => First_Interpretation)); + Last_In_Region := Null_Identifier; + Current_Region_Start := Interpretations.Last + 1; + First_Hide_Index := Hidden_Decls.Last + 1; + First_Interpretation := Interpretations.Last + 1; + end Push_Interpretations; + + procedure Pop_Interpretations + is + Cell : Scope_Cell renames Scopes.Table (Scopes.Last); + begin + pragma Assert (Scopes.Table (Scopes.Last).Kind = Scope_Start); + + -- All the declarative regions must have been removed. + pragma Assert (Last_In_Region = Null_Identifier); + pragma Assert (Current_Region_Start = Interpretations.Last + 1); + pragma Assert (First_Hide_Index = Hidden_Decls.Last + 1); + pragma Assert (First_Interpretation = Interpretations.Last + 1); + + Last_In_Region := Cell.Saved_Last_In_Region; + Current_Region_Start := Cell.Saved_Region_Start; + First_Hide_Index := Cell.Saved_First_Hide_Index; + First_Interpretation := Cell.Saved_First_Interpretation; + + Scopes.Decrement_Last; + end Pop_Interpretations; + + -- Create a new declarative region. + -- Simply push a region_start cell and update current_scope_start. + procedure Open_Declarative_Region is + begin + Scopes.Append ((Kind => Scope_Region, + Saved_Last_In_Region => Last_In_Region, + Saved_Region_Start => Current_Region_Start, + Saved_First_Hide_Index => First_Hide_Index, + Saved_First_Interpretation => No_Name_Interpretation)); + Last_In_Region := Null_Identifier; + Current_Region_Start := Interpretations.Last + 1; + First_Hide_Index := Hidden_Decls.Last + 1; + end Open_Declarative_Region; + + -- Close a declarative region. + -- Update interpretation of identifiers. + procedure Close_Declarative_Region + is + Cell : Scope_Cell renames Scopes.Table (Scopes.Last); + Id : Name_Id; + begin + pragma Assert (Cell.Kind = Scope_Region); + + -- Restore hidden declarations. + for I in reverse First_Hide_Index .. Hidden_Decls.Last loop + declare + Inter : constant Name_Interpretation_Type := + Hidden_Decls.Table (I); + Prev_Inter, Next_Inter : Name_Interpretation_Type; + begin + Prev_Inter := Interpretations.Table (Inter).Prev; + Next_Inter := Interpretations.Table (Prev_Inter).Prev; + Interpretations.Table (Inter).Prev := Next_Inter; + Interpretations.Table (Prev_Inter).Prev := Inter; + end; + end loop; + Hidden_Decls.Set_Last (First_Hide_Index - 1); + + -- Remove interpretations of that region. + Id := Last_In_Region; + if Id /= Null_Identifier then + declare + Inter : Name_Interpretation_Type; + begin + loop + Inter := Get_Interpretation_Raw (Id); + pragma Assert (Inter >= Current_Region_Start); + Set_Interpretation (Id, Interpretations.Table (Inter).Prev); + Id := Interpretations.Table (Inter).Prev_In_Region; + exit when Id = Null_Identifier; + end loop; + pragma Assert (Inter = Current_Region_Start); + end; + Interpretations.Set_Last (Current_Region_Start - 1); + end if; + + Last_In_Region := Cell.Saved_Last_In_Region; + Current_Region_Start := Cell.Saved_Region_Start; + First_Hide_Index := Cell.Saved_First_Hide_Index; + + Scopes.Decrement_Last; + end Close_Declarative_Region; + + procedure Open_Scope_Extension renames Open_Declarative_Region; + procedure Close_Scope_Extension renames Close_Declarative_Region; + + function Get_Next_Interpretation (Ni : Name_Interpretation_Type) + return Name_Interpretation_Type + is + pragma Assert (Valid_Interpretation (Ni)); + Cell : Interpretation_Cell renames Interpretations.Table (Ni); + begin + if Cell.Prev_Hidden + or else not Valid_Interpretation (Cell.Prev) + then + return No_Name_Interpretation; + else + return Cell.Prev; + end if; + end Get_Next_Interpretation; + + function Get_Declaration (Ni : Name_Interpretation_Type) return Iir is + begin + pragma Assert (Valid_Interpretation (Ni)); + return Interpretations.Table (Ni).Decl; + end Get_Declaration; + + function Get_Under_Interpretation (Id : Name_Id) + return Name_Interpretation_Type + is + Inter : constant Name_Interpretation_Type := Get_Interpretation (Id); + begin + -- ID has no interpretation. + -- So, there is no 'under' interpretation (FIXME: prove it). + pragma Assert (Valid_Interpretation (Inter)); + + declare + Cell : Interpretation_Cell renames Interpretations.Table (Inter); + Prev : constant Name_Interpretation_Type := Cell.Prev; + begin + -- Get_Under_Interpretation can be used only to get a hidden + -- interpretation. + pragma Assert (Cell.Prev_Hidden); + + if Valid_Interpretation (Prev) + -- Not a conflict one (use clauses). + and then Get_Declaration (Prev) /= Null_Iir + then + return Prev; + else + return No_Name_Interpretation; + end if; + end; + end Get_Under_Interpretation; + + function Strip_Non_Object_Alias (Decl : Iir) return Iir + is + Res : Iir; + begin + Res := Decl; + if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then + Res := Get_Named_Entity (Get_Name (Res)); + end if; + return Res; + end Strip_Non_Object_Alias; + + function Get_Non_Alias_Declaration (Ni : Name_Interpretation_Type) + return Iir is + begin + return Strip_Non_Object_Alias (Get_Declaration (Ni)); + end Get_Non_Alias_Declaration; + + -- Return TRUE if INTER was made directly visible via a use clause. + function Is_Potentially_Visible (Inter : Name_Interpretation_Type) + return Boolean is + begin + return Interpretations.Table (Inter).Is_Potential; + end Is_Potentially_Visible; + + -- Return TRUE iif DECL can be overloaded. + function Is_Overloadable (Decl : Iir) return Boolean is + begin + -- LRM93 10.3: + -- The overloaded declarations considered in this chapter are those for + -- subprograms and enumeration literals. + case Get_Kind (Decl) is + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Function_Declaration + | Iir_Kind_Interface_Procedure_Declaration => + return True; + when Iir_Kind_Non_Object_Alias_Declaration => + case Get_Kind (Get_Named_Entity (Get_Name (Decl))) is + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Function_Declaration + | Iir_Kind_Interface_Procedure_Declaration => + return True; + when Iir_Kind_Non_Object_Alias_Declaration => + raise Internal_Error; + when others => + return False; + end case; + when others => + return False; + end case; + end Is_Overloadable; + + -- Return TRUE if INTER was made direclty visible in the current + -- declarative region. + function Is_In_Current_Declarative_Region (Inter : Name_Interpretation_Type) + return Boolean is + begin + return Inter >= Current_Region_Start; + end Is_In_Current_Declarative_Region; + + -- Emit a warning when DECL hides PREV_DECL. + procedure Warning_Hide (Decl : Iir; Prev_Decl : Iir) + is + begin + if Get_Kind (Decl) in Iir_Kinds_Interface_Declaration + and then Get_Kind (Get_Parent (Decl)) = Iir_Kind_Component_Declaration + then + -- Do not warn when an interface in a component hides a declaration. + -- This is a common case (eg: in testbenches), and there is no real + -- hiding. + return; + end if; + + if Get_Kind (Decl) = Iir_Kind_Element_Declaration then + -- Do not warn for record elements. They are used by selection. + return; + end if; + + if Decl = Prev_Decl then + -- Can happen in configuration. No real hidding. + return; + end if; + + Warning_Msg_Sem (Warnid_Hide, +Decl, + "declaration of %i hides %n", (+Decl, +Prev_Decl)); + end Warning_Hide; + + -- Add interpretation DECL to the identifier of DECL. + -- POTENTIALLY is true if the identifier comes from a use clause. + procedure Add_Name (Decl : Iir; Ident : Name_Id; Potentially : Boolean) + is + -- Current interpretation of ID. This is the one before DECL is + -- added (if so). + Raw_Inter : constant Name_Interpretation_Type := + Get_Interpretation_Raw (Ident); + Current_Inter : constant Name_Interpretation_Type := + Get_Interpretation_From_Raw (Raw_Inter); + Current_Decl : Iir; + + -- Add DECL in the chain of interpretation for the identifier. + procedure Add_New_Interpretation (Hid_Prev : Boolean; D : Iir := Decl) is + begin + Interpretations.Append ((Decl => D, + Prev => Raw_Inter, + Is_Potential => Potentially, + Prev_Hidden => Hid_Prev, + Prev_In_Region => Last_In_Region)); + Set_Interpretation (Ident, Interpretations.Last); + Last_In_Region := Ident; + end Add_New_Interpretation; + begin + if Ident = Null_Identifier then + -- Missing identifier can happen only in case of parse error. + pragma Assert (Flags.Flag_Force_Analysis); + return; + end if; + + if not Valid_Interpretation (Raw_Inter) then + -- Very simple: no hidding, no overloading. + Add_New_Interpretation (True); + return; + end if; + + if Is_Conflict_Declaration (Raw_Inter) then + if Potentially then + -- Yet another conflicting interpretation. + return; + else + -- Very simple: no hidding, no overloading. + -- (current interpretation is Conflict_Interpretation if there is + -- only potentially visible declarations that are not made + -- directly visible). + -- Note: in case of conflict interpretation, it may be unnecessary + -- to keep the current interpretation (but it is simpler as is). + Add_New_Interpretation (True); + return; + end if; + end if; + + if Potentially then + -- Do not re-add a potential decl. This handles cases like: + -- 'use p.all; use p.all;'. + -- FIXME: add a flag (or reuse Visible_Flag) to avoid walking all + -- the interpretations. + declare + Inter : Name_Interpretation_Type := Current_Inter; + begin + while Valid_Interpretation (Inter) loop + if Get_Declaration (Inter) = Decl then + return; + end if; + Inter := Get_Next_Interpretation (Inter); + end loop; + end; + end if; + + -- LRM 10.3 Visibility + -- Each of two declarations is said to be a homograph of the other if + -- both declarations have the same identifier, operator symbol, or + -- character literal, and overloading is allowed for at most one + -- of the two. + -- + -- GHDL: the condition 'overloading is allowed for at most one of the + -- two' is false iff overloading is allowed for both; this is a nand. + + -- Note: at this stage, current_inter is valid. + Current_Decl := Get_Declaration (Current_Inter); + + if Is_Overloadable (Current_Decl) and then Is_Overloadable (Decl) then + -- Current_Inter and Decl overloads (well, they have the same + -- designator). + + -- LRM 10.3 Visibility + -- If overloading is allowed for both declarations, then each of the + -- two is a homograph of the other if they have the same identifier, + -- operator symbol or character literal, as well as the same + -- parameter and result profile. + + declare + Homograph : Name_Interpretation_Type; + Prev_Homograph : Name_Interpretation_Type; + + -- Hide HOMOGRAPH (ie unlink it from the chain of interpretation). + procedure Hide_Homograph + is + S : Name_Interpretation_Type; + begin + if Prev_Homograph = No_Name_Interpretation then + Prev_Homograph := Interpretations.Last; + end if; + + -- PREV_HOMOGRAPH must be the interpretation just before + -- HOMOGRAPH. + pragma Assert + (Interpretations.Table (Prev_Homograph).Prev = Homograph); + + -- Hide previous interpretation. + Hidden_Decls.Append (Homograph); + + S := Interpretations.Table (Homograph).Prev; + Interpretations.Table (Homograph).Prev := Prev_Homograph; + Interpretations.Table (Prev_Homograph).Prev := S; + end Hide_Homograph; + + function Get_Hash_Non_Alias (D : Iir) return Iir_Int32 is + begin + return Get_Subprogram_Hash (Strip_Non_Object_Alias (D)); + end Get_Hash_Non_Alias; + + -- Return True iff D is an implicit declaration (either a + -- subprogram or an implicit alias). + function Is_Implicit_Declaration (D : Iir) return Boolean is + begin + case Get_Kind (D) is + when Iir_Kind_Non_Object_Alias_Declaration => + return Get_Implicit_Alias_Flag (D); + when Iir_Kind_Enumeration_Literal => + return False; + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + return Is_Implicit_Subprogram (D); + when others => + Error_Kind ("is_implicit_declaration", D); + end case; + end Is_Implicit_Declaration; + + -- Return TRUE iff D is an implicit alias of an implicit + -- subprogram. + function Is_Implicit_Alias (D : Iir) return Boolean is + begin + -- FIXME: Is it possible to have an implicit alias of an + -- explicit subprogram ? Yes for enumeration literal and + -- physical units. + return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration + and then Get_Implicit_Alias_Flag (D) + and then Is_Implicit_Subprogram (Get_Named_Entity + (Get_Name (D))); + end Is_Implicit_Alias; + + -- Replace the homograph of DECL by DECL. + procedure Replace_Homograph is + begin + Interpretations.Table (Homograph).Decl := Decl; + end Replace_Homograph; + + Decl_Hash : Iir_Int32; + Hash : Iir_Int32; + begin + Decl_Hash := Get_Hash_Non_Alias (Decl); + -- The hash must have been computed. + pragma Assert (Decl_Hash /= 0); + + -- LRM02 10.3 Visibility + -- Each of two declarations is said to be a /homograph/ of the + -- other if both declarations have the same identifier, operator + -- symbol, or character literal, and if overloading is allowed for + -- at most one of the two. + -- + -- LRM08 12.3 Visibility + -- Each of two declarations is said to be a /homograph/ of the + -- other if and only if both declarations have the same + -- designator, and they denote different named entities, and + -- either overloading is allows for at most one of the two, or + -- overloading is allowed for both declarations and they have the + -- same parameter and result type profile. + + -- GHDL: here we are in the case when both declarations are + -- overloadable. Also, always follow the LRM08 rules as they fix + -- issues. + -- GHDL: Special case for a second declaration with the same + -- designator and that denotes the same named entity than a + -- previous one (that would be an alias): according to the LRM, + -- they are both visible and there are no ambiguity as they + -- denotes the same named entity. In GHDL, the new one hides the + -- previous one. The behaviour should be the same. + + -- Find an homograph of this declaration (and also keep the + -- interpretation just before it in the chain). + Homograph := Current_Inter; + Prev_Homograph := No_Name_Interpretation; + while Homograph /= No_Name_Interpretation loop + Current_Decl := Get_Declaration (Homograph); + Hash := Get_Hash_Non_Alias (Current_Decl); + exit when Decl_Hash = Hash + and then Is_Same_Profile (Decl, Current_Decl); + Prev_Homograph := Homograph; + Homograph := Get_Next_Interpretation (Homograph); + end loop; + + if Homograph = No_Name_Interpretation then + -- Simple case: no homograph. + Add_New_Interpretation (False); + return; + end if; + + -- There is an homograph (or the named entity is the same). + if Potentially then + -- Added DECL would be made potentially visible. + + -- LRM93 10.4 1) / LRM08 12.4 a) Use Clauses + -- 1. A potentially visible declaration is not made + -- directly visible if the place considered is within the + -- immediate scope of a homograph of the declaration. + if not Is_Potentially_Visible (Homograph) then + return; + end if; + + -- LRM08 12.4 Use Clauses + -- b) If two potentially visible declarations are homograph + -- and one is explicitly declared and the other is + -- implicitly declared, then the implicit declaration is + -- not made directly visible. + if (Flags.Flag_Explicit or else Flags.Vhdl_Std >= Vhdl_08) + and then Is_Potentially_Visible (Homograph) + then + declare + Implicit_Current_Decl : constant Boolean := + Is_Implicit_Declaration (Current_Decl); + Implicit_Decl : constant Boolean := + Is_Implicit_Declaration (Decl); + begin + if Implicit_Current_Decl and then not Implicit_Decl then + if Is_In_Current_Declarative_Region (Homograph) then + Replace_Homograph; + else + -- Insert DECL and hide homograph. + Add_New_Interpretation (False); + Hide_Homograph; + end if; + return; + elsif not Implicit_Current_Decl and then Implicit_Decl + then + -- Discard decl. + return; + elsif Strip_Non_Object_Alias (Decl) + = Strip_Non_Object_Alias (Current_Decl) + then + -- This rule is not written clearly in the LRM, but + -- if two designators denote the same named entity, + -- no need to make both visible. + return; + end if; + end; + end if; + + -- GHDL: if the homograph is in the same declarative + -- region than DECL, it must be an implicit declaration + -- to be hidden. + -- FIXME: this rule is not in the LRM93, but it is necessary + -- so that explicit declaration hides the implicit one. + if Flags.Vhdl_Std < Vhdl_08 + and then not Flags.Flag_Explicit + and then Get_Parent (Decl) = Get_Parent (Current_Decl) + then + declare + Implicit_Current_Decl : constant Boolean := + Is_Implicit_Subprogram (Current_Decl); + Implicit_Decl : constant Boolean := + Is_Implicit_Subprogram (Decl); + begin + if Implicit_Current_Decl and not Implicit_Decl then + -- Note: no need to save previous interpretation, as + -- it is in the same declarative region. + -- Replace the previous homograph with DECL. + Replace_Homograph; + return; + elsif not Implicit_Current_Decl and Implicit_Decl then + -- As we have replaced the homograph, it is possible + -- than the implicit declaration is re-added (by + -- a new use clause). Discard it. + return; + end if; + end; + end if; + + -- The homograph was made visible in an outer declarative + -- region. Therefore, it must not be hidden. + Add_New_Interpretation (False); + + return; + else + -- Added DECL would be made directly visible. + + if not Is_Potentially_Visible (Homograph) then + -- The homograph was also declared in that declarative + -- region or in an inner one. + if Is_In_Current_Declarative_Region (Homograph) then + -- ... and was declared in the same region + + -- To sum up: at this point both DECL and CURRENT_DECL + -- are overloadable, have the same profile (but may be + -- aliases) and are declared in the same declarative + -- region. + + -- LRM08 12.3 Visibility + -- LRM93 10.3 Visibility + -- Two declarations that occur immediately within + -- the same declarative regions [...] shall not be + -- homograph, unless exactely one of them is the + -- implicit declaration of a predefined operation, + + -- LRM08 12.3 Visibility + -- or is an implicit alias of such implicit declaration. + -- + -- GHDL: FIXME: 'implicit alias' + + -- LRM08 12.3 Visibility + -- LRM93 10.3 Visibility + -- Each of two declarations is said to be a + -- homograph of the other if and only if both + -- declarations have the same designator, [...] + -- + -- LRM08 12.3 Visibility + -- [...] and they denote different named entities, + -- and [...] + declare + Is_Decl_Implicit : Boolean; + Is_Current_Decl_Implicit : Boolean; + begin + if Flags.Vhdl_Std >= Vhdl_08 then + Is_Current_Decl_Implicit := + Is_Implicit_Subprogram (Current_Decl) + or else Is_Implicit_Alias (Current_Decl); + Is_Decl_Implicit := Is_Implicit_Subprogram (Decl) + or else Is_Implicit_Alias (Decl); + + -- If they denote the same entity, they aren't + -- homograph. + if Strip_Non_Object_Alias (Decl) + = Strip_Non_Object_Alias (Current_Decl) + then + if Is_Current_Decl_Implicit + and then not Is_Decl_Implicit + then + -- They aren't homograph but DECL is stronger + -- (at it is not an implicit declaration) + -- than CURRENT_DECL + Replace_Homograph; + end if; + + return; + end if; + + if Is_Decl_Implicit + and then not Is_Current_Decl_Implicit + then + -- Re-declaration of an implicit subprogram via + -- an implicit alias is simply discarded. + return; + end if; + else + -- Can an implicit subprogram declaration appears + -- after an explicit one in vhdl 93? I don't + -- think so. + Is_Decl_Implicit := Is_Implicit_Subprogram (Decl); + Is_Current_Decl_Implicit := + Is_Implicit_Subprogram (Current_Decl); + end if; + + if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit) + then + Error_Msg_Sem + (+Decl, "redeclaration of %n defined at %l", + (+Current_Decl, +Current_Decl)); + return; + end if; + + if not Is_Decl_Implicit and Is_Current_Decl_Implicit + then + -- DECL 'overrides' the predefined current + -- declaration. + + -- LRM93 10.3 Visibility + -- In such cases, a predefined operation is always + -- hidden by the other homograph. Where hidden in + -- this manner, an implicit declaration is hidden + -- within the entire scope of the other declaration + -- (regardless of which declaration occurs first); + -- the implicit declaration is visible neither by + -- selection nor directly. + Set_Visible_Flag (Current_Decl, False); + if Get_Kind (Decl) + in Iir_Kinds_Subprogram_Declaration + then + Set_Hide_Implicit_Flag (Decl, True); + end if; + end if; + end; + else + -- GHDL: hide directly visible declaration declared in + -- an outer region. + null; + end if; + else + -- LRM 10.4 Use Clauses + -- 1. A potentially visible declaration is not made + -- directly visible if the place considered is within the + -- immediate scope of a homograph of the declaration. + + -- GHDL: hide the potentially visible declaration. + null; + end if; + Add_New_Interpretation (False); + + Hide_Homograph; + return; + end if; + end; + end if; + + -- The current interpretation and the new one aren't overloadable, ie + -- they are homograph (well almost). + + if Is_Potentially_Visible (Current_Inter) then + if Potentially then + -- LRM93 10.4 2) / LRM08 12.4 c) Use clauses + -- Potentially visible declarations that have the same + -- designator are not made directly visible unless each of + -- them is either an enumeration literal specification or + -- the declaration of a subprogram. + if Decl = Get_Declaration (Current_Inter) then + -- The rule applies only for distinct declaration. + -- This handles 'use p.all; use P.all;'. + -- FIXME: this should have been handled at the start of + -- this subprogram. + raise Internal_Error; + return; + end if; + + -- LRM08 12.3 Visibility + -- Each of two declarations is said to be a homograph of the + -- other if and only if both declarations have the same + -- designator; and they denote different named entities, [...] + if Flags.Vhdl_Std >= Vhdl_08 then + if Strip_Non_Object_Alias (Decl) + = Strip_Non_Object_Alias (Current_Decl) + then + return; + end if; + end if; + + -- Conflict. + Add_New_Interpretation (True, Null_Iir); + return; + else + -- LRM93 10.4 item #1 + -- A potentially visible declaration is not made directly + -- visible if the place considered is within the immediate + -- scope of a homograph of the declaration. + -- GHDL: Could directly replace the previous interpretation + -- (added in same scope), but don't do that for entity + -- declarations, since it is used to find default binding. + Add_New_Interpretation (True); + return; + end if; + else + -- There is already a declaration in the current scope. + if Potentially then + -- LRM93 §10.4 item #1 + -- Discard the new and potentially visible declaration. + -- However, add the type. + -- FIXME: Add_In_Visible_List (Ident, Decl); + return; + else + if Is_In_Current_Declarative_Region (Current_Inter) then + -- They are perhaps visible in the same declarative region. + + -- LRM93 11.2 + -- If two or more logical names having the same + -- identifier appear in library clauses in the same + -- context, the second and subsequent occurences of the + -- logical name have no effect. The same is true of + -- logical names appearing both in the context clause + -- of a primary unit and in the context clause of a + -- corresponding secondary unit. + -- GHDL: we apply this rule with VHDL-87, because of implicits + -- library clauses STD and WORK. + if Get_Kind (Decl) = Iir_Kind_Library_Declaration + and then + Get_Kind (Current_Decl) = Iir_Kind_Library_Declaration + then + return; + end if; + + -- None of the two declarations are potentially visible, ie + -- both are visible. + -- LRM §10.3: + -- Two declarations that occur immediately within the same + -- declarative region must not be homographs, + -- FIXME: unless one of them is the implicit declaration of a + -- predefined operation. + Error_Msg_Sem + (+Decl, "identifier %i already used for a declaration", + (1 => +Ident), Cont => True); + Error_Msg_Sem + (+Current_Decl, "previous declaration: %n", +Current_Decl); + return; + else + -- Homograph, not in the same scope. + -- LRM §10.3: + -- A declaration is said to be hidden within (part of) an inner + -- declarative region if the inner region contains an homograph + -- of this declaration; the outer declaration is the hidden + -- within the immediate scope of the inner homograph. + if Is_Warning_Enabled (Warnid_Hide) + and then not Is_Potentially_Visible (Current_Inter) + then + Warning_Hide (Decl, Current_Decl); + end if; + + Add_New_Interpretation (True); + return; + end if; + end if; + end if; + end Add_Name; + + procedure Add_Name (Decl: Iir) is + begin + Add_Name (Decl, Get_Identifier (Decl), False); + end Add_Name; + + procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir) + is + Inter : Name_Interpretation_Type; + begin + Inter := Get_Interpretation (Id); + loop + exit when Get_Declaration (Inter) = Old; + Inter := Get_Next_Interpretation (Inter); + pragma Assert (Valid_Interpretation (Inter)); + end loop; + Interpretations.Table (Inter).Decl := Decl; + pragma Assert (Get_Next_Interpretation (Inter) = No_Name_Interpretation); + end Replace_Name; + + procedure Name_Visible (Decl : Iir) is + begin + -- A name can be made visible only once. + pragma Assert (not Get_Visible_Flag (Decl)); + Set_Visible_Flag (Decl, True); + end Name_Visible; + + procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type) + is + begin + case Get_Kind (Decl) is + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Enumeration_Literal -- By use clause + | Iir_Kind_Constant_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kinds_Interface_Object_Declaration + | Iir_Kind_Interface_Package_Declaration + | Iir_Kinds_Interface_Subprogram_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Context_Declaration + | Iir_Kinds_Concurrent_Statement + | Iir_Kinds_Sequential_Statement => + Handle_Decl (Decl, Arg); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + if not Is_Second_Subprogram_Specification (Decl) then + Handle_Decl (Decl, Arg); + end if; + when Iir_Kind_Type_Declaration => + declare + Def : constant Iir := Get_Type_Definition (Decl); + List : Iir_Flist; + El : Iir; + begin + -- Handle incomplete type declaration. + if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then + return; + end if; + + Handle_Decl (Decl, Arg); + + if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then + List := Get_Enumeration_Literal_List (Def); + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Handle_Decl (El, Arg); + end loop; + end if; + end; + when Iir_Kind_Anonymous_Type_Declaration => + Handle_Decl (Decl, Arg); + + declare + Def : constant Iir := Get_Type_Definition (Decl); + El : Iir; + begin + if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then + El := Get_Unit_Chain (Def); + while El /= Null_Iir loop + Handle_Decl (El, Arg); + El := Get_Chain (El); + end loop; + end if; + end; + when Iir_Kind_Interface_Type_Declaration => + Handle_Decl (Decl, Arg); + declare + El : Iir; + begin + El := Get_Interface_Type_Subprograms (Decl); + while El /= Null_Iir loop + Handle_Decl (El, Arg); + El := Get_Chain (El); + end loop; + end; + when Iir_Kind_Use_Clause + | Iir_Kind_Context_Reference => + Handle_Decl (Decl, Arg); + when Iir_Kind_Library_Clause => + Handle_Decl (Decl, Arg); +-- El := Get_Library_Declaration (Decl); +-- if El /= Null_Iir then +-- -- May be empty. +-- Handle_Decl (El, Arg); +-- end if; + + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + null; + + when Iir_Kind_Package_Body => + null; + + when Iir_Kind_Attribute_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Disconnection_Specification => + null; + when Iir_Kinds_Signal_Attribute + | Iir_Kind_Signal_Attribute_Declaration => + null; + + when Iir_Kind_Protected_Type_Body => + -- FIXME: allowed only in debugger (if the current scope is + -- within a package body) ? + null; + + when others => + Error_Kind ("iterator_decl", Decl); + end case; + end Iterator_Decl; + + -- Handle context_clause of context reference CTXT. + procedure Add_One_Context_Reference (Ctxt : Iir) + is + Name : constant Iir := Get_Selected_Name (Ctxt); + Ent : constant Iir := Get_Named_Entity (Name); + Item : Iir; + begin + if Ent = Null_Iir or else Is_Error (Ent) then + -- Stop now in case of error. + return; + end if; + pragma Assert (Get_Kind (Ent) = Iir_Kind_Context_Declaration); + + Item := Get_Context_Items (Ent); + while Item /= Null_Iir loop + case Get_Kind (Item) is + when Iir_Kind_Use_Clause => + Add_Use_Clause (Item); + when Iir_Kind_Library_Clause => + Add_Name (Get_Library_Declaration (Item), + Get_Identifier (Item), False); + when Iir_Kind_Context_Reference => + Add_Context_Reference (Item); + when others => + Error_Kind ("add_context_reference", Item); + end case; + Item := Get_Chain (Item); + end loop; + end Add_One_Context_Reference; + + procedure Add_Context_Reference (Ref : Iir) + is + Ctxt : Iir; + begin + Ctxt := Ref; + loop + Add_One_Context_Reference (Ctxt); + Ctxt := Get_Context_Reference_Chain (Ctxt); + exit when Ctxt = Null_Iir; + end loop; + end Add_Context_Reference; + + -- Make POTENTIALLY (or not) visible DECL. + procedure Add_Name_Decl (Decl : Iir; Potentially : Boolean) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Use_Clause => + if not Potentially then + Add_Use_Clause (Decl); + end if; + when Iir_Kind_Context_Reference => + pragma Assert (not Potentially); + Add_Context_Reference (Decl); + when Iir_Kind_Library_Clause => + Add_Name (Get_Library_Declaration (Decl), + Get_Identifier (Decl), Potentially); + when Iir_Kind_Anonymous_Type_Declaration => + null; + when others => + Add_Name (Decl, Get_Identifier (Decl), Potentially); + end case; + end Add_Name_Decl; + + procedure Add_Declaration is + new Iterator_Decl (Arg_Type => Boolean, Handle_Decl => Add_Name_Decl); + + procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type) + is + Decl : Iir; + It : List_Iterator; + begin + if Decl_List = Null_Iir_List then + return; + end if; + It := List_Iterate (Decl_List); + while Is_Valid (It) loop + Decl := Get_Element (It); + Handle_Decl (Decl, Arg); + Next (It); + end loop; + end Iterator_Decl_List; + + procedure Iterator_Decl_Chain (Chain_First : Iir; Arg : Arg_Type) + is + Decl: Iir; + begin + Decl := Chain_First; + while Decl /= Null_Iir loop + Handle_Decl (Decl, Arg); + Decl := Get_Chain (Decl); + end loop; + end Iterator_Decl_Chain; + + procedure Add_Declarations_1 is new Iterator_Decl_Chain + (Arg_Type => Boolean, Handle_Decl => Add_Declaration); + + procedure Add_Declarations (Chain : Iir; Potentially : Boolean := False) + renames Add_Declarations_1; + + procedure Add_Declarations_List is new Iterator_Decl_List + (Arg_Type => Boolean, Handle_Decl => Add_Declaration); + + procedure Add_Declarations_From_Interface_Chain (Chain : Iir) + is + El : Iir; + Id : Name_Id; + begin + El := Chain; + while El /= Null_Iir loop + Id := Get_Identifier (El); + + -- The chain may be from an implicitely declared subprograms, with + -- anonymous identifiers. In that case, all interfaces are + -- anonymous and there is no need to iterate. + exit when Id = Null_Identifier; + + Add_Name (El, Id, False); + El := Get_Chain (El); + end loop; + end Add_Declarations_From_Interface_Chain; + + procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir) + is + El: Iir; + Label: Name_Id; + begin + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + Label := Get_Label (El); + if Label /= Null_Identifier then + Add_Name (El, Get_Identifier (El), False); + end if; + El := Get_Chain (El); + end loop; + end Add_Declarations_Of_Concurrent_Statement; + + procedure Add_Context_Clauses (Unit : Iir_Design_Unit) is + begin + Add_Declarations (Get_Context_Items (Unit), False); + end Add_Context_Clauses; + + -- Add declarations from an entity into the current declarative region. + -- This is needed when an architecture is analysed. + procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration) + is + begin + Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Entity)); + Add_Declarations_From_Interface_Chain (Get_Port_Chain (Entity)); + Add_Declarations (Get_Declaration_Chain (Entity), False); + Add_Declarations_Of_Concurrent_Statement (Entity); + end Add_Entity_Declarations; + + -- Add declarations from a package into the current declarative region. + -- (for a use clause or when a package body is analyzed) + procedure Add_Package_Declarations + (Decl: Iir_Package_Declaration; Potentially : Boolean) + is + Header : constant Iir := Get_Package_Header (Decl); + begin + -- LRM08 12.1 Declarative region + -- d) A package declaration together with the corresponding body + -- + -- GHDL: the formal generic declarations are considered to be in the + -- same declarative region as the package declarations (and therefore + -- in the same scope), even if they don't occur immediately within a + -- package declaration. + if Header /= Null_Iir then + Add_Declarations (Get_Generic_Chain (Header), Potentially); + end if; + + Add_Declarations (Get_Declaration_Chain (Decl), Potentially); + end Add_Package_Declarations; + + procedure Add_Package_Instantiation_Declarations + (Decl: Iir; Potentially : Boolean) is + begin + -- LRM08 4.9 Package instantiation declarations + -- The package instantiation declaration is equivalent to declaration of + -- a generic-mapped package, consisting of a package declaration [...] + Add_Declarations (Get_Generic_Chain (Decl), Potentially); + Add_Declarations (Get_Declaration_Chain (Decl), Potentially); + end Add_Package_Instantiation_Declarations; + + -- Add declarations from a package into the current declarative region. + -- This is needed when a package body is analysed. + procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is + begin + Add_Package_Declarations (Decl, False); + end Add_Package_Declarations; + + procedure Add_Component_Declarations (Component: Iir_Component_Declaration) + is + begin + Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Component)); + Add_Declarations_From_Interface_Chain (Get_Port_Chain (Component)); + end Add_Component_Declarations; + + procedure Add_Protected_Type_Declarations + (Decl : Iir_Protected_Type_Declaration) is + begin + Add_Declarations (Get_Declaration_Chain (Decl), False); + end Add_Protected_Type_Declarations; + + procedure Extend_Scope_Of_Block_Declarations (Decl : Iir) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Architecture_Body => + Add_Context_Clauses (Get_Design_Unit (Decl)); + when Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement_Body => + -- FIXME: formal, iterator ? + null; + when others => + Error_Kind ("extend_scope_of_block_declarations", Decl); + end case; + Add_Declarations (Get_Declaration_Chain (Decl), False); + Add_Declarations_Of_Concurrent_Statement (Decl); + end Extend_Scope_Of_Block_Declarations; + + procedure Use_Library_All (Library : Iir_Library_Declaration) + is + Design_File : Iir_Design_File; + Design_Unit : Iir_Design_Unit; + Library_Unit : Iir; + begin + Design_File := Get_Design_File_Chain (Library); + while Design_File /= Null_Iir loop + Design_Unit := Get_First_Design_Unit (Design_File); + while Design_Unit /= Null_Iir loop + Library_Unit := Get_Library_Unit (Design_Unit); + if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then + Add_Name (Design_Unit, Get_Identifier (Design_Unit), True); + end if; + Design_Unit := Get_Chain (Design_Unit); + end loop; + Design_File := Get_Chain (Design_File); + end loop; + end Use_Library_All; + + procedure Potentially_Add_Name (Name : Iir) is + begin + Add_Name (Name, Get_Identifier (Name), True); + end Potentially_Add_Name; + + -- LRM08 12.4 Use clauses + -- Moreover, the following declarations, if any, that occurs immediately + -- within the package denoted by the prefix of the selected name, are also + -- identifier: + procedure Use_Selected_Type_Name (Name : Iir) + is + Type_Def : constant Iir := Get_Type (Name); + Base_Type : constant Iir := Get_Base_Type (Type_Def); + begin + case Get_Kind (Base_Type) is + when Iir_Kind_Enumeration_Type_Definition => + -- LRM08 12.4 Use clauses + -- - If the type mark denotes an enumeration type of a subtype of + -- an enumeration type, the enumeration literals of the base + -- type + declare + List : constant Iir_Flist := + Get_Enumeration_Literal_List (Base_Type); + El : Iir; + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Potentially_Add_Name (El); + end loop; + end; + when Iir_Kind_Physical_Type_Definition => + -- LRM08 12.4 Use clauses + -- - If the type mark denotes a subtype of a physical type, the + -- units of the base type + declare + El : Iir; + begin + El := Get_Unit_Chain (Base_Type); + while El /= Null_Iir loop + Potentially_Add_Name (El); + El := Get_Chain (El); + end loop; + end; + when others => + null; + end case; + + -- LRM08 12.4 Use clauses + -- - The implicit declarations of predefined operations for the type + -- that are not hidden by homographs explicitely declared immediately + -- within the package denoted by the prefix of the selected name + -- - The declarations of homographs, explicitely declared immediately + -- within the package denotes by the prefix of the selected name, + -- that hide implicit declarations of predefined operations for the + -- type + declare + Type_Decl : constant Iir := Get_Type_Declarator (Base_Type); + El : Iir; + Has_Override : Boolean; + begin + Has_Override := False; + El := Get_Chain (Type_Decl); + while El /= Null_Iir loop + if Is_Implicit_Subprogram (El) + and then Is_Operation_For_Type (El, Base_Type) + then + if Get_Visible_Flag (El) then + -- Implicit declaration EL was overriden by a user + -- declaration. Don't make it visible. + Potentially_Add_Name (El); + else + Has_Override := True; + end if; + El := Get_Chain (El); + else + exit; + end if; + end loop; + + -- Explicitely declared homograph. + if Has_Override then + while El /= Null_Iir loop + if Get_Kind (El) in Iir_Kinds_Subprogram_Declaration + and then Get_Hide_Implicit_Flag (El) + and then Is_Operation_For_Type (El, Base_Type) + then + Potentially_Add_Name (El); + end if; + El := Get_Chain (El); + end loop; + end if; + end; + end Use_Selected_Type_Name; + + -- LRM02 10.4 Use clauses + -- Each selected name in a use clause identifiers one or more declarations + -- that will potentially become directly visible. If the suffix of the + -- selected name is a simple name, a character literal, or operator + -- symbol, then the selected name identifiers only the declarations(s) of + -- that simple name, character literal, or operator symbol contained + -- within the package or library denoted by the prefix of the selected + -- name. + procedure Use_Selected_Name (Name : Iir) is + begin + case Get_Kind (Name) is + when Iir_Kind_Overload_List => + Add_Declarations_List (Get_Overload_List (Name), True); + when Iir_Kind_Error => + null; + when others => + Potentially_Add_Name (Name); + + -- LRM08 12.4 Use clauses + -- If the suffix of the selected name is a type mark, then the + -- declaration of the type or subtype denoted by the type mark + -- is identified. Moreover [...] + if (Vhdl_Std >= Vhdl_08 or else Flag_Relaxed_Rules) + and then Get_Kind (Name) in Iir_Kinds_Type_Declaration + then + Use_Selected_Type_Name (Name); + end if; + end case; + end Use_Selected_Name; + + -- LRM93 10.4 Use clauses + -- If the suffix is the reserved word ALL, then all the selected name + -- identifies all declaration that are contained within the package or + -- library denotes by te prefix of the selected name. + procedure Use_All_Names (Name: Iir) is + begin + case Get_Kind (Name) is + when Iir_Kind_Library_Declaration => + Use_Library_All (Name); + when Iir_Kind_Package_Declaration => + Add_Package_Declarations (Name, True); + when Iir_Kind_Package_Instantiation_Declaration => + Add_Package_Instantiation_Declarations (Name, True); + when Iir_Kind_Interface_Package_Declaration => + -- LRM08 6.5.5 Interface package declarations + -- Within an entity declaration, an architecture body, a + -- component declaration, or an uninstantiated subprogram or + -- package declaration that declares a given interface package, + -- the name of the given interface package denotes an undefined + -- instance of the uninstantiated package. + Add_Package_Instantiation_Declarations (Name, True); + when Iir_Kind_Error => + null; + when others => + raise Internal_Error; + end case; + end Use_All_Names; + + procedure Add_Use_Clause (Clause : Iir_Use_Clause) + is + Name : Iir; + Cl : Iir_Use_Clause; + begin + Cl := Clause; + loop + Name := Get_Selected_Name (Cl); + if Name = Null_Iir then + pragma Assert (Flags.Flag_Force_Analysis); + null; + else + if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then + Name := Get_Prefix (Name); + if not Is_Error (Name) then + Use_All_Names (Get_Named_Entity (Name)); + end if; + else + if not Is_Error (Name) then + Use_Selected_Name (Get_Named_Entity (Name)); + end if; + end if; + end if; + Cl := Get_Use_Clause_Chain (Cl); + exit when Cl = Null_Iir; + end loop; + end Add_Use_Clause; + + -- Debugging subprograms. + procedure Disp_All_Names; + pragma Unreferenced (Disp_All_Names); + + procedure Disp_Scopes; + pragma Unreferenced (Disp_Scopes); + + procedure Disp_Detailed_Interpretations (Ident : Name_Id); + pragma Unreferenced (Disp_Detailed_Interpretations); + + procedure Dump_Current_Scope; + pragma Unreferenced (Dump_Current_Scope); + + procedure Disp_Detailed_Interpretations (Ident : Name_Id) + is + Inter: Name_Interpretation_Type; + Decl : Iir; + begin + Log (Name_Table.Image (Ident)); + Log_Line (":"); + + Inter := Get_Interpretation (Ident); + while Valid_Interpretation (Inter) loop + Log (Name_Interpretation_Type'Image (Inter)); + if Is_Potentially_Visible (Inter) then + Log (" (use)"); + end if; + Log (":"); + Decl := Get_Declaration (Inter); + Log (Iir'Image (Decl)); + Log (":"); + Log (Iir_Kind'Image (Get_Kind (Decl))); + Log_Line (", loc: " & Image (Get_Location (Decl))); + if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then + Log_Line (" " & Disp_Subprg (Decl)); + end if; + Inter := Get_Next_Interpretation (Inter); + end loop; + end Disp_Detailed_Interpretations; + + procedure Disp_All_Interpretations + (Interpretation : Name_Interpretation_Type) + is + Inter: Name_Interpretation_Type; + begin + Inter := Interpretation; + while Valid_Interpretation (Inter) loop + Log (Name_Interpretation_Type'Image (Inter)); + Log ("."); + Log (Iir_Kind'Image (Get_Kind (Get_Declaration (Inter)))); + Inter := Get_Next_Interpretation (Inter); + end loop; + Log_Line; + end Disp_All_Interpretations; + + procedure Disp_All_Names + is + Inter: Name_Interpretation_Type; + begin + for I in 0 .. Name_Table.Last_Name_Id loop + Inter := Get_Interpretation (I); + if Valid_Interpretation (Inter) then + Log (Name_Table.Image (I)); + Log (Name_Id'Image (I)); + Log (":"); + Disp_All_Interpretations (Inter); + end if; + end loop; + Log_Line ("interprations.last = " + & Name_Interpretation_Type'Image (Interpretations.Last)); + Log_Line ("current_region_start =" + & Name_Interpretation_Type'Image (Current_Region_Start)); + end Disp_All_Names; + + procedure Dump_Interpretation (Inter : Name_Interpretation_Type) + is + Decl : Iir; + begin + Log (Name_Interpretation_Type'Image (Inter)); + if Is_Potentially_Visible (Inter) then + Log (" (use)"); + end if; + Log (": "); + Decl := Get_Declaration (Inter); + if Decl = Null_Iir then + Log_Line ("null: conflict"); + else + Log (Iir_Kind'Image (Get_Kind (Decl))); + Log_Line (", loc: " & Image (Get_Location (Decl))); + if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then + Log_Line (" " & Disp_Subprg (Decl)); + end if; + end if; + end Dump_Interpretation; + + procedure Dump_A_Scope (First, Last : Name_Interpretation_Type) is + begin + if First > Last then + Log_Line ("scope is empty"); + return; + end if; + + for Inter in reverse First .. Last loop + declare + Cell : Interpretation_Cell renames Interpretations.Table (Inter); + begin + Dump_Interpretation (Inter); + if Cell.Prev_Hidden then + Log (" [prev:"); + Log (Name_Interpretation_Type'Image (Cell.Prev)); + if Cell.Prev_Hidden then + Log (" hidden"); + end if; + Log_Line ("]"); + else + if Cell.Prev < First then + Log_Line (" [last in scope]"); + end if; + end if; + end; + end loop; + end Dump_A_Scope; + + procedure Dump_Current_Scope is + begin + Dump_A_Scope (Current_Region_Start, Interpretations.Last); + end Dump_Current_Scope; + + procedure Disp_Scopes is + begin + for I in reverse Scopes.First .. Scopes.Last loop + declare + S : Scope_Cell renames Scopes.Table (I); + begin + case S.Kind is + when Scope_Start => + Log ("scope_start at"); + when Scope_Region => + Log ("scope_region at"); + end case; + Log_Line (Name_Interpretation_Type'Image (S.Saved_Region_Start)); + end; + end loop; + end Disp_Scopes; +end Vhdl.Sem_Scopes; |