diff options
28 files changed, 494 insertions, 675 deletions
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index 8b8ffe49a..dc3e1af52 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -650,8 +650,7 @@ package body Canon is Canon_Expression (Get_Right (Expr)); if Get_Kind (Expr) = Iir_Kind_Concatenation_Operator and then Canon_Concatenation - and then Get_Kind (Get_Implementation (Expr)) = - Iir_Kind_Implicit_Function_Declaration + and then Is_Implicit_Subprogram (Get_Implementation (Expr)) then --Canon_Concatenation_Operator (Expr); raise Internal_Error; @@ -2304,10 +2303,6 @@ package body Canon is when Iir_Kind_Component_Declaration => null; - when Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration => - null; - when Iir_Kind_Configuration_Specification => Canon_Component_Specification (Decl, Parent); Canon_Component_Configuration (Top, Decl); diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index e2f776a79..90338af7d 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -202,11 +202,9 @@ package body Disp_Vhdl is Put ('<'); Disp_Ident (Get_Identifier (Decl)); Put ('>'); - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => Disp_Function_Name (Decl); - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => Disp_Identifier (Decl); when Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Enumeration_Type_Definition @@ -274,8 +272,6 @@ package body Disp_Vhdl is | Iir_Kind_Subtype_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kinds_Interface_Object_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Function_Declaration @@ -1417,8 +1413,7 @@ package body Disp_Vhdl is procedure Disp_Subprogram_Declaration (Subprg: Iir) is Start : constant Count := Col; - Implicit : constant Boolean := - Get_Kind (Subprg) in Iir_Kinds_Implicit_Subprogram_Declaration; + Implicit : constant Boolean := Is_Implicit_Subprogram (Subprg); Inter : Iir; begin if Implicit @@ -1435,10 +1430,7 @@ package body Disp_Vhdl is Put (' '); end if; Put ("function"); - when Iir_Kind_Implicit_Function_Declaration => - Put ("function"); - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => Put ("procedure"); when others => raise Internal_Error; @@ -1455,16 +1447,14 @@ package body Disp_Vhdl is end if; case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => Put (" return "); if Implicit then Disp_Type (Get_Return_Type (Subprg)); else Disp_Name (Get_Return_Type_Mark (Subprg)); end if; - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => null; when others => raise Internal_Error; @@ -1704,10 +1694,6 @@ package body Disp_Vhdl is Disp_Nature_Declaration (Decl); when Iir_Kind_Non_Object_Alias_Declaration => Disp_Non_Object_Alias_Declaration (Decl); - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Disp_Subprogram_Declaration (Decl); - Put_Line (";"); when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => Disp_Subprogram_Declaration (Decl); diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index 1652bb43e..b78bfc2d2 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -663,15 +663,6 @@ package body Errorout is return "configuration specification"; when Iir_Kind_Component_Configuration => return "component configuration"; - when Iir_Kind_Implicit_Function_Declaration => - return Disp_Identifier (Node, "implicit function") - & Disp_Identifier (Get_Type_Reference (Node), " of type"); --- return "implicit function " --- & Get_Predefined_Function_Name --- (Get_Implicit_Definition (Node)); - when Iir_Kind_Implicit_Procedure_Declaration => - return "implicit procedure " - & Get_Predefined_Function_Name (Get_Implicit_Definition (Node)); when Iir_Kind_Concurrent_Procedure_Call_Statement => return "concurrent procedure call"; @@ -940,10 +931,6 @@ package body Errorout is case Get_Kind (Subprg) is when Iir_Kind_Enumeration_Literal => Append (Res, "enumeration literal "); - when Iir_Kind_Implicit_Function_Declaration => - Append (Res, "implicit function "); - when Iir_Kind_Implicit_Procedure_Declaration => - Append (Res, "implicit procedure "); when Iir_Kind_Function_Declaration => Append (Res, "function "); when Iir_Kind_Procedure_Declaration => @@ -974,9 +961,7 @@ package body Errorout is Append (Res, " ["); case Get_Kind (Subprg) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Function_Declaration + when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => declare El : Iir; @@ -994,8 +979,7 @@ package body Errorout is end case; case Get_Kind (Subprg) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Function_Declaration + when Iir_Kind_Function_Declaration | Iir_Kind_Enumeration_Literal => Append (Res, " return "); Append_Type (Get_Return_Type (Subprg)); diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index 8279e140c..5387e6f90 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -1401,6 +1401,9 @@ package body Evaluation is | Iir_Predefined_Std_Ulogic_Array_Match_Inequality => -- TODO raise Internal_Error; + + when Iir_Predefined_None => + raise Internal_Error; end case; exception when Constraint_Error => @@ -2895,8 +2898,7 @@ package body Evaluation is end loop; case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => Path_Add (" return "); Path_Add_Type_Name (Get_Return_Type (Subprg)); when others => @@ -2955,9 +2957,7 @@ package body Evaluation is Path_Add_Name (El); Path_Add (":"); when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + | Iir_Kind_Procedure_Declaration => Path_Add_Element (Get_Parent (El), Is_Instance); Path_Add_Name (El); if Flags.Vhdl_Std >= Vhdl_02 then @@ -3024,8 +3024,6 @@ package body Evaluation is | Iir_Kinds_Library_Unit_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kinds_Concurrent_Statement | Iir_Kinds_Sequential_Statement => Path_Add_Element (Prefix, Is_Instance); diff --git a/src/vhdl/ieee-std_logic_1164.adb b/src/vhdl/ieee-std_logic_1164.adb index ee58fe7a5..b0c355b09 100644 --- a/src/vhdl/ieee-std_logic_1164.adb +++ b/src/vhdl/ieee-std_logic_1164.adb @@ -17,6 +17,7 @@ -- 02111-1307, USA. with Types; use Types; with Std_Names; use Std_Names; +with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; with Std_Package; @@ -28,7 +29,8 @@ package body Ieee.Std_Logic_1164 is Res := Decl; loop exit when Res = Null_Iir; - exit when Get_Kind (Res) /= Iir_Kind_Implicit_Function_Declaration; + exit when not (Get_Kind (Res) = Iir_Kind_Function_Declaration + and then Is_Implicit_Subprogram (Res)); Res := Get_Chain (Res); end loop; return Res; diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index d35b374a1..fc99f74ff 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -456,8 +456,6 @@ package body Iirs is | Iir_Kind_Across_Quantity_Declaration | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Body | Iir_Kind_Procedure_Body @@ -1819,7 +1817,7 @@ package body Iirs is begin pragma Assert (D /= Null_Iir); pragma Assert (Has_Implicit_Definition (Get_Kind (D))); - return Iir_Predefined_Functions'Val (Get_Field9 (D)); + return Iir_Predefined_Functions'Val (Get_Field7 (D)); end Get_Implicit_Definition; procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions) @@ -1827,21 +1825,21 @@ package body Iirs is begin pragma Assert (D /= Null_Iir); pragma Assert (Has_Implicit_Definition (Get_Kind (D))); - Set_Field9 (D, Iir_Predefined_Functions'Pos (Def)); + Set_Field7 (D, Iir_Predefined_Functions'Pos (Def)); end Set_Implicit_Definition; function Get_Type_Reference (Target : Iir) return Iir is begin pragma Assert (Target /= Null_Iir); pragma Assert (Has_Type_Reference (Get_Kind (Target))); - return Get_Field10 (Target); + return Get_Field11 (Target); end Get_Type_Reference; procedure Set_Type_Reference (Target : Iir; Decl : Iir) is begin pragma Assert (Target /= Null_Iir); pragma Assert (Has_Type_Reference (Get_Kind (Target))); - Set_Field10 (Target, Decl); + Set_Field11 (Target, Decl); end Set_Type_Reference; function Get_Default_Value (Target : Iir) return Iir is diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index b1214c71f..9e84c5076 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -1208,12 +1208,16 @@ package Iirs is -- -- --Get/Set_Generic_Map_Aspect_Chain (Field8) -- + -- Get/Set_Implicit_Definition (Field7) + -- -- Get/Set_Return_Type_Mark (Field8) -- -- Get/Set_Subprogram_Body (Field9) -- -- Get/Set_Subprogram_Depth (Field10) -- + -- Get/Set_Type_Reference (Field11) + -- -- Get/Set_Overload_Number (Field12) -- -- Get/Set_Seen_Flag (Flag1) @@ -1285,52 +1289,6 @@ package Iirs is -- -- Get/Set_End_Has_Identifier (Flag9) - -- Iir_Kind_Implicit_Procedure_Declaration (Medium) - -- Iir_Kind_Implicit_Function_Declaration (Medium) - -- - -- This node contains a subprogram_declaration that was implicitly defined - -- just after a type declaration. - -- This declaration is inserted by sem. - -- - -- Get/Set_Parent (Field0) - -- - -- Only for Iir_Kind_Implicit_Function_Declaration: - -- Get/Set_Return_Type (Field1) - -- - -- Only for Iir_Kind_Implicit_Function_Declaration: - -- Get/Set_Type (Alias Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Subprogram_Hash (Field4) - -- - -- Get/Set_Interface_Declaration_Chain (Field5) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Implicit_Definition (Field9) - -- - -- Get/Set_Type_Reference (Field10) - -- - -- Get/Set_Overload_Number (Field12) - -- - -- Get/Set_Wait_State (State1) - -- - -- Get/Set_Seen_Flag (Flag1) - -- - -- Only for Iir_Kind_Implicit_Function_Declaration: - -- Get/Set_Pure_Flag (Flag2) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_Use_Flag (Flag6) - -- Iir_Kind_Signal_Declaration (Short) -- -- Get/Set_Parent (Field0) @@ -3492,8 +3450,6 @@ package Iirs is Iir_Kind_Enumeration_Literal, Iir_Kind_Function_Declaration, -- Subprg, Func - Iir_Kind_Implicit_Function_Declaration, -- Subprg, Func, Imp_Subprg - Iir_Kind_Implicit_Procedure_Declaration, -- Subprg, Proc, Imp_Subprg Iir_Kind_Procedure_Declaration, -- Subprg, Proc Iir_Kind_Function_Body, Iir_Kind_Procedure_Body, @@ -3711,7 +3667,7 @@ package Iirs is ( Iir_Predefined_Error, - -- Predefined operators for BOOLEAN type. + -- Predefined operators for BOOLEAN type. Iir_Predefined_Boolean_And, Iir_Predefined_Boolean_Or, Iir_Predefined_Boolean_Nand, @@ -3723,7 +3679,7 @@ package Iirs is Iir_Predefined_Boolean_Rising_Edge, Iir_Predefined_Boolean_Falling_Edge, - -- Predefined operators for any enumeration type. + -- Predefined operators for any enumeration type. Iir_Predefined_Enum_Equality, Iir_Predefined_Enum_Inequality, Iir_Predefined_Enum_Less, @@ -3735,7 +3691,7 @@ package Iirs is Iir_Predefined_Enum_Maximum, Iir_Predefined_Enum_To_String, - -- Predefined operators for BIT type. + -- Predefined operators for BIT type. Iir_Predefined_Bit_And, Iir_Predefined_Bit_Or, Iir_Predefined_Bit_Nand, @@ -3756,7 +3712,7 @@ package Iirs is Iir_Predefined_Bit_Rising_Edge, Iir_Predefined_Bit_Falling_Edge, - -- Predefined operators for any integer type. + -- Predefined operators for any integer type. Iir_Predefined_Integer_Equality, Iir_Predefined_Integer_Inequality, Iir_Predefined_Integer_Less, @@ -3781,7 +3737,7 @@ package Iirs is Iir_Predefined_Integer_Maximum, Iir_Predefined_Integer_To_String, - -- Predefined operators for any floating type. + -- Predefined operators for any floating type. Iir_Predefined_Floating_Equality, Iir_Predefined_Floating_Inequality, Iir_Predefined_Floating_Less, @@ -3807,12 +3763,12 @@ package Iirs is Iir_Predefined_Real_To_String_Digits, Iir_Predefined_Real_To_String_Format, - -- Predefined operator for universal types. + -- Predefined operator for universal types. Iir_Predefined_Universal_R_I_Mul, Iir_Predefined_Universal_I_R_Mul, Iir_Predefined_Universal_R_I_Div, - -- Predefined operators for physical types. + -- Predefined operators for physical types. Iir_Predefined_Physical_Equality, Iir_Predefined_Physical_Inequality, Iir_Predefined_Physical_Less, @@ -3841,15 +3797,15 @@ package Iirs is Iir_Predefined_Time_To_String_Unit, - -- Predefined operators for access. + -- Predefined operators for access. Iir_Predefined_Access_Equality, Iir_Predefined_Access_Inequality, - -- Predefined operators for record. + -- Predefined operators for record. Iir_Predefined_Record_Equality, Iir_Predefined_Record_Inequality, - -- Predefined operators for array. + -- Predefined operators for array. Iir_Predefined_Array_Equality, Iir_Predefined_Array_Inequality, Iir_Predefined_Array_Less, @@ -3867,7 +3823,7 @@ package Iirs is Iir_Predefined_Vector_Minimum, Iir_Predefined_Vector_Maximum, - -- Predefined shift operators. + -- Predefined shift operators. Iir_Predefined_Array_Sll, Iir_Predefined_Array_Srl, Iir_Predefined_Array_Sla, @@ -3875,9 +3831,10 @@ package Iirs is Iir_Predefined_Array_Rol, Iir_Predefined_Array_Ror, - -- Predefined operators for one dimensional array. - -- For bit and boolean type, the operations are the same. For a neutral - -- noun, we use TF (for True/False) instead of Bit, Boolean or Logic. + -- Predefined operators for one dimensional array. + -- For bit and boolean type, the operations are the same. To be + -- neutral, we use TF (for True/False) instead of Bit, Boolean or + -- Logic. Iir_Predefined_TF_Array_And, Iir_Predefined_TF_Array_Or, Iir_Predefined_TF_Array_Nand, @@ -3929,25 +3886,12 @@ package Iirs is Iir_Predefined_Attribute_Driving, Iir_Predefined_Attribute_Driving_Value, - -- Access procedure - Iir_Predefined_Deallocate, - - -- file function / procedures. - Iir_Predefined_File_Open, - Iir_Predefined_File_Open_Status, - Iir_Predefined_File_Close, - Iir_Predefined_Read, - Iir_Predefined_Read_Length, - Iir_Predefined_Flush, - Iir_Predefined_Write, - Iir_Predefined_Endfile, - - -- To_String + -- To_String Iir_Predefined_Array_Char_To_String, Iir_Predefined_Bit_Vector_To_Ostring, Iir_Predefined_Bit_Vector_To_Hstring, - -- IEEE.Std_Logic_1164.Std_Ulogic + -- IEEE.Std_Logic_1164.Std_Ulogic Iir_Predefined_Std_Ulogic_Match_Equality, Iir_Predefined_Std_Ulogic_Match_Inequality, Iir_Predefined_Std_Ulogic_Match_Less, @@ -3958,16 +3902,39 @@ package Iirs is Iir_Predefined_Std_Ulogic_Array_Match_Equality, Iir_Predefined_Std_Ulogic_Array_Match_Inequality, - -- Predefined function. - Iir_Predefined_Now_Function - ); + -- Impure subprograms. + + -- Access procedure + Iir_Predefined_Deallocate, + + -- File function / procedures. + Iir_Predefined_File_Open, + Iir_Predefined_File_Open_Status, + Iir_Predefined_File_Close, + Iir_Predefined_Read, + Iir_Predefined_Read_Length, + Iir_Predefined_Flush, + Iir_Predefined_Write, + Iir_Predefined_Endfile, + + -- Misc impure functions. + Iir_Predefined_Now_Function, + + -- A not predefined and not known function. User function. + Iir_Predefined_None + ); -- Return TRUE iff FUNC is a short-cut predefined function. function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) return Boolean; + -- Pure and impure functions form a partition of implicit functions. subtype Iir_Predefined_Pure_Functions is Iir_Predefined_Functions range - Iir_Predefined_Boolean_And .. Iir_Predefined_Attribute_Driving_Value; + Iir_Predefined_Boolean_And .. + Iir_Predefined_Functions'Pred (Iir_Predefined_Deallocate); + subtype Iir_Predefined_Impure_Functions is Iir_Predefined_Functions range + Iir_Predefined_Deallocate .. + Iir_Predefined_Functions'Pred (Iir_Predefined_None); subtype Iir_Predefined_Dyadic_TF_Array_Functions is Iir_Predefined_Functions range @@ -3999,7 +3966,19 @@ package Iirs is --Iir_Predefined_Std_Ulogic_Match_Greater Iir_Predefined_Std_Ulogic_Match_Greater_Equal; - -- Staticness as defined by LRM93 §6.1 and §7.4 + -- Subtype for implicit subprograms. These have no corresponding bodies. + -- Implicit and explicit subprograms are partitions: they are disjoint + -- and cover all the cases. + subtype Iir_Predefined_Implicit is Iir_Predefined_Functions range + Iir_Predefined_Error .. + Iir_Predefined_Functions'Pred (Iir_Predefined_None); + + -- Subtype for exlicit subprograms. These require a corresponding body. + subtype Iir_Predefined_Explicit is Iir_Predefined_Functions range + Iir_Predefined_None .. + Iir_Predefined_Functions'Last; + + -- Staticness as defined by LRM93 §6.1 and §7.4 type Iir_Staticness is (Unknown, None, Globally, Locally); -- Staticness as defined by LRM93 §6.1 and §7.4 @@ -4222,29 +4201,14 @@ package Iirs is --Iir_Kind_Remainder_Operator Iir_Kind_Exponentiation_Operator; - subtype Iir_Kinds_Function_Declaration is Iir_Kind range - Iir_Kind_Function_Declaration .. - Iir_Kind_Implicit_Function_Declaration; - subtype Iir_Kinds_Functions_And_Literals is Iir_Kind range Iir_Kind_Enumeration_Literal .. - --Iir_Kind_Function_Declaration - Iir_Kind_Implicit_Function_Declaration; - - subtype Iir_Kinds_Procedure_Declaration is Iir_Kind range - Iir_Kind_Implicit_Procedure_Declaration .. - Iir_Kind_Procedure_Declaration; + Iir_Kind_Function_Declaration; subtype Iir_Kinds_Subprogram_Declaration is Iir_Kind range Iir_Kind_Function_Declaration .. - --Iir_Kind_Implicit_Function_Declaration - --Iir_Kind_Implicit_Procedure_Declaration Iir_Kind_Procedure_Declaration; - subtype Iir_Kinds_Implicit_Subprogram_Declaration is Iir_Kind range - Iir_Kind_Implicit_Function_Declaration .. - Iir_Kind_Implicit_Procedure_Declaration; - subtype Iir_Kinds_Process_Statement is Iir_Kind range Iir_Kind_Sensitized_Process_Statement .. Iir_Kind_Process_Statement; @@ -4482,8 +4446,6 @@ package Iirs is --Iir_Kind_Through_Quantity_Declaration --Iir_Kind_Enumeration_Literal --Iir_Kind_Function_Declaration - --Iir_Kind_Implicit_Function_Declaration - --Iir_Kind_Implicit_Procedure_Declaration --Iir_Kind_Procedure_Declaration --Iir_Kind_Function_Body --Iir_Kind_Procedure_Body @@ -4762,10 +4724,6 @@ package Iirs is subtype Iir_Procedure_Body is Iir; - subtype Iir_Implicit_Function_Declaration is Iir; - - subtype Iir_Implicit_Procedure_Declaration is Iir; - subtype Iir_Use_Clause is Iir; subtype Iir_Constant_Declaration is Iir; @@ -5395,13 +5353,13 @@ package Iirs is pragma Inline (Get_Return_Type); -- Code of an implicit subprogram definition. - -- Field: Field9 (pos) + -- Field: Field7 (pos) function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions; procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions); -- For an implicit subprogram, the type_reference is the type declaration -- for which the implicit subprogram was defined. - -- Field: Field10 Ref + -- Field: Field11 Ref function Get_Type_Reference (Target : Iir) return Iir; procedure Set_Type_Reference (Target : Iir; Decl : Iir); diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index d767ded03..2d84983c1 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -734,6 +734,12 @@ package body Iirs_Utils is and then Get_Subprogram_Specification (Bod) /= Spec; end Is_Second_Subprogram_Specification; + function Is_Implicit_Subprogram (Spec : Iir) return Boolean is + begin + return Get_Kind (Spec) in Iir_Kinds_Subprogram_Declaration + and then Get_Implicit_Definition (Spec) in Iir_Predefined_Implicit; + end Is_Implicit_Subprogram; + function Is_Same_Profile (L, R: Iir) return Boolean is L1, R1 : Iir; @@ -757,16 +763,16 @@ package body Iirs_Utils is -- Check L and R are both of the same 'kind'. -- Also the return profile for functions. - if L_Kind in Iir_Kinds_Function_Declaration - and then R_Kind in Iir_Kinds_Function_Declaration + if L_Kind = Iir_Kind_Function_Declaration + and then R_Kind = Iir_Kind_Function_Declaration then if Get_Base_Type (Get_Return_Type (L1)) /= Get_Base_Type (Get_Return_Type (R1)) then return False; end if; - elsif L_Kind in Iir_Kinds_Procedure_Declaration - and then R_Kind in Iir_Kinds_Procedure_Declaration + elsif L_Kind = Iir_Kind_Procedure_Declaration + and then R_Kind = Iir_Kind_Procedure_Declaration then null; elsif L_Kind = Iir_Kind_Enumeration_Literal diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index a588ab870..da3e72b93 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -117,6 +117,11 @@ package Iirs_Utils is -- is to match the body with its declaration. function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean; + -- Return True iif SPEC is the specification of an implicit subprogram. + -- False for explicit subprograms. + function Is_Implicit_Subprogram (Spec : Iir) return Boolean; + pragma Inline (Is_Implicit_Subprogram); + -- If NAME is a simple or an expanded name, return the denoted declaration. -- Otherwise, return NAME. function Strip_Denoting_Name (Name : Iir) return Iir; diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index f31a5a3b4..10c27e2bc 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -1081,10 +1081,6 @@ package body Nodes_Meta is return "enumeration_literal"; when Iir_Kind_Function_Declaration => return "function_declaration"; - when Iir_Kind_Implicit_Function_Declaration => - return "implicit_function_declaration"; - when Iir_Kind_Implicit_Procedure_Declaration => - return "implicit_procedure_declaration"; when Iir_Kind_Procedure_Declaration => return "procedure_declaration"; when Iir_Kind_Function_Body => @@ -2664,6 +2660,7 @@ package body Nodes_Meta is Field_Overload_Number, Field_Identifier, Field_Subprogram_Hash, + Field_Implicit_Definition, Field_Seen_Flag, Field_Pure_Flag, Field_Foreign_Flag, @@ -2681,46 +2678,14 @@ package body Nodes_Meta is Field_Return_Type_Mark, Field_Parent, Field_Return_Type, - Field_Subprogram_Body, - -- Iir_Kind_Implicit_Function_Declaration - Field_Overload_Number, - Field_Identifier, - Field_Subprogram_Hash, - Field_Implicit_Definition, - Field_Seen_Flag, - Field_Pure_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Use_Flag, - Field_Wait_State, - Field_Chain, - Field_Interface_Declaration_Chain, - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Parent, - Field_Return_Type, - Field_Type_Reference, - -- Iir_Kind_Implicit_Procedure_Declaration - Field_Overload_Number, - Field_Identifier, - Field_Subprogram_Hash, - Field_Implicit_Definition, - Field_Seen_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Use_Flag, - Field_Wait_State, - Field_Chain, - Field_Interface_Declaration_Chain, - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Parent, Field_Type_Reference, + Field_Subprogram_Body, -- Iir_Kind_Procedure_Declaration Field_Subprogram_Depth, Field_Overload_Number, Field_Identifier, Field_Subprogram_Hash, + Field_Implicit_Definition, Field_Seen_Flag, Field_Passive_Flag, Field_Foreign_Flag, @@ -2736,6 +2701,7 @@ package body Nodes_Meta is Field_Generic_Chain, Field_Return_Type_Mark, Field_Parent, + Field_Type_Reference, Field_Subprogram_Body, -- Iir_Kind_Function_Body Field_Impure_Depth, @@ -3927,153 +3893,151 @@ package body Nodes_Meta is Iir_Kind_Across_Quantity_Declaration => 586, Iir_Kind_Through_Quantity_Declaration => 598, Iir_Kind_Enumeration_Literal => 609, - Iir_Kind_Function_Declaration => 631, - Iir_Kind_Implicit_Function_Declaration => 648, - Iir_Kind_Implicit_Procedure_Declaration => 663, - Iir_Kind_Procedure_Declaration => 683, - Iir_Kind_Function_Body => 693, - Iir_Kind_Procedure_Body => 703, - Iir_Kind_Object_Alias_Declaration => 715, - Iir_Kind_File_Declaration => 730, - Iir_Kind_Guard_Signal_Declaration => 743, - Iir_Kind_Signal_Declaration => 760, - Iir_Kind_Variable_Declaration => 773, - Iir_Kind_Constant_Declaration => 787, - Iir_Kind_Iterator_Declaration => 799, - Iir_Kind_Interface_Constant_Declaration => 815, - Iir_Kind_Interface_Variable_Declaration => 831, - Iir_Kind_Interface_Signal_Declaration => 852, - Iir_Kind_Interface_File_Declaration => 868, - Iir_Kind_Interface_Package_Declaration => 877, - Iir_Kind_Identity_Operator => 881, - Iir_Kind_Negation_Operator => 885, - Iir_Kind_Absolute_Operator => 889, - Iir_Kind_Not_Operator => 893, - Iir_Kind_Condition_Operator => 897, - Iir_Kind_Reduction_And_Operator => 901, - Iir_Kind_Reduction_Or_Operator => 905, - Iir_Kind_Reduction_Nand_Operator => 909, - Iir_Kind_Reduction_Nor_Operator => 913, - Iir_Kind_Reduction_Xor_Operator => 917, - Iir_Kind_Reduction_Xnor_Operator => 921, - Iir_Kind_And_Operator => 926, - Iir_Kind_Or_Operator => 931, - Iir_Kind_Nand_Operator => 936, - Iir_Kind_Nor_Operator => 941, - Iir_Kind_Xor_Operator => 946, - Iir_Kind_Xnor_Operator => 951, - Iir_Kind_Equality_Operator => 956, - Iir_Kind_Inequality_Operator => 961, - Iir_Kind_Less_Than_Operator => 966, - Iir_Kind_Less_Than_Or_Equal_Operator => 971, - Iir_Kind_Greater_Than_Operator => 976, - Iir_Kind_Greater_Than_Or_Equal_Operator => 981, - Iir_Kind_Match_Equality_Operator => 986, - Iir_Kind_Match_Inequality_Operator => 991, - Iir_Kind_Match_Less_Than_Operator => 996, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1001, - Iir_Kind_Match_Greater_Than_Operator => 1006, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1011, - Iir_Kind_Sll_Operator => 1016, - Iir_Kind_Sla_Operator => 1021, - Iir_Kind_Srl_Operator => 1026, - Iir_Kind_Sra_Operator => 1031, - Iir_Kind_Rol_Operator => 1036, - Iir_Kind_Ror_Operator => 1041, - Iir_Kind_Addition_Operator => 1046, - Iir_Kind_Substraction_Operator => 1051, - Iir_Kind_Concatenation_Operator => 1056, - Iir_Kind_Multiplication_Operator => 1061, - Iir_Kind_Division_Operator => 1066, - Iir_Kind_Modulus_Operator => 1071, - Iir_Kind_Remainder_Operator => 1076, - Iir_Kind_Exponentiation_Operator => 1081, - Iir_Kind_Function_Call => 1089, - Iir_Kind_Aggregate => 1095, - Iir_Kind_Parenthesis_Expression => 1098, - Iir_Kind_Qualified_Expression => 1102, - Iir_Kind_Type_Conversion => 1107, - Iir_Kind_Allocator_By_Expression => 1111, - Iir_Kind_Allocator_By_Subtype => 1115, - Iir_Kind_Selected_Element => 1121, - Iir_Kind_Dereference => 1126, - Iir_Kind_Implicit_Dereference => 1131, - Iir_Kind_Slice_Name => 1138, - Iir_Kind_Indexed_Name => 1144, - Iir_Kind_Psl_Expression => 1146, - Iir_Kind_Sensitized_Process_Statement => 1165, - Iir_Kind_Process_Statement => 1183, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1194, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1206, - Iir_Kind_Concurrent_Assertion_Statement => 1214, - Iir_Kind_Psl_Default_Clock => 1218, - Iir_Kind_Psl_Assert_Statement => 1227, - Iir_Kind_Psl_Cover_Statement => 1236, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1242, - Iir_Kind_Block_Statement => 1255, - Iir_Kind_Generate_Statement => 1267, - Iir_Kind_Component_Instantiation_Statement => 1277, - Iir_Kind_Simple_Simultaneous_Statement => 1284, - Iir_Kind_Signal_Assignment_Statement => 1293, - Iir_Kind_Null_Statement => 1297, - Iir_Kind_Assertion_Statement => 1304, - Iir_Kind_Report_Statement => 1310, - Iir_Kind_Wait_Statement => 1317, - Iir_Kind_Variable_Assignment_Statement => 1323, - Iir_Kind_Return_Statement => 1329, - Iir_Kind_For_Loop_Statement => 1337, - Iir_Kind_While_Loop_Statement => 1344, - Iir_Kind_Next_Statement => 1350, - Iir_Kind_Exit_Statement => 1356, - Iir_Kind_Case_Statement => 1363, - Iir_Kind_Procedure_Call_Statement => 1368, - Iir_Kind_If_Statement => 1376, - Iir_Kind_Elsif => 1381, - Iir_Kind_Character_Literal => 1388, - Iir_Kind_Simple_Name => 1395, - Iir_Kind_Selected_Name => 1403, - Iir_Kind_Operator_Symbol => 1408, - Iir_Kind_Selected_By_All_Name => 1413, - Iir_Kind_Parenthesis_Name => 1417, - Iir_Kind_Base_Attribute => 1419, - Iir_Kind_Left_Type_Attribute => 1424, - Iir_Kind_Right_Type_Attribute => 1429, - Iir_Kind_High_Type_Attribute => 1434, - Iir_Kind_Low_Type_Attribute => 1439, - Iir_Kind_Ascending_Type_Attribute => 1444, - Iir_Kind_Image_Attribute => 1450, - Iir_Kind_Value_Attribute => 1456, - Iir_Kind_Pos_Attribute => 1462, - Iir_Kind_Val_Attribute => 1468, - Iir_Kind_Succ_Attribute => 1474, - Iir_Kind_Pred_Attribute => 1480, - Iir_Kind_Leftof_Attribute => 1486, - Iir_Kind_Rightof_Attribute => 1492, - Iir_Kind_Delayed_Attribute => 1500, - Iir_Kind_Stable_Attribute => 1508, - Iir_Kind_Quiet_Attribute => 1516, - Iir_Kind_Transaction_Attribute => 1524, - Iir_Kind_Event_Attribute => 1528, - Iir_Kind_Active_Attribute => 1532, - Iir_Kind_Last_Event_Attribute => 1536, - Iir_Kind_Last_Active_Attribute => 1540, - Iir_Kind_Last_Value_Attribute => 1544, - Iir_Kind_Driving_Attribute => 1548, - Iir_Kind_Driving_Value_Attribute => 1552, - Iir_Kind_Behavior_Attribute => 1552, - Iir_Kind_Structure_Attribute => 1552, - Iir_Kind_Simple_Name_Attribute => 1559, - Iir_Kind_Instance_Name_Attribute => 1564, - Iir_Kind_Path_Name_Attribute => 1569, - Iir_Kind_Left_Array_Attribute => 1576, - Iir_Kind_Right_Array_Attribute => 1583, - Iir_Kind_High_Array_Attribute => 1590, - Iir_Kind_Low_Array_Attribute => 1597, - Iir_Kind_Length_Array_Attribute => 1604, - Iir_Kind_Ascending_Array_Attribute => 1611, - Iir_Kind_Range_Array_Attribute => 1618, - Iir_Kind_Reverse_Range_Array_Attribute => 1625, - Iir_Kind_Attribute_Name => 1633 + Iir_Kind_Function_Declaration => 633, + Iir_Kind_Procedure_Declaration => 655, + Iir_Kind_Function_Body => 665, + Iir_Kind_Procedure_Body => 675, + Iir_Kind_Object_Alias_Declaration => 687, + Iir_Kind_File_Declaration => 702, + Iir_Kind_Guard_Signal_Declaration => 715, + Iir_Kind_Signal_Declaration => 732, + Iir_Kind_Variable_Declaration => 745, + Iir_Kind_Constant_Declaration => 759, + Iir_Kind_Iterator_Declaration => 771, + Iir_Kind_Interface_Constant_Declaration => 787, + Iir_Kind_Interface_Variable_Declaration => 803, + Iir_Kind_Interface_Signal_Declaration => 824, + Iir_Kind_Interface_File_Declaration => 840, + Iir_Kind_Interface_Package_Declaration => 849, + Iir_Kind_Identity_Operator => 853, + Iir_Kind_Negation_Operator => 857, + Iir_Kind_Absolute_Operator => 861, + Iir_Kind_Not_Operator => 865, + Iir_Kind_Condition_Operator => 869, + Iir_Kind_Reduction_And_Operator => 873, + Iir_Kind_Reduction_Or_Operator => 877, + Iir_Kind_Reduction_Nand_Operator => 881, + Iir_Kind_Reduction_Nor_Operator => 885, + Iir_Kind_Reduction_Xor_Operator => 889, + Iir_Kind_Reduction_Xnor_Operator => 893, + Iir_Kind_And_Operator => 898, + Iir_Kind_Or_Operator => 903, + Iir_Kind_Nand_Operator => 908, + Iir_Kind_Nor_Operator => 913, + Iir_Kind_Xor_Operator => 918, + Iir_Kind_Xnor_Operator => 923, + Iir_Kind_Equality_Operator => 928, + Iir_Kind_Inequality_Operator => 933, + Iir_Kind_Less_Than_Operator => 938, + Iir_Kind_Less_Than_Or_Equal_Operator => 943, + Iir_Kind_Greater_Than_Operator => 948, + Iir_Kind_Greater_Than_Or_Equal_Operator => 953, + Iir_Kind_Match_Equality_Operator => 958, + Iir_Kind_Match_Inequality_Operator => 963, + Iir_Kind_Match_Less_Than_Operator => 968, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 973, + Iir_Kind_Match_Greater_Than_Operator => 978, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 983, + Iir_Kind_Sll_Operator => 988, + Iir_Kind_Sla_Operator => 993, + Iir_Kind_Srl_Operator => 998, + Iir_Kind_Sra_Operator => 1003, + Iir_Kind_Rol_Operator => 1008, + Iir_Kind_Ror_Operator => 1013, + Iir_Kind_Addition_Operator => 1018, + Iir_Kind_Substraction_Operator => 1023, + Iir_Kind_Concatenation_Operator => 1028, + Iir_Kind_Multiplication_Operator => 1033, + Iir_Kind_Division_Operator => 1038, + Iir_Kind_Modulus_Operator => 1043, + Iir_Kind_Remainder_Operator => 1048, + Iir_Kind_Exponentiation_Operator => 1053, + Iir_Kind_Function_Call => 1061, + Iir_Kind_Aggregate => 1067, + Iir_Kind_Parenthesis_Expression => 1070, + Iir_Kind_Qualified_Expression => 1074, + Iir_Kind_Type_Conversion => 1079, + Iir_Kind_Allocator_By_Expression => 1083, + Iir_Kind_Allocator_By_Subtype => 1087, + Iir_Kind_Selected_Element => 1093, + Iir_Kind_Dereference => 1098, + Iir_Kind_Implicit_Dereference => 1103, + Iir_Kind_Slice_Name => 1110, + Iir_Kind_Indexed_Name => 1116, + Iir_Kind_Psl_Expression => 1118, + Iir_Kind_Sensitized_Process_Statement => 1137, + Iir_Kind_Process_Statement => 1155, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1166, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1178, + Iir_Kind_Concurrent_Assertion_Statement => 1186, + Iir_Kind_Psl_Default_Clock => 1190, + Iir_Kind_Psl_Assert_Statement => 1199, + Iir_Kind_Psl_Cover_Statement => 1208, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1214, + Iir_Kind_Block_Statement => 1227, + Iir_Kind_Generate_Statement => 1239, + Iir_Kind_Component_Instantiation_Statement => 1249, + Iir_Kind_Simple_Simultaneous_Statement => 1256, + Iir_Kind_Signal_Assignment_Statement => 1265, + Iir_Kind_Null_Statement => 1269, + Iir_Kind_Assertion_Statement => 1276, + Iir_Kind_Report_Statement => 1282, + Iir_Kind_Wait_Statement => 1289, + Iir_Kind_Variable_Assignment_Statement => 1295, + Iir_Kind_Return_Statement => 1301, + Iir_Kind_For_Loop_Statement => 1309, + Iir_Kind_While_Loop_Statement => 1316, + Iir_Kind_Next_Statement => 1322, + Iir_Kind_Exit_Statement => 1328, + Iir_Kind_Case_Statement => 1335, + Iir_Kind_Procedure_Call_Statement => 1340, + Iir_Kind_If_Statement => 1348, + Iir_Kind_Elsif => 1353, + Iir_Kind_Character_Literal => 1360, + Iir_Kind_Simple_Name => 1367, + Iir_Kind_Selected_Name => 1375, + Iir_Kind_Operator_Symbol => 1380, + Iir_Kind_Selected_By_All_Name => 1385, + Iir_Kind_Parenthesis_Name => 1389, + Iir_Kind_Base_Attribute => 1391, + Iir_Kind_Left_Type_Attribute => 1396, + Iir_Kind_Right_Type_Attribute => 1401, + Iir_Kind_High_Type_Attribute => 1406, + Iir_Kind_Low_Type_Attribute => 1411, + Iir_Kind_Ascending_Type_Attribute => 1416, + Iir_Kind_Image_Attribute => 1422, + Iir_Kind_Value_Attribute => 1428, + Iir_Kind_Pos_Attribute => 1434, + Iir_Kind_Val_Attribute => 1440, + Iir_Kind_Succ_Attribute => 1446, + Iir_Kind_Pred_Attribute => 1452, + Iir_Kind_Leftof_Attribute => 1458, + Iir_Kind_Rightof_Attribute => 1464, + Iir_Kind_Delayed_Attribute => 1472, + Iir_Kind_Stable_Attribute => 1480, + Iir_Kind_Quiet_Attribute => 1488, + Iir_Kind_Transaction_Attribute => 1496, + Iir_Kind_Event_Attribute => 1500, + Iir_Kind_Active_Attribute => 1504, + Iir_Kind_Last_Event_Attribute => 1508, + Iir_Kind_Last_Active_Attribute => 1512, + Iir_Kind_Last_Value_Attribute => 1516, + Iir_Kind_Driving_Attribute => 1520, + Iir_Kind_Driving_Value_Attribute => 1524, + Iir_Kind_Behavior_Attribute => 1524, + Iir_Kind_Structure_Attribute => 1524, + Iir_Kind_Simple_Name_Attribute => 1531, + Iir_Kind_Instance_Name_Attribute => 1536, + Iir_Kind_Path_Name_Attribute => 1541, + Iir_Kind_Left_Array_Attribute => 1548, + Iir_Kind_Right_Array_Attribute => 1555, + Iir_Kind_High_Array_Attribute => 1562, + Iir_Kind_Low_Array_Attribute => 1569, + Iir_Kind_Length_Array_Attribute => 1576, + Iir_Kind_Ascending_Array_Attribute => 1583, + Iir_Kind_Range_Array_Attribute => 1590, + Iir_Kind_Reverse_Range_Array_Attribute => 1597, + Iir_Kind_Attribute_Name => 1605 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -6383,8 +6347,6 @@ package body Nodes_Meta is | Iir_Kind_Across_Quantity_Declaration | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Body | Iir_Kind_Procedure_Body @@ -6457,8 +6419,6 @@ package body Nodes_Meta is | Iir_Kind_Package_Header | Iir_Kind_Component_Declaration | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Interface_Package_Declaration => return True; @@ -6493,7 +6453,6 @@ package body Nodes_Meta is | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Guard_Signal_Declaration @@ -6758,8 +6717,6 @@ package body Nodes_Meta is begin case K is when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration => return True; when others => @@ -6810,8 +6767,6 @@ package body Nodes_Meta is begin case K is when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration => return True; when others => @@ -6835,8 +6790,6 @@ package body Nodes_Meta is case K is when Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration => return True; when others => @@ -6859,8 +6812,7 @@ package body Nodes_Meta is begin case K is when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => + | Iir_Kind_Function_Declaration => return True; when others => return False; @@ -6870,8 +6822,8 @@ package body Nodes_Meta is function Has_Implicit_Definition (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => return True; when others => return False; @@ -6881,8 +6833,8 @@ package body Nodes_Meta is function Has_Type_Reference (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => return True; when others => return False; @@ -7101,8 +7053,6 @@ package body Nodes_Meta is | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_File_Declaration @@ -7218,8 +7168,6 @@ package body Nodes_Meta is | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_File_Declaration @@ -7686,8 +7634,6 @@ package body Nodes_Meta is begin case K is when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement => @@ -7713,8 +7659,6 @@ package body Nodes_Meta is case K is when Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement => @@ -7726,13 +7670,7 @@ package body Nodes_Meta is function Has_Pure_Flag (K : Iir_Kind) return Boolean is begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - return True; - when others => - return False; - end case; + return K = Iir_Kind_Function_Declaration; end Has_Pure_Flag; function Has_Foreign_Flag (K : Iir_Kind) return Boolean is @@ -7902,8 +7840,6 @@ package body Nodes_Meta is | Iir_Kind_Binding_Indication | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Package_Header - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Component_Instantiation_Statement => return True; @@ -8115,8 +8051,6 @@ package body Nodes_Meta is | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Body | Iir_Kind_Procedure_Body @@ -8980,8 +8914,6 @@ package body Nodes_Meta is | Iir_Kind_Architecture_Body | Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement @@ -9083,8 +9015,6 @@ package body Nodes_Meta is | Iir_Kind_Across_Quantity_Declaration | Iir_Kind_Through_Quantity_Declaration | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_File_Declaration diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 239a0e675..0611fc548 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -5322,7 +5322,7 @@ package body Parse is Old : Iir; pragma Unreferenced (Old); begin - -- Create the node. + -- Create the node. case Current_Token is when Tok_Procedure => Kind := Iir_Kind_Procedure_Declaration; @@ -5335,6 +5335,7 @@ package body Parse is end case; Subprg := Create_Iir (Kind); Set_Location (Subprg); + Set_Implicit_Definition (Subprg, Iir_Predefined_None); case Current_Token is when Tok_Procedure => @@ -5353,14 +5354,16 @@ package body Parse is end if; Set_Has_Pure (Subprg, True); -- FIXME: what to do in case of error ?? - -- Eat PURE or IMPURE. + + -- Eat 'pure' or 'impure'. Scan; + Expect (Tok_Function, "'function' must follow 'pure' or 'impure'"); when others => raise Internal_Error; end case; - -- Eat PROCEDURE or FUNCTION. + -- Eat 'procedure' or 'function'. Scan; if Current_Token = Tok_Identifier then @@ -5382,7 +5385,9 @@ package body Parse is Expect (Tok_Identifier); end if; + -- Eat designator (identifier or string). Scan; + if Current_Token = Tok_Left_Paren then -- Parse the interface declaration. if Kind = Iir_Kind_Function_Declaration then diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 1410c176c..833df587f 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -1160,11 +1160,11 @@ package body Sem is end if; case Get_Kind (Left) is - when Iir_Kinds_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => return Are_Trees_Chain_Equal (Get_Interface_Declaration_Chain (Left), Get_Interface_Declaration_Chain (Right)); - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => if not Are_Trees_Equal (Get_Return_Type (Left), Get_Return_Type (Right)) then @@ -1452,7 +1452,6 @@ package body Sem is Interpretation : Name_Interpretation_Type; Decl1: Iir; Hash : Iir_Int32; - Kind : Iir_Kind; begin Hash := Get_Subprogram_Hash (Decl); Interpretation := Get_Interpretation (Get_Identifier (Decl)); @@ -1464,14 +1463,12 @@ package body Sem is return Null_Iir; end if; Decl1 := Get_Declaration (Interpretation); - Kind := Get_Kind (Decl1); -- Should be sure DECL1 and DECL belongs to the same declarative -- region, ie DECL1 was not made visible via a USE clause. -- -- Also, only check for explicitly subprograms (and not -- implicit one). - if (Kind = Iir_Kind_Function_Declaration - or Kind = Iir_Kind_Procedure_Declaration) + if not Is_Implicit_Subprogram (Decl1) and then not Is_Potentially_Visible (Interpretation) and then Get_Subprogram_Hash (Decl1) = Hash and then Is_Same_Profile (Decl, Decl1) @@ -1500,26 +1497,27 @@ package body Sem is case Get_Kind (Prev) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - -- The previous declaration is a user subprogram. - Num := Get_Overload_Number (Prev) + 1; - if Num = 1 - and then Get_Parent (Prev) = Get_Parent (Decl) - then - -- The previous was not (yet) overloaded. Mark it as - -- overloaded. - -- Do not mark it if it is not in the same declarative part. - -- (ie, do not change a subprogram declaration in the - -- package while analyzing the body). - Set_Overload_Number (Prev, 1); - Num := 2; + if Is_Implicit_Subprogram (Prev) then + -- Implicit declarations aren't taken into account (as they + -- are mangled differently). + Inter := Get_Next_Interpretation (Inter); + else + -- The previous declaration is a user subprogram. + Num := Get_Overload_Number (Prev) + 1; + if Num = 1 + and then Get_Parent (Prev) = Get_Parent (Decl) + then + -- The previous was not (yet) overloaded. Mark it as + -- overloaded. + -- Do not mark it if it is not in the same declarative + -- part (ie, do not change a subprogram declaration in + -- the package while analyzing the body). + Set_Overload_Number (Prev, 1); + Num := 2; + end if; + Set_Overload_Number (Decl, Num); + return; end if; - Set_Overload_Number (Decl, Num); - return; - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - -- Implicit declarations aren't taken into account (as they - -- are mangled differently). - Inter := Get_Next_Interpretation (Inter); when Iir_Kind_Enumeration_Literal => -- Enumeration literal are ignored for overload number. Inter := Get_Next_Interpretation (Inter); @@ -1648,7 +1646,7 @@ package body Sem is Itype : Iir; begin Kind := Get_Kind (Subprg); - if Kind in Iir_Kinds_Function_Declaration + if Kind = Iir_Kind_Function_Declaration or else Kind = Iir_Kind_Enumeration_Literal then Itype := Get_Base_Type (Get_Return_Type (Subprg)); @@ -1856,7 +1854,7 @@ package body Sem is Callee := Get_Nth_Element (Callees, I); exit when Callee = Null_Iir; case Get_Kind (Callee) is - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => null; when Iir_Kind_Procedure_Declaration => State := Get_Wait_State (Callee); @@ -1872,8 +1870,6 @@ package body Sem is --Set_Wait_State (Spec, True); --exit; end case; - when Iir_Kind_Implicit_Procedure_Declaration => - null; when others => Error_Kind ("sem_subprogram_body(2)", Callee); end case; @@ -2284,7 +2280,9 @@ package body Sem is case Get_Kind (El) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - return True; + if not Is_Implicit_Subprogram (El) then + return True; + end if; when Iir_Kind_Constant_Declaration => if Get_Default_Value (El) = Null_Iir then return True; @@ -2307,9 +2305,6 @@ package body Sem is when Iir_Kind_Anonymous_Type_Declaration | Iir_Kind_Subtype_Declaration => null; - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; when Iir_Kind_Attribute_Declaration | Iir_Kind_Attribute_Specification => null; diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index 96e660875..a6b35961b 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -889,7 +889,7 @@ package body Sem_Assocs is function Extract_Type_Of_Conversion (Func : Iir) return Iir is begin case Get_Kind (Func) is - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => if Is_Chain_Length_One (Get_Interface_Declaration_Chain (Func)) then return Get_Type (Func); @@ -1136,7 +1136,7 @@ package body Sem_Assocs is P_Type : Iir; begin case Get_Kind (Func) is - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => R_Type := Get_Type (Func); P_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); if Get_Base_Type (R_Type) = Res_Base_Type @@ -1252,7 +1252,7 @@ package body Sem_Assocs is Set_Named_Entity (Conv, Func); case Get_Kind (Func) is - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => Res := Create_Iir (Iir_Kind_Function_Call); Location_Copy (Res, Conv); Set_Implementation (Res, Func); diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb index a3a166102..1dd38684e 100644 --- a/src/vhdl/sem_decls.adb +++ b/src/vhdl/sem_decls.adb @@ -386,8 +386,8 @@ package body Sem_Decls is use Iir_Chains.Interface_Declaration_Chain_Handling; Type_Mark : constant Iir := Get_File_Type_Mark (Type_Definition); Type_Mark_Type : constant Iir := Get_Type (Type_Mark); - Proc: Iir_Implicit_Procedure_Declaration; - Func: Iir_Implicit_Function_Declaration; + Proc: Iir_Procedure_Declaration; + Func: Iir_Function_Declaration; Inter: Iir; Loc : Location_Type; File_Interface_Kind : Iir_Kind; @@ -401,12 +401,13 @@ package body Sem_Decls is for I in 1 .. 2 loop -- Create the implicit file_open (form 1) declaration. -- Create the implicit file_open (form 2) declaration. - Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); + Proc := Create_Iir (Iir_Kind_Procedure_Declaration); Set_Location (Proc, Loc); Set_Parent (Proc, Get_Parent (Decl)); Set_Identifier (Proc, Std_Names.Name_File_Open); Set_Type_Reference (Proc, Decl); Set_Visible_Flag (Proc, True); + Set_Wait_State (Proc, False); Build_Init (Last_Interface); case I is when 1 => @@ -453,13 +454,14 @@ package body Sem_Decls is end loop; -- Create the implicit file_close declaration. - Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); + Proc := Create_Iir (Iir_Kind_Procedure_Declaration); Set_Identifier (Proc, Std_Names.Name_File_Close); Set_Location (Proc, Loc); Set_Parent (Proc, Get_Parent (Decl)); Set_Implicit_Definition (Proc, Iir_Predefined_File_Close); Set_Type_Reference (Proc, Decl); Set_Visible_Flag (Proc, True); + Set_Wait_State (Proc, False); Build_Init (Last_Interface); Inter := Create_Iir (Iir_Kind_Interface_File_Declaration); Set_Identifier (Inter, Std_Names.Name_F); @@ -479,12 +481,13 @@ package body Sem_Decls is end if; -- Create the implicit procedure read declaration. - Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); + Proc := Create_Iir (Iir_Kind_Procedure_Declaration); Set_Identifier (Proc, Std_Names.Name_Read); Set_Location (Proc, Loc); Set_Parent (Proc, Get_Parent (Decl)); Set_Type_Reference (Proc, Decl); Set_Visible_Flag (Proc, True); + Set_Wait_State (Proc, False); Build_Init (Last_Interface); Inter := Create_Iir (File_Interface_Kind); Set_Identifier (Inter, Std_Names.Name_F); @@ -517,12 +520,13 @@ package body Sem_Decls is Insert_Incr (Last, Proc); -- Create the implicit procedure write declaration. - Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); + Proc := Create_Iir (Iir_Kind_Procedure_Declaration); Set_Identifier (Proc, Std_Names.Name_Write); Set_Location (Proc, Loc); Set_Parent (Proc, Get_Parent (Decl)); Set_Type_Reference (Proc, Decl); Set_Visible_Flag (Proc, True); + Set_Wait_State (Proc, False); Build_Init (Last_Interface); Inter := Create_Iir (File_Interface_Kind); Set_Identifier (Inter, Std_Names.Name_F); @@ -546,12 +550,13 @@ package body Sem_Decls is -- Create the implicit procedure flush declaration if Flags.Vhdl_Std >= Vhdl_08 then - Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); + Proc := Create_Iir (Iir_Kind_Procedure_Declaration); Set_Identifier (Proc, Std_Names.Name_Flush); Set_Location (Proc, Loc); Set_Parent (Proc, Get_Parent (Decl)); Set_Type_Reference (Proc, Decl); Set_Visible_Flag (Proc, True); + Set_Wait_State (Proc, False); Build_Init (Last_Interface); Inter := Create_Iir (File_Interface_Kind); Set_Identifier (Inter, Std_Names.Name_F); @@ -566,7 +571,7 @@ package body Sem_Decls is Insert_Incr (Last, Proc); end if; -- Create the implicit function endfile declaration. - Func := Create_Iir (Iir_Kind_Implicit_Function_Declaration); + Func := Create_Iir (Iir_Kind_Function_Declaration); Set_Identifier (Func, Std_Names.Name_Endfile); Set_Location (Func, Loc); Set_Parent (Func, Get_Parent (Decl)); @@ -608,15 +613,14 @@ package body Sem_Decls is Type_Definition : Iir; Last : Iir; - procedure Add_Operation - (Name : Name_Id; - Def : Iir_Predefined_Functions; - Interface_Chain : Iir; - Return_Type : Iir) + procedure Add_Operation (Name : Name_Id; + Def : Iir_Predefined_Functions; + Interface_Chain : Iir; + Return_Type : Iir) is - Operation : Iir_Implicit_Function_Declaration; + Operation : Iir_Function_Declaration; begin - Operation := Create_Iir (Iir_Kind_Implicit_Function_Declaration); + Operation := Create_Iir (Iir_Kind_Function_Declaration); Location_Copy (Operation, Decl); Set_Parent (Operation, Get_Parent (Decl)); Set_Interface_Declaration_Chain (Operation, Interface_Chain); @@ -1009,11 +1013,11 @@ package body Sem_Decls is Add_Relational (Name_Op_Inequality, Iir_Predefined_Access_Inequality); declare - Deallocate_Proc: Iir_Implicit_Procedure_Declaration; + Deallocate_Proc: Iir_Procedure_Declaration; Var_Interface: Iir_Interface_Variable_Declaration; begin Deallocate_Proc := - Create_Iir (Iir_Kind_Implicit_Procedure_Declaration); + Create_Iir (Iir_Kind_Procedure_Declaration); Set_Identifier (Deallocate_Proc, Std_Names.Name_Deallocate); Set_Implicit_Definition (Deallocate_Proc, Iir_Predefined_Deallocate); @@ -2050,8 +2054,7 @@ package body Sem_Decls is return List = Null_Iir_List and then Get_Type (N_Entity) = Get_Type (Get_Return_Type_Mark (Sig)); - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => -- LRM93 2.3.2 Signatures -- * if the reserved word RETURN is present, the subprogram is -- a function and the base type of the type mark following @@ -2062,8 +2065,7 @@ package body Sem_Decls is then return False; end if; - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => -- LRM93 2.3.2 Signatures -- * [...] or the reserved word RETURN is absent and the -- subprogram is a procedure. @@ -2310,15 +2312,14 @@ package body Sem_Decls is -- the implicit operation being aliased. El := Get_Chain (Type_Decl); while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - exit when Get_Type_Reference (El) /= Type_Decl; - when others => - exit; - end case; - Add_Implicit_Alias (El); - El := Get_Chain (El); + if Is_Implicit_Subprogram (El) + and then Get_Type_Reference (El) = Type_Decl + then + Add_Implicit_Alias (El); + El := Get_Chain (El); + else + exit; + end if; end loop; end Add_Aliases_For_Type_Alias; @@ -2331,9 +2332,7 @@ package body Sem_Decls is begin case Get_Kind (N_Entity) is when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + | Iir_Kind_Procedure_Declaration => -- LRM93 4.3.3.2 Non-Object Aliases -- 2. A signature is required if the name denotes a subprogram -- (including an operator) or enumeration literal. @@ -2386,7 +2385,7 @@ package body Sem_Decls is -- overloads the operator symbol. In this latter case, -- the operator symbol and the function both must meet the -- requirements of 2.3.1. - if Get_Kind (N_Entity) not in Iir_Kinds_Function_Declaration then + if Get_Kind (N_Entity) /= Iir_Kind_Function_Declaration then Error_Msg_Sem ("alias of an operator must denote a function", Alias); return; @@ -2774,22 +2773,23 @@ package body Sem_Decls is end if; when Iir_Kind_Component_Declaration => Sem_Component_Declaration (Decl); - when Iir_Kind_Function_Declaration => - Sem_Subprogram_Declaration (Decl); - if Is_Global - and then Is_A_Resolution_Function (Decl, Null_Iir) - then - Set_Resolution_Function_Flag (Decl, True); + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + if Is_Implicit_Subprogram (Decl) then + Sem_Scopes.Add_Name (Decl); + -- Implicit subprogram are already visible. + else + Sem_Subprogram_Declaration (Decl); + if Is_Global + and then Get_Kind (Decl) = Iir_Kind_Function_Declaration + and then Is_A_Resolution_Function (Decl, Null_Iir) + then + Set_Resolution_Function_Flag (Decl, True); + end if; end if; - when Iir_Kind_Procedure_Declaration => - Sem_Subprogram_Declaration (Decl); when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => Sem_Subprogram_Body (Decl); - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Sem_Scopes.Add_Name (Decl); - -- Implicit subprogram are already visible. when Iir_Kind_Non_Object_Alias_Declaration => -- Added by Sem_Alias_Declaration. Need to check that no -- existing attribute specification apply to them. @@ -2929,7 +2929,9 @@ package body Sem_Decls is end if; when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - if Get_Subprogram_Body (El) = Null_Iir then + if not Is_Implicit_Subprogram (El) + and then Get_Subprogram_Body (El) = Null_Iir + then Error_Msg_Sem ("missing body for " & Disp_Node (El) & " declared at " & Disp_Location (El), Decl); @@ -2964,6 +2966,7 @@ package body Sem_Decls is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => if not Get_Use_Flag (El) + and then not Is_Implicit_Subprogram (El) and then not Is_Second_Subprogram_Specification (El) then Warning_Msg_Sem diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 1fa2a875e..311eaefab 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -324,7 +324,7 @@ package body Sem_Expr is | Iir_Kind_Library_Declaration | Iir_Kind_Library_Clause | Iir_Kind_Component_Declaration - | Iir_Kinds_Procedure_Declaration + | Iir_Kind_Procedure_Declaration | Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Element_Declaration @@ -333,7 +333,7 @@ package body Sem_Expr is Error_Msg_Sem (Disp_Node (Expr) & " not allowed in an expression", Loc); return Null_Iir; - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => return Expr; when Iir_Kind_Overload_List => return Expr; @@ -865,22 +865,22 @@ package body Sem_Expr is when others => Error_Kind ("set_function_call_staticness (1)", Expr); end case; - case Get_Kind (Imp) is - when Iir_Kind_Implicit_Function_Declaration => - if Get_Implicit_Definition (Imp) - not in Iir_Predefined_Pure_Functions - then - -- Predefined functions such as Now, Endfile are not static. - Staticness := None; - end if; - when Iir_Kind_Function_Declaration => + + -- Staticness. + case Get_Implicit_Definition (Imp) is + when Iir_Predefined_Error => + raise Internal_Error; + when Iir_Predefined_Pure_Functions => + null; + when Iir_Predefined_Impure_Functions => + -- Predefined functions such as Now, Endfile are not static. + Staticness := None; + when Iir_Predefined_Explicit => if Get_Pure_Flag (Imp) then Staticness := Min (Staticness, Globally); else Staticness := None; end if; - when others => - Error_Kind ("set_function_call_staticness (2)", Imp); end case; Set_Expr_Staticness (Expr, Staticness); end Set_Function_Call_Staticness; @@ -1149,20 +1149,14 @@ package body Sem_Expr is return; end if; - case Get_Kind (Imp) is - when Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration => - if Get_Implicit_Definition (Imp) in Iir_Predefined_Pure_Functions - then - return; - end if; - when Iir_Kind_Function_Declaration => - Sem_Call_Purity_Check (Subprg, Imp, Expr); - Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr); - when Iir_Kind_Procedure_Declaration => - Sem_Call_Purity_Check (Subprg, Imp, Expr); + if Is_Implicit_Subprogram (Imp) then + -- FIXME: impure predefined functions. + null; + else + Sem_Call_Purity_Check (Subprg, Imp, Expr); + Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr); + if Get_Kind (Imp) = Iir_Kind_Procedure_Declaration then Sem_Call_Wait_Check (Subprg, Imp, Expr); - Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr); -- Check passive. if Get_Passive_Flag (Imp) = False then case Get_Kind (Subprg) is @@ -1177,9 +1171,8 @@ package body Sem_Expr is null; end case; end if; - when others => - raise Internal_Error; - end case; + end if; + end if; end Sem_Subprogram_Call_Finish; -- EXPR is a function or procedure call. @@ -1215,7 +1208,7 @@ package body Sem_Expr is -- an enumeration literal. goto Continue; end if; - when Iir_Kinds_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => if Is_Func_Call then -- The identifier of a procedure call must be a procedure. goto Continue; @@ -1341,14 +1334,12 @@ package body Sem_Expr is else -- Only one interpretation for the subprogram name. if Is_Func then - if Get_Kind (Inter_List) not in Iir_Kinds_Function_Declaration - then + if Get_Kind (Inter_List) /= Iir_Kind_Function_Declaration then Error_Msg_Sem ("name does not designate a function", Expr); return Null_Iir; end if; else - if Get_Kind (Inter_List) not in Iir_Kinds_Procedure_Declaration - then + if Get_Kind (Inter_List) /= Iir_Kind_Procedure_Declaration then Error_Msg_Sem ("name does not designate a procedure", Expr); return Null_Iir; end if; @@ -1552,7 +1543,7 @@ package body Sem_Expr is return Null_Iir; end if; - if Get_Kind (El) = Iir_Kind_Implicit_Function_Declaration then + if Is_Implicit_Subprogram (El) then Ref_Type := Get_Type_Reference (El); if Ref_Type = Universal_Integer_Type_Declaration or Ref_Type = Universal_Real_Type_Declaration @@ -1587,18 +1578,18 @@ package body Sem_Expr is -- One must be an implicit declaration, the other must be an explicit -- declaration. - if Get_Kind (Sub1) = Iir_Kind_Implicit_Function_Declaration then - if Get_Kind (Sub2) /= Iir_Kind_Function_Declaration then + pragma Assert (Get_Kind (Sub1) = Iir_Kind_Function_Declaration); + pragma Assert (Get_Kind (Sub2) = Iir_Kind_Function_Declaration); + if Is_Implicit_Subprogram (Sub1) then + if Is_Implicit_Subprogram (Sub2) then return Null_Iir; end if; Res := Sub2; - elsif Get_Kind (Sub1) = Iir_Kind_Function_Declaration then - if Get_Kind (Sub2) /= Iir_Kind_Implicit_Function_Declaration then + else + if not Is_Implicit_Subprogram (Sub2) then return Null_Iir; end if; Res := Sub1; - else - Error_Kind ("get_explicit_subprogram", Sub1); end if; -- They must have the same profile. @@ -1730,7 +1721,7 @@ package body Sem_Expr is Decl := Get_Non_Alias_Declaration (Interpretation); -- It is compatible with operand types ? - if Get_Kind (Decl) not in Iir_Kinds_Function_Declaration then + if Get_Kind (Decl) /= Iir_Kind_Function_Declaration then raise Internal_Error; end if; @@ -3981,7 +3972,7 @@ package body Sem_Expr is | Iir_Kind_Allocator_By_Subtype => return Sem_Allocator (Expr, A_Type); - when Iir_Kinds_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => Error_Msg_Sem (Disp_Node (Expr) & " cannot be used as an expression", Expr); return Null_Iir; diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index c93643024..5a1c123a8 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -59,9 +59,7 @@ package body Sem_Names is exit when El = Null_Iir; case Get_Kind (El) is when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + | Iir_Kind_Procedure_Declaration => Error_Msg_Sem (Disp_Subprg (El), El); when Iir_Kind_Function_Call => El := Get_Implementation (El); @@ -144,7 +142,7 @@ package body Sem_Names is Decl := Get_Nth_Element (List, I); exit when Decl = Null_Iir; case Get_Kind (Decl) is - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => Add_Element (Res_List, Get_Return_Type (Decl)); when Iir_Kind_Enumeration_Literal | Iir_Kind_Function_Call @@ -226,8 +224,8 @@ package body Sem_Names is Free_Iir (El); when Iir_Kind_Attribute_Name => Free_Iir (El); - when Iir_Kinds_Function_Declaration - | Iir_Kinds_Procedure_Declaration + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration | Iir_Kind_Enumeration_Literal => null; when Iir_Kinds_Denoting_Name => @@ -418,7 +416,7 @@ package body Sem_Names is is Inter : Iir; begin - if Get_Kind (Prefix) not in Iir_Kinds_Function_Declaration then + if Get_Kind (Prefix) /= Iir_Kind_Function_Declaration then return True; end if; Inter := Get_Interface_Declaration_Chain (Prefix); @@ -486,7 +484,7 @@ package body Sem_Names is function Maybe_Insert_Function_Call (Name : Iir; Spec : Iir) return Iir is begin - if Get_Kind (Spec) in Iir_Kinds_Function_Declaration then + if Get_Kind (Spec) = Iir_Kind_Function_Declaration then return Sem_As_Function_Call (Name, Spec, Null_Iir); else return Spec; @@ -1413,11 +1411,11 @@ package body Sem_Names is Name_Res := Finish_Sem_Denoting_Name (Name, Res); Set_Base_Name (Name_Res, Res); return Name_Res; - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => Name_Res := Finish_Sem_Denoting_Name (Name, Res); Set_Type (Name_Res, Get_Return_Type (Res)); return Name_Res; - when Iir_Kinds_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => return Finish_Sem_Denoting_Name (Name, Res); when Iir_Kind_Type_Conversion => pragma Assert (Get_Kind (Name) = Iir_Kind_Parenthesis_Name); @@ -2090,7 +2088,7 @@ package body Sem_Names is -- Only values can be indexed or sliced. -- Catch errors such as slice of a type conversion. if not Is_Object_Name (Sub_Name) - and then Get_Kind (Sub_Name) not in Iir_Kinds_Function_Declaration + and then Get_Kind (Sub_Name) /= Iir_Kind_Function_Declaration then if Finish then Error_Msg_Sem ("prefix is not an array value (found " @@ -2173,7 +2171,7 @@ package body Sem_Names is Match : Boolean; begin Used := False; - if Get_Kind (Sub_Name) in Iir_Kinds_Function_Declaration then + if Get_Kind (Sub_Name) = Iir_Kind_Function_Declaration then Sem_Association_Chain (Get_Interface_Declaration_Chain (Sub_Name), Assoc_Chain, False, Missing_Parameter, Name, Match); @@ -2184,7 +2182,7 @@ package body Sem_Names is Used := True; end if; end if; - if Get_Kind (Sub_Name) not in Iir_Kinds_Procedure_Declaration then + if Get_Kind (Sub_Name) /= Iir_Kind_Procedure_Declaration then R := Sem_As_Indexed_Or_Slice_Name (Sub_Name, False); if R /= Null_Iir then Add_Result (Res, R); @@ -2296,7 +2294,7 @@ package body Sem_Names is ("no overloaded function found matching " & Disp_Node (Prefix_Name), Name); end if; - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => Sem_Parenthesis_Function (Prefix); if Res = Null_Iir then Error_Parenthesis_Function (Prefix); @@ -2357,7 +2355,7 @@ package body Sem_Names is end if; return; - when Iir_Kinds_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => Error_Msg_Sem ("function name is a procedure", Name); when Iir_Kinds_Process_Statement @@ -2442,7 +2440,7 @@ package body Sem_Names is | Iir_Kind_Indexed_Name | Iir_Kind_Function_Call => Sem_As_Selected_By_All_Name (Prefix); - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => Prefix := Sem_As_Function_Call (Name => Prefix_Name, Spec => Prefix, Assoc_Chain => Null_Iir); @@ -2529,8 +2527,8 @@ package body Sem_Names is when Iir_Kinds_Object_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration - | Iir_Kinds_Function_Declaration - | Iir_Kinds_Procedure_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration | Iir_Kinds_Sequential_Statement @@ -3113,9 +3111,7 @@ package body Sem_Names is -- of a component declaration. case Get_Kind (Prefix) is when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Constant_Declaration @@ -3415,9 +3411,9 @@ package body Sem_Names is El := Get_Nth_Element (List, I); exit when El = Null_Iir; case Get_Kind (El) is - when Iir_Kinds_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => null; - when Iir_Kinds_Function_Declaration => + when Iir_Kind_Function_Declaration => if Maybe_Function_Call (El) then Replace_Nth_Element (List, P, El); P := P + 1; @@ -3545,8 +3541,7 @@ package body Sem_Names is | Iir_Kind_Selected_Name => Expr := Get_Named_Entity (Res); case Get_Kind (Expr) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Function_Declaration => + when Iir_Kind_Function_Declaration => if Maybe_Function_Call (Expr) then Expr := Sem_As_Function_Call (Res, Expr, Null_Iir); if Get_Kind (Expr) /= Iir_Kind_Function_Call then diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb index 71c758575..67e42453e 100644 --- a/src/vhdl/sem_scopes.adb +++ b/src/vhdl/sem_scopes.adb @@ -362,14 +362,14 @@ package body Sem_Scopes is -- subprograms and enumeration literals. case Get_Kind (Decl) is when Iir_Kind_Enumeration_Literal - | Iir_Kinds_Function_Declaration - | Iir_Kinds_Procedure_Declaration => + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => return True; when Iir_Kind_Non_Object_Alias_Declaration => case Get_Kind (Get_Named_Entity (Get_Name (Decl))) is when Iir_Kind_Enumeration_Literal - | Iir_Kinds_Function_Declaration - | Iir_Kinds_Procedure_Declaration => + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => return True; when Iir_Kind_Non_Object_Alias_Declaration => raise Internal_Error; @@ -563,14 +563,13 @@ package body Sem_Scopes is function Is_Implicit_Declaration (D : Iir) return Boolean is begin case Get_Kind (D) is - when Iir_Kinds_Implicit_Subprogram_Declaration => - return True; when Iir_Kind_Non_Object_Alias_Declaration => return Get_Implicit_Alias_Flag (D); - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration => + when Iir_Kind_Enumeration_Literal => return False; + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + return Is_Implicit_Subprogram (D); when others => Error_Kind ("is_implicit_declaration", D); end case; @@ -585,8 +584,8 @@ package body Sem_Scopes is -- physical units. return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration and then Get_Implicit_Alias_Flag (D) - and then (Get_Kind (Get_Named_Entity (Get_Name (D))) - in Iir_Kinds_Implicit_Subprogram_Declaration); + and then Is_Implicit_Subprogram (Get_Named_Entity + (Get_Name (D))); end Is_Implicit_Alias; -- Replace the homograph of DECL by DECL. @@ -686,11 +685,9 @@ package body Sem_Scopes is then declare Implicit_Current_Decl : constant Boolean := - (Get_Kind (Current_Decl) - in Iir_Kinds_Implicit_Subprogram_Declaration); + Is_Implicit_Subprogram (Current_Decl); Implicit_Decl : constant Boolean := - (Get_Kind (Decl) - in Iir_Kinds_Implicit_Subprogram_Declaration); + Is_Implicit_Subprogram (Decl); begin if Implicit_Current_Decl and not Implicit_Decl then -- Note: no need to save previous interpretation, as @@ -753,12 +750,9 @@ package body Sem_Scopes is begin if Flags.Vhdl_Std >= Vhdl_08 then Is_Current_Decl_Implicit := - (Get_Kind (Current_Decl) in - Iir_Kinds_Implicit_Subprogram_Declaration) + Is_Implicit_Subprogram (Current_Decl) or else Is_Implicit_Alias (Current_Decl); - Is_Decl_Implicit := - (Get_Kind (Decl) in - Iir_Kinds_Implicit_Subprogram_Declaration) + Is_Decl_Implicit := Is_Implicit_Subprogram (Decl) or else Is_Implicit_Alias (Decl); -- If they denote the same entity, they aren't @@ -789,12 +783,9 @@ package body Sem_Scopes is -- Can an implicit subprogram declaration appears -- after an explicit one in vhdl 93? I don't -- think so. - Is_Decl_Implicit := - (Get_Kind (Decl) - in Iir_Kinds_Implicit_Subprogram_Declaration); + Is_Decl_Implicit := Is_Implicit_Subprogram (Decl); Is_Current_Decl_Implicit := - (Get_Kind (Current_Decl) - in Iir_Kinds_Implicit_Subprogram_Declaration); + Is_Implicit_Subprogram (Current_Decl); end if; if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit) @@ -973,9 +964,7 @@ package body Sem_Scopes is is begin case Get_Kind (Decl) is - when Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Subtype_Declaration + when Iir_Kind_Subtype_Declaration | Iir_Kind_Enumeration_Literal -- By use clause | Iir_Kind_Constant_Declaration | Iir_Kind_Signal_Declaration diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb index 1746903c1..100ff659d 100644 --- a/src/vhdl/sem_specs.adb +++ b/src/vhdl/sem_specs.adb @@ -47,11 +47,9 @@ package body Sem_Specs is return Tok_Configuration; when Iir_Kind_Package_Declaration => return Tok_Package; - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration => return Tok_Procedure; - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => return Tok_Function; when Iir_Kind_Type_Declaration => return Tok_Type; @@ -415,8 +413,6 @@ package body Sem_Specs is case Get_Kind (Ent) is when Iir_Kinds_Library_Unit_Declaration | Iir_Kinds_Concurrent_Statement - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kinds_Sequential_Statement | Iir_Kinds_Non_Alias_Object_Declaration | Iir_Kind_Type_Declaration @@ -679,9 +675,7 @@ package body Sem_Specs is -- literals. case Get_Kind (Name) is when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Enumeration_Literal => Append_Element (List, Name); when others => diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index 7712bb99f..c220791bb 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -1061,25 +1061,25 @@ package body Sem_Stmts is case Get_Kind (Current_Subprogram) is when Iir_Kind_Process_Statement => null; - when Iir_Kinds_Function_Declaration => - -- LRM93 §8.2 + when Iir_Kind_Function_Declaration => + -- LRM93 8.2 -- It is an error if a wait statement appears in a function -- subprogram [...] Error_Msg_Sem ("wait statement not allowed in a function subprogram", Stmt); return; - when Iir_Kinds_Procedure_Declaration => - -- LRM93 §8.2 + when Iir_Kind_Procedure_Declaration => + -- LRM93 8.2 -- [It is an error ...] or in a procedure that has a parent that -- is a function subprogram. - -- LRM93 §8.2 + -- LRM93 8.2 -- [...] or in a procedure that has a parent that is such a -- process statement. -- GHDL: this is checked at the end of analysis or during -- elaboration. Set_Wait_State (Current_Subprogram, True); when Iir_Kind_Sensitized_Process_Statement => - -- LRM93 §8.2 + -- LRM93 8.2 -- Furthermore, it is an error if a wait statement appears in an -- explicit process statement that includes a sensitivity list, -- [...] diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb index 9bddd644d..8cf5265c6 100644 --- a/src/vhdl/sem_types.adb +++ b/src/vhdl/sem_types.adb @@ -670,9 +670,7 @@ package body Sem_Types is while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration => + | Iir_Kind_Function_Declaration => null; when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => @@ -1235,7 +1233,7 @@ package body Sem_Types is begin -- LRM93 2.4 -- A resolution function must be a [pure] function; - if Get_Kind (Func) not in Iir_Kinds_Function_Declaration then + if Get_Kind (Func) /= Iir_Kind_Function_Declaration then return False; end if; Decl := Get_Interface_Declaration_Chain (Func); diff --git a/src/vhdl/std_package.adb b/src/vhdl/std_package.adb index 11d1e674b..5f65aa249 100644 --- a/src/vhdl/std_package.adb +++ b/src/vhdl/std_package.adb @@ -290,11 +290,11 @@ package body Std_Package is Inter2_Id : Name_Id := Null_Identifier; Inter2_Type : Iir := Null_Iir) is - Decl : Iir_Implicit_Function_Declaration; + Decl : Iir_Function_Declaration; Inter : Iir_Interface_Constant_Declaration; Inter2 : Iir_Interface_Constant_Declaration; begin - Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); + Decl := Create_Std_Decl (Iir_Kind_Function_Declaration); Set_Std_Identifier (Decl, Name); Set_Return_Type (Decl, String_Type_Definition); Set_Pure_Flag (Decl, True); @@ -323,10 +323,10 @@ package body Std_Package is procedure Create_Edge_Function (Name : Name_Id; Func : Iir_Predefined_Functions; Inter_Type : Iir) is - Decl : Iir_Implicit_Function_Declaration; + Decl : Iir_Function_Declaration; Inter : Iir_Interface_Constant_Declaration; begin - Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); + Decl := Create_Std_Decl (Iir_Kind_Function_Declaration); Set_Std_Identifier (Decl, Name); Set_Return_Type (Decl, Boolean_Type_Definition); Set_Pure_Flag (Decl, True); @@ -899,10 +899,9 @@ package body Std_Package is -- -- impure function NOW return DELAY_LENGTH. declare - Function_Now : Iir_Implicit_Function_Declaration; + Function_Now : Iir_Function_Declaration; begin - Function_Now := - Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); + Function_Now := Create_Std_Decl (Iir_Kind_Function_Declaration); Set_Std_Identifier (Function_Now, Std_Names.Name_Now); if Vhdl_Std = Vhdl_87 then Set_Return_Type (Function_Now, Time_Subtype_Definition); diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 3083e421c..b6f1c66b2 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2041,9 +2041,10 @@ package body Trans.Chap4 is while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration => + | Iir_Kind_Function_Declaration => -- Translate interfaces. - if (not Flag_Discard_Unused or else Get_Use_Flag (El)) + if not Is_Implicit_Subprogram (El) + and then (not Flag_Discard_Unused or else Get_Use_Flag (El)) and then not Is_Second_Subprogram_Specification (El) then Info := Add_Info (El, Kind_Subprg); @@ -2057,9 +2058,6 @@ package body Trans.Chap4 is when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => null; - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; when others => Translate_Declaration (El); end case; @@ -2076,11 +2074,30 @@ package body Trans.Chap4 is while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration => - -- Translate only if used. - if Get_Info (El) /= null then - Chap2.Translate_Subprogram_Declaration (El); - Translate_Resolution_Function (El); + | Iir_Kind_Function_Declaration => + if Is_Implicit_Subprogram (El) then + if Flag_Discard_Unused_Implicit + and then not Get_Use_Flag (El) + then + case Get_Implicit_Definition (El) is + when Iir_Predefined_Array_Equality + | Iir_Predefined_Array_Greater + | Iir_Predefined_Record_Equality => + -- Used implicitly in case statement or other + -- predefined equality. + Chap7.Translate_Implicit_Subprogram (El, Infos); + when others => + null; + end case; + else + Chap7.Translate_Implicit_Subprogram (El, Infos); + end if; + else + -- Translate only if used. + if Get_Info (El) /= null then + Chap2.Translate_Subprogram_Declaration (El); + Translate_Resolution_Function (El); + end if; end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => @@ -2103,24 +2120,6 @@ package body Trans.Chap4 is when Iir_Kind_Protected_Type_Body => Chap3.Translate_Protected_Type_Body (El); Chap3.Translate_Protected_Type_Body_Subprograms (El); - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - if Flag_Discard_Unused_Implicit - and then not Get_Use_Flag (El) - then - case Get_Implicit_Definition (El) is - when Iir_Predefined_Array_Equality - | Iir_Predefined_Array_Greater - | Iir_Predefined_Record_Equality => - -- Used implicitly in case statement or other - -- predefined equality. - Chap7.Translate_Implicit_Subprogram (El, Infos); - when others => - null; - end case; - else - Chap7.Translate_Implicit_Subprogram (El, Infos); - end if; when others => null; end case; @@ -2186,17 +2185,15 @@ package body Trans.Chap4 is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - if Get_Info (Decl) /= null then + if not Is_Implicit_Subprogram (Decl) + and then Get_Info (Decl) /= null + then Chap2.Elab_Subprogram_Interfaces (Decl); end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => null; - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; - when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Transaction_Attribute => diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 35544cff1..eb8303693 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -998,8 +998,7 @@ package body Trans.Chap6 is Obj : Iir; Assoc_Chain : Iir; begin - if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration - then + if Is_Implicit_Subprogram (Imp) then -- FIXME : to be done raise Internal_Error; else diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 67ea81106..bcee1264d 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -1060,8 +1060,7 @@ package body Trans.Chap7 is others => ON_Nil); function Translate_Shortcut_Operator - (Imp : Iir_Implicit_Function_Declaration; Left, Right : Iir) - return O_Enode + (Imp : Iir_Function_Declaration; Left, Right : Iir) return O_Enode is Rtype : Iir; Res : O_Dnode; @@ -1137,8 +1136,7 @@ package body Trans.Chap7 is end Translate_Lib_Operator; function Translate_Predefined_Lib_Operator - (Left, Right : O_Enode; Func : Iir_Implicit_Function_Declaration) - return O_Enode + (Left, Right : O_Enode; Func : Iir_Function_Declaration) return O_Enode is Info : constant Subprg_Info_Acc := Get_Info (Func); Constr : O_Assoc_List; @@ -1226,7 +1224,8 @@ package body Trans.Chap7 is begin if Get_Kind (E) = Iir_Kind_Concatenation_Operator then Imp := Get_Implementation (E); - if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration + if (Get_Implicit_Definition (Imp) + in Iir_Predefined_Concat_Functions) and then Get_Return_Type (Imp) = Expr_Type then Walk_Concat (Imp, Get_Left (E), Get_Right (E)); @@ -1237,7 +1236,8 @@ package body Trans.Chap7 is -- Note that associations are always 'simple': no formal, no -- default expression in implicit declarations. Imp := Get_Implementation (E); - if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration + if (Get_Implicit_Definition (Imp) + in Iir_Predefined_Concat_Functions) and then Get_Return_Type (Imp) = Expr_Type then Assocs := Get_Parameter_Association_Chain (E); @@ -2123,7 +2123,7 @@ package body Trans.Chap7 is end Translate_Predefined_Std_Ulogic_Array_Match; function Translate_Predefined_Operator - (Imp : Iir_Implicit_Function_Declaration; + (Imp : Iir_Function_Declaration; Left, Right : Iir; Res_Type : Iir; Loc : Iir) @@ -4018,7 +4018,7 @@ package body Trans.Chap7 is when Iir_Kinds_Dyadic_Operator => Imp := Get_Implementation (Expr); - if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration then + if Is_Implicit_Subprogram (Imp) then return Translate_Predefined_Operator (Imp, Get_Left (Expr), Get_Right (Expr), Res_Type, Expr); else @@ -4027,7 +4027,7 @@ package body Trans.Chap7 is end if; when Iir_Kinds_Monadic_Operator => Imp := Get_Implementation (Expr); - if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration then + if Is_Implicit_Subprogram (Imp) then return Translate_Predefined_Operator (Imp, Get_Operand (Expr), Null_Iir, Res_Type, Expr); else @@ -4039,8 +4039,7 @@ package body Trans.Chap7 is declare Assoc_Chain : Iir; begin - if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration - then + if Is_Implicit_Subprogram (Imp) then declare Left, Right : Iir; begin @@ -4590,17 +4589,12 @@ package body Trans.Chap7 is begin El := Get_Chain (Get_Type_Declarator (Base_Type)); while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - if Get_Implicit_Definition (El) = Imp then - return El; - else - El := Get_Chain (El); - end if; - when others => - raise Internal_Error; - end case; + pragma Assert (Is_Implicit_Subprogram (El)); + if Get_Implicit_Definition (El) = Imp then + return El; + else + El := Get_Chain (El); + end if; end loop; raise Internal_Error; end Find_Predefined_Function; @@ -5594,7 +5588,8 @@ package body Trans.Chap7 is end if; case Kind is - when Iir_Predefined_Error => + when Iir_Predefined_Error + | Iir_Predefined_None => raise Internal_Error; when Iir_Predefined_Boolean_And | Iir_Predefined_Boolean_Or diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 8f63e7827..07bf43cf4 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -2912,8 +2912,7 @@ package body Trans.Chap8 is Imp : constant Iir := Get_Implementation (Call); begin Canon.Canon_Subprogram_Call (Call); - if Get_Kind (Imp) = Iir_Kind_Implicit_Procedure_Declaration - then + if Is_Implicit_Subprogram (Imp) then Translate_Implicit_Procedure_Call (Call); else Translate_Procedure_Call (Call); diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index 9bdc7a96d..fe7032c4a 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -1961,9 +1961,7 @@ package body Trans.Rtis is null; when Iir_Kind_Component_Declaration => null; - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Function_Declaration + when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => -- FIXME: to be added (for foreign). null; @@ -2128,9 +2126,7 @@ package body Trans.Rtis is end; when Iir_Kind_Component_Declaration => Generate_Component_Declaration (Decl); - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Function_Declaration + when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => -- FIXME: to be added (for foreign). null; diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index 4c913006e..e23357ee8 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -1338,7 +1338,7 @@ package body Trans is Info.T := Ortho_Info_Type_Array_Init; Free_Type_Info (Info); end if; - when Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => case Get_Implicit_Definition (I) is when Iir_Predefined_Bit_Array_Match_Equality | Iir_Predefined_Bit_Array_Match_Inequality => diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 977e01f00..42ffbab6e 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -1810,15 +1810,17 @@ package body Translation is Decl := Get_Chain (Decl); Chap7.Init_Implicit_Subprogram_Infos (Infos); + + -- Implicit subprograms are immediately follow the type declaration. while Decl /= Null_Iir loop - case Get_Kind (Decl) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Chap7.Translate_Implicit_Subprogram (Decl, Infos); - Decl := Get_Chain (Decl); - when others => - exit; - end case; + if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration + and then Is_Implicit_Subprogram (Decl) + then + Chap7.Translate_Implicit_Subprogram (Decl, Infos); + Decl := Get_Chain (Decl); + else + exit; + end if; end loop; end Translate_Type_Implicit_Subprograms; @@ -1902,7 +1904,7 @@ package body Translation is Decl := Get_Chain (Decl); when Iir_Kind_Attribute_Declaration => Decl := Get_Chain (Decl); - when Iir_Kind_Implicit_Function_Declaration => + when Iir_Kind_Function_Declaration => case Get_Implicit_Definition (Decl) is when Iir_Predefined_Now_Function => null; |