-- 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 Ada.Text_IO; 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_Info (Id)); end Get_Interpretation_Raw; procedure Set_Interpretation (Id : Name_Id; Inter : Name_Interpretation_Type) is begin Name_Table.Set_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 Ada.Text_IO.Put_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 pragma Assert (Cell.Prev_Hidden); if Valid_Interpretation (Prev) 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 => 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 => 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; -- 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 not Valid_Interpretation (Current_Inter) then -- Very simple: no hidding, no overloading. Add_New_Interpretation (True); return; end if; if Is_Conflict_Declaration (Current_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); -- 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. 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 Is_In_Current_Declarative_Region (Homograph) then if not Is_Potentially_Visible (Homograph) then return; end if; 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 ("redeclaration of " & Disp_Node (Current_Decl) & " defined at " & Disp_Location (Current_Decl), 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 -- selected nor directly. Set_Visible_Flag (Current_Decl, False); 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_In_Current_Declarative_Region (Current_Inter) then -- They are perhaps visible in the same declarative region. 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 -- 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 ("identifier '" & Name_Table.Image (Ident) & "' already used for a declaration", Decl); Error_Msg_Sem ("previous declaration: " & Disp_Node (Current_Decl), Current_Decl); return; end if; end if; end if; -- 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. Add_New_Interpretation (True); 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_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_File_Declaration | Iir_Kind_Interface_Package_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_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 : Iir; List : Iir_List; El : Iir; begin Def := Get_Type_Definition (Decl); -- 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 Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; Handle_Decl (El, Arg); end loop; end if; end; when Iir_Kind_Anonymous_Type_Declaration => Handle_Decl (Decl, Arg); declare Def : Iir; El : Iir; begin Def := Get_Type_Definition (Decl); 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_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_Attribute_Specification | Iir_Kind_Configuration_Specification | Iir_Kind_Disconnection_Specification => null; when Iir_Kinds_Signal_Attribute => 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; begin if Decl_List = Null_Iir_List then return; end if; for I in Natural loop Decl := Get_Nth_Element (Decl_List, I); exit when Decl = Null_Iir; Handle_Decl (Decl, Arg); 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; begin El := Chain; while El /= Null_Iir loop Add_Name (El, Get_Identifier (El), 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 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 => Add_Declaration (Name, True); end case; end Use_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 Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then Use_All_Names (Get_Named_Entity (Get_Prefix (Name))); else Use_Selected_Name (Get_Named_Entity (Name)); 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 use Ada.Text_IO; use Name_Table; Inter: Name_Interpretation_Type; Decl : Iir; begin Put (Name_Table.Image (Ident)); Put_Line (":"); Inter := Get_Interpretation (Ident); while Valid_Interpretation (Inter) loop Put (Name_Interpretation_Type'Image (Inter)); if Is_Potentially_Visible (Inter) then Put (" (use)"); end if; Put (": "); Decl := Get_Declaration (Inter); Put (Iir_Kind'Image (Get_Kind (Decl))); Put_Line (", loc: " & Image (Get_Location (Decl))); if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then Put_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 use Ada.Text_IO; Inter: Name_Interpretation_Type; begin Inter := Interpretation; while Valid_Interpretation (Inter) loop Put (Name_Interpretation_Type'Image (Inter)); Put ('.'); Put (Iir_Kind'Image (Get_Kind (Get_Declaration (Inter)))); Inter := Get_Next_Interpretation (Inter); end loop; New_Line; end Disp_All_Interpretations; procedure Disp_All_Names is use Ada.Text_IO; Inter: Name_Interpretation_Type; begin for I in 0 .. Name_Table.Last_Name_Id loop Inter := Get_Interpretation (I); if Valid_Interpretation (Inter) then Put (Name_Table.Image (I)); Put (Name_Id'Image (I)); Put (':'); Disp_All_Interpretations (Inter); end if; end loop; Put_Line ("interprations.last = " & Name_Interpretation_Type'Image (Interpretations.Last)); Put_Line ("current_region_start =" & Name_Interpretation_Type'Image (Current_Region_Start)); end Disp_All_Names; procedure Dump_Interpretation (Inter : Name_Interpretation_Type) is use Ada.Text_IO; use Name_Table; Decl : Iir; begin Put (Name_Interpretation_Type'Image (Inter)); if Is_Potentially_Visible (Inter) then Put (" (use)"); end if; Put (": "); Decl := Get_Declaration (Inter); Put (Iir_Kind'Image (Get_Kind (Decl))); Put_Line (", loc: " & Image (Get_Location (Decl))); if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then Put_Line (" " & Disp_Subprg (Decl)); end if; end Dump_Interpretation; procedure Dump_A_Scope (First, Last : Name_Interpretation_Type) is use Ada.Text_IO; begin if First > Last then Put_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 Put (" [prev:"); Put (Name_Interpretation_Type'Image (Cell.Prev)); if Cell.Prev_Hidden then Put (" hidden"); end if; Put_Line ("]"); else if Cell.Prev < First then Put_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 use Ada.Text_IO; 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 => Put ("scope_start at"); when Scope_Region => Put ("scope_region at"); end case; Put_Line (Name_Interpretation_Type'Image (S.Saved_Region_Start)); end; end loop; end Disp_Scopes; end Sem_Scopes;