diff options
| -rw-r--r-- | src/vhdl/parse.adb | 243 |
1 files changed, 140 insertions, 103 deletions
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 989885209..3acd4a731 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -189,6 +189,20 @@ package body Parse is end loop; end Eat_Tokens_Until_Semi_Colon; + procedure Resync_To_End_Of_Statement is + begin + loop + case Current_Token is + when Tok_Eof + | Tok_Semi_Colon + | Tok_End => + exit; + when others => + Scan; + end case; + end loop; + end Resync_To_End_Of_Statement; + -- Expect and scan ';' emit an error message using MSG if not present. procedure Scan_Semi_Colon (Msg : String) is begin @@ -831,7 +845,7 @@ package body Parse is when others => Error_Msg_Parse - ("identifier or all is expected after '.'"); + ("identifier or ""all"" is expected after '.'"); Res := Prefix; end case; @@ -1301,13 +1315,13 @@ package body Parse is Last := Inter; end loop; - Expect (Tok_Colon, "':' must follow the interface element identifier"); - - -- Skip ':' if Flag_Elocations then Set_Colon_Location (First, Get_Token_Location); end if; - Scan; + + -- Skip ':' + Expect_Scan (Tok_Colon, + "':' must follow the interface element identifier"); -- Parse mode. case Current_Token is @@ -2449,8 +2463,9 @@ package body Parse is Scan; if Current_Token = Tok_Semi_Colon then - -- If there is a ';', this is an imcomplete type declaration. - Invalidate_Current_Token; + -- If there is a ';', this is an incomplete type declaration. + Scan; + Decl := Create_Iir (Iir_Kind_Type_Declaration); Set_Identifier (Decl, Ident); Set_Location (Decl, Loc); @@ -2571,8 +2586,7 @@ package body Parse is Set_Location (Decl, Loc); -- ';' is expected after end of type declaration - Expect (Tok_Semi_Colon); - Invalidate_Current_Token; + Expect_Scan (Tok_Semi_Colon); if Flag_Elocations then Create_Elocations (Decl); @@ -2842,7 +2856,7 @@ package body Parse is end Parse_Subtype_Indication; -- precond : SUBTYPE - -- postcond: ';' + -- postcond: next token -- -- [ LRM93 4.2 ] -- subtype_declaration ::= SUBTYPE identifier IS subtype_indication ; @@ -2854,25 +2868,30 @@ package body Parse is Start_Loc : Location_Type; begin Decl := Create_Iir (Iir_Kind_Subtype_Declaration); + Set_Parent (Decl, Parent); + Set_Location (Decl); Start_Loc := Get_Token_Location; -- Eat 'subtype'. - Scan_Expect (Tok_Identifier); + Scan; - Set_Identifier (Decl, Current_Identifier); - Set_Parent (Decl, Parent); - Set_Location (Decl); + if Current_Token = Tok_Identifier then + Set_Identifier (Decl, Current_Identifier); - -- Skip identifier. - Scan_Expect (Tok_Is); + -- Skip identifier. + Scan; + else + Error_Msg_Parse ("identifier expected after 'type'"); + end if; -- Skip 'is'. - Scan; + Expect_Scan (Tok_Is); Def := Parse_Subtype_Indication; Set_Subtype_Indication (Decl, Def); - Expect (Tok_Semi_Colon); + -- Skip 'end'. + Expect_Scan (Tok_Semi_Colon); if Flag_Elocations then Create_Elocations (Decl); @@ -2916,13 +2935,8 @@ package body Parse is Scan; - if Current_Token /= Tok_Is then - Error_Msg_Parse ("'is' expected here"); - -- Act as if IS token was forgotten. - else - -- Skip 'is'. - Scan; - end if; + -- Skip 'is'. + Expect_Scan (Tok_Is); case Current_Token is when Tok_Array => @@ -2977,8 +2991,8 @@ package body Parse is Set_Location (Decl, Loc); -- ';' is expected after end of type declaration - Expect (Tok_Semi_Colon); - Invalidate_Current_Token; + Expect_Scan (Tok_Semi_Colon); + return Decl; end Parse_Nature_Declaration; @@ -3018,7 +3032,7 @@ package body Parse is end Parse_Subnature_Indication; -- precond : TERMINAL - -- postcond: ; + -- postcond: next token. -- -- [ 4.3.1.5 Terminal declarations ] -- terminal_declaration ::= @@ -3066,12 +3080,12 @@ package body Parse is end if; Terminal := Get_Chain (Terminal); end loop; - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); return First; end Parse_Terminal_Declaration; -- precond : QUANTITY - -- postcond: ; + -- postcond: next token. -- -- [ 4.3.1.6 Quantity declarations ] -- quantity_declaration ::= @@ -3271,12 +3285,12 @@ package body Parse is Eat_Tokens_Until_Semi_Colon; return Null_Iir; end case; - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); return First; end Parse_Quantity_Declaration; -- precond : token (CONSTANT, SIGNAL, VARIABLE, FILE) - -- postcond: ; + -- postcond: next token. -- -- KIND can be iir_kind_constant_declaration, iir_kind_file_declaration -- or iir_kind_variable_declaration @@ -3400,7 +3414,7 @@ package body Parse is end loop; -- Skip ':'. - Scan; + Expect_Scan (Tok_Colon); Object_Type := Parse_Subtype_Indication; @@ -3492,14 +3506,14 @@ package body Parse is Object := Get_Chain (Object); end loop; - -- ';' is not eaten. - Expect (Tok_Semi_Colon); + -- Skip ';'. + Expect_Scan (Tok_Semi_Colon); return First; end Parse_Object_Declaration; -- precond : COMPONENT - -- postcond: ';' + -- postcond: next token. -- -- [ LRM93 4.5 ] -- component_declaration ::= @@ -3543,6 +3557,10 @@ package body Parse is end if; Check_End_Name (Tok_Component, Component); + + -- Skip ';'. + Scan; + return Component; end Parse_Component_Declaration; @@ -3591,7 +3609,7 @@ package body Parse is end Parse_Signature; -- precond : ALIAS - -- postcond: a token + -- postcond: next token -- -- [ LRM93 4.3.3 ] -- alias_declaration ::= @@ -3639,8 +3657,7 @@ package body Parse is end if; -- FIXME: nice message if token is ':=' ? - Expect (Tok_Is); - Scan; + Expect_Scan (Tok_Is); Set_Name (Res, Parse_Signature_Name); if Flag_Elocations then @@ -3648,11 +3665,14 @@ package body Parse is Set_Start_Location (Res, Start_Loc); end if; + -- Skip ';'. + Expect_Scan (Tok_Semi_Colon); + return Res; end Parse_Alias_Declaration; -- precond : FOR - -- postcond: ';' + -- postcond: next token. -- -- [ LRM93 5.2 ] -- configuration_specification ::= @@ -3666,12 +3686,14 @@ package body Parse is Set_Location (Res); -- Eat 'for'. - Expect (Tok_For); - Scan; + Expect_Scan (Tok_For); Parse_Component_Specification (Res); Set_Binding_Indication (Res, Parse_Binding_Indication); - Expect (Tok_Semi_Colon); + + -- Skip ';'. + Expect_Scan (Tok_Semi_Colon); + return Res; end Parse_Configuration_Specification; @@ -3805,7 +3827,7 @@ package body Parse is end Parse_Entity_Name_List; -- precond : ATTRIBUTE - -- postcond: ';' + -- postcond: next token -- -- [ 4.4 ] -- attribute_declaration ::= ATTRIBUTE identifier : type_mark ; @@ -3846,7 +3868,7 @@ package body Parse is Scan; Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True)); - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); when Tok_Of => Res := Create_Iir (Iir_Kind_Attribute_Specification); @@ -3860,13 +3882,12 @@ package body Parse is Scan; Parse_Entity_Name_List (Res); - Expect (Tok_Is); -- Skip 'is'. - Scan; + Expect_Scan (Tok_Is); Set_Expression (Res, Parse_Expression); - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); when others => Error_Msg_Parse ("':' or 'of' expected after identifier"); @@ -3891,7 +3912,8 @@ package body Parse is -- entity_class_entry_list ::= entity_class_entry { , entity_class_entry } -- -- entity_class_entry ::= entity_class [ <> ] - function Parse_Group return Iir is + function Parse_Group return Iir + is Loc : Location_Type; Ident : Name_Id; begin @@ -3899,7 +3921,10 @@ package body Parse is Scan_Expect (Tok_Identifier); Loc := Get_Token_Location; Ident := Current_Identifier; + + -- Skip 'group'. Scan; + case Current_Token is when Tok_Is => declare @@ -3944,7 +3969,7 @@ package body Parse is -- Skip ')' ';' Expect_Scan (Tok_Right_Paren); - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); return Res; end; when Tok_Colon => @@ -3976,7 +4001,7 @@ package body Parse is -- Skip ')' ';'. Expect_Scan (Tok_Right_Paren); - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); Set_Group_Constituent_List (Res, List_To_Flist (List)); return Res; @@ -4026,7 +4051,7 @@ package body Parse is end Parse_Signal_List; -- precond : DISCONNECT - -- postcond: ';' + -- postcond: next token. -- -- [ LRM93 5.4 ] -- disconnection_specification ::= @@ -4036,26 +4061,29 @@ package body Parse is is Res : Iir_Disconnection_Specification; begin + pragma Assert (Current_Token = Tok_Disconnect); + Res := Create_Iir (Iir_Kind_Disconnection_Specification); Set_Location (Res); -- Skip 'disconnect' - Expect (Tok_Disconnect); Scan; Set_Signal_List (Res, Parse_Signal_List); -- Skip ':' - Expect (Tok_Colon); - Scan; + Expect_Scan (Tok_Colon); Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True)); -- Skip 'after' - Expect (Tok_After); - Scan; + Expect_Scan (Tok_After); Set_Expression (Res, Parse_Expression); + + -- Skip ';'. + Expect_Scan (Tok_Semi_Colon); + return Res; end Parse_Disconnection_Specification; @@ -4620,6 +4648,11 @@ package body Parse is (+Decl, "package body not allowed in a package"); end if; end if; + + if Current_Token = Tok_Semi_Colon then + -- Skip ';'. + Scan; + end if; when Tok_Identifier => if Vhdl_Std >= Vhdl_08 and then Current_Identifier = Name_Default @@ -4647,6 +4680,11 @@ package body Parse is Error_Kind ("parse_declarative_part", Parent); end case; Decl := Parse_Psl_Default_Clock; + + if Current_Token = Tok_Semi_Colon then + -- Skip ';' (scan without PSL keywords). + Scan; + end if; else Error_Msg_Parse ("object class keyword such as 'variable' is expected"); @@ -4661,15 +4699,11 @@ package body Parse is if Decl /= Null_Iir then Append_Subchain (Last_Decl, Parent, Decl); end if; - - if Current_Token = Tok_Semi_Colon or Current_Token = Tok_Invalid then - Scan; - end if; end loop; end Parse_Declarative_Part; -- precond : ENTITY - -- postcond: ';' + -- postcond: ';'. -- -- [ LRM93 1.1 ] -- entity_declaration ::= @@ -4705,10 +4739,10 @@ package body Parse is "an identifier is expected after ""entity"""); Set_Identifier (Res, Current_Identifier); Set_Location (Res); - - Scan_Expect (Tok_Is, "missing ""is"" after identifier"); Scan; + Expect_Scan (Tok_Is); + Parse_Generic_Port_Clauses (Res); Parse_Declarative_Part (Res); @@ -4726,11 +4760,8 @@ package body Parse is end if; -- end keyword is expected to finish an entity declaration - Expect (Tok_End); End_Loc := Get_Token_Location; - - -- Skip 'end'. - Scan; + Expect_Scan (Tok_End); if Current_Token = Tok_Entity then if Flags.Vhdl_Std = Vhdl_87 then @@ -4741,7 +4772,7 @@ package body Parse is end if; Check_End_Name (Res); Expect (Tok_Semi_Colon); - Invalidate_Current_Token; + Set_Library_Unit (Unit, Res); if Flag_Elocations then @@ -5321,6 +5352,7 @@ package body Parse is when Tok_Comma | Tok_Semi_Colon + | Tok_Right_Paren | Tok_Eof | Tok_End => -- Token not to be skipped @@ -6039,7 +6071,11 @@ package body Parse is begin Res := Create_Iir (Iir_Kind_Wait_Statement); Set_Location (Res); + + -- Skip 'wait'. Scan; + + -- Sensitivity clause. case Current_Token is when Tok_On => List := Create_Iir_List; @@ -6054,13 +6090,15 @@ package body Parse is return Res; when others => Error_Msg_Parse ("'on', 'until', 'for' or ';' expected"); - Eat_Tokens_Until_Semi_Colon; + Resync_To_End_Of_Statement; return Res; end case; + + -- Condition clause. case Current_Token is when Tok_On => Error_Msg_Parse ("only one sensitivity is allowed"); - -- FIXME: sync + Resync_To_End_Of_Statement; return Res; when Tok_Until => Scan; @@ -6071,17 +6109,19 @@ package body Parse is return Res; when others => Error_Msg_Parse ("'until', 'for' or ';' expected"); - Eat_Tokens_Until_Semi_Colon; + Resync_To_End_Of_Statement; return Res; end case; + + -- Timeout clause. case Current_Token is when Tok_On => Error_Msg_Parse ("only one sensitivity clause is allowed"); - -- FIXME: sync + Resync_To_End_Of_Statement; return Res; when Tok_Until => Error_Msg_Parse ("only one condition clause is allowed"); - -- FIXME: sync + Resync_To_End_Of_Statement; return Res; when Tok_For => Scan; @@ -6091,7 +6131,7 @@ package body Parse is return Res; when others => Error_Msg_Parse ("'for' or ';' expected"); - Eat_Tokens_Until_Semi_Colon; + Resync_To_End_Of_Statement; return Res; end case; end Parse_Wait_Statement; @@ -6421,7 +6461,7 @@ package body Parse is Set_Prefix (Call, Target); Set_Procedure_Call (Stmt, Call); Set_Location (Call); - Eat_Tokens_Until_Semi_Colon; + Resync_To_End_Of_Statement; return Stmt; end if; end Parse_Sequential_Assignment_Statement; @@ -6824,7 +6864,7 @@ package body Parse is end Parse_Sequential_Statements; -- precond : PROCEDURE, FUNCTION, PURE or IMPURE. - -- postcond: ';' + -- postcond: next token. -- -- [ LRM93 2.1 ] -- subprogram_declaration ::= subprogram_specification ; @@ -6912,6 +6952,9 @@ package body Parse is end if; if Current_Token = Tok_Semi_Colon then + -- Skip ';'. + Scan; + return Subprg; end if; @@ -7000,7 +7043,7 @@ package body Parse is when others => null; end case; - Expect (Tok_Semi_Colon); + Expect_Scan (Tok_Semi_Colon); return Subprg; end Parse_Subprogram_Declaration; @@ -8453,7 +8496,7 @@ package body Parse is end Parse_Library_Clause; -- precond : USE - -- postcond: ; + -- postcond: next token (after ';'). -- -- [ LRM93 10.4 ] -- use_clause ::= USE selected_name { , selected_name } @@ -8494,13 +8537,13 @@ package body Parse is Scan; end loop; - Expect (Tok_Semi_Colon, "';' expected at end of use clause"); + Expect_Scan (Tok_Semi_Colon, "';' expected at end of use clause"); return First; end Parse_Use_Clause; -- precond : ARCHITECTURE - -- postcond: ';' + -- postcond: ';'. -- -- [ LRM93 1.2 ] -- architecture_body ::= @@ -8543,22 +8586,24 @@ package body Parse is Parse_Declarative_Part (Res); -- Skip 'begin'. - Expect (Tok_Begin); Begin_Loc := Get_Token_Location; - Scan; + Expect_Scan (Tok_Begin); Parse_Concurrent_Statements (Res); -- end was scanned. End_Loc := Get_Token_Location; -- Skip 'end'. - Scan; + Expect_Scan (Tok_End); + if Current_Token = Tok_Architecture then if Flags.Vhdl_Std = Vhdl_87 then Error_Msg_Parse ("'architecture' keyword not allowed here by vhdl 87"); end if; Set_End_Has_Reserved_Id (Res, True); + + -- Skip 'architecture'. Scan; end if; Check_End_Name (Res); @@ -8823,8 +8868,6 @@ package body Parse is while Current_Token = Tok_Use loop Append_Subchain (Last, Res, Parse_Use_Clause); - -- Eat ';'. - Scan; end loop; end; end if; @@ -8978,12 +9021,11 @@ package body Parse is when others => exit; end case; - Scan; end loop; end Parse_Configuration_Declarative_Part; -- precond : CONFIGURATION - -- postcond: ';' + -- postcond: ';'. -- -- [ LRM93 1.3 ] -- configuration_declaration ::= @@ -9010,16 +9052,15 @@ package body Parse is Set_Location (Res); -- Skip identifier. - Scan_Expect (Tok_Of); + Scan; -- Skip 'of'. - Scan; + Expect_Scan (Tok_Of); Set_Entity_Name (Res, Parse_Name (False)); -- Skip 'is'. - Expect (Tok_Is); - Scan; + Expect_Scan (Tok_Is); Parse_Configuration_Declarative_Part (Res); @@ -9079,7 +9120,7 @@ package body Parse is end Parse_Package_Header; -- precond : token (after 'IS') - -- postcond: ';' + -- postcond: ';'. -- -- [ LRM93 2.5, LRM08 4.7 ] -- package_declaration ::= @@ -9107,11 +9148,10 @@ package body Parse is Parse_Declarative_Part (Res); - Expect (Tok_End); End_Loc := Get_Token_Location; -- Skip 'end' - Scan; + Expect_Scan (Tok_End); if Current_Token = Tok_Package then if Flags.Vhdl_Std = Vhdl_87 then @@ -9135,7 +9175,7 @@ package body Parse is end Parse_Package_Declaration; -- precond : BODY - -- postcond: ';' + -- postcond: ';'. -- -- [ LRM93 2.6, LRM08 4.8 ] -- package_body ::= @@ -9194,7 +9234,7 @@ package body Parse is end Parse_Package_Body; -- precond : NEW - -- postcond: ';' + -- postcond: ';'. -- -- [ LRM08 4.9 ] -- package_instantiation_declaration ::= @@ -9223,13 +9263,13 @@ package body Parse is (Res, Parse_Association_List_In_Parenthesis); end if; - Expect (Tok_Semi_Colon); - if Flag_Elocations then Create_Elocations (Res); Set_End_Location (Res, Get_Token_Location); end if; + Expect (Tok_Semi_Colon); + return Res; end Parse_Package_Instantiation_Declaration; @@ -9264,8 +9304,7 @@ package body Parse is Scan; -- Skip 'is'. - Expect (Tok_Is); - Scan; + Expect_Scan (Tok_Is); if Current_Token = Tok_New then Res := Parse_Package_Instantiation_Declaration (Parent, Id, Loc); @@ -9306,7 +9345,6 @@ package body Parse is Els := Parse_Library_Clause; when Tok_Use => Els := Parse_Use_Clause; - Scan; when Tok_Context => Parse_Context_Declaration_Or_Reference (Unit, Els); if Els = Null_Iir then @@ -9332,7 +9370,6 @@ package body Parse is Error_Msg_Parse ("'with' not allowed in context clause " & "(try 'use' or 'library')"); Els := Parse_Use_Clause; - Scan; when others => exit; end case; |