From 6ea238c5598b6db98a8fc161a1493b4b3446ce90 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 24 Sep 2020 07:46:32 +0200 Subject: vhdl: parse subprogram instantiations. For #1470 --- src/vhdl/vhdl-parse.adb | 260 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 174 insertions(+), 86 deletions(-) (limited to 'src/vhdl/vhdl-parse.adb') diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index 7ac389a13..885604414 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -79,6 +79,7 @@ package body Vhdl.Parse is First_Cond : Iir) return Iir; function Parse_Simultaneous_Case_Statement (Label : Name_Id; Loc : Location_Type; Expr : Iir) return Iir; + function Parse_Generic_Map_Aspect return Iir; -- Maximum number of nested parenthesis, before generating an error. Max_Parenthesis_Depth : constant Natural := 1000; @@ -1997,10 +1998,20 @@ package body Vhdl.Parse is end if; end Parse_Subprogram_Designator; + -- Emit an error message is function declaration SUBPRG has no return + -- type mark. + procedure Check_Function_Specification (Subprg : Iir) is + begin + if Get_Return_Type_Mark (Subprg) = Null_Iir then + Error_Msg_Parse ("'return' expected"); + Set_Return_Type_Mark (Subprg, Create_Error_Node); + end if; + end Check_Function_Specification; + -- Precond: '(' or return or any -- Postcond: next token procedure Parse_Subprogram_Parameters_And_Return - (Subprg : Iir; Is_Func : Boolean) + (Subprg : Iir; Is_Func : Boolean; Required : Boolean) is Old : Iir; pragma Unreferenced (Old); @@ -2049,9 +2060,8 @@ package body Vhdl.Parse is (Subprg, Parse_Type_Mark (Check_Paren => True)); end if; else - if Is_Func then - Error_Msg_Parse ("'return' expected"); - Set_Return_Type_Mark (Subprg, Create_Error_Node); + if Is_Func and Required then + Check_Function_Specification (Subprg); end if; end if; end Parse_Subprogram_Parameters_And_Return; @@ -2128,7 +2138,7 @@ package body Vhdl.Parse is Parse_Subprogram_Designator (Subprg); Parse_Subprogram_Parameters_And_Return - (Subprg, Kind = Iir_Kind_Interface_Function_Declaration); + (Subprg, Kind = Iir_Kind_Interface_Function_Declaration, True); -- TODO: interface_subprogram_default @@ -5326,6 +5336,7 @@ package body Vhdl.Parse is | Tok_Impure => Decl := Parse_Subprogram_Declaration; if Decl /= Null_Iir + and then Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration and then Get_Subprogram_Body (Decl) /= Null_Iir then if Get_Kind (Parent) = Iir_Kind_Package_Declaration then @@ -8022,6 +8033,141 @@ package body Vhdl.Parse is end loop; end Parse_Sequential_Statements; + procedure Parse_Subprogram_Body (Subprg : Iir; Is_Loc : Location_Type) + is + Kind : constant Iir_Kind := Get_Kind (Subprg); + Subprg_Body : Iir; + Begin_Loc, End_Loc : Location_Type; + begin + -- The body. + Set_Has_Body (Subprg, True); + if Kind = Iir_Kind_Function_Declaration then + Subprg_Body := Create_Iir (Iir_Kind_Function_Body); + else + Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body); + end if; + Location_Copy (Subprg_Body, Subprg); + + Set_Subprogram_Body (Subprg, Subprg_Body); + Set_Subprogram_Specification (Subprg_Body, Subprg); + Set_Chain (Subprg, Subprg_Body); + + Parse_Declarative_Part (Subprg_Body, Subprg_Body); + + -- Skip 'begin'. + Begin_Loc := Get_Token_Location; + Expect_Scan (Tok_Begin); + + Set_Sequential_Statement_Chain + (Subprg_Body, Parse_Sequential_Statements (Subprg_Body)); + + -- Skip 'end'. + End_Loc := Get_Token_Location; + Expect_Scan (Tok_End); + + if Flag_Elocations then + Create_Elocations (Subprg_Body); + Set_Is_Location (Subprg_Body, Is_Loc); + Set_Begin_Location (Subprg_Body, Begin_Loc); + Set_End_Location (Subprg_Body, End_Loc); + end if; + + case Current_Token is + when Tok_Function => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'function' not allowed here by vhdl 87"); + end if; + if Kind = Iir_Kind_Procedure_Declaration then + Error_Msg_Parse ("'procedure' expected instead of 'function'"); + end if; + Set_End_Has_Reserved_Id (Subprg_Body, True); + + -- Skip 'function'. + Scan; + + when Tok_Procedure => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'procedure' not allowed here by vhdl 87"); + end if; + if Kind = Iir_Kind_Function_Declaration then + Error_Msg_Parse ("'function' expected instead of 'procedure'"); + end if; + Set_End_Has_Reserved_Id (Subprg_Body, True); + + -- Skip 'procedure' + Scan; + + when others => + null; + end case; + case Current_Token is + when Tok_Identifier => + Check_End_Name (Get_Identifier (Subprg), Subprg_Body); + when Tok_String => + if Scan_To_Operator_Name (Get_Token_Location) + /= Get_Identifier (Subprg) + then + Error_Msg_Parse ("misspelling, %i expected", +Subprg); + end if; + Set_End_Has_Identifier (Subprg_Body, True); + + -- Skip string. + Scan; + + when others => + null; + end case; + Scan_Semi_Colon_Declaration ("subprogram body"); + end Parse_Subprogram_Body; + + -- precond : NEW + -- + -- LRM08 4.4 Subprogram instantiation declarations + -- subprogram_instantiation_declaration ::= + -- subprogram_kind designator IS + -- NEW uninstantiated_subprogram_name [ signature ] + -- [ generic_map_aspect ]; + function Parse_Subprogram_Instantiation (Subprg : Iir) return Iir + is + Res : Iir; + begin + case Iir_Kinds_Subprogram_Declaration (Get_Kind (Subprg)) is + when Iir_Kind_Function_Declaration => + Res := Create_Iir (Iir_Kind_Function_Instantiation_Declaration); + if Get_Has_Pure (Subprg) then + Error_Msg_Parse + (+Subprg, "pure/impure not allowed for instantiations"); + end if; + if Get_Return_Type_Mark (Subprg) /= Null_Iir then + Error_Msg_Parse + (+Subprg, "return type not allowed for instantiations"); + end if; + when Iir_Kind_Procedure_Declaration => + Res := Create_Iir (Iir_Kind_Procedure_Instantiation_Declaration); + end case; + Location_Copy (Res, Subprg); + Set_Identifier (Res, Get_Identifier (Subprg)); + + if Get_Interface_Declaration_Chain (Subprg) /= Null_Iir then + Error_Msg_Parse + (+Subprg, "interfaces not allowed for instantiations"); + end if; + + -- Skip 'new'. + Scan; + + Set_Uninstantiated_Subprogram_Name (Res, Parse_Signature_Name); + + if Current_Token = Tok_Generic then + Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); + end if; + + -- Skip ';'. + Expect_Scan (Tok_Semi_Colon); + + return Res; + end Parse_Subprogram_Instantiation; + -- precond : PROCEDURE, FUNCTION, PURE or IMPURE. -- postcond: next token. -- @@ -8050,9 +8196,9 @@ package body Vhdl.Parse is function Parse_Subprogram_Declaration return Iir is Kind : Iir_Kind; - Subprg: Iir; - Subprg_Body : Iir; - Start_Loc, Is_Loc, Begin_Loc, End_Loc : Location_Type; + Subprg : Iir; + Gen : Iir; + Start_Loc, Is_Loc : Location_Type; begin -- Create the node. Start_Loc := Get_Token_Location; @@ -8102,8 +8248,16 @@ package body Vhdl.Parse is -- Designator. Parse_Subprogram_Designator (Subprg); + if Current_Token = Tok_Generic then + -- Eat 'generic' + Scan; + + Gen := Parse_Interface_List (Generic_Interface_List, Subprg); + Set_Generic_Chain (Subprg, Gen); + end if; + Parse_Subprogram_Parameters_And_Return - (Subprg, Kind = Iir_Kind_Function_Declaration); + (Subprg, Kind = Iir_Kind_Function_Declaration, False); if Flag_Elocations then Create_Elocations (Subprg); @@ -8115,96 +8269,30 @@ package body Vhdl.Parse is -- Skip 'is'. Is_Loc := Get_Token_Location; Scan; + + if Current_Token = Tok_New then + return Parse_Subprogram_Instantiation (Subprg); + end if; when Tok_Begin => Error_Msg_Parse ("missing 'is' before 'begin'"); Is_Loc := Get_Token_Location; when others => + if Kind = Iir_Kind_Function_Declaration then + Check_Function_Specification (Subprg); + end if; + -- Skip ';'. Expect_Scan (Tok_Semi_Colon); return Subprg; end case; - -- The body. - Set_Has_Body (Subprg, True); if Kind = Iir_Kind_Function_Declaration then - Subprg_Body := Create_Iir (Iir_Kind_Function_Body); - else - Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body); - end if; - Location_Copy (Subprg_Body, Subprg); - - Set_Subprogram_Body (Subprg, Subprg_Body); - Set_Subprogram_Specification (Subprg_Body, Subprg); - Set_Chain (Subprg, Subprg_Body); - - Parse_Declarative_Part (Subprg_Body, Subprg_Body); - - -- Skip 'begin'. - Begin_Loc := Get_Token_Location; - Expect_Scan (Tok_Begin); - - Set_Sequential_Statement_Chain - (Subprg_Body, Parse_Sequential_Statements (Subprg_Body)); - - -- Skip 'end'. - End_Loc := Get_Token_Location; - Expect_Scan (Tok_End); - - if Flag_Elocations then - Create_Elocations (Subprg_Body); - Set_Is_Location (Subprg_Body, Is_Loc); - Set_Begin_Location (Subprg_Body, Begin_Loc); - Set_End_Location (Subprg_Body, End_Loc); + Check_Function_Specification (Subprg); end if; - case Current_Token is - when Tok_Function => - if Flags.Vhdl_Std = Vhdl_87 then - Error_Msg_Parse ("'function' not allowed here by vhdl 87"); - end if; - if Kind = Iir_Kind_Procedure_Declaration then - Error_Msg_Parse ("'procedure' expected instead of 'function'"); - end if; - Set_End_Has_Reserved_Id (Subprg_Body, True); - - -- Skip 'function'. - Scan; - - when Tok_Procedure => - if Flags.Vhdl_Std = Vhdl_87 then - Error_Msg_Parse ("'procedure' not allowed here by vhdl 87"); - end if; - if Kind = Iir_Kind_Function_Declaration then - Error_Msg_Parse ("'function' expected instead of 'procedure'"); - end if; - Set_End_Has_Reserved_Id (Subprg_Body, True); - - -- Skip 'procedure' - Scan; - - when others => - null; - end case; - case Current_Token is - when Tok_Identifier => - Check_End_Name (Get_Identifier (Subprg), Subprg_Body); - when Tok_String => - if Scan_To_Operator_Name (Get_Token_Location) - /= Get_Identifier (Subprg) - then - Error_Msg_Parse ("misspelling, %i expected", +Subprg); - end if; - Set_End_Has_Identifier (Subprg_Body, True); - - -- Skip string. - Scan; - - when others => - null; - end case; - Scan_Semi_Colon_Declaration ("subprogram body"); - + -- The body. + Parse_Subprogram_Body (Subprg, Is_Loc); return Subprg; end Parse_Subprogram_Declaration; -- cgit v1.2.3