diff options
Diffstat (limited to 'src/vhdl/vhdl-sem_names.adb')
| -rw-r--r-- | src/vhdl/vhdl-sem_names.adb | 4313 |
1 files changed, 4313 insertions, 0 deletions
diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb new file mode 100644 index 000000000..d72af8c28 --- /dev/null +++ b/src/vhdl/vhdl-sem_names.adb @@ -0,0 +1,4313 @@ +-- 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 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 Vhdl.Sem; +with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; +with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes; +with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; +with Vhdl.Sem_Stmts; use Vhdl.Sem_Stmts; +with Vhdl.Sem_Decls; use Vhdl.Sem_Decls; +with Vhdl.Sem_Assocs; use Vhdl.Sem_Assocs; +with Vhdl.Sem_Specs; +with Vhdl.Sem_Types; +with Vhdl.Sem_Psl; +with Xrefs; use Xrefs; + +package body Vhdl.Sem_Names is + -- Finish the analyze of NAME using RES as named entity. + -- This is called when the analyze 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; + + -- Return the fully analyzed name of NAME. + function Name_To_Analyzed_Name (Name : Iir) return Iir; + + procedure Error_Overload (Expr: Iir) is + begin + if Is_Error (Expr) then + -- Avoid error storm. + return; + end if; + Error_Msg_Sem (+Expr, "can't resolve overload for %n", +Expr); + end Error_Overload; + + procedure Disp_Overload_List (List : Iir_List; Loc : Iir) + is + El : Iir; + It : List_Iterator; + begin + Error_Msg_Sem (+Loc, "possible interpretations are:", Cont => True); + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + case Get_Kind (El) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Error_Msg_Sem (+El, Disp_Subprg (El)); + when Iir_Kind_Function_Call => + El := Get_Implementation (El); + Error_Msg_Sem (+El, Disp_Subprg (El)); + when others => + Error_Msg_Sem (+El, "%n", +El); + end case; + Next (It); + 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; + It : List_Iterator; + begin + -- Create the list of possible return types. + Res_List := Create_Iir_List; + It := List_Iterate (List); + while Is_Valid (It) loop + Decl := Get_Element (It); + 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_Slice_Name + | Iir_Kind_Selected_Element => + Add_Element (Res_List, Get_Type (Decl)); + when others => + Error_Kind ("create_list_of_types", Decl); + end case; + Next (It); + 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); + It : List_Iterator; + Call : Iir; + El : Iir; + Imp : Iir; + Inter : Iir; + begin + Call := Null_Iir; + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + 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; + Next (It); + 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; + It : List_Iterator; + 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); + It := List_Iterate (List_List); + while Is_Valid (It) loop + Append_Element (Res_List, Get_Element (It)); + Next (It); + 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_Kind_Interface_Function_Declaration + | Iir_Kind_Interface_Procedure_Declaration => + 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; + It : List_Iterator; + 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); + It := List_Iterate (List_List); + while Is_Valid (It) loop + El := Get_Element (It); + if El /= Keep then + Sem_Name_Free (El); + end if; + Next (It); + 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 => + declare + Header : constant Iir := Get_Package_Header (Decl); + begin + if Is_Valid (Header) + and then Get_Is_Within_Flag (Decl) + then + Iterator_Decl_Chain (Get_Generic_Chain (Header), Id); + end if; + end; + when Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Interface_Package_Declaration => + -- Generics are not visible in selected name. + null; + -- 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 + | Iir_Kind_Interface_Package_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 + (+Prefix, "type of the prefix should be a protected type"); + 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_Flist := 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 Flist_First .. Flist_Last (Index_List) loop + Index := Get_Nth_Element (Index_List, I); + Index_Subtype := Get_Index_Type (Prefix_Type, 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; + Set_Nth_Element (Index_List, 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)); + + -- 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))); + + -- An indexed name cannot be locally static. + if Flags.Vhdl_Std < Vhdl_08 then + Expr_Staticness := Min (Globally, Expr_Staticness); + end if; + Set_Expr_Staticness + (Expr, Min (Expr_Staticness, Get_Expr_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_Flist; + 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 (+Name, "slice can only be applied to an array"); + 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 + (+Name, "slice prefix must be an one-dimensional array"); + 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 (Warnid_Runtime_Error, +Name, + "direction mismatch results in a null slice"); + + end if; + Error_Msg_Sem (+Name, "direction of the range mismatch"); + 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_Is_Ref (Slice_Type, True); + 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_Flist (1)); + Set_Index_Constraint_List (Expr_Type, + Get_Index_Subtype_List (Expr_Type)); + 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)); + Set_Nth_Element (Get_Index_Subtype_List (Expr_Type), 0, 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, Sem_Types.Copy_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 (+Name, "%n requires parameters", +Expr); + 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); + + if Is_Error (Name) then + Set_Type (Name, Name); + return Name; + end if; + + -- Analyze the name (if not already done). + Res := Get_Named_Entity (Name); + if Res = Null_Iir then + Sem_Name (Name); + Res := Get_Named_Entity (Name); + end if; + if Res /= Null_Iir and then Is_Overload_List (Res) then + Error_Msg_Sem (+Name, "name does not denote a type mark"); + return Create_Error_Type (Name); + end if; + Res := Finish_Sem_Name (Name); + + -- LRM87 14.1 Predefined attributes + if Get_Kind (Res) = Iir_Kind_Base_Attribute then + Error_Msg_Sem + (+Name, "'Base attribute cannot be used as a type mark"); + end if; + + Atype := Name_To_Type_Definition (Res); + + if Is_Error (Atype) then + if Get_Kind (Res) in Iir_Kinds_Denoting_Name then + Set_Named_Entity (Res, Atype); + else + return Create_Error_Type (Name); + end if; + elsif not Incomplete then + if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then + Error_Msg_Sem + (+Name, "invalid use of an incomplete type definition"); + Atype := Create_Error_Type (Name); + Set_Named_Entity (Res, Atype); + end if; + end if; + + Set_Type (Res, Atype); + + return Res; + end Sem_Type_Mark; + + -- Return Globally if the prefix of NAME is a globally static name. + function Get_Object_Type_Staticness (Name : Iir) return Iir_Staticness + is + Base : constant Iir := Get_Base_Name (Name); + Parent : Iir; + begin + if Get_Kind (Base) in Iir_Kinds_Dereference then + return None; + end if; + + Parent := Get_Parent (Base); + loop + case Get_Kind (Parent) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Block_Statement + | Iir_Kind_Block_Header + | Iir_Kind_Component_Declaration + | Iir_Kinds_Process_Statement + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_Design_Unit => + -- Globally static. + return Globally; + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Protected_Type_Body => + -- Possibly nested construct. + Parent := Get_Parent (Parent); + when Iir_Kinds_Subprogram_Declaration + | Iir_Kinds_Subprogram_Body + | Iir_Kinds_Interface_Subprogram_Declaration => + -- Not globally static. + return None; + when others => + Error_Kind ("get_object_type_staticness", Parent); + end case; + end loop; + end Get_Object_Type_Staticness; + + 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; + Staticness : Iir_Staticness; + 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 := Null_Iir; + else + Parameter := Sem_Expression + (Param, Universal_Integer_Type_Definition); + if Parameter /= Null_Iir then + if Get_Expr_Staticness (Parameter) /= Locally then + Error_Msg_Sem (+Parameter, "parameter must be locally static"); + end if; + else + -- Don't forget there is a parameter, so the attribute cannot + -- be reanalyzed with a default parameter. + Parameter := Error_Mark; + 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)); + -- Convert function declaration to call. + if Get_Kind (Prefix) in Iir_Kinds_Denoting_Name + and then + (Get_Kind (Get_Named_Entity (Prefix)) + = Iir_Kind_Function_Declaration) + then + Prefix := Function_Declaration_To_Call (Prefix); + end if; + 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_Flist := + Get_Index_Subtype_List (Prefix_Type); + begin + if Is_Null (Parameter) + or else Get_Expr_Staticness (Parameter) /= Locally + then + Dim := 1; + else + Dim := Get_Value (Parameter); + end if; + if Dim < 1 or else Dim > Iir_Int64 (Get_Nbr_Elements (Indexes_List)) + then + Error_Msg_Sem (+Attr, "parameter value out of bound"); + 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. + -- + -- LRM08 9.4.3 Globally static primaries + -- l) A predefined attribute that is a function, [other than ... and + -- other than ...], whose prefix is appropriate for a globally + -- static attribute, and whose actual parameter (if any) is a + -- globally static expression. + -- + -- A prefix is appropriate for a globally static attribute if it denotes + -- a signal, a constant, a type or subtype, a globally static function + -- call, a variable that is not of an access type, or a variable of an + -- access type whose designated subtype is fully constrained. + + -- LRM93 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. + + -- LRM93 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. + + Staticness := Get_Type_Staticness (Prefix_Type); + if Is_Object_Name (Prefix) then + Staticness := Iir_Staticness'Max + (Staticness, Get_Object_Type_Staticness (Prefix)); + end if; + Set_Expr_Staticness (Attr, Staticness); + 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 (+Attr, "%n requires a parameter", +Attr); + return; + end if; + + Prefix := Finish_Sem_Name (Get_Prefix (Attr)); + Free_Iir (Attr_Name); + Set_Prefix (Attr, Prefix); + + 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 (+Attr, "parameter must be an integer"); + 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; + pragma Assert (Get_Parameter (Attr) = Null_Iir); + 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 (+Attr, "'transaction does not allow a parameter"); + 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 + (+Param, "parameter of signal attribute must be static"); + 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_Flist; + 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 Flist_First .. Flist_Last (Index_List1) loop + El1 := Get_Index_Type (Index_List1, I); + 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 + (Name : Iir; Type_Mark : Iir; Actual : Iir; In_Formal : Boolean) + 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, Name); + 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 + | Iir_Kinds_Allocator => + Error_Msg_Sem + (+Actual, "%n cannot be a type conversion operand", +Actual); + return Conv; + when Iir_Kind_Range_Expression => + -- Try to nicely handle expression like NAME (A to B). + Error_Msg_Sem + (+Actual, "subtype indication not allowed in an expression"); + return Conv; + when Iir_Kind_Error => + return Conv; + when others => + null; + end case; + + -- 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; + Set_Expression (Conv, Expr); + + -- 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. + 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 + (+Conv, + "conversion not allowed between not closely related types"); + -- Avoid error storm in evaluation. + Set_Expr_Staticness (Conv, None); + else + -- Unless the type conversion appears in the formal part of an + -- association, the expression must be readable. + if not In_Formal then + 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 : constant Iir := Get_Subprogram_Body (Subprg_Spec); + begin + 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 + (Loc, Warnid_Pure, + "reference to %n violate pure rule for %n", (+Obj, +Subprg)); + end Error_Pure; + + Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram; + Subprg_Body : Iir; + Parent : Iir; + Decl : 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; + + -- Follow aliases. + if Get_Kind (Obj) = Iir_Kind_Object_Alias_Declaration then + Decl := Get_Object_Prefix (Get_Name (Obj)); + else + Decl := Obj; + end if; + + -- Not all objects are impure. + case Get_Kind (Decl) is + when Iir_Kind_Object_Alias_Declaration => + raise Program_Error; + when 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 (Decl)) 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; + + -- DECL is declared in the immediate declarative part of the subprogram. + Parent := Get_Parent (Decl); + 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_Kind_Generate_Statement_Body + | 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; + + -- 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_Denoting_Name (Name : Iir; Res : Iir) return Iir is + begin + case Iir_Kinds_Denoting_Name (Get_Kind (Name)) is + when Iir_Kind_Simple_Name + | Iir_Kind_Character_Literal + | Iir_Kind_Operator_Symbol => + Set_Base_Name (Name, Res); + Xref_Ref (Name, Res); + return Name; + when Iir_Kind_Selected_Name => + declare + Prefix, Res_Prefix : Iir; + Old_Res : Iir; + begin + Xref_Ref (Name, Res); + Prefix := Name; + Res_Prefix := Res; + loop + Prefix := Get_Prefix (Prefix); + Res_Prefix := Get_Parent (Res_Prefix); + + -- Get the parent for expanded_name, may skip some parents. + case Get_Kind (Res_Prefix) is + when Iir_Kind_Design_Unit => + Res_Prefix := + Get_Library (Get_Design_File (Res_Prefix)); + when others => + null; + end case; + + pragma Assert (Get_Kind (Prefix) in Iir_Kinds_Denoting_Name); + Xref_Ref (Prefix, Res_Prefix); + + -- Cannot use Free_Old_Entity_Name as a prefix may not be + -- the parent (for protected subprogram calls). + Old_Res := Get_Named_Entity (Prefix); + if Is_Overload_List (Old_Res) then + Free_Iir (Old_Res); + Set_Named_Entity (Prefix, Res_Prefix); + end if; + + exit when Get_Kind (Prefix) /= Iir_Kind_Selected_Name; + end loop; + end; + return Name; + when Iir_Kind_Reference_Name => + -- Not in the sources. + raise Internal_Error; + end case; + end Finish_Sem_Denoting_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 => + 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 + | Iir_Kind_Psl_Endpoint_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); + if Get_Is_Forward_Ref (Prefix) then + Set_Base_Name (Prefix, Null_Iir); + end if; + 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 + | Iir_Kind_Interface_Type_Declaration => + Name_Res := Finish_Sem_Denoting_Name (Name, Res); + Set_Base_Name (Name_Res, Res); + return Name_Res; + when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_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 + | Iir_Kind_Interface_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_Kind_Subtype_Attribute => + null; + 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 + | Iir_Kind_Base_Attribute => + pragma Assert (Get_Kind (Name) = Iir_Kind_Attribute_Name); + Free_Iir (Name); + 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_Kinds_External_Name => + pragma Assert (Name = Res); + return Res; + when Iir_Kind_Psl_Expression => + return Res; + when Iir_Kind_Psl_Declaration => + return Name; + when Iir_Kind_Element_Declaration => + -- Certainly an error! + return Name; + when Iir_Kind_Error => + return Name; + when others => + Error_Kind ("finish_sem_name_1", Res); + end case; + + -- The name has a prefix, finish it. + 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_Named_Entity (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 + | Iir_Kind_Subtype_Attribute => + Sem_Name_Free_Result (Name, Res); + when others => + Error_Kind ("finish_sem_name_1(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; + Res_It : List_Iterator; + N : Natural; + begin + Interpretation := Get_Interpretation (Id); + + if not Valid_Interpretation (Interpretation) then + -- Unknown name. + if not Soft then + Interpretation := Get_Interpretation_Raw (Id); + if Valid_Interpretation (Interpretation) + and then Is_Conflict_Declaration (Interpretation) + then + Error_Msg_Sem + (+Name, "no declaration for %i (due to conflicts)", +Name); + else + Error_Msg_Sem (+Name, "no declaration for %i", +Name); + end if; + 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 ? + 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 (+Name, "%n is not visible here", +Res); + end if; + -- Even if a named entity was found, return an error_mark. + -- Indeed, the named entity found is certainly the one being + -- analyzed, and the analyze 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 paths (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. + Res_It := List_Iterate (Res_List); + while Is_Valid (Res_It) loop + Set_Seen_Flag (Get_Element (Res_It), False); + Next (Res_It); + end loop; + + Res := Create_Overload_List (Res_List); + end if; + + Set_Named_Entity (Name, Res); + end Sem_Simple_Name; + + -- LRM93 §6.3 + -- Selected Names. + procedure Sem_Selected_Name + (Name: Iir; Keep_Alias : Boolean := False; Soft : 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; + + -- Analyze 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. + -- + -- Analyze SUB_NAME.NAME as a selected element. + procedure Sem_As_Selected_Element (Sub_Name : Iir) + is + Name_Type : Iir; + Ptr_Type : Iir; + Rec_El : Iir; + R : Iir; + Se : Iir; + begin + Name_Type := Get_Type (Sub_Name); + if Kind_In (Name_Type, Iir_Kind_Access_Type_Definition, + Iir_Kind_Access_Subtype_Definition) + then + Ptr_Type := Name_Type; + Name_Type := Get_Designated_Type (Name_Type); + else + Ptr_Type := Null_Iir; + end if; + + -- Only records have elements. + if not Kind_In (Name_Type, Iir_Kind_Record_Type_Definition, + Iir_Kind_Record_Subtype_Definition) + then + return; + end if; + + Rec_El := Find_Name_In_Flist + (Get_Elements_Declaration_List (Name_Type), Suffix); + if Rec_El = Null_Iir then + -- No such element in the record type. + 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_Identifier (Se, Suffix); + Set_Named_Entity (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 + (+Name, "%n does not designate a record", +Prefix); + else + Error_Msg_Sem + (+Name, "no element %i in %n", (+Suffix, +Base_Type)); + 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 => + -- Declarations not allowed in protected types. + -- Just ignore them. + null; + 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 (+Name, "no method %i in %n", (+Suffix, +Prot_Type)); + end Error_Protected_Item; + + -- Emit an error message if unit is not found in library LIB. + procedure Error_Unit_Not_Found (Lib : Iir) + is + use Std_Names; + begin + Error_Msg_Sem (+Name, "unit %i not found in %n", (+Suffix, +Lib)); + + -- Give an advice for common synopsys packages. + if Get_Identifier (Lib) = Name_Ieee then + if Suffix = Name_Std_Logic_Arith + or else Suffix = Name_Std_Logic_Signed + or else Suffix = Name_Std_Logic_Unsigned + then + Error_Msg_Sem + (+Name, + " (use --ieee=synopsys for non-standard synopsys packages)"); + elsif Suffix = Name_Std_Logic_Textio then + Error_Msg_Sem + (+Name, " (use --ieee=synopsys or --std=08 for " + & "this non-standard synopsys package)"); + end if; + end if; + end Error_Unit_Not_Found; + begin + -- Analyze prefix. + if Soft then + Sem_Name_Soft (Prefix_Name); + else + Sem_Name (Prefix_Name); + end if; + Prefix := Get_Named_Entity (Prefix_Name); + if Is_Error (Prefix) 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; + It : List_Iterator; + El : Iir; + begin + -- So, first try as expanded name. + Prefix_List := Get_Overload_List (Prefix); + It := List_Iterate (Prefix_List); + while Is_Valid (It) loop + El := Get_Element (It); + case Get_Kind (El) is + when Iir_Kind_Function_Call + | Iir_Kind_Selected_Element => + -- Not an expanded name. + null; + when others => + Sem_As_Expanded_Name (El); + end case; + Next (It); + end loop; + + -- If no expanded name are found, try as selected element. + if Res = Null_Iir then + It := List_Iterate (Prefix_List); + while Is_Valid (It) loop + El := Get_Element (It); + case Get_Kind (El) is + when Iir_Kind_Procedure_Declaration => + -- A procedure cannot be the prefix of a selected + -- element. + null; + when others => + Sem_As_Selected_Element (El); + end case; + Next (It); + end loop; + end if; + end; + if Res = Null_Iir and then not Soft then + Error_Msg_Sem + (+Name, "no suffix %i for overloaded selected name", +Suffix); + 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 := Load_Primary_Unit (Prefix, Suffix, Name); + if Res /= Null_Iir then + Sem.Add_Dependence (Res); + Res := Get_Library_Unit (Res); + elsif not Soft then + Error_Unit_Not_Found (Prefix); + 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_Interface_Package_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 + 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 + if not Soft then + Error_Msg_Sem + (+Name, "no declaration for %i in %n", (+Suffix, +Prefix)); + end if; + else + -- LRM93 6.3 + -- This form of expanded name is only allowed within the + -- construct itself. + -- FIXME: LRM08 12.3 Visibility h) + if not Kind_In (Prefix, + Iir_Kind_Package_Declaration, + Iir_Kind_Package_Instantiation_Declaration) + and then not Get_Is_Within_Flag (Prefix) + then + if not Soft then + Error_Msg_Sem + (+Prefix_Loc, + "an expanded name is only allowed " + & "within the construct"); + end if; + -- Hum, keep res. + elsif Get_Kind (Prefix) = Iir_Kind_Package_Declaration + and then not Get_Is_Within_Flag (Prefix) + and then Is_Uninstantiated_Package (Prefix) + then + -- LRM08 12.3 f) Visibility + -- For a declaration given in a package declaration, other + -- than in a package declaration that defines an + -- uninstantiated package: [...] + if not Soft then + Error_Msg_Sem + (+Prefix_Loc, + "cannot refer a declaration in an " + & "uninstantiated package"); + end if; + 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 and then not Soft 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 and then not Soft then + Error_Protected_Item (Prefix); + end if; + else + Sem_As_Selected_Element (Prefix); + if Res = Null_Iir and then not Soft 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 + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Type_Conversion => + if not Soft then + Error_Msg_Sem + (+Prefix_Loc, "%n cannot be selected by name", +Prefix); + end if; + + when Iir_Kind_Error => + -- Let's propagate the error. + null; + + 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 (+Name, "only one index specification is allowed"); + 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: analyze 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 (+Name, "index must be a static expression"); + end if; + Set_Index_List (Res, Create_Iir_Flist (1)); + Set_Nth_Element (Get_Index_List (Res), 0, 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 (+Name, "index must be a static expression"); + 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_Name : constant Iir := Get_Prefix (Name); + Prefix: Iir; + Res : Iir; + Res_Prefix : 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 (+Name, "prefix is not a function 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 not Is_Function_Declaration (Sub_Name) + then + if Finish then + Error_Msg_Sem + (+Name, "prefix is not an array value (found %n)", +Sub_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 and then not Is_Error (Base_Type) then + Error_Msg_Sem (+Name, "type of prefix is not an array"); + 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 + (+Name, "number of indexes mismatches array dimension"); + 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_Flist := + 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 (+Name, "missing parameters for function call"); + 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; + 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; + Set_Index_List (R, List_To_Flist (Idx_List)); + 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; + + -- A function call. + if Is_Function_Declaration (Sub_Name) 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); + Add_Result (Res_Prefix, Sub_Name); + Used := True; + end if; + end if; + + -- A slice/index of a call (without parameters). + if not Is_Procedure_Declaration (Sub_Name) then + R := Sem_As_Indexed_Or_Slice_Name (Sub_Name, False); + if R /= Null_Iir then + Add_Result (Res, R); + Add_Result (Res_Prefix, Sub_Name); + 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 (+Name, "cannot match %n with actuals", +Prefix); + -- 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. + 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 Kind_In (Prefix, + Iir_Kind_Type_Declaration, Iir_Kind_Subtype_Declaration) + then + -- A type conversion. The prefix is a type mark. + declare + In_Formal : Boolean; + begin + if Actual = Null_Iir then + -- More than one actual. Keep only the first. + Error_Msg_Sem + (+Name, "type conversion allows only one expression"); + In_Formal := False; + else + In_Formal := Get_In_Formal_Flag (Assoc_Chain); + 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, In_Formal)); + end; + return; + end if; + + -- Select between slice or indexed name. + Actual_Expr := Null_Iir; + if Actual /= Null_Iir then + -- Only one actual: can be a slice or an index + 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 + -- Any other expression: an indexed name. + Slice_Index_Kind := Iir_Kind_Indexed_Name; + end if; + else + -- More than one actual: an indexed name. + + -- FIXME: improve error message for multi-dim slice ? + Slice_Index_Kind := Index_Or_Not (Assoc_Chain); + end if; + + -- Analyze actuals if not already done (done for slices). + 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; + + Res_Prefix := Null_Iir; + + case Get_Kind (Prefix) is + when Iir_Kind_Overload_List => + declare + El : Iir; + Prefix_List : Iir_List; + It : List_Iterator; + begin + Prefix_List := Get_Overload_List (Prefix); + It := List_Iterate (Prefix_List); + while Is_Valid (It) loop + El := Get_Element (It); + Sem_Parenthesis_Function (El); + Next (It); + end loop; + -- Some prefixes may have been removed, replace with the + -- rebuilt prefix list. + Free_Overload_List (Prefix); + Set_Named_Entity (Prefix_Name, Res_Prefix); + end; + if Res = Null_Iir then + Error_Msg_Sem + (+Name, "no overloaded function found matching %n", + +Prefix_Name); + end if; + when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_Function_Declaration => + Sem_Parenthesis_Function (Prefix); + Set_Named_Entity (Prefix_Name, Res_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 (+Name, "bad attribute parameter"); + 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 (+Name, "bad attribute parameter"); + Set_Named_Entity (Name, Error_Mark); + return; + end if; + + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration => + Error_Msg_Sem + (+Name, "subprogram name is a type mark (missing apostrophe)"); + + 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 (+Name, "bad attribute parameter"); + Set_Named_Entity (Name, Error_Mark); + end if; + return; + + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Procedure_Declaration => + Error_Msg_Sem (+Name, "cannot call %n in an expression", + +Prefix); + + when Iir_Kinds_Process_Statement + | Iir_Kind_Component_Declaration + | Iir_Kind_Type_Conversion + | Iir_Kind_Unit_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Attribute_Declaration => + Error_Msg_Sem (+Name, "%n cannot be indexed or sliced", +Prefix); + Res := Null_Iir; + + when Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Endpoint_Declaration => + Res := Sem_Psl.Sem_Psl_Name (Name); + + when Iir_Kinds_Library_Unit => + Error_Msg_Sem (+Name, "function name is a design unit"); + + 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 : constant Iir_List := Get_Overload_List (Prefix); + It : List_Iterator; + begin + It := List_Iterate (Prefix_List); + while Is_Valid (It) loop + Sem_As_Selected_By_All_Name (Get_Element (It)); + Next (It); + 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 (+Name, "prefix type is not an access type"); + 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_Type : Iir; + Res : Iir; + Base_Type : Iir; + Type_Decl : Iir; + begin + Prefix_Name := Finish_Sem_Name (Get_Prefix (Attr)); + Prefix_Type := Name_To_Type_Definition (Prefix_Name); + if not Is_Error (Prefix_Type) then + Base_Type := Get_Base_Type (Prefix_Type); + -- 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; + else + Base_Type := Prefix_Type; + end if; + 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_Name : constant Iir := Get_Prefix (Attr); + Prefix : Iir; + Value : Iir; + Attr_Id : Name_Id; + begin + Prefix := Get_Named_Entity (Prefix_Name); + + -- 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 (+Attr, "prefix of user defined attribute cannot be " + & "an object subelement"); + return Error_Mark; + when Iir_Kind_Dereference => + Error_Msg_Sem (+Attr, "prefix of user defined attribute cannot be " + & "an anonymous object"); + return Error_Mark; + when Iir_Kind_Attribute_Declaration => + Error_Msg_Sem (+Attr, "prefix of user defined attribute cannot be " + & "an attribute"); + return Error_Mark; + when Iir_Kind_Function_Call => + Error_Msg_Sem (+Attr, "invalid prefix or user defined attribute"); + 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_Kind_Component_Declaration + | Iir_Kinds_Library_Unit => + -- FIXME: to complete + null; + when Iir_Kinds_Sequential_Statement + | Iir_Kinds_Concurrent_Statement => + -- May appear textually before the statement. + Set_Is_Forward_Ref (Prefix_Name, True); + 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 (+Attr, "%n was not annotated with attribute %i", + (+Prefix, +Attr_Id)); + if Attr_Id = Std_Names.Name_First or Attr_Id = Std_Names.Name_Last + then + -- Nice (?) message for Ada users. + Error_Msg_Sem + (+Attr, "(you may use 'high, 'low, 'left or 'right attribute)"); + 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_Type : Iir; + Res : Iir; + begin + -- LRM93 14.1 + -- Prefix: Any discrete or physical type of subtype T. + Prefix_Type := + Name_To_Type_Definition (Name_To_Analyzed_Name (Prefix_Name)); + Set_Type (Prefix_Name, Prefix_Type); + if Is_Error (Prefix_Type) then + --Error_Msg_Sem + --(+Attr, "prefix of %i attribute must be a type", +Id); + return Error_Mark; + end if; + + case Id is + when Name_Image + | Name_Value => + if Get_Kind (Prefix_Type) + not in Iir_Kinds_Scalar_Type_And_Subtype_Definition + then + Error_Msg_Sem + (+Attr, "prefix of %i attribute must be a scalar type", + (1 => +Id), Cont => True); + Error_Msg_Sem + (+Attr, "found %n defined at %l", + (+Prefix_Type, +Prefix_Type)); + 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 + (+Attr, "prefix of %i" + & " attribute must be discrete or physical type", + (1 => +Id), Cont => True); + Error_Msg_Sem + (+Attr, "found %n defined at %l", + (+Prefix_Type, +Prefix_Type)); + 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 + (+Attr, + "prefix of range attribute must be an array type or object"); + return Error_Mark; + when others => + Error_Msg_Sem (+Attr, "attribute %i not valid on this type", +Id); + 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. + pragma Assert (Get_Kind (Prefix_Name) = Iir_Kind_Attribute_Name); + Free_Iir (Prefix_Name); + 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 (+Attr, "object prefix must be an array"); + return Error_Mark; + end case; + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Type_Declaration + | Iir_Kind_Base_Attribute + | Iir_Kind_Subtype_Attribute + | Iir_Kind_Element_Attribute => + Prefix_Type := Get_Type (Prefix); + if not Is_Fully_Constrained_Type (Prefix_Type) then + Error_Msg_Sem (+Attr, "prefix type is not constrained"); + -- 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 + (+Attr, "%n is not an appropriate prefix for %i attribute", + (+Prefix, +Attr)); + return Error_Mark; + when others => + Error_Msg_Sem + (+Attr, "prefix must denote an array object or type"); + return Error_Mark; + end case; + + case Get_Kind (Prefix_Type) is + when Iir_Kinds_Scalar_Type_And_Subtype_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 (+Attr, "prefix of %i 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; + + -- For 'Subtype + function Sem_Subtype_Attribute (Attr : Iir_Attribute_Name) return Iir + is + Prefix_Name : constant Iir := Get_Prefix (Attr); + Prefix : Iir; + Prefix_Type : Iir; + Res : Iir; + begin + Prefix := Get_Named_Entity (Prefix_Name); + + -- LRM08 16.2 Predefined attributes + -- Prefix: Any prefix O that is appropriate for an object, or an alias + -- thereof + if Get_Kind (Prefix) not in Iir_Kinds_Object_Declaration then + Error_Msg_Sem (+Attr, "prefix must denote an object"); + return Error_Mark; + end if; + + Prefix_Type := Get_Type (Prefix); + + Res := Create_Iir (Iir_Kind_Subtype_Attribute); + Location_Copy (Res, Attr); + Set_Prefix (Res, Prefix); + Set_Type (Res, Prefix_Type); + + Set_Base_Name (Res, Get_Base_Name (Prefix_Name)); + Set_Name_Staticness (Res, Get_Name_Staticness (Prefix)); + Set_Type_Staticness (Res, Get_Type_Staticness (Prefix_Type)); + + return Res; + end Sem_Subtype_Attribute; + + 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); + Location_Copy (Res, Attr); + 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 + (+Attr, "%i 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 + (+Attr, "prefix of %i 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 + (+Attr, "'driving or 'driving_value is available only " + & "within a concurrent statement"); + 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 + (+Attr, "'driving or 'driving_value not available " + & "within this concurrent statement"); + 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 + (+Attr, "mode of 'driving or 'driving_value prefix " + & "must be out, inout or buffer"); + end case; + when others => + Error_Msg_Sem + (+Attr, "bad prefix for 'driving or 'driving_value"); + 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 + | 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 + (+Attr, + "local ports or generics of a component cannot be a prefix"); + end if; + + when Iir_Kind_Subtype_Attribute + | Iir_Kind_Base_Attribute => + declare + Atype : constant Iir := Get_Type (Prefix); + begin + if Is_Anonymous_Type_Definition (Atype) then + Error_Msg_Sem (+Attr, "%n is not a named entity", +Prefix); + return Create_Error_Expr (Attr, String_Type_Definition); + end if; + Prefix := Get_Type_Declarator (Atype); + end; + when others => + Error_Msg_Sem (+Attr, "%n is not a named entity", +Prefix); + return Create_Error_Expr (Attr, String_Type_Definition); + end case; + + case Get_Identifier (Attr) is + when Name_Simple_Name => + declare + Id : constant Name_Id := Name_Table.Get_Identifier + (Eval_Simple_Name (Get_Identifier (Prefix))); + begin + Res := Create_Iir (Iir_Kind_Simple_Name_Attribute); + Set_Simple_Name_Identifier (Res, Id); + Attr_Type := Create_Unidim_Array_By_Length + (String_Type_Definition, + Iir_Int64 (Name_Table.Get_Name_Length (Id)), + Attr); + Set_Simple_Name_Subtype (Res, Attr_Type); + Set_Expr_Staticness (Res, Locally); + end; + + 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 (+Attr, "prefix of attribute is overloaded"); + 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 Name_Subtype => + if Flags.Vhdl_Std >= Vhdl_08 then + Res := Sem_Subtype_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 analyzed. + 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 operator_symbol. + 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 Iir_Kinds_External_Name => + Sem_External_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 analyzed. + 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 operator_symbol. + Sem_Simple_Name (Name, False, Soft => True); + when Iir_Kind_Selected_Name => + Sem_Selected_Name (Name, Keep_Alias => False, Soft => True); + when Iir_Kind_Parenthesis_Name => + -- FIXME: SOFT!! + Sem_Parenthesis_Name (Name); + when others => + Error_Kind ("sem_name_soft", Name); + end case; + end Sem_Name_Soft; + + procedure Sem_Name_Clean_1 (Name : Iir) + is + Named_Entity : Iir; + Atype : Iir; + begin + if Name = Null_Iir then + return; + end if; + + -- Clear and free overload lists of Named_entity and type. + Named_Entity := Get_Named_Entity (Name); + Set_Named_Entity (Name, Null_Iir); + if Named_Entity /= Null_Iir + and then Is_Overload_List (Named_Entity) + then + Free_Iir (Named_Entity); + end if; + + Atype := Get_Type (Name); + Set_Type (Name, Null_Iir); + if Atype /= Null_Iir + and then Is_Overload_List (Atype) + then + Free_Iir (Atype); + end if; + end Sem_Name_Clean_1; + + procedure Sem_Name_Clean (Name : Iir) is + begin + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => + Sem_Name_Clean_1 (Name); + when Iir_Kind_Parenthesis_Name + | Iir_Kind_Selected_Name => + Sem_Name_Clean_1 (Get_Prefix (Name)); + Sem_Name_Clean_1 (Name); + when others => + Error_Kind ("sem_name_clean", Name); + end case; + end Sem_Name_Clean; + + -- Remove procedure specification from LIST. + function Remove_Procedures_From_List (Expr : Iir) return Iir + is + El : Iir; + List : Iir_List; + It : List_Iterator; + New_List : Iir_List; + begin + if not Is_Overload_List (Expr) then + return Expr; + end if; + List := Get_Overload_List (Expr); + New_List := Create_Iir_List; + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + case Get_Kind (El) is + when Iir_Kind_Procedure_Declaration => + null; + when Iir_Kind_Function_Declaration => + if Maybe_Function_Call (El) then + Append_Element (New_List, El); + end if; + when others => + Append_Element (New_List, El); + end case; + Next (It); + end loop; + case Get_Nbr_Elements (New_List) is + when 0 => + Free_Iir (Expr); + Destroy_Iir_List (New_List); + return Null_Iir; + when 1 => + Free_Iir (Expr); + El := Get_First_Element (New_List); + Destroy_Iir_List (New_List); + return El; + when others => + Set_Overload_List (Expr, New_List); + Destroy_Iir_List (List); + return Expr; + end case; + end Remove_Procedures_From_List; + + -- Return the fully analyzed name of NAME. + function Name_To_Analyzed_Name (Name : Iir) return Iir is + begin + case Get_Kind (Name) is + when Iir_Kind_Attribute_Name + | Iir_Kind_Parenthesis_Name => + return Get_Named_Entity (Name); + when others => + return Name; + end case; + end Name_To_Analyzed_Name; + + -- Convert name EXPR to an expression (ie, create function call). + -- A_TYPE is the expected type of the expression. + -- Returns an Error node 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; + Expr_It : List_Iterator; + Res : Iir; + Res1 : Iir; + El : Iir; + begin + Expr := Get_Named_Entity (Name); + if Get_Kind (Expr) = Iir_Kind_Error then + return Expr; + end if; + if Check_Is_Expression (Expr, Name) = Null_Iir then + return Create_Error_Expr (Name, A_Type); + 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 (+Name, "%n cannot be used as expression", +Name); + return Create_Error_Expr (Name, A_Type); + 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 Create_Error_Expr (Res, A_Type); + end if; + if Are_Basetypes_Compatible (Get_Base_Type (Res_Type), A_Type) + = Not_Compatible + then + Error_Not_Match (Res, A_Type); + return Create_Error_Expr (Res, A_Type); + 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; + Expr_It := List_Iterate (Expr_List); + while Is_Valid (Expr_It) loop + El := Get_Element (Expr_It); + if Are_Basetypes_Compatible (Get_Base_Type (Get_Type (El)), + A_Type) + /= Not_Compatible + then + Add_Result (Res, El); + end if; + Next (Expr_It); + end loop; + if Res = Null_Iir then + -- Specific error message for a non-visible enumeration + -- literal. + if (Get_Kind (Get_Base_Type (A_Type)) + = Iir_Kind_Enumeration_Type_Definition) + and then Kind_In (Name, Iir_Kind_Simple_Name, + Iir_Kind_Character_Literal) + then + Res := Find_Name_In_Flist (Get_Enumeration_Literal_List + (Get_Base_Type (A_Type)), + Get_Identifier (Name)); + if Res /= Null_Iir then + Error_Msg_Sem + (+Name, "enumeration literal %i is not visible " + & "(add a use clause)", +Name); + -- Keep the literal as result. + end if; + end if; + end if; + + if Res = Null_Iir then + Error_Not_Match (Name, A_Type); + return Create_Error_Expr (Name, A_Type); + 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 Create_Error_Expr (Name, A_Type); + 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 Create_Error_Expr (Name, A_Type); + 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, "%n doesn't denote a range", +Name); + return Error_Mark; + end case; + end Name_To_Range; + + function Name_To_Type_Definition (Name : Iir) return Iir + is + Atype : Iir; + begin + case Get_Kind (Name) is + when Iir_Kinds_Denoting_Name => + -- Common correct case. + Atype := Get_Named_Entity (Name); + case Get_Kind (Atype) is + when Iir_Kind_Type_Declaration => + return Get_Type_Definition (Atype); + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Interface_Type_Declaration => + return Get_Type (Atype); + when Iir_Kind_Error => + return Atype; + when others => + Error_Msg_Sem + (+Name, "a type mark must denote a type or a subtype", + Cont => True); + Error_Msg_Sem + (+Name, "(type mark denotes %n)", +Atype); + return Create_Error_Type (Atype); + end case; + when Iir_Kind_Subtype_Attribute + | Iir_Kind_Element_Attribute + | Iir_Kind_Base_Attribute => + return Get_Type (Name); + when Iir_Kinds_Expression_Attribute => + Error_Msg_Sem (+Name, "%n is not a valid type mark", +Name); + return Create_Error_Type (Name); + when others => + if not Is_Error (Name) then + Error_Msg_Sem + (+Name, "a type mark must be a simple or expanded name"); + end if; + return Create_Error_Type (Name); + end case; + end Name_To_Type_Definition; + + 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); + + -- LRM08 8.1 Names + -- A name is said to be a static name if and only if one of the + -- following condition holds: + -- - The name is an external name. + Set_Name_Staticness (Name, Globally); + + Set_Expr_Staticness (Name, None); + + -- Consider the node as analyzed. + Set_Named_Entity (Name, Name); + 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 (+Name, Class_Name & " name expected"); + else + Error_Msg_Sem (+Name, Class_Name & " name expected, found %n", + +Get_Named_Entity (Name)); + end if; + end Error_Class_Match; +end Vhdl.Sem_Names; |