-- 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 Evaluation; use Evaluation; with Iirs_Utils; use Iirs_Utils; with Libraries; with Errorout; use Errorout; with Flags; use Flags; with Name_Table; with Std_Package; use Std_Package; with Types; use Types; with Iir_Chains; use Iir_Chains; with Std_Names; with Sem; with Sem_Scopes; use Sem_Scopes; with Sem_Expr; use Sem_Expr; with Sem_Stmts; use Sem_Stmts; with Sem_Decls; use Sem_Decls; with Sem_Assocs; use Sem_Assocs; with Sem_Specs; with Sem_Types; with Sem_Psl; with Xrefs; use Xrefs; package body Sem_Names is -- Finish the semantization of NAME using RES as named entity. -- This is called when the semantization is finished and an uniq -- interpretation has been determined (RES). -- -- Error messages are emitted here. function Finish_Sem_Name (Name : Iir; Res : Iir) return Iir; procedure Error_Overload (Expr: Iir) is begin Error_Msg_Sem ("can't resolve overload for " & Disp_Node (Expr), Expr); end Error_Overload; procedure Disp_Overload_List (List : Iir_List; Loc : Iir) is El : Iir; begin Error_Msg_Sem ("possible interpretations are:", Loc); for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; case Get_Kind (El) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => Error_Msg_Sem (Disp_Subprg (El), El); when Iir_Kind_Function_Call => El := Get_Implementation (El); Error_Msg_Sem (Disp_Subprg (El), El); when others => Error_Msg_Sem (Disp_Node (El), El); end case; end loop; end Disp_Overload_List; -- Create an overload list. -- must be destroyed with free_iir. function Get_Overload_List return Iir_Overload_List is Res : Iir; begin Res := Create_Iir (Iir_Kind_Overload_List); return Res; end Get_Overload_List; function Create_Overload_List (List : Iir_List) return Iir_Overload_List is Res : Iir_Overload_List; begin Res := Get_Overload_List; Set_Overload_List (Res, List); return Res; end Create_Overload_List; procedure Free_Overload_List (N : in out Iir_Overload_List) is List : Iir_List; begin List := Get_Overload_List (N); Destroy_Iir_List (List); Free_Iir (N); N := Null_Iir; end Free_Overload_List; function Simplify_Overload_List (List : Iir_List) return Iir is Res : Iir; L1 : Iir_List; begin case Get_Nbr_Elements (List) is when 0 => L1 := List; Destroy_Iir_List (L1); return Null_Iir; when 1 => L1 := List; Res := Get_First_Element (List); Destroy_Iir_List (L1); return Res; when others => return Create_Overload_List (List); end case; end Simplify_Overload_List; -- Return true if AN_IIR is an overload list. function Is_Overload_List (An_Iir: Iir) return Boolean is begin return Get_Kind (An_Iir) = Iir_Kind_Overload_List; end Is_Overload_List; function Is_Defined_Type (Atype : Iir) return Boolean is begin return Atype /= Null_Iir and then not Kind_In (Get_Kind (Atype), Iir_Kind_Overload_List, Iir_Kind_Wildcard_Type_Definition); end Is_Defined_Type; -- From the list LIST of function or enumeration literal, extract the -- list of (return) types. -- If there is only one type, return it. -- If there is no types, return NULL. -- Otherwise, return the list as an overload list. function Create_List_Of_Types (List : Iir_List) return Iir is Res_List : Iir_List; Decl : Iir; begin -- Create the list of possible return types. Res_List := Create_Iir_List; for I in Natural loop Decl := Get_Nth_Element (List, I); exit when Decl = Null_Iir; case Get_Kind (Decl) is when Iir_Kind_Function_Declaration => Add_Element (Res_List, Get_Return_Type (Decl)); when Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Call | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element => Add_Element (Res_List, Get_Type (Decl)); when others => Error_Kind ("create_list_of_types", Decl); end case; end loop; return Simplify_Overload_List (Res_List); end Create_List_Of_Types; procedure Add_Result (Res : in out Iir; Decl : Iir) is Nres : Iir; Nres_List : Iir_List; begin if Decl = Null_Iir then return; end if; if Res = Null_Iir then Res := Decl; elsif Is_Overload_List (Res) then Append_Element (Get_Overload_List (Res), Decl); else Nres_List := Create_Iir_List; Nres := Create_Overload_List (Nres_List); Append_Element (Nres_List, Res); Append_Element (Nres_List, Decl); Res := Nres; end if; end Add_Result; -- Extract from overload list RES the function call without implicit -- conversion. Return Null_Iir if there is no function call, or if there -- is an expressions that isn't a function call, or if there is more than -- one function call without implicit conversion. -- Cf Sem_Expr.Get_Non_Implicit_Subprogram function Extract_Call_Without_Implicit_Conversion (Res : Iir) return Iir is pragma Assert (Is_Overload_List (Res)); List : constant Iir_List := Get_Overload_List (Res); Call : Iir; El : Iir; Imp : Iir; Inter : Iir; begin Call := Null_Iir; for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; if Get_Kind (El) = Iir_Kind_Function_Call then Imp := Get_Implementation (El); Inter := Get_Interface_Declaration_Chain (Imp); if Get_Type (Inter) = Universal_Integer_Type_Definition or else Get_Type (Inter) = Universal_Real_Type_Definition then -- The type of the first interface is a universal type. So, -- there were no implicit conversions. Once there is an -- implicit conversion, the only way to 'convert' to a -- universal type is through T'Pos, which has to be resolved. -- Note: there are no interface of convertible types. -- GHDL: this is not proven... if Call /= Null_Iir then -- More than one call without implicit conversion. return Null_Iir; else Call := El; end if; end if; else return Null_Iir; end if; end loop; return Call; end Extract_Call_Without_Implicit_Conversion; -- Move elements of result list LIST to result list RES. -- Destroy LIST if necessary. procedure Add_Result_List (Res : in out Iir; List : Iir); pragma Unreferenced (Add_Result_List); procedure Add_Result_List (Res : in out Iir; List : Iir) is El : Iir; List_List : Iir_List; Res_List : Iir_List; begin if Res = Null_Iir then Res := List; elsif List = Null_Iir then null; elsif not Is_Overload_List (List) then Add_Result (Res, List); else if not Is_Overload_List (Res) then El := Res; Res := Get_Overload_List; Append_Element (Get_Overload_List (Res), El); end if; List_List := Get_Overload_List (List); Res_List := Get_Overload_List (Res); for I in Natural loop El := Get_Nth_Element (List_List, I); exit when El = Null_Iir; Append_Element (Res_List, El); end loop; Free_Iir (List); end if; end Add_Result_List; -- Free interpretations of LIST except KEEP (which can be Null_Iir to free -- the whole list). procedure Sem_Name_Free_Result (List : Iir; Keep : Iir) is procedure Sem_Name_Free (El : Iir) is begin case Get_Kind (El) is when Iir_Kind_Function_Call | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element => Sem_Name_Free (Get_Prefix (El)); Free_Iir (El); when Iir_Kind_Attribute_Name => Free_Iir (El); when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Enumeration_Literal => null; when Iir_Kinds_Denoting_Name => null; when others => Error_Kind ("sem_name_free", El); end case; end Sem_Name_Free; El : Iir; List_List : Iir_List; begin if List = Null_Iir then return; elsif not Is_Overload_List (List) then if List /= Keep then Sem_Name_Free (List); end if; else List_List := Get_Overload_List (List); for I in Natural loop El := Get_Nth_Element (List_List, I); exit when El = Null_Iir; if El /= Keep then Sem_Name_Free (El); end if; end loop; Free_Iir (List); end if; end Sem_Name_Free_Result; procedure Free_Parenthesis_Name (Name : Iir; Res : Iir) is Chain, Next_Chain : Iir; begin pragma Assert (Get_Kind (Res) /= Iir_Kind_Function_Call); Chain := Get_Association_Chain (Name); while Chain /= Null_Iir loop Next_Chain := Get_Chain (Chain); Free_Iir (Chain); Chain := Next_Chain; end loop; Free_Iir (Name); end Free_Parenthesis_Name; -- Find all named declaration whose identifier is ID in DECL_LIST and -- return it. -- The result can be NULL (if no such declaration exist), -- a declaration, or an overload_list containing all declarations. function Find_Declarations_In_List (Decl: Iir; Name : Iir_Selected_Name; Keep_Alias : Boolean) return Iir is Res: Iir := Null_Iir; -- If indentifier of DECL is ID, then add DECL in the result. procedure Handle_Decl (Decl : Iir; Id : Name_Id) is begin -- Use_clauses may appear in a declaration list. case Get_Kind (Decl) is when Iir_Kind_Use_Clause | Iir_Kind_Anonymous_Type_Declaration => return; when Iir_Kind_Non_Object_Alias_Declaration => if Get_Identifier (Decl) = Id then if Keep_Alias then Add_Result (Res, Decl); else Add_Result (Res, Get_Named_Entity (Get_Name (Decl))); end if; end if; when others => -- Consider only visible declarations (case of an implicit -- declaration that is overriden by explicit one). if Get_Identifier (Decl) = Id and Get_Visible_Flag (Decl) then Add_Result (Res, Decl); end if; end case; end Handle_Decl; procedure Iterator_Decl is new Sem_Scopes.Iterator_Decl (Arg_Type => Name_Id, Handle_Decl => Handle_Decl); --procedure Iterator_Decl_List is new Sem_Scopes.Iterator_Decl_List -- (Arg_Type => Name_Id, Handle_Decl => Iterator_Decl); procedure Iterator_Decl_Chain is new Sem_Scopes.Iterator_Decl_Chain (Arg_Type => Name_Id, Handle_Decl => Iterator_Decl); Id : constant Name_Id := Get_Identifier (Name); begin case Get_Kind (Decl) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => Iterator_Decl_Chain (Get_Interface_Declaration_Chain (Decl), Id); when Iir_Kind_Entity_Declaration => Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id); Iterator_Decl_Chain (Get_Port_Chain (Decl), Id); when Iir_Kind_Architecture_Body => null; when Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement => null; when Iir_Kind_Package_Declaration => null; when Iir_Kind_Package_Instantiation_Declaration => Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id); when Iir_Kind_Block_Statement => declare Header : constant Iir := Get_Block_Header (Decl); begin if Header /= Null_Iir then Iterator_Decl_Chain (Get_Generic_Chain (Header), Id); Iterator_Decl_Chain (Get_Port_Chain (Header), Id); end if; end; when Iir_Kind_For_Loop_Statement => Handle_Decl (Get_Parameter_Specification (Decl), Id); when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => null; when others => Error_Kind ("find_declarations_in_list", Decl); end case; case Get_Kind (Decl) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => declare Decl_Body : constant Iir := Get_Subprogram_Body (Decl); begin Iterator_Decl_Chain (Get_Declaration_Chain (Decl_Body), Id); Iterator_Decl_Chain (Get_Sequential_Statement_Chain (Decl_Body), Id); end; when Iir_Kind_Architecture_Body | Iir_Kind_Entity_Declaration | Iir_Kind_Block_Statement => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Decl), Id); when Iir_Kind_For_Generate_Statement => declare Bod : constant Iir := Get_Generate_Statement_Body (Decl); begin Iterator_Decl_Chain (Get_Declaration_Chain (Bod), Id); Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Bod), Id); end; when Iir_Kind_If_Generate_Statement => declare Clause : Iir; Bod : Iir; begin -- Look only in the current generate_statement_body Clause := Decl; while Clause /= Null_Iir loop Bod := Get_Generate_Statement_Body (Clause); if Get_Is_Within_Flag (Bod) then Iterator_Decl_Chain (Get_Declaration_Chain (Bod), Id); Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Bod), Id); exit; end if; Clause := Get_Generate_Else_Clause (Clause); end loop; end; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); Iterator_Decl_Chain (Get_Sequential_Statement_Chain (Decl), Id); when Iir_Kind_For_Loop_Statement => null; when others => Error_Kind ("find_declarations_in_list", Decl); end case; --if Res = Null_Iir then -- Error_Msg_Sem ("""" & Name_Table.Image (Id) & """ not defined in " -- & Disp_Node (Decl), Name); --end if; return Res; end Find_Declarations_In_List; -- Create an implicit_dereference node if PREFIX is of type access. -- Return PREFIX otherwise. -- PARENT is used if an implicit dereference node is created, to copy -- location from. function Insert_Implicit_Dereference (Prefix : Iir; Parent : Iir) return Iir is Prefix_Type : Iir; Res : Iir_Implicit_Dereference; begin Prefix_Type := Get_Type (Prefix); case Get_Kind (Prefix_Type) is when Iir_Kind_Access_Type_Definition | Iir_Kind_Access_Subtype_Definition => null; when others => return Prefix; end case; Check_Read (Prefix); Res := Create_Iir (Iir_Kind_Implicit_Dereference); Location_Copy (Res, Parent); Set_Type (Res, Get_Designated_Type (Prefix_Type)); Set_Prefix (Res, Prefix); Set_Base_Name (Res, Res); Set_Expr_Staticness (Res, None); return Res; end Insert_Implicit_Dereference; -- If PREFIX is a function specification that cannot be converted to a -- function call (because of lack of association), return FALSE. function Maybe_Function_Call (Prefix : Iir) return Boolean is Inter : Iir; begin if Get_Kind (Prefix) /= Iir_Kind_Function_Declaration then return True; end if; Inter := Get_Interface_Declaration_Chain (Prefix); while Inter /= Null_Iir loop if Get_Default_Value (Inter) = Null_Iir then return False; end if; Inter := Get_Chain (Inter); end loop; return True; end Maybe_Function_Call; procedure Name_To_Method_Object (Call : Iir; Name : Iir) is Prefix : Iir; Obj : Iir; begin if Get_Kind (Name) /= Iir_Kind_Selected_Name then return; end if; Prefix := Get_Prefix (Name); Obj := Get_Named_Entity (Prefix); if Obj /= Null_Iir and then Kind_In (Obj, Iir_Kind_Variable_Declaration, Iir_Kind_Interface_Variable_Declaration) and then Get_Type (Obj) /= Null_Iir then if Get_Kind (Get_Type (Obj)) /= Iir_Kind_Protected_Type_Declaration then Error_Msg_Sem ("type of the prefix should be a protected type", Prefix); return; end if; Set_Method_Object (Call, Obj); end if; end Name_To_Method_Object; -- NAME is the name of the function (and not the parenthesis name) function Sem_As_Function_Call (Name : Iir; Spec : Iir; Assoc_Chain : Iir) return Iir_Function_Call is Call : Iir_Function_Call; begin -- Check. pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name); Call := Create_Iir (Iir_Kind_Function_Call); Location_Copy (Call, Name); if Get_Kind (Name) = Iir_Kind_Parenthesis_Name then Set_Prefix (Call, Get_Prefix (Name)); else Set_Prefix (Call, Name); end if; Name_To_Method_Object (Call, Name); Set_Implementation (Call, Spec); Set_Parameter_Association_Chain (Call, Assoc_Chain); Set_Type (Call, Get_Return_Type (Spec)); Set_Base_Name (Call, Call); return Call; end Sem_As_Function_Call; -- If SPEC is a function specification, then return a function call, -- else return SPEC. function Maybe_Insert_Function_Call (Name : Iir; Spec : Iir) return Iir is begin if Get_Kind (Spec) = Iir_Kind_Function_Declaration then return Sem_As_Function_Call (Name, Spec, Null_Iir); else return Spec; end if; end Maybe_Insert_Function_Call; -- If PTR_TYPE is not NULL_IIR, then return an implciti dereference to -- PREFIX, else return PREFIX. function Maybe_Insert_Dereference (Prefix : Iir; Ptr_Type : Iir) return Iir is Id : Iir; begin if Ptr_Type /= Null_Iir then Id := Create_Iir (Iir_Kind_Implicit_Dereference); Location_Copy (Id, Prefix); Set_Type (Id, Get_Designated_Type (Ptr_Type)); Set_Prefix (Id, Prefix); Set_Base_Name (Id, Id); return Id; else return Prefix; end if; end Maybe_Insert_Dereference; procedure Finish_Sem_Indexed_Name (Expr : Iir) is Prefix : constant Iir := Get_Prefix (Expr); Prefix_Type : constant Iir := Get_Type (Prefix); Index_List : constant Iir_List := Get_Index_List (Expr); Index_Subtype : Iir; Index : Iir; Expr_Staticness : Iir_Staticness; begin Expr_Staticness := Locally; -- LRM93 §6.4: there must be one such expression for each index -- position of the array and each expression must be of the -- type of the corresponding index. -- Loop on the indexes. for I in Natural loop Index_Subtype := Get_Index_Type (Prefix_Type, I); exit when Index_Subtype = Null_Iir; Index := Get_Nth_Element (Index_List, I); -- The index_subtype can be an unconstrained index type. Index := Check_Is_Expression (Index, Index); if Index /= Null_Iir then Index := Sem_Expression (Index, Get_Base_Type (Index_Subtype)); end if; if Index /= Null_Iir then if Get_Expr_Staticness (Index) = Locally and then Get_Type_Staticness (Index_Subtype) = Locally then Index := Eval_Expr_Check (Index, Index_Subtype); end if; Replace_Nth_Element (Get_Index_List (Expr), I, Index); Expr_Staticness := Min (Expr_Staticness, Get_Expr_Staticness (Index)); else Expr_Staticness := None; end if; end loop; Set_Type (Expr, Get_Element_Subtype (Prefix_Type)); -- An indexed name cannot be locally static. Set_Expr_Staticness (Expr, Min (Globally, Min (Expr_Staticness, Get_Expr_Staticness (Prefix)))); -- LRM93 §6.1: -- a name is said to be a static name iff: -- The name is an indexed name whose prefix is a static name -- and every expression that appears as part of the name is a -- static expression. -- -- a name is said to be a locally static name iif: -- The name is an indexed name whose prefix is a locally -- static name and every expression that appears as part -- of the name is a locally static expression. Set_Name_Staticness (Expr, Min (Expr_Staticness, Get_Name_Staticness (Prefix))); Set_Base_Name (Expr, Get_Base_Name (Prefix)); end Finish_Sem_Indexed_Name; procedure Finish_Sem_Dereference (Res : Iir) is begin Set_Base_Name (Res, Res); Check_Read (Get_Prefix (Res)); Set_Expr_Staticness (Res, None); Set_Name_Staticness (Res, None); end Finish_Sem_Dereference; procedure Finish_Sem_Slice_Name (Name : Iir_Slice_Name) is -- The prefix of the slice Prefix : constant Iir := Get_Prefix (Name); Prefix_Type : constant Iir := Get_Type (Prefix); Prefix_Base_Type : Iir; Prefix_Bt : constant Iir := Get_Base_Type (Prefix_Type); Index_List: Iir_List; Index_Type: Iir; Suffix: Iir; Slice_Type : Iir; Expr_Type : Iir; Staticness : Iir_Staticness; Prefix_Rng : Iir; begin Set_Base_Name (Name, Get_Base_Name (Prefix)); -- LRM93 §6.5: the prefix of an indexed name must be appropriate -- for an array type. if Get_Kind (Prefix_Bt) /= Iir_Kind_Array_Type_Definition then Error_Msg_Sem ("slice can only be applied to an array", Name); return; end if; -- LRM93 §6.5: -- The prefix of a slice must be appropriate for a -- one-dimensionnal array object. Index_List := Get_Index_Subtype_List (Prefix_Type); if Get_Nbr_Elements (Index_List) /= 1 then Error_Msg_Sem ("slice prefix must be an unidimensional array", Name); return; end if; Index_Type := Get_Index_Type (Index_List, 0); Prefix_Rng := Eval_Static_Range (Index_Type); -- LRM93 6.5 -- It is an error if either the bounds of the discrete range does not -- belong to the index range of the prefixing array, *unless* the slice -- is a null slice. -- -- LRM93 6.5 -- The slice is a null slice if the discrete range is a null range. -- LRM93 §6.5: -- The bounds of the discrete range [...] must be of the -- type of the index of the array. Suffix := Sem_Discrete_Range_Expression (Get_Suffix (Name), Index_Type, False); if Suffix = Null_Iir then return; end if; Suffix := Eval_Range_If_Static (Suffix); Set_Suffix (Name, Suffix); -- LRM93 §6.5: -- It is an error if the direction of the discrete range is not -- the same as that of the index range of the array denoted -- by the prefix of the slice name. -- Check this only if the type is a constrained type. if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition and then Get_Index_Constraint_Flag (Prefix_Type) and then Get_Expr_Staticness (Suffix) = Locally and then Prefix_Rng /= Null_Iir and then Get_Direction (Suffix) /= Get_Direction (Prefix_Rng) then if False and then Flags.Vhdl_Std = Vhdl_87 then -- emit a warning for a null slice. Warning_Msg_Sem ("direction mismatch results in a null slice", Name); end if; Error_Msg_Sem ("direction of the range mismatch", Name); end if; -- LRM93 §7.4.1 -- A slice is never a locally static expression. case Get_Kind (Suffix) is when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => Suffix := Get_Type (Suffix); Staticness := Get_Type_Staticness (Suffix); when Iir_Kind_Range_Expression | Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => Staticness := Get_Expr_Staticness (Suffix); when others => Error_Kind ("finish_sem_slice_name", Suffix); end case; Set_Expr_Staticness (Name, Min (Min (Staticness, Get_Expr_Staticness (Prefix)), Globally)); Set_Name_Staticness (Name, Min (Staticness, Get_Name_Staticness (Prefix))); -- The type of the slice is a subtype of the base type whose -- range contraint is the slice itself. if Get_Kind (Suffix) in Iir_Kinds_Discrete_Type_Definition then Slice_Type := Suffix; else case Get_Kind (Get_Base_Type (Index_Type)) is when Iir_Kind_Integer_Type_Definition => Slice_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition); when Iir_Kind_Enumeration_Type_Definition => Slice_Type := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); when others => Error_Kind ("sem_expr: slice_name", Get_Base_Type (Index_Type)); end case; Set_Range_Constraint (Slice_Type, Suffix); Set_Type_Staticness (Slice_Type, Staticness); Set_Base_Type (Slice_Type, Get_Base_Type (Index_Type)); Set_Location (Slice_Type, Get_Location (Suffix)); end if; Expr_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Location (Expr_Type, Get_Location (Suffix)); Set_Index_Subtype_List (Expr_Type, Create_Iir_List); Prefix_Base_Type := Get_Base_Type (Prefix_Type); Set_Base_Type (Expr_Type, Prefix_Base_Type); Set_Signal_Type_Flag (Expr_Type, Get_Signal_Type_Flag (Prefix_Base_Type)); Append_Element (Get_Index_Subtype_List (Expr_Type), Slice_Type); Set_Element_Subtype (Expr_Type, Get_Element_Subtype (Prefix_Type)); if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then Set_Resolution_Indication (Expr_Type, Get_Resolution_Indication (Prefix_Type)); else Set_Resolution_Indication (Expr_Type, Null_Iir); end if; Set_Type_Staticness (Expr_Type, Min (Get_Type_Staticness (Prefix_Type), Get_Type_Staticness (Slice_Type))); Set_Type (Name, Expr_Type); Set_Slice_Subtype (Name, Expr_Type); Set_Index_Constraint_Flag (Expr_Type, True); Set_Constraint_State (Expr_Type, Fully_Constrained); if Is_Signal_Object (Prefix) then Sem_Types.Set_Type_Has_Signal (Expr_Type); end if; end Finish_Sem_Slice_Name; -- PREFIX is the name denoting the function declaration, and its analysis -- is already finished. procedure Finish_Sem_Function_Call (Call : Iir; Prefix : Iir) is Rtype : Iir; begin Set_Prefix (Call, Prefix); Set_Implementation (Call, Get_Named_Entity (Prefix)); -- LRM08 8.1 Names -- The name is a simple name or selected name that does NOT denote a -- function call [...] -- -- GHDL: so function calls are never static names. Set_Name_Staticness (Call, None); -- FIXME: modify sem_subprogram_call to avoid such a type swap. Rtype := Get_Type (Call); Set_Type (Call, Null_Iir); if Sem_Subprogram_Call (Call, Null_Iir) = Null_Iir then Set_Type (Call, Rtype); end if; end Finish_Sem_Function_Call; function Function_Declaration_To_Call (Name : Iir) return Iir is Expr : Iir; begin Expr := Get_Named_Entity (Name); if Maybe_Function_Call (Expr) then Expr := Sem_As_Function_Call (Name, Expr, Null_Iir); pragma Assert (Get_Kind (Expr) = Iir_Kind_Function_Call); Finish_Sem_Function_Call (Expr, Name); return Expr; else Error_Msg_Sem (Disp_Node (Expr) & " requires parameters", Name); Set_Type (Name, Get_Type (Expr)); Set_Expr_Staticness (Name, None); Set_Named_Entity (Name, Create_Error_Expr (Expr, Get_Type (Expr))); return Name; end if; end Function_Declaration_To_Call; function Sem_Type_Mark (Name : Iir; Incomplete : Boolean := False) return Iir is Atype : Iir; Res : Iir; begin -- The name must not have been analyzed. pragma Assert (Get_Type (Name) = Null_Iir); -- Analyze the name (if not already done). if Get_Named_Entity (Name) = Null_Iir then Sem_Name (Name); end if; Res := Finish_Sem_Name (Name); if Get_Kind (Res) in Iir_Kinds_Denoting_Name then -- Common correct case. Atype := Get_Named_Entity (Res); if Get_Kind (Atype) = Iir_Kind_Type_Declaration then Atype := Get_Type_Definition (Atype); elsif Get_Kind (Atype) = Iir_Kind_Subtype_Declaration then Atype := Get_Type (Atype); else Error_Msg_Sem ("a type mark must denote a type or a subtype", Name); Atype := Create_Error_Type (Atype); Set_Named_Entity (Res, Atype); end if; else if Get_Kind (Res) /= Iir_Kind_Error then Error_Msg_Sem ("a type mark must be a simple or expanded name", Name); end if; Res := Name; Atype := Create_Error_Type (Name); Set_Named_Entity (Res, Atype); end if; if not Incomplete then if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then Error_Msg_Sem ("invalid use of an incomplete type definition", Name); Atype := Create_Error_Type (Name); Set_Named_Entity (Res, Atype); end if; end if; Set_Type (Res, Atype); return Res; end Sem_Type_Mark; procedure Finish_Sem_Array_Attribute (Attr_Name : Iir; Attr : Iir; Param : Iir) is Parameter : Iir; Prefix_Type : Iir; Index_Type : Iir; Prefix : Iir; Prefix_Name : Iir; begin -- LRM93 14.1 -- Parameter: A locally static expression of type universal_integer, the -- value of which must not exceed the dimensionality of A. If omitted, -- it defaults to 1. if Param = Null_Iir then Parameter := Universal_Integer_One; else Parameter := Sem_Expression (Param, Universal_Integer_Type_Definition); if Parameter = Null_Iir then Parameter := Universal_Integer_One; else if Get_Expr_Staticness (Parameter) /= Locally then Error_Msg_Sem ("parameter must be locally static", Parameter); Parameter := Universal_Integer_One; end if; end if; end if; -- See Sem_Array_Attribute_Name for comments about the prefix. Prefix_Name := Get_Prefix (Attr_Name); if Is_Type_Name (Prefix_Name) /= Null_Iir then Prefix := Sem_Type_Mark (Prefix_Name); else Prefix := Finish_Sem_Name (Prefix_Name, Get_Prefix (Attr)); end if; Set_Prefix (Attr, Prefix); Prefix_Type := Get_Type (Prefix); if Is_Error (Prefix_Type) then return; end if; declare Dim : Iir_Int64; Indexes_List : constant Iir_List := Get_Index_Subtype_List (Prefix_Type); begin Dim := Get_Value (Parameter); if Dim < 1 or else Dim > Iir_Int64 (Get_Nbr_Elements (Indexes_List)) then Error_Msg_Sem ("parameter value out of bound", Attr); Parameter := Universal_Integer_One; Dim := 1; end if; Index_Type := Get_Index_Type (Indexes_List, Natural (Dim - 1)); end; case Get_Kind (Attr) is when Iir_Kind_Left_Array_Attribute | Iir_Kind_Right_Array_Attribute | Iir_Kind_High_Array_Attribute | Iir_Kind_Low_Array_Attribute => Set_Type (Attr, Index_Type); when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => Set_Type (Attr, Index_Type); when Iir_Kind_Length_Array_Attribute => Set_Type (Attr, Convertible_Integer_Type_Definition); when Iir_Kind_Ascending_Array_Attribute => Set_Type (Attr, Boolean_Type_Definition); when others => raise Internal_Error; end case; pragma Assert (Get_Parameter (Attr) = Null_Iir); Set_Parameter (Attr, Parameter); -- If the corresponding type is known, save it so that it is not -- necessary to extract it from the object. if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition and then Get_Constraint_State (Prefix_Type) = Fully_Constrained then Set_Index_Subtype (Attr, Index_Type); end if; -- LRM08 9.4.2 Locally static primaries -- g) A predefined attribute that is a function, [other than ... and -- other than ...], whose prefix is either a locally static subtype -- or is an object that is of a locally static subtype, and whose -- actual parameter (if any) is a locally static expression. -- LRM 7.4.1 -- A locally static range is either [...], or a range of the first form -- whose prefix denotes either a locally static subtype or an object -- that is of a locally static subtype. -- LRM 7.4.2 -- A globally static range is either [...], or a range of the first form -- whose prefix denotes either a globally static subtype or an object -- that is of a globally static subtype. -- -- A globally static subtype is either a globally static scalar subtype, -- a globally static array subtype, [...] -- -- A globally static array subtype is a constrained array subtype -- formed by imposing on an unconstrained array type a globally static -- index constraint. Set_Expr_Staticness (Attr, Get_Type_Staticness (Prefix_Type)); end Finish_Sem_Array_Attribute; procedure Finish_Sem_Scalar_Type_Attribute (Attr_Name : Iir; Attr : Iir; Param : Iir) is Prefix : Iir; Prefix_Type : Iir; Prefix_Bt : Iir; Parameter : Iir; Param_Type : Iir; begin if Param = Null_Iir then Error_Msg_Sem (Disp_Node (Attr) & " requires a parameter", Attr); return; end if; Prefix := Get_Prefix (Attr); if Get_Kind (Prefix) = Iir_Kind_Attribute_Name then Prefix := Finish_Sem_Name (Prefix); Set_Prefix (Attr, Prefix); pragma Assert (Get_Kind (Prefix) = Iir_Kind_Base_Attribute); else Prefix := Sem_Type_Mark (Prefix); end if; Set_Prefix (Attr, Prefix); Free_Iir (Attr_Name); Prefix_Type := Get_Type (Prefix); Prefix_Bt := Get_Base_Type (Prefix_Type); case Get_Kind (Attr) is when Iir_Kind_Pos_Attribute => -- LRM93 14.1 -- Parameter: An expression whose type is the base type of T. Parameter := Sem_Expression (Param, Prefix_Bt); when Iir_Kind_Val_Attribute => -- LRM93 14.1 -- Parameter: An expression of any integer type. Param_Type := Get_Type (Param); if Is_Overload_List (Param_Type) then Parameter := Sem_Expression (Param, Universal_Integer_Type_Definition); else if Get_Kind (Get_Base_Type (Param_Type)) /= Iir_Kind_Integer_Type_Definition then Error_Msg_Sem ("parameter must be an integer", Attr); return; end if; Parameter := Param; end if; when Iir_Kind_Succ_Attribute | Iir_Kind_Pred_Attribute | Iir_Kind_Leftof_Attribute | Iir_Kind_Rightof_Attribute => -- LRM93 14.1 -- Parameter: An expression whose type is the base type of T. Parameter := Sem_Expression (Param, Prefix_Bt); when Iir_Kind_Image_Attribute => -- LRM93 14.1 -- Parameter: An expression whose type is the base type of T. Parameter := Sem_Expression (Param, Prefix_Bt); when Iir_Kind_Value_Attribute => -- Parameter: An expression of type string. Parameter := Sem_Expression (Param, String_Type_Definition); when others => raise Internal_Error; end case; if Get_Parameter (Attr) /= Null_Iir then raise Internal_Error; end if; if Parameter = Null_Iir then Set_Parameter (Attr, Param); Set_Expr_Staticness (Attr, None); return; end if; Set_Parameter (Attr, Parameter); Set_Expr_Staticness (Attr, Min (Get_Type_Staticness (Prefix_Type), Get_Expr_Staticness (Parameter))); Set_Name_Staticness (Attr, Get_Expr_Staticness (Attr)); end Finish_Sem_Scalar_Type_Attribute; procedure Finish_Sem_Signal_Attribute (Attr_Name : Iir; Attr : Iir; Parameter : Iir) is Param : Iir; Prefix : Iir; Prefix_Name : Iir; begin Prefix_Name := Get_Prefix (Attr_Name); Prefix := Finish_Sem_Name (Prefix_Name, Get_Prefix (Attr)); Set_Prefix (Attr, Prefix); Free_Iir (Attr_Name); if Parameter = Null_Iir then return; end if; if Get_Kind (Attr) = Iir_Kind_Transaction_Attribute then Error_Msg_Sem ("'transaction does not allow a parameter", Attr); else Param := Sem_Expression (Parameter, Time_Subtype_Definition); if Param /= Null_Iir then -- LRM93 14.1 -- Parameter: A static expression of type TIME [that evaluate -- to a nonnegative value.] if Get_Expr_Staticness (Param) = None then Error_Msg_Sem ("parameter of signal attribute must be static", Param); end if; Set_Parameter (Attr, Param); end if; end if; end Finish_Sem_Signal_Attribute; function Is_Type_Abstract_Numeric (Atype : Iir) return Boolean is begin case Get_Kind (Atype) is when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Floating_Type_Definition => return True; when others => return False; end case; end Is_Type_Abstract_Numeric; function Are_Types_Closely_Related (Type1, Type2 : Iir) return Boolean is Base_Type1 : constant Iir := Get_Base_Type (Type1); Base_Type2 : constant Iir := Get_Base_Type (Type2); Ant1, Ant2 : Boolean; Index_List1, Index_List2 : Iir_List; El1, El2 : Iir; begin -- LRM 7.3.5 -- In particular, a type is closely related to itself. if Base_Type1 = Base_Type2 then return True; end if; -- LRM 7.3.5 -- a) Abstract Numeric Types: Any abstract numeric type is closely -- related to any other abstract numeric type. Ant1 := Is_Type_Abstract_Numeric (Type1); Ant2 := Is_Type_Abstract_Numeric (Type2); if Ant1 and Ant2 then return True; end if; if Ant1 or Ant2 then return False; end if; -- LRM 7.3.5 -- b) Array Types: Two array types are closely related if and only if -- The types have the same dimensionality; For each index position, -- the index types are either the same or are closely related; and -- The element types are the same. -- -- No other types are closely related. if not (Get_Kind (Base_Type1) = Iir_Kind_Array_Type_Definition and then Get_Kind (Base_Type2) = Iir_Kind_Array_Type_Definition) then return False; end if; Index_List1 := Get_Index_Subtype_List (Base_Type1); Index_List2 := Get_Index_Subtype_List (Base_Type2); if Get_Nbr_Elements (Index_List1) /= Get_Nbr_Elements (Index_List2) then return False; end if; if Get_Base_Type (Get_Element_Subtype (Base_Type1)) /= Get_Base_Type (Get_Element_Subtype (Base_Type2)) then return False; end if; for I in Natural loop El1 := Get_Index_Type (Index_List1, I); exit when El1 = Null_Iir; El2 := Get_Index_Type (Index_List2, I); if not Are_Types_Closely_Related (El1, El2) then return False; end if; end loop; return True; end Are_Types_Closely_Related; function Sem_Type_Conversion (Loc : Iir; Type_Mark : Iir; Actual : Iir) return Iir is Conv_Type : constant Iir := Get_Type (Type_Mark); Conv: Iir_Type_Conversion; Expr: Iir; Staticness : Iir_Staticness; begin Conv := Create_Iir (Iir_Kind_Type_Conversion); Location_Copy (Conv, Loc); Set_Type_Mark (Conv, Type_Mark); Set_Type (Conv, Conv_Type); Set_Expression (Conv, Actual); -- Default staticness in case of error. Set_Expr_Staticness (Conv, None); -- Bail out if no actual (or invalid one). if Actual = Null_Iir then return Conv; end if; -- LRM93 7.3.5 -- Furthermore, the operand of a type conversion is not allowed to be -- the literal null, an allocator, an aggregate, or a string literal. case Get_Kind (Actual) is when Iir_Kind_Null_Literal | Iir_Kind_Aggregate | Iir_Kind_String_Literal8 => Error_Msg_Sem (Disp_Node (Actual) & " cannot be a type conversion operand", Actual); return Conv; when others => -- LRM93 7.3.5 -- The type of the operand of a type conversion must be -- determinable independent of the context (in particular, -- independent of the target type). Expr := Sem_Expression_Universal (Actual); if Expr = Null_Iir then return Conv; end if; if Get_Kind (Expr) in Iir_Kinds_Allocator then Error_Msg_Sem (Disp_Node (Expr) & " cannot be a type conversion operand", Expr); end if; Set_Expression (Conv, Expr); end case; -- LRM93 7.4.1 Locally Static Primaries. -- 9. a type conversion whose expression is a locally static expression. -- LRM93 7.4.2 Globally Static Primaries. -- 14. a type conversion whose expression is a globally static -- expression. if Expr /= Null_Iir then Staticness := Get_Expr_Staticness (Expr); -- If the type mark is not locally static, the expression cannot -- be locally static. This was clarified in VHDL 08, but a type -- mark that denotes an unconstrained array type, does not prevent -- the expression from being static. if Get_Kind (Conv_Type) not in Iir_Kinds_Array_Type_Definition or else Get_Constraint_State (Conv_Type) = Fully_Constrained then Staticness := Min (Staticness, Get_Type_Staticness (Conv_Type)); end if; -- LRM87 7.4 Static Expressions -- A type conversion is not a locally static expression. if Flags.Vhdl_Std = Vhdl_87 then Staticness := Min (Globally, Staticness); end if; Set_Expr_Staticness (Conv, Staticness); if not Are_Types_Closely_Related (Conv_Type, Get_Type (Expr)) then -- FIXME: should explain why the types are not closely related. Error_Msg_Sem ("conversion not allowed between not closely related types", Conv); -- Avoid error storm in evaluation. Set_Expr_Staticness (Conv, None); else Check_Read (Expr); end if; end if; return Conv; end Sem_Type_Conversion; -- OBJ is an 'impure' object (variable, signal or file) referenced at -- location LOC. -- Check the pure rules (LRM08 4 Subprograms and packages, -- LRM08 4.3 Subprograms bodies). procedure Sem_Check_Pure (Loc : Iir; Obj : Iir) is procedure Update_Impure_Depth (Subprg_Spec : Iir; Depth : Iir_Int32) is Bod : Iir; begin Bod := Get_Subprogram_Body (Subprg_Spec); if Bod = Null_Iir then return; end if; if Depth < Get_Impure_Depth (Bod) then Set_Impure_Depth (Bod, Depth); end if; end Update_Impure_Depth; procedure Error_Pure (Subprg : Iir; Obj : Iir) is begin Error_Msg_Sem_Relaxed ("reference to " & Disp_Node (Obj) & " violate pure rule for " & Disp_Node (Subprg), Loc); end Error_Pure; Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram; Subprg_Body : Iir; Parent : Iir; begin -- Apply only in subprograms. if Subprg = Null_Iir then return; end if; case Get_Kind (Subprg) is when Iir_Kinds_Process_Statement => return; when Iir_Kind_Procedure_Declaration => -- Exit now if already known as impure. if Get_Purity_State (Subprg) = Impure then return; end if; when Iir_Kind_Function_Declaration => -- Exit now if impure. if Get_Pure_Flag (Subprg) = False then return; end if; when others => Error_Kind ("sem_check_pure", Subprg); end case; -- Not all objects are impure. case Get_Kind (Obj) is when Iir_Kind_Object_Alias_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_File_Declaration => null; when Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration => -- When referenced as a formal name (FIXME: this is an -- approximation), the rules don't apply. if not Get_Is_Within_Flag (Get_Parent (Obj)) then return; end if; when Iir_Kind_File_Declaration => -- LRM 93 2.2 -- If a pure function is the parent of a given procedure, then -- that procedure must not contain a reference to an explicitly -- declared file object [...] -- -- A pure function must not contain a reference to an explicitly -- declared file. if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then Error_Pure (Subprg, Obj); else Set_Purity_State (Subprg, Impure); Set_Impure_Depth (Get_Subprogram_Body (Subprg), Iir_Depth_Impure); end if; return; when others => return; end case; -- OBJ is declared in the immediate declarative part of the subprogram. Parent := Get_Parent (Obj); Subprg_Body := Get_Subprogram_Body (Subprg); if Parent = Subprg or else Parent = Subprg_Body then return; end if; -- Function. if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then Error_Pure (Subprg, Obj); return; end if; case Get_Kind (Parent) is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Package_Declaration | Iir_Kind_Package_Body | Iir_Kind_Block_Statement | Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement | Iir_Kinds_Process_Statement | Iir_Kind_Protected_Type_Body => -- The procedure is impure. Set_Purity_State (Subprg, Impure); Set_Impure_Depth (Subprg_Body, Iir_Depth_Impure); return; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => Update_Impure_Depth (Subprg, Get_Subprogram_Depth (Get_Subprogram_Specification (Parent))); when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => Update_Impure_Depth (Subprg, Get_Subprogram_Depth (Parent)); when others => Error_Kind ("sem_check_pure(2)", Parent); end case; end Sem_Check_Pure; -- Set All_Sensitized_State to False iff OBJ is a signal declaration -- and the current subprogram is in a package body. procedure Sem_Check_All_Sensitized (Obj : Iir) is Subprg : Iir; begin -- We cares only of signals. if Get_Kind (Obj) /= Iir_Kind_Signal_Declaration then return; end if; -- We cares only of subprograms. Give up if we are in a process. Subprg := Sem_Stmts.Get_Current_Subprogram; if Subprg = Null_Iir or else Get_Kind (Subprg) not in Iir_Kinds_Subprogram_Declaration then return; end if; if Get_Kind (Get_Library_Unit (Sem.Get_Current_Design_Unit)) = Iir_Kind_Package_Body then Set_All_Sensitized_State (Subprg, Invalid_Signal); else Set_All_Sensitized_State (Subprg, Read_Signal); end if; end Sem_Check_All_Sensitized; function Finish_Sem_Denoting_Name (Name : Iir; Res : Iir) return Iir is Prefix : Iir; begin case Iir_Kinds_Denoting_Name (Get_Kind (Name)) is when Iir_Kind_Simple_Name | Iir_Kind_Character_Literal | Iir_Kind_Operator_Symbol => Xref_Ref (Name, Res); return Name; when Iir_Kind_Selected_Name => Xref_Ref (Name, Res); Prefix := Get_Prefix (Name); loop pragma Assert (Get_Kind (Prefix) in Iir_Kinds_Denoting_Name); Xref_Ref (Prefix, Get_Named_Entity (Prefix)); exit when Get_Kind (Prefix) /= Iir_Kind_Selected_Name; Prefix := Get_Prefix (Prefix); end loop; return Name; end case; end Finish_Sem_Denoting_Name; -- Free overload list of NAME but keep RES interpretation. procedure Free_Old_Entity_Name (Name : Iir; Res : Iir) is Old_Res : constant Iir := Get_Named_Entity (Name); begin if Old_Res /= Null_Iir and then Old_Res /= Res then pragma Assert (Is_Overload_List (Old_Res)); Sem_Name_Free_Result (Old_Res, Res); end if; Set_Named_Entity (Name, Res); end Free_Old_Entity_Name; function Finish_Sem_Name_1 (Name : Iir; Res : Iir) return Iir is Prefix : Iir; Name_Prefix : Iir; Name_Res : Iir; begin case Get_Kind (Res) is when Iir_Kinds_Library_Unit_Declaration => return Finish_Sem_Denoting_Name (Name, Res); when Iir_Kinds_Sequential_Statement | Iir_Kinds_Concurrent_Statement => -- Label or part of an expanded name (for process, block -- and generate). return Finish_Sem_Denoting_Name (Name, Res); when Iir_Kinds_Object_Declaration | Iir_Kinds_Quantity_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration => Name_Res := Finish_Sem_Denoting_Name (Name, Res); Set_Base_Name (Name_Res, Res); Set_Name_Staticness (Name_Res, Get_Name_Staticness (Res)); Set_Expr_Staticness (Name_Res, Get_Expr_Staticness (Res)); Sem_Check_Pure (Name_Res, Res); Sem_Check_All_Sensitized (Res); Set_Type (Name_Res, Get_Type (Res)); return Name_Res; when Iir_Kind_Attribute_Value => pragma Assert (Get_Kind (Name) = Iir_Kind_Attribute_Name); Prefix := Finish_Sem_Name (Get_Prefix (Name)); Set_Prefix (Name, Prefix); Set_Base_Name (Name, Res); Set_Type (Name, Get_Type (Res)); Set_Name_Staticness (Name, Get_Name_Staticness (Res)); Set_Expr_Staticness (Name, Get_Expr_Staticness (Res)); return Name; when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Component_Declaration | Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Non_Object_Alias_Declaration | Iir_Kind_Library_Declaration | Iir_Kind_Interface_Package_Declaration => Name_Res := Finish_Sem_Denoting_Name (Name, Res); Set_Base_Name (Name_Res, Res); return Name_Res; when Iir_Kind_Function_Declaration => Name_Res := Finish_Sem_Denoting_Name (Name, Res); Set_Type (Name_Res, Get_Return_Type (Res)); return Name_Res; when Iir_Kind_Procedure_Declaration => return Finish_Sem_Denoting_Name (Name, Res); when Iir_Kind_Type_Conversion => pragma Assert (Get_Kind (Name) = Iir_Kind_Parenthesis_Name); Set_Type_Mark (Res, Sem_Type_Mark (Get_Prefix (Name))); Free_Parenthesis_Name (Name, Res); return Res; when Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element | Iir_Kind_Slice_Name | Iir_Kind_Dereference => -- Fall through. null; when Iir_Kind_Implicit_Dereference => -- The name may not have a prefix. Prefix := Finish_Sem_Name_1 (Name, Get_Prefix (Res)); Set_Prefix (Res, Prefix); Finish_Sem_Dereference (Res); return Res; when Iir_Kind_Function_Call => case Get_Kind (Name) is when Iir_Kind_Parenthesis_Name => -- Usual case. Prefix := Finish_Sem_Name (Get_Prefix (Name), Get_Implementation (Res)); Finish_Sem_Function_Call (Res, Prefix); Free_Iir (Name); when Iir_Kinds_Denoting_Name => -- Call without association list. Prefix := Finish_Sem_Name (Name, Get_Implementation (Res)); Finish_Sem_Function_Call (Res, Prefix); when others => Error_Kind ("Finish_Sem_Name(function call)", Name); end case; return Res; when Iir_Kinds_Array_Attribute => if Get_Parameter (Res) = Null_Iir then Finish_Sem_Array_Attribute (Name, Res, Null_Iir); end if; if Get_Kind (Name) = Iir_Kind_Attribute_Name then Free_Iir (Name); else Free_Iir (Get_Prefix (Name)); Free_Parenthesis_Name (Name, Res); end if; return Res; when Iir_Kinds_Scalar_Type_Attribute | Iir_Kind_Image_Attribute | Iir_Kind_Value_Attribute => if Get_Parameter (Res) = Null_Iir then Finish_Sem_Scalar_Type_Attribute (Name, Res, Null_Iir); else Free_Parenthesis_Name (Name, Res); end if; return Res; when Iir_Kinds_Signal_Value_Attribute => null; when Iir_Kinds_Signal_Attribute => if Get_Parameter (Res) = Null_Iir then Finish_Sem_Signal_Attribute (Name, Res, Null_Iir); else Free_Parenthesis_Name (Name, Res); end if; return Res; when Iir_Kinds_Type_Attribute => Free_Iir (Name); return Res; when Iir_Kind_Base_Attribute => return Res; when Iir_Kind_Simple_Name_Attribute | Iir_Kind_Path_Name_Attribute | Iir_Kind_Instance_Name_Attribute => Free_Iir (Name); return Res; when Iir_Kind_Psl_Expression => return Res; when Iir_Kind_Psl_Declaration => return Name; when Iir_Kind_Element_Declaration | Iir_Kind_Error => -- Certainly an error! return Res; when others => Error_Kind ("finish_sem_name", Res); end case; -- Finish prefix. Prefix := Get_Prefix (Res); Name_Prefix := Get_Prefix (Name); Prefix := Finish_Sem_Name_1 (Name_Prefix, Prefix); Set_Prefix (Res, Prefix); case Get_Kind (Res) is when Iir_Kind_Indexed_Name => Finish_Sem_Indexed_Name (Res); Free_Parenthesis_Name (Name, Res); when Iir_Kind_Slice_Name => Finish_Sem_Slice_Name (Res); Free_Parenthesis_Name (Name, Res); when Iir_Kind_Selected_Element => pragma Assert (Get_Kind (Name) = Iir_Kind_Selected_Name); Xref_Ref (Res, Get_Selected_Element (Res)); Set_Name_Staticness (Res, Get_Name_Staticness (Prefix)); Set_Expr_Staticness (Res, Get_Expr_Staticness (Prefix)); Set_Base_Name (Res, Get_Base_Name (Prefix)); Free_Iir (Name); when Iir_Kind_Dereference => pragma Assert (Get_Kind (Name) = Iir_Kind_Selected_By_All_Name); Finish_Sem_Dereference (Res); Free_Iir (Name); when Iir_Kinds_Signal_Value_Attribute => Sem_Name_Free_Result (Name, Res); when others => Error_Kind ("finish_sem_name(2)", Res); end case; return Res; end Finish_Sem_Name_1; function Finish_Sem_Name (Name : Iir; Res : Iir) return Iir is begin if Get_Kind (Res) /= Iir_Kind_Implicit_Dereference then -- There is no corresponding name for implicit_dereference (because -- it is implicit). -- Free overload list (but keep RES interpretation) for other cases. Free_Old_Entity_Name (Name, Res); end if; return Finish_Sem_Name_1 (Name, Res); end Finish_Sem_Name; function Finish_Sem_Name (Name : Iir) return Iir is begin return Finish_Sem_Name_1 (Name, Get_Named_Entity (Name)); end Finish_Sem_Name; -- LRM93 6.2 -- The evaluation of a simple name has no other effect than to determine -- the named entity denoted by the name. -- -- NAME may be a simple name, a strig literal or a character literal. -- GHDL: set interpretation of NAME (possibly an overload list) or -- error_mark for unknown names. -- If SOFT is TRUE, then no error message is reported in case of failure. procedure Sem_Simple_Name (Name : Iir; Keep_Alias : Boolean; Soft : Boolean) is Id : constant Name_Id := Get_Identifier (Name); Interpretation: Name_Interpretation_Type; Res: Iir; Res_List : Iir_List; N : Natural; begin Interpretation := Get_Interpretation (Id); if not Valid_Interpretation (Interpretation) then -- Unknown name. if not Soft then Error_Msg_Sem ("no declaration for """ & Image_Identifier (Name) & """", Name); end if; Res := Error_Mark; elsif not Valid_Interpretation (Get_Next_Interpretation (Interpretation)) then -- One simple interpretation. Res := Get_Declaration (Interpretation); -- For a design unit, return the library unit if Get_Kind (Res) = Iir_Kind_Design_Unit then -- FIXME: should replace interpretation ? Libraries.Load_Design_Unit (Res, Name); Sem.Add_Dependence (Res); Res := Get_Library_Unit (Res); end if; -- Check visibility. if not Get_Visible_Flag (Res) then if Flag_Relaxed_Rules and then Get_Kind (Res) in Iir_Kinds_Object_Declaration and then Valid_Interpretation (Get_Under_Interpretation (Id)) then Res := Get_Declaration (Get_Under_Interpretation (Id)); else if not Soft then Error_Msg_Sem (Disp_Node (Res) & " is not visible here", Name); end if; -- Even if a named entity was found, return an error_mark. -- Indeed, the named entity found is certainly the one being -- semantized, and the semantization may be uncomplete. Res := Error_Mark; end if; end if; if not Keep_Alias and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then Set_Alias_Declaration (Name, Res); Res := Get_Named_Entity (Get_Name (Res)); end if; else -- Name is overloaded. Res_List := Create_Iir_List; N := 0; -- The SEEN_FLAG is used to get only one meaning which can be reached -- through several pathes (such as aliases). while Valid_Interpretation (Interpretation) loop if Keep_Alias then Res := Get_Declaration (Interpretation); else Res := Get_Non_Alias_Declaration (Interpretation); end if; if not Get_Seen_Flag (Res) then Set_Seen_Flag (Res, True); N := N + 1; Append_Element (Res_List, Res); end if; Interpretation := Get_Next_Interpretation (Interpretation); end loop; -- FIXME: there can be only one element (a function and its alias!). -- Clear SEEN_FLAG. for I in 0 .. N - 1 loop Res := Get_Nth_Element (Res_List, I); Set_Seen_Flag (Res, False); end loop; Res := Create_Overload_List (Res_List); end if; Set_Base_Name (Name, Res); Set_Named_Entity (Name, Res); end Sem_Simple_Name; -- LRM93 §6.3 -- Selected Names. procedure Sem_Selected_Name (Name: Iir; Keep_Alias : Boolean := False) is Suffix : constant Name_Id := Get_Identifier (Name); Prefix_Name : constant Iir := Get_Prefix (Name); Prefix_Loc : constant Location_Type := Get_Location (Prefix_Name); Prefix: Iir; Res : Iir; -- Semantize SUB_NAME.NAME as an expanded name (ie, NAME is declared -- within SUB_NAME). This is possible only if the expanded name is -- analyzed within the context of SUB_NAME. procedure Sem_As_Expanded_Name (Sub_Name : Iir) is Sub_Res : Iir; begin if Get_Is_Within_Flag (Sub_Name) then Sub_Res := Find_Declarations_In_List (Sub_Name, Name, Keep_Alias); if Sub_Res /= Null_Iir then Add_Result (Res, Sub_Res); end if; end if; end Sem_As_Expanded_Name; -- LRM93 §6.3 -- For a selected name that is used to denote a record element, -- the suffix must be a simple name denoting an element of a -- record object or value. The prefix must be appropriate for the -- type of this object or value. -- -- Semantize SUB_NAME.NAME as a selected element. procedure Sem_As_Selected_Element (Sub_Name : Iir) is Base_Type : Iir; Ptr_Type : Iir; Rec_El : Iir; R : Iir; Se : Iir; begin -- FIXME: if not is_expr (sub_name) return. Base_Type := Get_Base_Type (Get_Type (Sub_Name)); if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then Ptr_Type := Base_Type; Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type)); else Ptr_Type := Null_Iir; end if; if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then return; end if; Rec_El := Find_Name_In_List (Get_Elements_Declaration_List (Base_Type), Suffix); if Rec_El = Null_Iir then return; end if; if not Maybe_Function_Call (Sub_Name) then return; end if; R := Maybe_Insert_Function_Call (Prefix_Name, Sub_Name); R := Maybe_Insert_Dereference (R, Ptr_Type); Se := Create_Iir (Iir_Kind_Selected_Element); Location_Copy (Se, Name); Set_Prefix (Se, R); Set_Type (Se, Get_Type (Rec_El)); Set_Selected_Element (Se, Rec_El); Set_Base_Name (Se, Get_Object_Prefix (R, False)); Add_Result (Res, Se); end Sem_As_Selected_Element; procedure Error_Selected_Element (Prefix_Type : Iir) is Base_Type : Iir; begin Base_Type := Get_Base_Type (Prefix_Type); if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type)); end if; if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then Error_Msg_Sem (Disp_Node (Prefix) & " does not designate a record", Name); else Error_Msg_Sem ("no element """ & Name_Table.Image (Suffix) & """ in " & Disp_Node (Base_Type), Name); end if; end Error_Selected_Element; procedure Sem_As_Protected_Item (Sub_Name : Iir) is Prot_Type : constant Iir := Get_Type (Sub_Name); Method : Iir; begin -- LRM98 12.3 Visibility -- s) For a subprogram declared immediately within a given protected -- type declaration: at the place of the suffix in a selected -- name whose prefix denotes an object of the protected type. Method := Get_Declaration_Chain (Prot_Type); while Method /= Null_Iir loop case Get_Kind (Method) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => if Get_Identifier (Method) = Suffix then Add_Result (Res, Method); end if; when Iir_Kind_Attribute_Specification | Iir_Kind_Use_Clause => null; when others => Error_Kind ("sem_as_protected_item", Method); end case; Method := Get_Chain (Method); end loop; end Sem_As_Protected_Item; procedure Error_Protected_Item (Prot_Type : Iir) is begin Error_Msg_Sem ("no method " & Name_Table.Image (Suffix) & " in " & Disp_Node (Prot_Type), Name); end Error_Protected_Item; begin -- Analyze prefix. Sem_Name (Prefix_Name); Prefix := Get_Named_Entity (Prefix_Name); if Prefix = Error_Mark then Set_Named_Entity (Name, Prefix); return; end if; Res := Null_Iir; case Get_Kind (Prefix) is when Iir_Kind_Overload_List => -- LRM93 6.3 -- If, according to the visibility rules, there is at -- least one possible interpretation of the prefix of a -- selected name as the name of an enclosing entity -- interface, architecture, subprogram, block statement, -- process statement, generate statement, or loop -- statement, then the only interpretations considered are -- those of the immediately preceding paragraph. -- -- In this case, the selected name is always interpreted -- as an expanded name. In particular, no interpretations -- of the prefix as a function call are considered. declare Prefix_List : Iir_List; El : Iir; begin -- So, first try as expanded name. Prefix_List := Get_Overload_List (Prefix); for I in Natural loop El := Get_Nth_Element (Prefix_List, I); exit when El = Null_Iir; case Get_Kind (El) is when Iir_Kind_Function_Call => -- Not an expanded name. null; when others => Sem_As_Expanded_Name (El); end case; end loop; -- If no expanded name are found, try as selected element. if Res = Null_Iir then for I in Natural loop El := Get_Nth_Element (Prefix_List, I); exit when El = Null_Iir; Sem_As_Selected_Element (El); end loop; end if; end; if Res = Null_Iir then Error_Msg_Sem ("no suffix """ & Name_Table.Image (Suffix) & """ for overloaded selected name", Name); end if; when Iir_Kind_Library_Declaration => -- LRM93 6.3 -- An expanded name denotes a primary unit constained in a design -- library if the prefix denotes the library and the suffix is the -- simple name if a primary unit whose declaration is contained -- in that library. -- An expanded name is not allowed for a secondary unit, -- particularly for an architecture body. -- GHDL: FIXME: error message more explicit Res := Libraries.Load_Primary_Unit (Prefix, Suffix, Name); if Res = Null_Iir then Error_Msg_Sem ("primary unit """ & Name_Table.Image (Suffix) & """ not found in " & Disp_Node (Prefix), Name); else Sem.Add_Dependence (Res); Res := Get_Library_Unit (Res); end if; when Iir_Kind_Process_Statement | Iir_Kind_Procedure_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Architecture_Body | Iir_Kind_Entity_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement | Iir_Kind_Block_Statement | Iir_Kind_For_Loop_Statement => -- LRM93 §6.3 -- An expanded name denotes a named entity declared immediatly -- within a named construct if the prefix that is an entity -- interface, an architecture, a subprogram, a block statement, -- a process statement, a generate statement, or a loop -- statement, and the suffix is the simple name, character -- literal, or operator symbol of an named entity whose -- declaration occurs immediatly within that construct. if Get_Kind (Prefix) = Iir_Kind_Design_Unit then Libraries.Load_Design_Unit (Prefix, Name); Sem.Add_Dependence (Prefix); Prefix := Get_Library_Unit (Prefix); -- Modified only for xrefs, since a design_unit points to -- the first context clause, while a library unit points to -- the identifier. Set_Named_Entity (Get_Prefix (Name), Prefix); end if; Res := Find_Declarations_In_List (Prefix, Name, Keep_Alias); if Res = Null_Iir then Error_Msg_Sem ("no declaration for """ & Name_Table.Image (Suffix) & """ in " & Disp_Node (Prefix), Name); else -- LRM93 §6.3 -- This form of expanded name is only allowed within the -- construct itself. if not Kind_In (Prefix, Iir_Kind_Package_Declaration, Iir_Kind_Package_Instantiation_Declaration) and then not Get_Is_Within_Flag (Prefix) then Error_Msg_Sem ("this expanded name is only allowed within the construct", Prefix_Loc); -- Hum, keep res. end if; end if; when Iir_Kind_Function_Declaration => Sem_As_Expanded_Name (Prefix); if Res = Null_Iir then Sem_As_Selected_Element (Prefix); end if; if Res = Null_Iir then Error_Selected_Element (Get_Return_Type (Prefix)); end if; when Iir_Kinds_Object_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element | Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference | Iir_Kind_Attribute_Value | Iir_Kind_Function_Call => if Get_Kind (Get_Type (Prefix)) = Iir_Kind_Protected_Type_Declaration then Sem_As_Protected_Item (Prefix); if Res = Null_Iir then Error_Protected_Item (Prefix); end if; else Sem_As_Selected_Element (Prefix); if Res = Null_Iir then Error_Selected_Element (Get_Type (Prefix)); end if; end if; when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Slice_Name => Error_Msg_Sem (Disp_Node (Prefix) & " cannot be selected by name", Prefix_Loc); when others => Error_Kind ("sem_selected_name(2)", Prefix); end case; if Res = Null_Iir then Res := Error_Mark; end if; Set_Named_Entity (Name, Res); end Sem_Selected_Name; -- If ASSOC_LIST has one element, which is an expression without formal, -- return the actual, else return NULL_IIR. function Get_One_Actual (Assoc_Chain : Iir) return Iir is Assoc : Iir; begin -- Only one actual ? if Assoc_Chain = Null_Iir or else Get_Chain (Assoc_Chain) /= Null_Iir then return Null_Iir; end if; -- Not 'open' association element ? Assoc := Assoc_Chain; if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then return Null_Iir; end if; -- Not an association (ie no formal) ? if Get_Formal (Assoc) /= Null_Iir then return Null_Iir; end if; return Get_Actual (Assoc); end Get_One_Actual; function Slice_Or_Index (Actual : Iir) return Iir_Kind is begin -- But it may be a slice name. case Get_Kind (Actual) is when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Subtype_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Range_Expression => return Iir_Kind_Slice_Name; when others => if Is_Range_Attribute_Name (Actual) then return Iir_Kind_Slice_Name; end if; end case; -- By default, this is an indexed name. return Iir_Kind_Indexed_Name; end Slice_Or_Index; -- Check whether association chain ASSOCS may be interpreted as indexes. function Index_Or_Not (Assocs : Iir) return Iir_Kind is El : Iir; begin El := Assocs; while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Association_Element_By_Expression => if Get_Formal (El) /= Null_Iir then return Iir_Kind_Error; end if; when others => -- Only expression are allowed. return Iir_Kind_Error; end case; El := Get_Chain (El); end loop; return Iir_Kind_Indexed_Name; end Index_Or_Not; function Sem_Index_Specification (Name : Iir_Parenthesis_Name; Itype : Iir) return Iir is Actual : Iir; Kind : Iir_Kind; Res : Iir; begin -- FIXME: reuse Sem_Name for the whole analysis ? Actual := Get_One_Actual (Get_Association_Chain (Name)); if Actual = Null_Iir then Error_Msg_Sem ("only one index specification is allowed", Name); return Null_Iir; end if; case Get_Kind (Actual) is when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => Sem_Name (Actual); Kind := Slice_Or_Index (Get_Named_Entity (Actual)); -- FIXME: semantization to be finished. --Maybe_Finish_Sem_Name (Actual); when others => Kind := Slice_Or_Index (Actual); end case; Res := Create_Iir (Kind); Location_Copy (Res, Name); case Kind is when Iir_Kind_Indexed_Name => Actual := Sem_Expression (Actual, Itype); if Actual = Null_Iir then return Null_Iir; end if; Check_Read (Actual); if Get_Expr_Staticness (Actual) < Globally then Error_Msg_Sem ("index must be a static expression", Name); end if; Set_Index_List (Res, Create_Iir_List); Append_Element (Get_Index_List (Res), Actual); when Iir_Kind_Slice_Name => Actual := Sem_Discrete_Range_Expression (Actual, Itype, False); if Actual = Null_Iir then return Null_Iir; end if; if Get_Expr_Staticness (Actual) < Globally then Error_Msg_Sem ("index must be a static expression", Name); end if; Set_Suffix (Res, Actual); when others => raise Internal_Error; end case; Free_Parenthesis_Name (Name, Res); return Res; end Sem_Index_Specification; procedure Sem_Parenthesis_Name (Name : Iir_Parenthesis_Name) is Prefix: Iir; Prefix_Name : Iir; Res : Iir; Assoc_Chain : Iir; Slice_Index_Kind : Iir_Kind; -- If FINISH is TRUE, then display error message in case of error. function Sem_As_Indexed_Or_Slice_Name (Sub_Name : Iir; Finish : Boolean) return Iir is Base_Type : Iir; Ptr_Type : Iir; P : Iir; R : Iir; begin if Slice_Index_Kind = Iir_Kind_Error then if Finish then Error_Msg_Sem ("prefix is not a function name", Name); end if; -- No way. return Null_Iir; end if; -- Only values can be indexed or sliced. -- Catch errors such as slice of a type conversion. if Name_To_Value (Sub_Name) = Null_Iir and then Get_Kind (Sub_Name) /= Iir_Kind_Function_Declaration then if Finish then Error_Msg_Sem ("prefix is not an array value (found " & Disp_Node (Sub_Name) & ")", Name); end if; return Null_Iir; end if; -- Extract type of prefix, handle possible implicit deference. Base_Type := Get_Base_Type (Get_Type (Sub_Name)); if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then Ptr_Type := Base_Type; Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type)); else Ptr_Type := Null_Iir; end if; if Get_Kind (Base_Type) /= Iir_Kind_Array_Type_Definition then if Finish then Error_Msg_Sem ("type of prefix is not an array", Name); end if; return Null_Iir; end if; if Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) /= Get_Chain_Length (Assoc_Chain) then if Finish then Error_Msg_Sem ("number of indexes mismatches array dimension", Name); end if; return Null_Iir; end if; -- For indexed names, discard type incompatibilities between indexes -- and array type indexes. -- The FINISH = True case will be handled by Finish_Sem_Indexed_Name. if Slice_Index_Kind = Iir_Kind_Indexed_Name and then not Finish then declare Type_Index_List : constant Iir_List := Get_Index_Subtype_List (Base_Type); Type_Index : Iir; Assoc : Iir; begin Assoc := Assoc_Chain; for I in Natural loop -- Assoc and Type_Index_List have the same length as this -- was checked just above. exit when Assoc = Null_Iir; if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then return Null_Iir; end if; Type_Index := Get_Index_Type (Type_Index_List, I); if Is_Expr_Compatible (Type_Index, Get_Actual (Assoc)) = Not_Compatible then return Null_Iir; end if; Assoc := Get_Chain (Assoc); end loop; end; end if; if not Maybe_Function_Call (Sub_Name) then if Finish then Error_Msg_Sem ("missing parameters for function call", Name); end if; return Null_Iir; end if; P := Maybe_Insert_Function_Call (Prefix_Name, Sub_Name); P := Maybe_Insert_Dereference (P, Ptr_Type); R := Create_Iir (Slice_Index_Kind); Location_Copy (R, Name); Set_Prefix (R, P); Set_Base_Name (R, Get_Object_Prefix (P)); case Slice_Index_Kind is when Iir_Kind_Slice_Name => Set_Suffix (R, Get_Actual (Assoc_Chain)); Set_Type (R, Get_Base_Type (Get_Type (P))); when Iir_Kind_Indexed_Name => declare Idx_El : Iir; Idx_List : Iir_List; begin Idx_List := Create_Iir_List; Set_Index_List (R, Idx_List); Idx_El := Assoc_Chain; while Idx_El /= Null_Iir loop Append_Element (Idx_List, Get_Actual (Idx_El)); Idx_El := Get_Chain (Idx_El); end loop; end; Set_Type (R, Get_Element_Subtype (Base_Type)); when others => raise Internal_Error; end case; return R; end Sem_As_Indexed_Or_Slice_Name; -- Sem parenthesis name when the prefix is a function declaration. -- Can be either a function call (and the expression is the actual) or -- a slice/index of the result of a call without actual. procedure Sem_Parenthesis_Function (Sub_Name : Iir) is Used : Boolean; R : Iir; Match : Compatibility_Level; Call : Iir; begin Used := False; if Get_Kind (Sub_Name) = Iir_Kind_Function_Declaration then Sem_Association_Chain (Get_Interface_Declaration_Chain (Sub_Name), Assoc_Chain, False, Missing_Parameter, Name, Match); if Match /= Not_Compatible then Call := Sem_As_Function_Call (Prefix_Name, Sub_Name, Assoc_Chain); Add_Result (Res, Call); Used := True; end if; end if; if Get_Kind (Sub_Name) /= Iir_Kind_Procedure_Declaration then R := Sem_As_Indexed_Or_Slice_Name (Sub_Name, False); if R /= Null_Iir then Add_Result (Res, R); Used := True; end if; end if; if not Used then Sem_Name_Free_Result (Sub_Name, Null_Iir); end if; end Sem_Parenthesis_Function; procedure Error_Parenthesis_Function (Spec : Iir) is Match : Compatibility_Level; begin Error_Msg_Sem ("cannot match " & Disp_Node (Prefix) & " with actuals", Name); -- Display error message. Sem_Association_Chain (Get_Interface_Declaration_Chain (Spec), Assoc_Chain, True, Missing_Parameter, Name, Match); end Error_Parenthesis_Function; Actual : Iir; Actual_Expr : Iir; begin -- The prefix is a function name, a type mark or an array. Prefix_Name := Get_Prefix (Name); Sem_Name (Prefix_Name); Prefix := Get_Named_Entity (Prefix_Name); if Prefix = Error_Mark then Set_Named_Entity (Name, Error_Mark); return; end if; Res := Null_Iir; Assoc_Chain := Get_Association_Chain (Name); Actual := Get_One_Actual (Assoc_Chain); if Get_Kind (Prefix) = Iir_Kind_Type_Declaration or else Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration then -- A type conversion. The prefix is a type mark. if Actual = Null_Iir then -- More than one actual. Keep only the first. Error_Msg_Sem ("type conversion allows only one expression", Name); end if; -- This is certainly the easiest case: the prefix is not overloaded, -- so the result can be computed. Set_Named_Entity (Name, Sem_Type_Conversion (Name, Prefix, Actual)); return; end if; -- Select between slice or indexed name. Actual_Expr := Null_Iir; if Actual /= Null_Iir then if Get_Kind (Actual) in Iir_Kinds_Name or else Get_Kind (Actual) = Iir_Kind_Attribute_Name then -- Maybe a discrete range name. Sem_Name (Actual); Actual_Expr := Get_Named_Entity (Actual); if Actual_Expr = Error_Mark then Set_Named_Entity (Name, Actual_Expr); return; end if; -- Decides between sliced or indexed name to actual. Slice_Index_Kind := Slice_Or_Index (Actual_Expr); elsif Get_Kind (Actual) = Iir_Kind_Range_Expression then -- This can only be a slice. Slice_Index_Kind := Iir_Kind_Slice_Name; -- Actual_Expr := -- Sem_Discrete_Range_Expression (Actual, Null_Iir, False); -- Set_Actual (Assoc_Chain, Actual_Expr); else Slice_Index_Kind := Iir_Kind_Indexed_Name; end if; else -- FIXME: improve error message for multi-dim slice ? Slice_Index_Kind := Index_Or_Not (Assoc_Chain); end if; if Slice_Index_Kind /= Iir_Kind_Slice_Name then if Sem_Actual_Of_Association_Chain (Assoc_Chain) = False then Actual := Null_Iir; else Actual := Get_One_Actual (Assoc_Chain); end if; end if; case Get_Kind (Prefix) is when Iir_Kind_Overload_List => declare El : Iir; Prefix_List : Iir_List; begin Prefix_List := Get_Overload_List (Prefix); for I in Natural loop El := Get_Nth_Element (Prefix_List, I); exit when El = Null_Iir; Sem_Parenthesis_Function (El); end loop; end; if Res = Null_Iir then Error_Msg_Sem ("no overloaded function found matching " & Disp_Node (Prefix_Name), Name); end if; when Iir_Kind_Function_Declaration => Sem_Parenthesis_Function (Prefix); if Res = Null_Iir then Error_Parenthesis_Function (Prefix); end if; when Iir_Kinds_Object_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference | Iir_Kind_Selected_Element | Iir_Kind_Attribute_Value | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Function_Call => Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True)); when Iir_Kinds_Array_Attribute => if Actual /= Null_Iir then Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Actual); Set_Named_Entity (Name, Prefix); else Error_Msg_Sem ("bad attribute parameter", Name); Set_Named_Entity (Name, Error_Mark); end if; return; when Iir_Kinds_Scalar_Type_Attribute | Iir_Kind_Image_Attribute | Iir_Kind_Value_Attribute => if Get_Parameter (Prefix) /= Null_Iir then -- Attribute already has a parameter, the expression -- is either a slice or an index. Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True)); elsif Actual /= Null_Iir then Finish_Sem_Scalar_Type_Attribute (Prefix_Name, Prefix, Actual); Set_Named_Entity (Name, Prefix); return; else Error_Msg_Sem ("bad attribute parameter", Name); Set_Named_Entity (Name, Error_Mark); return; end if; when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration => Error_Msg_Sem ("subprogram name is a type mark (missing apostrophe)", Name); when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Delayed_Attribute => if Actual /= Null_Iir then Finish_Sem_Signal_Attribute (Prefix_Name, Prefix, Actual); Set_Named_Entity (Name, Prefix); else Error_Msg_Sem ("bad attribute parameter", Name); Set_Named_Entity (Name, Error_Mark); end if; return; when Iir_Kind_Procedure_Declaration => Error_Msg_Sem ("function name is a procedure", Name); when Iir_Kinds_Process_Statement | Iir_Kind_Component_Declaration | Iir_Kind_Type_Conversion => Error_Msg_Sem (Disp_Node (Prefix) & " cannot be indexed or sliced", Name); Res := Null_Iir; when Iir_Kind_Psl_Declaration => Res := Sem_Psl.Sem_Psl_Name (Name); when Iir_Kinds_Library_Unit_Declaration => Error_Msg_Sem ("function name is a design unit", Name); when Iir_Kind_Error => -- Continue with the error. Res := Prefix; when others => Error_Kind ("sem_parenthesis_name", Prefix); end case; if Res = Null_Iir then Res := Error_Mark; end if; Set_Named_Entity (Name, Res); end Sem_Parenthesis_Name; procedure Sem_Selected_By_All_Name (Name : Iir_Selected_By_All_Name) is Prefix : Iir; Prefix_Name : Iir; Res : Iir; procedure Sem_As_Selected_By_All_Name (Sub_Name : Iir) is Base_Type : Iir; R, R1 : Iir; begin -- Only accept prefix of access type. Base_Type := Get_Base_Type (Get_Type (Sub_Name)); if Get_Kind (Base_Type) /= Iir_Kind_Access_Type_Definition then return; end if; if not Maybe_Function_Call (Sub_Name) then return; end if; R1 := Maybe_Insert_Function_Call (Get_Prefix (Name), Sub_Name); R := Create_Iir (Iir_Kind_Dereference); Location_Copy (R, Name); Set_Prefix (R, R1); -- FIXME: access subtype. Set_Type (R, Get_Designated_Type (Base_Type)); Add_Result (Res, R); end Sem_As_Selected_By_All_Name; begin Prefix := Get_Prefix (Name); Sem_Name (Prefix); Prefix_Name := Prefix; Prefix := Get_Named_Entity (Prefix); if Prefix = Null_Iir then return; end if; Res := Null_Iir; case Get_Kind (Prefix) is when Iir_Kind_Overload_List => declare Prefix_List : Iir_List; El : Iir; begin Prefix_List := Get_Overload_List (Prefix); for I in Natural loop El := Get_Nth_Element (Prefix_List, I); exit when El = Null_Iir; Sem_As_Selected_By_All_Name (El); end loop; end; when Iir_Kinds_Object_Declaration | Iir_Kind_Selected_Element | Iir_Kind_Dereference | Iir_Kind_Indexed_Name | Iir_Kind_Function_Call => Sem_As_Selected_By_All_Name (Prefix); when Iir_Kind_Function_Declaration => Prefix := Sem_As_Function_Call (Name => Prefix_Name, Spec => Prefix, Assoc_Chain => Null_Iir); Sem_As_Selected_By_All_Name (Prefix); when Iir_Kind_Error => Set_Named_Entity (Name, Error_Mark); return; when others => Error_Kind ("sem_selected_by_all_name", Prefix); end case; if Res = Null_Iir then Error_Msg_Sem ("prefix type is not an access type", Name); Res := Error_Mark; end if; Set_Named_Entity (Name, Res); end Sem_Selected_By_All_Name; function Sem_Base_Attribute (Attr : Iir_Attribute_Name) return Iir is Prefix_Name : Iir; Prefix : Iir; Res : Iir; Base_Type : Iir; Type_Decl : Iir; begin Prefix_Name := Finish_Sem_Name (Get_Prefix (Attr)); -- FIXME: handle error Prefix := Get_Named_Entity (Prefix_Name); case Get_Kind (Prefix) is when Iir_Kind_Type_Declaration => Base_Type := Get_Type_Definition (Prefix); when Iir_Kind_Subtype_Declaration => Base_Type := Get_Base_Type (Get_Type (Prefix)); -- Get the first subtype. FIXME: ref? Type_Decl := Get_Type_Declarator (Base_Type); if Get_Kind (Type_Decl) = Iir_Kind_Anonymous_Type_Declaration then Base_Type := Get_Subtype_Definition (Type_Decl); end if; when others => Error_Msg_Sem ("prefix of 'base attribute must be a type or a subtype", Attr); return Error_Mark; end case; Res := Create_Iir (Iir_Kind_Base_Attribute); Location_Copy (Res, Attr); Set_Prefix (Res, Prefix_Name); Set_Type (Res, Base_Type); return Res; end Sem_Base_Attribute; function Sem_User_Attribute (Attr : Iir_Attribute_Name) return Iir is Prefix : Iir; Value : Iir; Attr_Id : Name_Id; begin Prefix := Get_Named_Entity (Get_Prefix (Attr)); -- LRM93 6.6 -- If the attribute name denotes an alias, then the attribute name -- denotes an attribute of the aliased name and not the alias itself, -- except when the attribute designator denotes any of the predefined -- attributes 'simple_name, 'path_name, or 'instance_name. if Get_Kind (Prefix) = Iir_Kind_Object_Alias_Declaration then -- GHDL: according to 4.3.3, the name cannot be an alias. Prefix := Strip_Denoting_Name (Get_Name (Prefix)); end if; -- LRM93 6.6 -- If the attribute designator denotes a user-defined attribute, the -- prefix cannot denote a subelement or a slice of an object. case Get_Kind (Prefix) is when Iir_Kind_Selected_By_All_Name | Iir_Kind_Selected_Name | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name => Error_Msg_Sem ("prefix of user defined attribute cannot be an " & "object subelement", Attr); return Error_Mark; when Iir_Kind_Dereference => Error_Msg_Sem ("prefix of user defined attribute cannot be an " & "anonymous object", Attr); return Error_Mark; when Iir_Kinds_Object_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration | Iir_Kinds_Sequential_Statement | Iir_Kinds_Concurrent_Statement | Iir_Kind_Component_Declaration | Iir_Kinds_Library_Unit_Declaration => -- FIXME: to complete null; when others => Error_Kind ("sem_user_attribute", Prefix); end case; Attr_Id := Get_Identifier (Attr); Value := Sem_Specs.Find_Attribute_Value (Prefix, Attr_Id); if Value = Null_Iir then Error_Msg_Sem (Disp_Node (Prefix) & " was not annotated with attribute '" & Name_Table.Image (Attr_Id) & ''', Attr); if Attr_Id = Std_Names.Name_First or Attr_Id = Std_Names.Name_Last then -- Nice (?) message for Ada users. Error_Msg_Sem ("(you may use 'high, 'low, 'left or 'right attribute)", Attr); end if; return Error_Mark; end if; Xref_Ref (Attr, Value); return Value; end Sem_User_Attribute; -- The prefix of scalar type attributes is a type name (or 'base), and -- therefore isn't overloadable. So at the end of the function, the -- analyze is finished. function Sem_Scalar_Type_Attribute (Attr : Iir_Attribute_Name) return Iir is use Std_Names; Prefix_Name : constant Iir := Get_Prefix (Attr); Id : constant Name_Id := Get_Identifier (Attr); Prefix : Iir; Prefix_Type : Iir; Res : Iir; begin Prefix := Get_Named_Entity (Prefix_Name); -- LRM93 14.1 -- Prefix: Any discrete or physical type of subtype T. case Get_Kind (Prefix) is when Iir_Kind_Type_Declaration => Prefix_Type := Get_Type_Definition (Prefix); when Iir_Kind_Subtype_Declaration => Prefix_Type := Get_Type (Prefix); when Iir_Kind_Base_Attribute => Prefix_Type := Get_Type (Prefix); when others => Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id) & " attribute must be a type", Attr); return Error_Mark; end case; case Id is when Name_Image | Name_Value => if Get_Kind (Prefix_Type) not in Iir_Kinds_Scalar_Type_Definition then Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id) & " attribute must be a scalar type", Attr); Error_Msg_Sem ("found " & Disp_Node (Prefix_Type) & " defined at " & Disp_Location (Prefix_Type), Attr); return Error_Mark; end if; when others => case Get_Kind (Prefix_Type) is when Iir_Kinds_Discrete_Type_Definition | Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Physical_Type_Definition => null; when others => Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id) & " attribute must be discrete or physical type", Attr); Error_Msg_Sem ("found " & Disp_Node (Prefix_Type) & " defined at " & Disp_Location (Prefix_Type), Attr); return Error_Mark; end case; end case; -- Create the resulting node. case Get_Identifier (Attr) is when Name_Pos => Res := Create_Iir (Iir_Kind_Pos_Attribute); when Name_Val => Res := Create_Iir (Iir_Kind_Val_Attribute); when Name_Succ => Res := Create_Iir (Iir_Kind_Succ_Attribute); when Name_Pred => Res := Create_Iir (Iir_Kind_Pred_Attribute); when Name_Leftof => Res := Create_Iir (Iir_Kind_Leftof_Attribute); when Name_Rightof => Res := Create_Iir (Iir_Kind_Rightof_Attribute); when Name_Image => Res := Create_Iir (Iir_Kind_Image_Attribute); when Name_Value => Res := Create_Iir (Iir_Kind_Value_Attribute); when others => raise Internal_Error; end case; Location_Copy (Res, Attr); Set_Prefix (Res, Prefix_Name); Set_Base_Name (Res, Res); case Get_Identifier (Attr) is when Name_Pos => -- LRM93 14.1 -- Result type: universal_integer. Set_Type (Res, Convertible_Integer_Type_Definition); when Name_Val => -- LRM93 14.1 -- Result type: the base type of T Set_Type (Res, Get_Base_Type (Prefix_Type)); when Name_Succ | Name_Pred | Name_Leftof | Name_Rightof => -- LRM93 14.1 -- Result type: the base type of T. Set_Type (Res, Get_Base_Type (Prefix_Type)); when Name_Image => -- LRM93 14.1 -- Result type: type string Set_Type (Res, String_Type_Definition); when Name_Value => -- LRM93 14.1 -- Result type: the base type of T. Set_Type (Res, Get_Base_Type (Prefix_Type)); when others => raise Internal_Error; end case; return Res; end Sem_Scalar_Type_Attribute; -- Analyze attributes whose prefix is a type or a subtype and result is -- a value (not a function). function Sem_Predefined_Type_Attribute (Attr : Iir_Attribute_Name) return Iir is use Std_Names; Prefix_Name : constant Iir := Get_Prefix (Attr); Id : constant Name_Id := Get_Identifier (Attr); Res : Iir; Prefix : Iir; Prefix_Type : Iir; begin case Id is when Name_Left => Res := Create_Iir (Iir_Kind_Left_Type_Attribute); when Name_Right => Res := Create_Iir (Iir_Kind_Right_Type_Attribute); when Name_High => Res := Create_Iir (Iir_Kind_High_Type_Attribute); when Name_Low => Res := Create_Iir (Iir_Kind_Low_Type_Attribute); when Name_Ascending => Res := Create_Iir (Iir_Kind_Ascending_Type_Attribute); when Name_Range | Name_Reverse_Range => Error_Msg_Sem ("prefix of range attribute must be an array type or object", Attr); return Error_Mark; when others => Error_Msg_Sem ("Attribute '" & Name_Table.Image (Id) & " not valid on this type", Attr); return Error_Mark; end case; Location_Copy (Res, Attr); Set_Base_Name (Res, Res); Prefix := Get_Named_Entity (Prefix_Name); case Get_Kind (Prefix) is when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => Prefix := Finish_Sem_Name (Prefix_Name, Prefix); Prefix_Type := Get_Type (Prefix); Set_Expr_Staticness (Res, Get_Expr_Staticness (Prefix)); when Iir_Kind_Base_Attribute => -- Base_Attribute is already finished. Prefix_Type := Get_Type (Prefix); Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type)); when others => Prefix := Sem_Type_Mark (Prefix_Name); Prefix_Type := Get_Type (Prefix); Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type)); end case; Set_Prefix (Res, Prefix); case Get_Identifier (Attr) is when Name_Ascending => -- LRM93 14.1 -- Result Type: type boolean. Set_Type (Res, Boolean_Type_Definition); when others => -- LRM 14.1 -- Result Type: Same type as T. Set_Type (Res, Prefix_Type); end case; return Res; end Sem_Predefined_Type_Attribute; -- Called for attributes Length, Left, Right, High, Low, Range, -- Reverse_Range, Ascending. -- FIXME: handle overload function Sem_Array_Attribute_Name (Attr : Iir_Attribute_Name) return Iir is use Std_Names; Prefix_Name : constant Iir := Get_Prefix (Attr); Prefix_Type : Iir; Prefix : Iir; Res : Iir; Res_Type : Iir; begin Prefix := Get_Named_Entity (Prefix_Name); -- LRM93 14.1 -- Prefix: Any prefix A that is appropriate for an array object, or an -- alias thereof, or that denotes a constrained array subtype. -- -- LRM08 16.2 Predefined attributes. -- Prefix of A'Left[(N)], A'Right[(N)]... : -- Any prefix A that is appropriate for an array object, or an alias -- thereof, or that denotes a constrained an array subtype whose index -- ranges are defined by a constraint. -- -- GHDL: the prefix cannot be a function call, as the result is not -- an object and it doesn't denote a subtype. References are: -- -- LRM08 6.4 Objects: -- An object is a named entity [...] -- In addition the following are objects, but are not named -- entities[...] -- -- LRM08 6 Declarations -- the name is said to denote the associated entity. case Get_Kind (Prefix) is when Iir_Kind_Dereference | Iir_Kinds_Object_Declaration | Iir_Kind_Function_Call | Iir_Kind_Function_Declaration | Iir_Kind_Selected_Element | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Attribute_Value | Iir_Kind_Image_Attribute => -- FIXME: list of expr. Prefix_Type := Get_Type (Prefix); case Get_Kind (Prefix_Type) is when Iir_Kind_Access_Type_Definition | Iir_Kind_Access_Subtype_Definition => declare Designated_Type : Iir; begin Designated_Type := Get_Designated_Type (Get_Base_Type (Prefix_Type)); Prefix := Insert_Implicit_Dereference (Prefix, Attr); Prefix_Type := Designated_Type; end; when Iir_Kinds_Array_Type_Definition => null; when others => Error_Msg_Sem ("object prefix must be an array", Attr); return Error_Mark; end case; when Iir_Kind_Subtype_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Base_Attribute => Prefix_Type := Get_Type (Prefix); if not Is_Fully_Constrained_Type (Prefix_Type) then Error_Msg_Sem ("prefix type is not constrained", Attr); -- We continue using the unconstrained array type. -- At least, this type is valid; and even if the array was -- constrained, the base type would be the same. end if; when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => -- For names such as pfx'Range'Left. -- Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Null_Iir); Prefix_Type := Get_Type (Prefix); when Iir_Kind_Process_Statement => Error_Msg_Sem (Disp_Node (Prefix) & " is not an appropriate prefix for '" & Name_Table.Image (Get_Identifier (Attr)) & " attribute", Attr); return Error_Mark; when others => Error_Msg_Sem ("prefix must denote an array object or type", Attr); return Error_Mark; end case; case Get_Kind (Prefix_Type) is when Iir_Kinds_Scalar_Type_Definition => -- Note: prefix is a scalar type or subtype. return Sem_Predefined_Type_Attribute (Attr); when Iir_Kinds_Array_Type_Definition => null; when others => Error_Msg_Sem ("prefix of '" & Name_Table.Image (Get_Identifier (Attr)) & " attribute must denote a constrained array subtype", Attr); return Error_Mark; end case; -- Type of the attribute. This is correct unless there is a parameter, -- and furthermore 'range and 'reverse_range has to be handled -- specially because the result is a range and not a value. Res_Type := Get_Index_Type (Get_Index_Subtype_List (Prefix_Type), 0); -- Create the node for the attribute. case Get_Identifier (Attr) is when Name_Left => Res := Create_Iir (Iir_Kind_Left_Array_Attribute); when Name_Right => Res := Create_Iir (Iir_Kind_Right_Array_Attribute); when Name_High => Res := Create_Iir (Iir_Kind_High_Array_Attribute); when Name_Low => Res := Create_Iir (Iir_Kind_Low_Array_Attribute); when Name_Range => Res := Create_Iir (Iir_Kind_Range_Array_Attribute); when Name_Reverse_Range => Res := Create_Iir (Iir_Kind_Reverse_Range_Array_Attribute); when Name_Length => Res := Create_Iir (Iir_Kind_Length_Array_Attribute); -- FIXME: Error if ambiguous Res_Type := Convertible_Integer_Type_Definition; when Name_Ascending => Res := Create_Iir (Iir_Kind_Ascending_Array_Attribute); -- FIXME: Error if ambiguous Res_Type := Boolean_Type_Definition; when others => raise Internal_Error; end case; Location_Copy (Res, Attr); Set_Prefix (Res, Prefix); Set_Type (Res, Res_Type); return Res; end Sem_Array_Attribute_Name; function Sem_Signal_Signal_Attribute (Attr : Iir_Attribute_Name; Kind : Iir_Kind) return Iir is Res : Iir; Prefix : Iir; begin Prefix := Get_Named_Entity (Get_Prefix (Attr)); Res := Create_Iir (Kind); if Kind = Iir_Kind_Delayed_Attribute then Set_Type (Res, Get_Type (Prefix)); elsif Kind = Iir_Kind_Transaction_Attribute then Set_Type (Res, Bit_Type_Definition); else Set_Type (Res, Boolean_Type_Definition); end if; Set_Base_Name (Res, Res); if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then -- LRM93 2.1.1.2 / LRM08 4.2.2.3 -- -- It is an error if signal-valued attributes 'STABLE , 'QUIET, -- 'TRANSACTION, and 'DELAYED of formal signal paramaters of any -- mode are read within a subprogram. case Get_Kind (Get_Parent (Prefix)) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => Error_Msg_Sem ("'" & Name_Table.Image (Get_Identifier (Attr)) & " is not allowed for a signal parameter", Attr); when others => null; end case; end if; Sem_Decls.Add_Declaration_For_Implicit_Signal (Res); return Res; end Sem_Signal_Signal_Attribute; function Sem_Signal_Attribute (Attr : Iir_Attribute_Name) return Iir is use Std_Names; Prefix: Iir; Res : Iir; Base : Iir; begin Prefix := Get_Named_Entity (Get_Prefix (Attr)); Base := Get_Object_Prefix (Prefix); case Get_Kind (Base) is when Iir_Kind_Signal_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kinds_Signal_Attribute => null; when others => Error_Msg_Sem ("prefix of '" & Name_Table.Image (Get_Identifier (Attr)) & " attribute must denote a signal", Attr); return Error_Mark; end case; case Get_Identifier (Attr) is when Name_Stable => Res := Sem_Signal_Signal_Attribute (Attr, Iir_Kind_Stable_Attribute); when Name_Quiet => Res := Sem_Signal_Signal_Attribute (Attr, Iir_Kind_Quiet_Attribute); when Name_Delayed => Res := Sem_Signal_Signal_Attribute (Attr, Iir_Kind_Delayed_Attribute); when Name_Transaction => Res := Sem_Signal_Signal_Attribute (Attr, Iir_Kind_Transaction_Attribute); when Name_Event => Res := Create_Iir (Iir_Kind_Event_Attribute); Set_Type (Res, Boolean_Type_Definition); when Name_Active => Res := Create_Iir (Iir_Kind_Active_Attribute); Set_Type (Res, Boolean_Type_Definition); when Name_Last_Value => Res := Create_Iir (Iir_Kind_Last_Value_Attribute); Set_Type (Res, Get_Type (Prefix)); when Name_Last_Event => Res := Create_Iir (Iir_Kind_Last_Event_Attribute); Set_Type (Res, Time_Type_Definition); when Name_Last_Active => Res := Create_Iir (Iir_Kind_Last_Active_Attribute); Set_Type (Res, Time_Type_Definition); when Name_Driving_Value => Res := Create_Iir (Iir_Kind_Driving_Value_Attribute); Set_Type (Res, Get_Type (Prefix)); -- FIXME: check restrictions. when Name_Driving => Res := Create_Iir (Iir_Kind_Driving_Attribute); Set_Type (Res, Boolean_Type_Definition); -- FIXME: check restrictions. when others => -- Not yet implemented attribute, or really an internal error. raise Internal_Error; end case; Location_Copy (Res, Attr); -- LRM 4.3.2 -- The value of an object is said to be read when one of the following -- conditions is satisfied: -- [...] -- * When the object is a signal and the value of any of its predefined -- attributes 'STABLE, 'QUIET, 'DELAYED, 'TRANSACTION, 'EVENT, -- 'ACTIVE, 'LAST_EVENT, 'LAST_ACTIVE, or 'LAST_VALUE is read. -- LRM 14.1 -- S'Driving Restrictions: -- S'Driving_Value Restrictions: -- This attribute is available only from within a process, a -- concurrent statement with an equivalent process, or a subprogram. -- If the prefix denotes a port, it is an error if the port does not -- have a mode of INOUT, OUT or BUFFER. It is also an error if the -- attribute name appears in a subprogram body that is not a declarative -- item contained within a process statement and the prefix is not a -- formal parameter of the given subprogram or of a parent of that -- subprogram. Finally, it is an error if the prefix denotes a -- subprogram formal parameter whose mode is not INOUT or OUT, or if -- S'Driving is False at the time of the evaluation of S'Driving_Value. case Get_Kind (Res) is when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Transaction_Attribute | Iir_Kind_Event_Attribute | Iir_Kind_Active_Attribute | Iir_Kind_Last_Event_Attribute | Iir_Kind_Last_Active_Attribute | Iir_Kind_Last_Value_Attribute => Check_Read (Prefix); when Iir_Kind_Driving_Attribute | Iir_Kind_Driving_Value_Attribute => -- FIXME: complete checks. if Get_Current_Concurrent_Statement = Null_Iir then Error_Msg_Sem ("'driving or 'driving_value is available only within a " & "concurrent statement", Attr); else case Get_Kind (Get_Current_Concurrent_Statement) is when Iir_Kinds_Process_Statement | Iir_Kind_Concurrent_Conditional_Signal_Assignment | Iir_Kind_Concurrent_Selected_Signal_Assignment | Iir_Kind_Concurrent_Procedure_Call_Statement => null; when others => Error_Msg_Sem ("'driving or 'driving_value not available within " & "this concurrent statement", Attr); end case; end if; case Get_Kind (Base) is when Iir_Kind_Signal_Declaration => null; when Iir_Kind_Interface_Signal_Declaration => case Get_Mode (Base) is when Iir_Buffer_Mode | Iir_Inout_Mode | Iir_Out_Mode => null; when others => Error_Msg_Sem ("mode of 'driving or 'driving_value prefix must " & "be out, inout or buffer", Attr); end case; when others => Error_Msg_Sem ("bad prefix for 'driving or 'driving_value", Attr); end case; when others => null; end case; -- According to LRM 7.4, signal attributes are not static expressions -- since the prefix (a signal) is not a static expression. Set_Expr_Staticness (Res, None); -- LRM02 6.1 / LRM08 8.1 -- A name is said to be a static name if and only if at least one of -- the following conditions holds: -- [...] -- - The name is a attribute name whose prefix is a static signal name -- and whose suffix is one of the predefined attributes 'DELAYED, -- 'STABLE, 'QUIET or 'TRANSACTION. -- According to LRM 6.1, attributes are not static names. if Flags.Vhdl_Std = Vhdl_93c or Flag_Relaxed_Rules or Flags.Vhdl_Std >= Vhdl_02 then case Get_Kind (Res) is when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Transaction_Attribute => Set_Name_Staticness (Res, Get_Name_Staticness (Prefix)); when others => Set_Name_Staticness (Res, None); end case; else Set_Name_Staticness (Res, None); end if; Set_Prefix (Res, Prefix); -- Set has_active_flag when activity is read. case Get_Kind (Res) is when Iir_Kind_Quiet_Attribute | Iir_Kind_Transaction_Attribute | Iir_Kind_Active_Attribute | Iir_Kind_Last_Active_Attribute => Set_Has_Active_Flag (Base, True); when others => null; end case; return Res; end Sem_Signal_Attribute; -- 'Simple_name, 'instance_name and 'path_name. function Sem_Name_Attribute (Attr : Iir_Attribute_Name) return Iir is use Std_Names; Prefix_Name : constant Iir := Get_Prefix (Attr); Prefix: Iir; Res : Iir; Attr_Type : Iir; begin Prefix := Get_Named_Entity (Prefix_Name); Set_Prefix (Attr, Finish_Sem_Name (Prefix_Name, Prefix)); -- LRM 14.1 Predefined attributes -- E'SIMPLE_NAME -- Prefix: Any named entity as defined in 5.1 -- E'INSTANCE_NAME -- Prefix: Any named entity other than the local ports and generics -- of a component declaration. -- E'PATH_NAME -- Prefix: Any named entity other than the local ports and generics -- of a component declaration. case Get_Kind (Prefix) is when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Component_Declaration | Iir_Kinds_Concurrent_Statement | Iir_Kinds_Sequential_Statement | Iir_Kind_Enumeration_Literal | Iir_Kind_Group_Declaration | Iir_Kind_Group_Template_Declaration | Iir_Kind_File_Declaration | Iir_Kinds_Library_Unit_Declaration | Iir_Kind_Non_Object_Alias_Declaration => null; when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_Constant_Declaration => if Get_Identifier (Attr) /= Name_Simple_Name and then Get_Kind (Get_Parent (Prefix)) = Iir_Kind_Component_Declaration then Error_Msg_Sem ("local ports or generics of a component cannot be a prefix", Attr); end if; when others => Error_Msg_Sem (Disp_Node (Prefix) & " is not a named entity", Attr); end case; case Get_Identifier (Attr) is when Name_Simple_Name => Res := Create_Iir (Iir_Kind_Simple_Name_Attribute); Eval_Simple_Name (Get_Identifier (Prefix)); Set_Simple_Name_Identifier (Res, Name_Table.Get_Identifier); Attr_Type := Create_Unidim_Array_By_Length (String_Type_Definition, Iir_Int64 (Name_Table.Nam_Length), Attr); Set_Simple_Name_Subtype (Res, Attr_Type); Set_Expr_Staticness (Res, Locally); when Name_Path_Name => Res := Create_Iir (Iir_Kind_Path_Name_Attribute); Set_Expr_Staticness (Res, Globally); Attr_Type := String_Type_Definition; when Name_Instance_Name => Res := Create_Iir (Iir_Kind_Instance_Name_Attribute); Set_Expr_Staticness (Res, Globally); Attr_Type := String_Type_Definition; when others => raise Internal_Error; end case; Location_Copy (Res, Attr); Set_Prefix (Res, Prefix_Name); Set_Type (Res, Attr_Type); return Res; end Sem_Name_Attribute; procedure Sem_Attribute_Name (Attr : Iir_Attribute_Name) is use Std_Names; Prefix : Iir; Res : Iir; Sig : Iir_Signature; begin -- LRM93 6.6 Attribute names -- The meaning of the prefix of an attribute name must be determinable -- independently of the attribute designator and independently of the -- fact that it is the prefix of an attribute. Prefix := Get_Prefix (Attr); -- LRM93 6.6 -- If the prefix of an attribute name denotes an alias, then the -- attribute name denotes an attribute of the aliased name and not the -- alias itself, except when the attribute designator denotes any of -- the predefined attributes 'Simple_Name, 'Path_Name or 'Instance_Name. -- If the prefix of an attribute name denotes an alias and the -- attribute designator denotes any of the predefined attributes -- 'Simple_Name, 'Path_Name or 'Instance_Name, then the attribute name -- denotes the attribute of the alias and not of the aliased name. if Flags.Vhdl_Std > Vhdl_87 and then Get_Identifier (Attr) in Name_Id_Name_Attributes then Sem_Name (Prefix, True); else Sem_Name (Prefix, False); end if; Prefix := Get_Named_Entity (Prefix); if Prefix = Error_Mark then Set_Named_Entity (Attr, Prefix); return; end if; -- LRM93 6.6 -- A signature may follow the prefix if and only if the prefix denotes -- a subprogram or enumeration literal, or an alias thereof. -- In this case, the signature is required to match (see Section 2.3.2) -- the parameter and result type profile of exactly one visible -- subprogram or enumeration literal, as is appropriate to the prefix. -- GHDL: this is done by Sem_Signature. Sig := Get_Attribute_Signature (Attr); if Sig /= Null_Iir then Prefix := Sem_Signature (Prefix, Sig); if Prefix = Null_Iir then Set_Named_Entity (Attr, Error_Mark); return; end if; Set_Named_Entity (Get_Prefix (Attr), Prefix); end if; if Get_Kind (Prefix) = Iir_Kind_Overload_List then -- FIXME: this should be allowed. Error_Msg_Sem ("prefix of attribute is overloaded", Attr); Set_Named_Entity (Attr, Error_Mark); return; end if; -- Set_Prefix (Attr, Finish_Sem_Name (Get_Prefix (Attr), Prefix)); case Get_Identifier (Attr) is when Name_Base => Res := Sem_Base_Attribute (Attr); when Name_Image | Name_Value => if Flags.Vhdl_Std > Vhdl_87 then Res := Sem_Scalar_Type_Attribute (Attr); else Res := Sem_User_Attribute (Attr); end if; when Name_Pos | Name_Val | Name_Succ | Name_Pred | Name_Rightof | Name_Leftof => Res := Sem_Scalar_Type_Attribute (Attr); when Name_Length | Name_Left | Name_Right | Name_High | Name_Low | Name_Range | Name_Reverse_Range => Res := Sem_Array_Attribute_Name (Attr); when Name_Ascending => if Flags.Vhdl_Std > Vhdl_87 then Res := Sem_Array_Attribute_Name (Attr); else Res := Sem_User_Attribute (Attr); end if; when Name_Stable | Name_Event | Name_Last_Value | Name_Delayed | Name_Quiet | Name_Transaction | Name_Active | Name_Last_Active | Name_Last_Event => Res := Sem_Signal_Attribute (Attr); when Name_Driving | Name_Driving_Value => if Flags.Vhdl_Std > Vhdl_87 then Res := Sem_Signal_Attribute (Attr); else Res := Sem_User_Attribute (Attr); end if; when Name_Simple_Name | Name_Path_Name | Name_Instance_Name => if Flags.Vhdl_Std > Vhdl_87 then Res := Sem_Name_Attribute (Attr); else Res := Sem_User_Attribute (Attr); end if; when others => Res := Sem_User_Attribute (Attr); end case; if Res = Null_Iir then Error_Kind ("sem_attribute_name", Attr); end if; Set_Named_Entity (Attr, Res); end Sem_Attribute_Name; -- LRM93 §6 procedure Sem_Name (Name : Iir; Keep_Alias : Boolean := False) is begin -- Exit now if NAME was already semantized. if Get_Named_Entity (Name) /= Null_Iir then return; end if; case Get_Kind (Name) is when Iir_Kind_Simple_Name | Iir_Kind_Character_Literal | Iir_Kind_Operator_Symbol => -- String_Literal may be a symbol_operator. Sem_Simple_Name (Name, Keep_Alias, Soft => False); when Iir_Kind_Selected_Name => Sem_Selected_Name (Name, Keep_Alias); when Iir_Kind_Parenthesis_Name => Sem_Parenthesis_Name (Name); when Iir_Kind_Selected_By_All_Name => Sem_Selected_By_All_Name (Name); when Iir_Kind_Attribute_Name => Sem_Attribute_Name (Name); when others => Error_Kind ("sem_name", Name); end case; end Sem_Name; procedure Sem_Name_Soft (Name : Iir) is begin -- Exit now if NAME was already semantized. if Get_Named_Entity (Name) /= Null_Iir then return; end if; case Get_Kind (Name) is when Iir_Kind_Simple_Name | Iir_Kind_Operator_Symbol => -- String_Literal may be a symbol_operator. Sem_Simple_Name (Name, False, Soft => True); when others => Error_Kind ("sem_name_soft", Name); end case; end Sem_Name_Soft; procedure Sem_Name_Clean (Name : Iir) is N : Iir; Next_N : Iir; Named_Entity : Iir; Atype : Iir; begin N := Name; while N /= Null_Iir loop case Get_Kind (N) is when Iir_Kind_Simple_Name | Iir_Kind_Operator_Symbol => Next_N := Null_Iir; when others => Error_Kind ("sem_name_clean", N); end case; -- Clear and free overload lists of Named_entity and type. Named_Entity := Get_Named_Entity (N); Set_Named_Entity (N, Null_Iir); if Named_Entity /= Null_Iir and then Is_Overload_List (Named_Entity) then Free_Iir (Named_Entity); end if; Atype := Get_Type (N); Set_Type (N, Null_Iir); if Atype /= Null_Iir and then Is_Overload_List (Atype) then Free_Iir (Atype); end if; N := Next_N; end loop; end Sem_Name_Clean; -- Remove procedure specification from LIST. function Remove_Procedures_From_List (Expr : Iir) return Iir is El : Iir; P : Natural; List : Iir_List; begin if not Is_Overload_List (Expr) then return Expr; end if; List := Get_Overload_List (Expr); P := 0; for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; case Get_Kind (El) is when Iir_Kind_Procedure_Declaration => null; when Iir_Kind_Function_Declaration => if Maybe_Function_Call (El) then Replace_Nth_Element (List, P, El); P := P + 1; end if; when others => Replace_Nth_Element (List, P, El); P := P + 1; end case; end loop; case P is when 0 => Free_Iir (Expr); return Null_Iir; when 1 => El := Get_First_Element (List); Free_Iir (Expr); return El; when others => Set_Nbr_Elements (List, P); return Expr; end case; end Remove_Procedures_From_List; -- Convert name EXPR to an expression (ie, create function call). -- A_TYPE is the expected type of the expression. -- Returns NULL_IIR in case of error. function Name_To_Expression (Name : Iir; A_Type : Iir) return Iir is Ret_Type : Iir; Res_Type : Iir; Expr : Iir; Expr_List : Iir_List; Res : Iir; Res1 : Iir; El : Iir; begin Expr := Get_Named_Entity (Name); if Get_Kind (Expr) = Iir_Kind_Error then return Null_Iir; end if; if Check_Is_Expression (Expr, Name) = Null_Iir then return Null_Iir; end if; -- Note: EXPR may contain procedure names... Expr := Remove_Procedures_From_List (Expr); Set_Named_Entity (Name, Expr); if Expr = Null_Iir then Error_Msg_Sem ("procedure name " & Disp_Node (Name) & " cannot be used as expression", Name); return Null_Iir; end if; if not Is_Overload_List (Expr) then Res := Finish_Sem_Name (Name); pragma Assert (Res /= Null_Iir); if A_Type /= Null_Iir then Res_Type := Get_Type (Res); if Res_Type = Null_Iir then return Null_Iir; end if; if Are_Basetypes_Compatible (Get_Base_Type (Res_Type), A_Type) = Not_Compatible then Error_Not_Match (Res, A_Type, Name); return Null_Iir; end if; -- Fall through. end if; else -- EXPR is an overloaded name. Expr_List := Get_Overload_List (Expr); if A_Type /= Null_Iir then -- Find the name returning A_TYPE. Res := Null_Iir; for I in Natural loop El := Get_Nth_Element (Expr_List, I); exit when El = Null_Iir; if Are_Basetypes_Compatible (Get_Base_Type (Get_Type (El)), A_Type) /= Not_Compatible then Add_Result (Res, El); end if; end loop; if Res = Null_Iir then Error_Not_Match (Name, A_Type, Name); return Null_Iir; elsif Is_Overload_List (Res) then Res1 := Extract_Call_Without_Implicit_Conversion (Res); if Res1 /= Null_Iir then Free_Iir (Res); Res := Res1; else Error_Overload (Name); Disp_Overload_List (Get_Overload_List (Res), Name); Free_Iir (Res); return Null_Iir; end if; end if; -- Free results Sem_Name_Free_Result (Expr, Res); Ret_Type := Get_Type (Name); if Ret_Type /= Null_Iir then pragma Assert (Is_Overload_List (Ret_Type)); Free_Overload_List (Ret_Type); end if; -- Fall through. else -- Create a list of type. Ret_Type := Create_List_Of_Types (Expr_List); if Ret_Type = Null_Iir or else not Is_Overload_List (Ret_Type) then Res1 := Extract_Call_Without_Implicit_Conversion (Expr); if Res1 /= Null_Iir then -- Found it. Res := Res1; -- Fall through else -- There is either no types or one type for -- several meanings. Error_Overload (Name); Disp_Overload_List (Expr_List, Name); --Free_Iir (Ret_Type); return Null_Iir; end if; else Set_Type (Name, Ret_Type); return Name; end if; end if; Set_Named_Entity (Name, Res); Res := Finish_Sem_Name (Name); end if; -- NAME has only one meaning, which is RES. case Get_Kind (Res) is when Iir_Kind_Simple_Name | Iir_Kind_Character_Literal | Iir_Kind_Selected_Name => Expr := Get_Named_Entity (Res); if Get_Kind (Expr) = Iir_Kind_Function_Declaration then return Function_Declaration_To_Call (Res); else Set_Type (Res, Get_Type (Expr)); Set_Expr_Staticness (Res, Get_Expr_Staticness (Expr)); --Set_Name_Staticness (Name, Get_Name_Staticness (Expr)); --Set_Base_Name (Name, Get_Base_Name (Expr)); return Res; end if; when Iir_Kind_Function_Call | Iir_Kind_Selected_Element | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Type_Conversion | Iir_Kind_Attribute_Name => return Eval_Expr_If_Static (Res); when Iir_Kind_Dereference => -- Never static. return Res; when Iir_Kinds_Array_Attribute => -- FIXME: exclude range and reverse_range. return Eval_Expr_If_Static (Res); when Iir_Kinds_Signal_Attribute | Iir_Kinds_Signal_Value_Attribute => -- Never static return Res; when Iir_Kinds_Type_Attribute | Iir_Kinds_Scalar_Type_Attribute | Iir_Kind_Image_Attribute | Iir_Kind_Value_Attribute | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Path_Name_Attribute | Iir_Kind_Instance_Name_Attribute => return Eval_Expr_If_Static (Res); when Iir_Kind_Parenthesis_Name | Iir_Kind_Selected_By_All_Name => raise Internal_Error; when others => Error_Kind ("name_to_expression", Res); end case; end Name_To_Expression; function Name_To_Range (Name : Iir) return Iir is Expr : Iir; begin Expr := Get_Named_Entity (Name); if Get_Kind (Expr) = Iir_Kind_Error then return Error_Mark; end if; case Get_Kind (Expr) is when Iir_Kind_Subtype_Declaration | Iir_Kind_Type_Declaration => Expr := Sem_Type_Mark (Name); Set_Expr_Staticness (Expr, Get_Type_Staticness (Get_Type (Expr))); return Expr; when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => if Get_Parameter (Expr) = Null_Iir then Finish_Sem_Array_Attribute (Name, Expr, Null_Iir); end if; if Get_Kind (Name) = Iir_Kind_Attribute_Name then Free_Iir (Name); else Free_Iir (Get_Prefix (Name)); Free_Parenthesis_Name (Name, Expr); end if; return Expr; when others => Error_Msg_Sem ("name " & Disp_Node (Name) & " doesn't denote a range", Name); return Error_Mark; end case; end Name_To_Range; function Create_Error_Name (Orig : Iir) return Iir is Res : Iir; begin Res := Create_Iir (Iir_Kind_Error); Set_Expr_Staticness (Res, None); Set_Error_Origin (Res, Orig); Location_Copy (Res, Orig); return Res; end Create_Error_Name; function Sem_Denoting_Name (Name: Iir) return Iir is Res: Iir; begin pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name); Sem_Name (Name); Res := Get_Named_Entity (Name); case Get_Kind (Res) is when Iir_Kind_Error => -- A message must have been displayed. return Name; when Iir_Kind_Overload_List => Error_Overload (Res); Set_Named_Entity (Name, Create_Error_Name (Name)); return Name; when Iir_Kinds_Concurrent_Statement | Iir_Kinds_Sequential_Statement | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration | Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kinds_Object_Declaration | Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Context_Declaration | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Library_Declaration | Iir_Kinds_Subprogram_Declaration | Iir_Kind_Component_Declaration => Res := Finish_Sem_Name (Name, Res); pragma Assert (Get_Kind (Res) in Iir_Kinds_Denoting_Name); return Res; when Iir_Kind_Selected_Element => -- An error (to be diagnosticed by the caller). return Name; when others => Error_Kind ("sem_denoting_name", Res); end case; end Sem_Denoting_Name; procedure Sem_External_Name (Name : Iir) is Atype : Iir; begin pragma Assert (Get_Type (Name) = Null_Iir); Atype := Get_Subtype_Indication (Name); Atype := Sem_Types.Sem_Subtype_Indication (Atype); Set_Subtype_Indication (Name, Atype); Atype := Get_Type_Of_Subtype_Indication (Atype); if Atype = Null_Iir then Atype := Create_Error_Type (Null_Iir); end if; Set_Type (Name, Atype); end Sem_External_Name; function Sem_Terminal_Name (Name : Iir) return Iir is Res : Iir; Ent : Iir; begin Res := Sem_Denoting_Name (Name); Ent := Get_Named_Entity (Res); if Get_Kind (Ent) /= Iir_Kind_Terminal_Declaration then Error_Class_Match (Name, "terminal"); Set_Named_Entity (Res, Create_Error_Name (Name)); end if; return Res; end Sem_Terminal_Name; procedure Error_Class_Match (Name : Iir; Class_Name : String) is Ent : constant Iir := Get_Named_Entity (Name); begin if Is_Error (Ent) then Error_Msg_Sem (Class_Name & " name expected", Name); else Error_Msg_Sem (Class_Name & " name expected, found " & Disp_Node (Get_Named_Entity (Name)), Name); end if; end Error_Class_Match; end Sem_Names;