diff options
Diffstat (limited to 'src/vhdl/sem_scopes.adb')
| -rw-r--r-- | src/vhdl/sem_scopes.adb | 1672 |
1 files changed, 0 insertions, 1672 deletions
diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb deleted file mode 100644 index e4f780961..000000000 --- a/src/vhdl/sem_scopes.adb +++ /dev/null @@ -1,1672 +0,0 @@ --- 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 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 Sem_Scopes; |