diff options
Diffstat (limited to 'parse.adb')
| -rw-r--r-- | parse.adb | 5701 |
1 files changed, 5701 insertions, 0 deletions
diff --git a/parse.adb b/parse.adb new file mode 100644 index 000000000..8364b29c3 --- /dev/null +++ b/parse.adb @@ -0,0 +1,5701 @@ +-- VHDL parser. +-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; use Ada.Text_IO; +with Types; use Types; +with Tokens; use Tokens; +with Scan; use Scan; +with Iirs_Utils; use Iirs_Utils; +with Errorout; use Errorout; +with Std_Names; use Std_Names; +with Flags; +with Name_Table; +with Str_Table; +with Iir_Chains; use Iir_Chains; +with Xrefs; + +-- Recursive descendant parser. +-- Each subprogram (should) parse one production rules. +-- Rules are written in a comment just before the subprogram. +-- terminals are written in upper case. +-- non-terminal are written in lower case. +-- syntaxic category of a non-terminal are written in upper case. +-- eg: next_statement ::= [ label : ] NEXT [ LOOP_label ] [ WHEN condition ] ; +-- Or (|) must be aligned by the previous or, or with the '=' character. +-- Indentation is 4. +-- +-- To document what is expected for input and what is left as an output +-- concerning token stream, a precond and a postcond comment shoud be +-- added before the above rules. +-- a token (such as IF or ';') means the current token is this token. +-- 'a token' means the current token was analysed. +-- 'next token' means the current token is to be analysed. + + +package body Parse is + + -- current_token must be valid. + -- Leaves a token. + function Parse_Simple_Expression return Iir_Expression; + function Parse_Primary return Iir_Expression; + function Parse_Use_Clause return Iir_Use_Clause; + + function Parse_Association_Chain return Iir; + + function Parse_Sequential_Statements (Parent : Iir) return Iir; + function Parse_Configuration_Item return Iir; + function Parse_Block_Configuration return Iir_Block_Configuration; + procedure Parse_Concurrent_Statements (Parent : Iir); + function Parse_Expression return Iir_Expression; + function Parse_Subprogram_Declaration return Iir; + function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir; + procedure Parse_Component_Specification (Res : Iir); + function Parse_Binding_Indication return Iir_Binding_Indication; + function Parse_Aggregate return Iir; + function Parse_Signature return Iir_Signature; + procedure Parse_Declarative_Part (Parent : Iir); + + Expect_Error: exception; + + -- Copy the current location into an iir. + procedure Set_Location (Node : Iir) is + begin + Set_Location (Node, Get_Token_Location); + end Set_Location; + + procedure Set_End_Location (Node : Iir) is + begin + Set_End_Location (Node, Get_Token_Location); + end Set_End_Location; + + procedure Unexpected (Where: String) is + begin + Error_Msg_Parse + ("unexpected token '" & Image (Current_Token) & "' in a " & Where); + end Unexpected; + +-- procedure Unexpected_Eof is +-- begin +-- Error_Msg_Parse ("unexpected end of file"); +-- end Unexpected_Eof; + + -- Emit an error if the current_token if different from TOKEN. + -- Otherwise, accept the current_token (ie set it to tok_invalid, unless + -- TOKEN is Tok_Identifier). + procedure Expect (Token: Token_Type; Msg: String := "") is + use Errorout; + begin + if Current_Token /= Token then + if Msg'Length > 0 then + Error_Msg_Parse (Msg); + Error_Msg_Parse ("(found: " & Image (Current_Token) & ")"); + else + Error_Msg_Parse + (''' & Image(Token) & "' is expected instead of '" + & Image (Current_Token) & '''); + end if; + raise Expect_Error; + end if; + + -- Accept the current_token. + if Current_Token /= Tok_Identifier then + Invalidate_Current_Token; + end if; + exception + when Parse_Error => + Put_Line ("found " & Token_Type'Image (Current_Token)); + if Current_Token = Tok_Identifier then + Put_Line ("identifier: " & Name_Table.Image (Current_Identifier)); + end if; + raise; + end Expect; + + -- Scan a token and expect it. + procedure Scan_Expect (Token: Token_Type; Msg: String := "") is + begin + Scan.Scan; + Expect (Token, Msg); + end Scan_Expect; + + -- If the current_token is an identifier, it must be equal to name. + -- In this case, a token is eaten. + -- If the current_token is not an identifier, this is a noop. + procedure Check_End_Name (Name : Name_Id; Decl : Iir) is + begin + if Current_Token /= Tok_Identifier then + return; + end if; + if Name = Null_Identifier then + Error_Msg_Parse + ("end label for an unlabeled declaration or statement"); + else + if Current_Identifier /= Name then + Error_Msg_Parse + ("mispelling, """ & Name_Table.Image (Name) & """ expected"); + else + Xrefs.Xref_End (Get_Token_Location, Decl); + end if; + end if; + Scan.Scan; + end Check_End_Name; + + procedure Check_End_Name (Decl : Iir) is + begin + Check_End_Name (Get_Identifier (Decl), Decl); + end Check_End_Name; + + + -- Expect ' END tok [ name ] ; ' + procedure Check_End_Name (Tok : Token_Type; Decl : Iir) is + begin + if Current_Token /= Tok_End then + Error_Msg_Parse ("""end " & Image (Tok) & ";"" expected"); + else + Scan.Scan; + if Current_Token /= Tok then + Error_Msg_Parse + ("""end"" must be followed by """ & Image (Tok) & """"); + else + Scan.Scan; + end if; + Check_End_Name (Decl); + Expect (Tok_Semi_Colon); + end if; + end Check_End_Name; + + procedure Eat_Tokens_Until_Semi_Colon is + begin + loop + case Current_Token is + when Tok_Semi_Colon + | Tok_Eof => + exit; + when others => + Scan.Scan; + end case; + end loop; + end Eat_Tokens_Until_Semi_Colon; + + -- precond : next token + -- postcond: next token. + -- + -- [§ 4.3.2 ] + -- mode ::= IN | OUT | INOUT | BUFFER | LINKAGE + -- + -- If there is no mode, DEFAULT is returned. + function Parse_Mode (Default: Iir_Mode) return Iir_Mode is + begin + case Current_Token is + when Tok_Identifier => + return Default; + when Tok_In => + Scan.Scan; + if Current_Token = Tok_Out then + -- Nice message for Ada users... + Error_Msg_Parse ("typo error, in out must be 'inout' in vhdl"); + Scan.Scan; + return Iir_Inout_Mode; + end if; + return Iir_In_Mode; + when Tok_Out => + Scan.Scan; + return Iir_Out_Mode; + when Tok_Inout => + Scan.Scan; + return Iir_Inout_Mode; + when Tok_Linkage => + Scan.Scan; + return Iir_Linkage_Mode; + when Tok_Buffer => + Scan.Scan; + return Iir_Buffer_Mode; + when others => + Error_Msg_Parse + ("mode is 'in', 'out', 'inout', 'buffer' or 'linkage'"); + return Iir_In_Mode; + end case; + end Parse_Mode; + + -- precond : next token + -- postcond: next token + -- + -- [ §4.3.1.2 ] + -- signal_kind ::= REGISTER | BUS + -- + -- If there is no signal_kind, then no_signal_kind is returned. + function Parse_Signal_Kind return Iir_Signal_Kind is + begin + if Current_Token = Tok_Bus then + Scan.Scan; + return Iir_Bus_Kind; + elsif Current_Token = Tok_Register then + Scan.Scan; + return Iir_Register_Kind; + else + return Iir_No_Signal_Kind; + end if; + end Parse_Signal_Kind; + + -- precond : next token + -- postcond: next token + -- + -- Parse a range. + -- If LEFT is not null_iir, then it must be an expression corresponding to + -- the left limit of the range, and the current_token must be either + -- tok_to or tok_downto. + -- If left is null_iir, the current token is used to create the left limit + -- expression. + -- + -- [§ 3.1] + -- range ::= RANGE_attribute_name + -- | simple_expression direction simple_expression + function Parse_Range_Expression + (Left: Iir; Discrete: Boolean := False) return Iir + is + Res : Iir; + Left1: Iir; + begin + if Left /= Null_Iir then + Left1 := Left; + else + Left1 := Parse_Simple_Expression; + end if; + + case Current_Token is + when Tok_To => + Res := Create_Iir (Iir_Kind_Range_Expression); + Set_Direction (Res, Iir_To); + when Tok_Downto => + Res := Create_Iir (Iir_Kind_Range_Expression); + Set_Direction (Res, Iir_Downto); + when Tok_Range => + if not Discrete then + Unexpected ("range definition"); + end if; + Scan.Scan; + if Current_Token = Tok_Box then + Unexpected ("<> not allowed here"); + Scan.Scan; + return Null_Iir; + end if; + Res := Parse_Range_Expression (Null_Iir, False); + if Res /= Null_Iir then + Set_Type (Res, Left1); + end if; + return Res; + when others => + if Left1 = Null_Iir then + return Null_Iir; + end if; + if Is_Range_Attribute_Name (Left1) then + return Left1; + end if; + if Discrete and then Get_Kind (Left1) in Iir_Kinds_Name then + return Left1; + end if; + Error_Msg_Parse ("'to' or 'downto' expected"); + return Null_Iir; + end case; + Set_Left_Limit (Res, Left1); + Location_Copy (Res, Left1); + + Scan.Scan; + Set_Right_Limit (Res, Parse_Simple_Expression); + return Res; + end Parse_Range_Expression; + + -- [ 3.1 ] + -- range_constraint ::= RANGE range + -- + -- [ 3.1 ] + -- range ::= range_attribute_name + -- | simple_expression direction simple_expression + -- + -- [ 3.1 ] + -- direction ::= TO | DOWNTO + + -- precond: TO or DOWNTO + -- postcond: next token + function Parse_Range_Right (Left : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Range_Expression); + Set_Location (Res); + Set_Left_Limit (Res, Left); + + case Current_Token is + when Tok_To => + Set_Direction (Res, Iir_To); + when Tok_Downto => + Set_Direction (Res, Iir_Downto); + when others => + raise Internal_Error; + end case; + + Scan.Scan; + Set_Right_Limit (Res, Parse_Simple_Expression); + return Res; + end Parse_Range_Right; + + -- precond: next token + -- postcond: next token + function Parse_Range return Iir + is + Left: Iir; + begin + Left := Parse_Simple_Expression; + + case Current_Token is + when Tok_To + | Tok_Downto => + return Parse_Range_Right (Left); + when others => + if Left /= Null_Iir then + if Is_Range_Attribute_Name (Left) then + return Left; + end if; + Error_Msg_Parse ("'to' or 'downto' expected"); + end if; + return Null_Iir; + end case; + end Parse_Range; + + -- precond: RANGE + -- postcond: next token + function Parse_Range_Constraint return Iir is + begin + if Current_Token /= Tok_Range then + Error_Msg_Parse ("'range' expected"); + return Null_Iir; + end if; + Scan.Scan; + + return Parse_Range; + end Parse_Range_Constraint; + + -- precond: next token + -- postcond: next token + -- + -- [ 3.2.1 ] + -- discrete_range ::= discrete_subtype_indication | range + function Parse_Discrete_Range return Iir + is + Left: Iir; + Rng : Iir; + begin + Left := Parse_Simple_Expression; + + case Current_Token is + when Tok_To + | Tok_Downto => + return Parse_Range_Right (Left); + when Tok_Range => + -- FIXME: create a subtype indication. + Rng := Parse_Range_Constraint; + Set_Type (Rng, Left); + return Rng; + when others => + -- Assume a discrete subtype indication. + return Left; + end case; + end Parse_Discrete_Range; + + -- Convert the STR (0 .. LEN - 1) into a operator symbol identifier. + -- Emit an error message if the name is not an operator name. + function Str_To_Operator_Name (Str : String_Fat_Acc; + Len : Nat32; + Loc : Location_Type) return Name_Id + is + -- LRM93 2.1 + -- Extra spaces are not allowed in an operator symbol, and the + -- case of letters is not signifiant. + + -- LRM93 2.1 + -- The sequence of characters represented by an operator symbol + -- must be an operator belonging to one of classes of operators + -- defined in section 7.2. + + procedure Bad_Operator_Symbol is + begin + Error_Msg_Parse ("""" & Str (1 .. Natural (Len)) + & """ is not an operator symbol", Loc); + end Bad_Operator_Symbol; + + procedure Check_Vhdl93 is + begin + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("""" & Str (1 .. Natural (Len)) + & """ is not a vhdl87 operator symbol", Loc); + end if; + end Check_Vhdl93; + + Id : Name_Id; + C1, C2, C3, C4 : Character; + begin + C1 := Str (1); + case Len is + when 1 => + -- =, <, >, +, -, *, /, & + case C1 is + when '=' => + Id := Name_Op_Equality; + when '>' => + Id := Name_Op_Greater; + when '<' => + Id := Name_Op_Less; + when '+' => + Id := Name_Op_Plus; + when '-' => + Id := Name_Op_Minus; + when '*' => + Id := Name_Op_Mul; + when '/' => + Id := Name_Op_Div; + when '&' => + Id := Name_Op_Concatenation; + when others => + Bad_Operator_Symbol; + Id := Name_Op_Plus; + end case; + when 2 => + -- or, /=, <=, >=, ** + C2 := Str (2); + case C1 is + when 'o' | 'O' => + Id := Name_Or; + if C2 /= 'r' and C2 /= 'R' then + Bad_Operator_Symbol; + end if; + when '/' => + Id := Name_Op_Inequality; + if C2 /= '=' then + Bad_Operator_Symbol; + end if; + when '<' => + Id := Name_Op_Less_Equal; + if C2 /= '=' then + Bad_Operator_Symbol; + end if; + when '>' => + Id := Name_Op_Greater_Equal; + if C2 /= '=' then + Bad_Operator_Symbol; + end if; + when '*' => + Id := Name_Op_Exp; + if C2 /= '*' then + Bad_Operator_Symbol; + end if; + when others => + Bad_Operator_Symbol; + Id := Name_Op_Equality; + end case; + when 3 => + -- mod, rem, and, xor, nor, abs, not, sll, sla, sra, srl, rol + -- ror + C2 := Str (2); + C3 := Str (3); + case C1 is + when 'm' | 'M' => + Id := Name_Mod; + if (C2 /= 'o' and C2 /= 'O') or (C3 /= 'd' and C3 /= 'D') + then + Bad_Operator_Symbol; + end if; + when 'a' | 'A' => + if (C2 = 'n' or C2 = 'N') and (C3 = 'd' or C3 = 'D') then + Id := Name_And; + elsif (C2 = 'b' or C2 = 'B') and (C3 = 's' or C3 = 'S') then + Id := Name_Abs; + else + Id := Name_And; + Bad_Operator_Symbol; + end if; + when 'x' | 'X' => + Id := Name_Xor; + if (C2 /= 'o' and C2 /= 'O') or (C3 /= 'r' and C3 /= 'R') + then + Bad_Operator_Symbol; + end if; + when 'n' | 'N' => + if C2 = 'o' or C2 = 'O' then + if C3 = 'r' or C3 = 'R' then + Id := Name_Nor; + elsif C3 = 't' or C3 = 'T' then + Id := Name_Not; + else + Id := Name_Not; + Bad_Operator_Symbol; + end if; + else + Id := Name_Not; + Bad_Operator_Symbol; + end if; + when 's' | 'S' => + if C2 = 'l' or C2 = 'L' then + if C3 = 'l' or C3 = 'L' then + Check_Vhdl93; + Id := Name_Sll; + elsif C3 = 'a' or C3 = 'A' then + Check_Vhdl93; + Id := Name_Sla; + else + Id := Name_Sll; + Bad_Operator_Symbol; + end if; + elsif C2 = 'r' or C2 = 'R' then + if C3 = 'l' or C3 = 'L' then + Check_Vhdl93; + Id := Name_Srl; + elsif C3 = 'a' or C3 = 'A' then + Check_Vhdl93; + Id := Name_Sra; + else + Id := Name_Srl; + Bad_Operator_Symbol; + end if; + else + Id := Name_Sll; + Bad_Operator_Symbol; + end if; + when 'r' | 'R' => + if C2 = 'e' or C2 = 'E' then + if C3 = 'm' or C3 = 'M' then + Id := Name_Rem; + else + Id := Name_Rem; + Bad_Operator_Symbol; + end if; + elsif C2 = 'o' or C2 = 'O' then + if C3 = 'l' or C3 = 'L' then + Check_Vhdl93; + Id := Name_Rol; + elsif C3 = 'r' or C3 = 'R' then + Check_Vhdl93; + Id := Name_Ror; + else + Id := Name_Rol; + Bad_Operator_Symbol; + end if; + else + Id := Name_Rem; + Bad_Operator_Symbol; + end if; + when others => + Id := Name_And; + Bad_Operator_Symbol; + end case; + when 4 => + -- nand, xnor + C2 := Str (2); + C3 := Str (3); + C4 := Str (4); + if (C1 = 'n' or C1 = 'N') + and (C2 = 'a' or C2 = 'A') + and (C3 = 'n' or C3 = 'N') + and (C4 = 'd' or C4 = 'D') + then + Id := Name_Nand; + elsif (C1 = 'x' or C1 = 'X') + and (C2 = 'n' or C2 = 'N') + and (C3 = 'o' or C3 = 'O') + and (C4 = 'r' or C4 = 'R') + then + Check_Vhdl93; + Id := Name_Xnor; + else + Id := Name_Nand; + Bad_Operator_Symbol; + end if; + when others => + Id := Name_Op_Plus; + Bad_Operator_Symbol; + end case; + return Id; + end Str_To_Operator_Name; + + function Scan_To_Operator_Name (Loc : Location_Type) return Name_Id is + begin + return Str_To_Operator_Name + (Str_Table.Get_String_Fat_Acc (Current_String_Id), + Current_String_Length, + Loc); + end Scan_To_Operator_Name; + pragma Inline (Scan_To_Operator_Name); + + -- Convert string literal STR to an operator symbol. + -- Emit an error message if the string is not an operator name. + function String_To_Operator_Symbol (Str : Iir_String_Literal) + return Iir + is + Id : Name_Id; + Res : Iir; + begin + Id := Str_To_Operator_Name + (Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)), + Get_String_Length (Str), + Get_Location (Str)); + Res := Create_Iir (Iir_Kind_Operator_Symbol); + Location_Copy (Res, Str); + Set_Identifier (Res, Id); + Free_Iir (Str); + return Res; + end String_To_Operator_Symbol; + + -- precond : next token + -- postcond: next token + -- + -- [ §6.1 ] + -- name ::= simple_name + -- | operator_symbol + -- | selected_name + -- | indexed_name + -- | slice_name + -- | attribute_name + -- + -- [ §6.2 ] + -- simple_name ::= identifier + -- + -- [ §6.5 ] + -- slice_name ::= prefix ( discrete_range ) + -- + -- [ §6.3 ] + -- selected_name ::= prefix . suffix + -- + -- [ §6.1 ] + -- prefix ::= name + -- | function_call + -- + -- [ §6.3 ] + -- suffix ::= simple_name + -- | character_literal + -- | operator_symbol + -- | ALL + -- + -- [ §3.2.1 ] + -- discrete_range ::= DISCRETE_subtype_indication | range + -- + -- [ §3.1 ] + -- range ::= RANGE_attribute_name + -- | simple_expression direction simple_expression + -- + -- [ §3.1 ] + -- direction ::= TO | DOWNTO + -- + -- [ §6.6 ] + -- attribute_name ::= + -- prefix [ signature ] ' attribute_designator [ ( expression ) ] + -- + -- [ §6.6 ] + -- attribute_designator ::= ATTRIBUTE_simple_name + function Parse_Name_Suffix (Pfx : Iir; Allow_Indexes: Boolean := True) + return Iir + is + Res: Iir; + Prefix: Iir; + begin + Res := Pfx; + loop + Prefix := Res; + + case Current_Token is + when Tok_Left_Bracket => + if not Allow_Indexes then + return Res; + end if; + + if Get_Kind (Prefix) = Iir_Kind_String_Literal then + Prefix := String_To_Operator_Symbol (Prefix); + end if; + + -- There is an attribute with a signature. + Res := Create_Iir (Iir_Kind_Attribute_Name); + Set_Prefix (Res, Prefix); + Set_Signature (Res, Parse_Signature); + if Current_Token /= Tok_Tick then + Error_Msg_Parse ("' is expected after a signature"); + else + Set_Location (Res); + Scan.Scan; + if Current_Token /= Tok_Identifier then + Error_Msg_Parse ("attribute_designator expected after '"); + else + Set_Attribute_Identifier (Res, Current_Identifier); + Scan.Scan; + end if; + end if; + + when Tok_Tick => + -- There is an attribute. + if Get_Kind (Prefix) = Iir_Kind_String_Literal then + Prefix := String_To_Operator_Symbol (Prefix); + end if; + + Scan.Scan; + if Current_Token = Tok_Left_Paren then + -- A qualified expression. + Res := Create_Iir (Iir_Kind_Qualified_Expression); + Set_Type_Mark (Res, Prefix); + Location_Copy (Res, Prefix); + Set_Expression (Res, Parse_Aggregate); + return Res; + elsif Current_Token /= Tok_Range + and then Current_Token /= Tok_Identifier + then + Expect (Tok_Identifier, "required for an attribute name"); + return Null_Iir; + end if; + Res := Create_Iir (Iir_Kind_Attribute_Name); + Set_Attribute_Identifier (Res, Current_Identifier); + Set_Location (Res); + Set_Prefix (Res, Prefix); + -- accept the identifier. + Scan.Scan; + + when Tok_Left_Paren => + if not Allow_Indexes then + return Res; + end if; + + if Get_Kind (Prefix) = Iir_Kind_String_Literal then + Prefix := String_To_Operator_Symbol (Prefix); + end if; + + Res := Create_Iir (Iir_Kind_Parenthesis_Name); + Set_Location (Res); + Set_Prefix (Res, Prefix); + Set_Association_Chain (Res, Parse_Association_Chain); + + when Tok_Dot => + if Get_Kind (Prefix) = Iir_Kind_String_Literal then + Prefix := String_To_Operator_Symbol (Prefix); + end if; + + Scan.Scan; + case Current_Token is + when Tok_All => + Res := Create_Iir (Iir_Kind_Selected_By_All_Name); + Set_Location (Res); + Set_Prefix (Res, Prefix); + when Tok_Identifier + | Tok_Character => + Res := Create_Iir (Iir_Kind_Selected_Name); + Set_Location (Res); + Set_Prefix (Res, Prefix); + Set_Suffix_Identifier (Res, Current_Identifier); + when Tok_String => + Res := Create_Iir (Iir_Kind_Selected_Name); + Set_Location (Res); + Set_Prefix (Res, Prefix); + Set_Suffix_Identifier + (Res, Scan_To_Operator_Name (Get_Token_Location)); + when others => + Error_Msg_Parse ("an identifier or all is expected"); + end case; + Scan.Scan; + when others => + return Res; + end case; + end loop; + end Parse_Name_Suffix; + + function Parse_Name (Allow_Indexes: Boolean := True) return Iir + is + Res: Iir; + begin + case Current_Token is + when Tok_Identifier => + Res := Create_Iir (Iir_Kind_Simple_Name); + Set_Identifier (Res, Current_Identifier); + Set_Location (Res); + when Tok_String => + Res := Create_Iir (Iir_Kind_String_Literal); + Set_String_Id (Res, Current_String_Id); + Set_String_Length (Res, Current_String_Length); + Set_Location (Res); + when others => + Error_Msg_Parse ("identifier expected here"); + raise Parse_Error; + end case; + + Scan.Scan; + + return Parse_Name_Suffix (Res, Allow_Indexes); + end Parse_Name; + + -- precond : next token + -- postcond: next token + -- + -- [ 4.2 ] + -- type_mark ::= type_name + -- | subtype_name + function Parse_Type_Mark (Check_Paren : Boolean := False) return Iir + is + Res : Iir; + Old : Iir; + begin + Res := Parse_Name (Allow_Indexes => False); + if Check_Paren and then Current_Token = Tok_Left_Paren then + Error_Msg_Parse ("index constraint not allowed here"); + Old := Parse_Name_Suffix (Res, True); + end if; + return Res; + end Parse_Type_Mark; + + -- precond : '(' + -- postcond: next token + -- + -- [ §4.3.2.1 ] + -- interface_list ::= interface_element { ; interface_element } + -- + -- [ §4.3.2.1 ] + -- interface_element ::= interface_declaration + -- + -- [ §4.3.2 ] + -- interface_declaration ::= interface_constant_declaration + -- | interface_signal_declaration + -- | interface_variable_declaration + -- | interface_file_declaration + -- + -- + -- [ §3.2.2 ] + -- identifier_list ::= identifier { , identifier } + -- + -- [ §4.3.2 ] + -- interface_constant_declaration ::= + -- [ CONSTANT ] identifier_list : [ IN ] subtype_indication + -- [ := STATIC_expression ] + -- + -- [ §4.3.2 ] + -- interface_file_declaration ::= FILE identifier_list : subtype_indication + -- + -- [ §4.3.2 ] + -- interface_signal_declaration ::= + -- [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ] + -- [ := STATIC_expression ] + -- + -- [ §4.3.2 ] + -- interface_variable_declaration ::= + -- [ VARIABLE ] identifier_list : [ mode ] subtype_indication + -- [ := STATIC_expression ] + -- + -- The default kind of interface declaration is DEFAULT. + function Parse_Interface_Chain (Default: Iir_Kind; Parent : Iir) + return Iir + is + Res, Last : Iir; + First, Prev_First : Iir; + Interface: Iir; + Is_Default : Boolean; + Interface_Mode: Iir_Mode; + Interface_Type: Iir; + Signal_Kind: Iir_Signal_Kind; + Default_Value: Iir; + Proxy : Iir_Proxy; + Lexical_Layout : Iir_Lexical_Layout_Type; + Prev_Loc : Location_Type; + begin + Expect (Tok_Left_Paren); + Res := Null_Iir; + Last := Null_Iir; + loop + Prev_Loc := Get_Token_Location; + Scan.Scan; + case Current_Token is + when Tok_Identifier => + Interface := Create_Iir (Default); + when Tok_Signal => + Interface := Create_Iir (Iir_Kind_Signal_Interface_Declaration); + when Tok_Variable => + Interface := + Create_Iir (Iir_Kind_Variable_Interface_Declaration); + when Tok_Constant => + Interface := + Create_Iir (Iir_Kind_Constant_Interface_Declaration); + when Tok_File => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("file interface not allowed in vhdl 87"); + end if; + Interface := Create_Iir (Iir_Kind_File_Interface_Declaration); + when Tok_Right_Paren => + Error_Msg_Parse + ("extra ';' at end of interface list", Prev_Loc); + exit; + when others => + Error_Msg_Parse + ("'signal', 'constant', 'variable', 'file' " + & "or identifier expected"); + -- Use a variable interface as a fall-back. + Interface := + Create_Iir (Iir_Kind_Variable_Interface_Declaration); + end case; + if Current_Token = Tok_Identifier then + Is_Default := True; + Lexical_Layout := 0; + else + Is_Default := False; + Lexical_Layout := Iir_Lexical_Has_Mode; + Scan.Scan; + end if; + + Prev_First := Last; + First := Interface; + loop + if Current_Token /= Tok_Identifier then + Expect (Tok_Identifier); + end if; + Set_Identifier (Interface, Current_Identifier); + Set_Location (Interface); + + if Res = Null_Iir then + Res := Interface; + else + Set_Chain (Last, Interface); + end if; + Last := Interface; + + Scan.Scan; + exit when Current_Token = Tok_Colon; + Expect (Tok_Comma, "',' or ':' after an identifier"); + Scan.Scan; + Interface := Create_Iir (Get_Kind (Interface)); + end loop; + + Expect (Tok_Colon, + "':' must follow the interface element identifier"); + Scan.Scan; + + -- LRM93 2.1.1 + -- If the mode is INOUT or OUT, and no object class is explicitly + -- specified, variable is assumed. + if Is_Default + and then Default /= Iir_Kind_Signal_Interface_Declaration + and then (Current_Token = Tok_Inout or else Current_Token = Tok_Out) + then + -- Convert into variable. + declare + O_Interface : Iir_Constant_Interface_Declaration; + N_Interface : Iir_Variable_Interface_Declaration; + begin + O_Interface := First; + while O_Interface /= Null_Iir loop + N_Interface := + Create_Iir (Iir_Kind_Variable_Interface_Declaration); + Location_Copy (N_Interface, O_Interface); + Set_Identifier (N_Interface, + Get_Identifier (O_Interface)); + if Prev_First = Null_Iir then + Res := N_Interface; + else + Set_Chain (Prev_First, N_Interface); + end if; + Prev_First := N_Interface; + if O_Interface = First then + First := N_Interface; + end if; + Last := N_Interface; + Interface := Get_Chain (O_Interface); + Free_Iir (O_Interface); + O_Interface := Interface; + end loop; + Interface := First; + end; + end if; + + case Current_Token is + when Tok_In + | Tok_Out + | Tok_Inout + | Tok_Linkage + | Tok_Buffer => + Lexical_Layout := Lexical_Layout or Iir_Lexical_Has_Mode; + when others => + null; + end case; + + case Get_Kind (Interface) is + when Iir_Kind_File_Interface_Declaration => + if Parse_Mode (Iir_Unknown_Mode) /= Iir_Unknown_Mode then + Error_Msg_Parse + ("mode can't be specified for a file interface"); + end if; + Interface_Mode := Iir_Inout_Mode; + when Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration => + -- LRM93 4.3.2 + -- If no mode is explicitly given in an interface declaration + -- other than an interface file declaration, mode IN is + -- assumed. + Interface_Mode := Parse_Mode (Iir_In_Mode); + when Iir_Kind_Constant_Interface_Declaration => + Interface_Mode := Parse_Mode (Iir_In_Mode); + if Interface_Mode /= Iir_In_Mode then + Error_Msg_Parse ("mode must be 'in' for a constant"); + end if; + when others => + raise Internal_Error; + end case; + + Interface_Type := Parse_Subtype_Indication; + if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration then + Signal_Kind := Parse_Signal_Kind; + else + Signal_Kind := Iir_No_Signal_Kind; + end if; + + if Current_Token = Tok_Assign then + if Get_Kind (Interface) = Iir_Kind_File_Interface_Declaration then + Error_Msg_Parse + ("default expression not allowed for an interface file"); + end if; + Scan.Scan; + Default_Value := Parse_Expression; + else + Default_Value := Null_Iir; + end if; + + Interface := First; + while Interface /= Null_Iir loop + Set_Mode (Interface, Interface_Mode); + Set_Parent (Interface, Parent); + if Interface = Last then + Set_Lexical_Layout (Interface, + Lexical_Layout or Iir_Lexical_Has_Type); + else + Set_Lexical_Layout (Interface, Lexical_Layout); + end if; + if Interface = First then + Set_Type (Interface, Interface_Type); + if Get_Kind (Interface) /= Iir_Kind_File_Interface_Declaration + then + Set_Default_Value (Interface, Default_Value); + end if; + else + Proxy := Create_Iir (Iir_Kind_Proxy); + Set_Proxy (Proxy, First); + Set_Type (Interface, Proxy); + end if; + if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration + then + Set_Signal_Kind (Interface, Signal_Kind); + end if; + Interface := Get_Chain (Interface); + end loop; + exit when Current_Token /= Tok_Semi_Colon; + end loop; + if Current_Token /= Tok_Right_Paren then + Error_Msg_Parse ("')' expected at end of interface list"); + end if; + Scan.Scan; + return Res; + end Parse_Interface_Chain; + + -- precond : PORT + -- postcond: next token + -- + -- [ §1.1.1 ] + -- port_clause ::= PORT ( port_list ) ; + -- + -- [ §1.1.1.2 ] + -- port_list ::= PORT_interface_list + procedure Parse_Port_Clause (Parent : Iir) + is + Res: Iir; + El : Iir; + begin + -- tok_port must have been scaned. + if Current_Token /= Tok_Port then + raise Program_Error; + end if; + + Scan.Scan; + Res := Parse_Interface_Chain + (Iir_Kind_Signal_Interface_Declaration, Parent); + + -- Check the interface are signal interfaces. + El := Res; + while El /= Null_Iir loop + if Get_Kind (El) /= Iir_Kind_Signal_Interface_Declaration then + Error_Msg_Parse ("port must be a signal", El); + end if; + El := Get_Chain (El); + end loop; + + if Current_Token /= Tok_Semi_Colon then + Error_Msg_Parse ("missing "";"" at end of port clause"); + else + Scan.Scan; + end if; + Set_Port_Chain (Parent, Res); + end Parse_Port_Clause; + + -- precond : GENERIC + -- postcond: next token + -- + -- [ §1.1.1 ] + -- generic_clause ::= GENERIC ( generic_list ) ; + -- + -- [ §1.1.1.1] + -- generic_list ::= GENERIC_interface_list + procedure Parse_Generic_Clause (Parent : Iir) + is + Res: Iir; + begin + -- tok_port must have been scaned. + if Current_Token /= Tok_Generic then + raise Program_Error; + end if; + + Scan.Scan; + Res := Parse_Interface_Chain + (Iir_Kind_Constant_Interface_Declaration, Parent); + if Current_Token /= Tok_Semi_Colon then + Error_Msg_Parse ("missing "";"" at end of generic clause"); + else + Scan.Scan; + end if; + Set_Generic_Chain (Parent, Res); + end Parse_Generic_Clause; + + -- precond : a token. + -- postcond: next token + -- + -- [ §1.1.1 ] + -- entity_header ::= + -- [ FORMAL_generic_clause ] + -- [ FORMAL_port_clause ] + -- + -- [ §4.5 ] + -- [ LOCAL_generic_clause ] + -- [ LOCAL_port_clause ] + procedure Parse_Generic_Port_Clauses (Parent : Iir) + is + Has_Port, Has_Generic : Boolean; + begin + Has_Port := False; + Has_Generic := False; + loop + if Current_Token = Tok_Generic then + if Has_Generic then + Error_Msg_Parse ("at most one generic clause is allowed"); + end if; + if Has_Port then + Error_Msg_Parse ("generic clause must precede port clause"); + end if; + Has_Generic := True; + Parse_Generic_Clause (Parent); + elsif Current_Token = Tok_Port then + if Has_Port then + Error_Msg_Parse ("at most one port clause is allowed"); + end if; + Has_Port := True; + Parse_Port_Clause (Parent); + else + exit; + end if; + end loop; + end Parse_Generic_Port_Clauses; + + -- precond : a token + -- postcond: next token + -- + -- [ §3.1.1 ] + -- enumeration_type_definition ::= + -- ( enumeration_literal { , enumeration_literal } ) + -- + -- [ §3.1.1 ] + -- enumeration_literal ::= identifier | character_literal + function Parse_Enumeration_Type_Definition + return Iir_Enumeration_Type_Definition + is + Pos: Iir_Int32; + Enum_Lit: Iir_Enumeration_Literal; + Enum_Type: Iir_Enumeration_Type_Definition; + Enum_List : Iir_List; + begin + -- This is an enumeration. + Enum_Type := Create_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Location (Enum_Type); + Enum_List := Create_Iir_List; + Set_Enumeration_Literal_List (Enum_Type, Enum_List); + + -- LRM93 3.1.1 + -- The position number of the first listed enumeration literal is zero. + Pos := 0; + -- scan every literal. + Scan.Scan; + if Current_Token = Tok_Right_Paren then + Error_Msg_Parse ("at least one literal must be declared"); + Scan.Scan; + return Enum_Type; + end if; + loop + if Current_Token /= Tok_Identifier + and then Current_Token /= Tok_Character + then + if Current_Token = Tok_Eof then + Error_Msg_Parse ("unexpected end of file"); + return Enum_Type; + end if; + Error_Msg_Parse ("identifier or character expected"); + end if; + Enum_Lit := Create_Iir (Iir_Kind_Enumeration_Literal); + Set_Identifier (Enum_Lit, Current_Identifier); + Set_Location (Enum_Lit); + Set_Enum_Pos (Enum_Lit, Pos); + + -- LRM93 3.1.1 + -- the position number for each additional enumeration literal is + -- one more than that if its predecessor in the list. + Pos := Pos + 1; + + Append_Element (Enum_List, Enum_Lit); + + -- next token. + Scan.Scan; + exit when Current_Token = Tok_Right_Paren; + if Current_Token /= Tok_Comma then + Error_Msg_Parse ("')' or ',' is expected after an enum literal"); + end if; + + -- scan a literal. + Scan.Scan; + end loop; + Scan.Scan; + return Enum_Type; + end Parse_Enumeration_Type_Definition; + + -- precond : ARRAY + -- postcond: ?? + -- + -- [ §3.2.1 ] + -- array_type_definition ::= unconstrained_array_definition + -- | constrained_array_definition + -- + -- unconstrained_array_definition ::= + -- ARRAY ( index_subtype_definition { , index_subtype_definition } ) + -- OF element_subtype_indication + -- + -- constrained_array_definition ::= + -- ARRAY index_constraint OF element_subtype_indication + -- + -- index_subtype_definition ::= type_mark RANGE <> + -- + -- index_constraint ::= ( discrete_range { , discrete_range } ) + -- + -- discrete_range ::= discrete_subtype_indication | range + function Parse_Array_Definition return Iir + is + Index_Constrained : Boolean; + Array_Constrained : Boolean; + First : Boolean; + Res_Type: Iir; + Index_List : Iir_List; + + Loc : Location_Type; + Def : Iir; + Type_Mark : Iir; + Rng : Iir; + begin + Loc := Get_Token_Location; + + Scan_Expect (Tok_Left_Paren); + Scan.Scan; + First := True; + Index_List := Create_Iir_List; + + loop + Type_Mark := Parse_Simple_Expression; + case Current_Token is + when Tok_Range => + -- Type_Mark is a name... + Scan.Scan; + if Current_Token = Tok_Box then + -- This is an index_subtype_definition. + Index_Constrained := False; + Scan.Scan; + Def := Type_Mark; + else + Index_Constrained := True; + Rng := Parse_Range; + -- FIXME: create a subtype_definition ? + if Rng /= Null_Iir then + Set_Type (Rng, Type_Mark); + Def := Rng; + else + Def := Type_Mark; + end if; + end if; + when Tok_To + | Tok_Downto => + Index_Constrained := True; + Def := Parse_Range_Right (Type_Mark); +-- Def := Create_Iir (Iir_Kind_Subtype_Definition); +-- Location_Copy (Def, Type_Mark); +-- Set_Type_Mark (Def, Type_Mark); +-- Set_Range_Constraint (Def, Rng); + when others => + Index_Constrained := True; + Def := Type_Mark; + end case; + + Append_Element (Index_List, Def); + + if First then + Array_Constrained := Index_Constrained; + First := False; + else + if Array_Constrained /= Index_Constrained then + Error_Msg_Parse + ("cannot mix constrained and unconstrained index"); + end if; + end if; + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + + if Array_Constrained then + Res_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition); + else + Res_Type := Create_Iir (Iir_Kind_Array_Type_Definition); + end if; + Set_Location (Res_Type, Loc); + Set_Index_Subtype_List (Res_Type, Index_List); + + Expect (Tok_Right_Paren); + Scan_Expect (Tok_Of); + Scan.Scan; + Set_Element_Subtype (Res_Type, Parse_Subtype_Indication); + return Res_Type; + end Parse_Array_Definition; + + -- precond : UNITS + -- postcond: next token + -- + -- [ §3.1.3 ] + -- physical_type_definition ::= + -- range_constraint + -- UNITS + -- base_unit_declaration + -- { secondary_unit_declaration } + -- END UNITS [ PHYSICAL_TYPE_simple_name ] + -- + -- [ §3.1.3 ] + -- base_unit_declaration ::= identifier ; + -- + -- [ §3.1.3 ] + -- secondary_unit_declaration ::= identifier = physical_literal ; + function Parse_Physical_Type_Definition + return Iir_Physical_Type_Definition + is + use Iir_Chains.Unit_Chain_Handling; + Res: Iir_Physical_Type_Definition; + Unit: Iir_Unit_Declaration; + Last : Iir_Unit_Declaration; + Multiplier : Iir; + begin + Res := Create_Iir (Iir_Kind_Physical_Type_Definition); + Set_Location (Res); + Expect (Tok_Units); + Scan.Scan; + -- Parse primary unit. + Expect (Tok_Identifier); + Unit := Create_Iir (Iir_Kind_Unit_Declaration); + Set_Location (Unit); + Set_Identifier (Unit, Current_Identifier); + Build_Init (Last); + Append (Last, Res, Unit); + Scan_Expect (Tok_Semi_Colon); + Scan.Scan; + -- Parse secondary units. + while Current_Token /= Tok_End loop + Unit := Create_Iir (Iir_Kind_Unit_Declaration); + Set_Location (Unit); + Set_Identifier (Unit, Current_Identifier); + Scan_Expect (Tok_Equal); + Scan.Scan; + Multiplier := Parse_Primary; + Set_Physical_Literal (Unit, Multiplier); + case Get_Kind (Multiplier) is + when Iir_Kind_Simple_Name + | Iir_Kind_Physical_Int_Literal => + null; + when others => + Error_Msg_Parse ("a physical literal is expected here"); + end case; + Append (Last, Res, Unit); + Expect (Tok_Semi_Colon); + Scan.Scan; + end loop; + Scan.Scan; + Expect (Tok_Units); + Scan.Scan; + return Res; + end Parse_Physical_Type_Definition; + + -- precond : RECORD + -- postcond: next token + -- + -- [ §3.2.2 ] + -- record_type_definition ::= + -- RECORD + -- element_declaration + -- { element_declaration } + -- END RECORD [ RECORD_TYPE_simple_name ] + -- + -- element_declaration ::= + -- identifier_list : element_subtype_definition + -- + -- element_subtype_definition ::= subtype_indication + function Parse_Record_Definition return Iir_Record_Type_Definition + is + use Iir_Chains.Element_Declaration_Chain_Handling; + Res: Iir_Record_Type_Definition; + Last : Iir_Element_Declaration; + El: Iir_Element_Declaration; + First : Iir; + Pos: Iir_Index32; + Subtype_Indication: Iir; + begin + Res := Create_Iir (Iir_Kind_Record_Type_Definition); + Set_Location (Res); + Scan.Scan; + Pos := 0; + Build_Init (Last); + First := Null_Iir; + loop + pragma Assert (First = Null_Iir); + -- Parse identifier_list + loop + El := Create_Iir (Iir_Kind_Element_Declaration); + Set_Location (El); + Expect (Tok_Identifier); + Set_Identifier (El, Current_Identifier); + Append (Last, Res, El); + Set_Element_Position (El, Pos); + Pos := Pos + 1; + if First = Null_Iir then + First := El; + end if; + Scan.Scan; + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + Expect (Tok_Colon); + Scan.Scan; + Subtype_Indication := Parse_Subtype_Indication; + while First /= Null_Iir loop + Set_Type (First, Subtype_Indication); + First := Get_Chain (First); + end loop; + Expect (Tok_Semi_Colon); + Scan.Scan; + exit when Current_Token = Tok_End; + end loop; + Set_Number_Element_Declaration (Res, Pos); + Scan_Expect (Tok_Record); + Scan.Scan; + return Res; + end Parse_Record_Definition; + + -- precond : ACCESS + -- postcond: ? + -- + -- [§3.3] + -- access_type_definition ::= ACCESS subtype_indication. + function Parse_Access_Definition return Iir_Access_Type_Definition is + Res : Iir_Access_Type_Definition; + begin + Res := Create_Iir (Iir_Kind_Access_Type_Definition); + Set_Location (Res); + Expect (Tok_Access); + Scan.Scan; + Set_Designated_Type (Res, Parse_Subtype_Indication); + return Res; + end Parse_Access_Definition; + + -- precond : FILE + -- postcond: ??? + -- + -- [ §3.4 ] + -- file_type_definition ::= FILE OF type_mark + function Parse_File_Type_Definition return Iir_File_Type_Definition + is + Res : Iir_File_Type_Definition; + Type_Mark: Iir; + begin + Res := Create_Iir (Iir_Kind_File_Type_Definition); + Set_Location (Res); + -- Accept token 'file'. + Scan_Expect (Tok_Of); + Scan.Scan; + Type_Mark := Parse_Type_Mark (Check_Paren => True); + if Get_Kind (Type_Mark) not in Iir_Kinds_Name then + Error_Msg_Parse ("type mark expected"); + else + Set_Type_Mark (Res, Type_Mark); + end if; + return Res; + end Parse_File_Type_Definition; + + -- precond : PROTECTED + -- postcond: ';' + -- + -- [ §3.5 ] + -- protected_type_definition ::= protected_type_declaration + -- | protected_type_body + -- + -- [ §3.5.1 ] + -- protected_type_declaration ::= PROTECTED + -- protected_type_declarative_part + -- END PROTECTED [ simple_name ] + -- + -- protected_type_declarative_part ::= + -- { protected_type_declarative_item } + -- + -- protected_type_declarative_item ::= + -- subprogram_declaration + -- | attribute_specification + -- | use_clause + -- + -- [ §3.5.2 ] + -- protected_type_body ::= PROTECTED BODY + -- protected_type_body_declarative_part + -- END PROTECTED BODY [ simple_name ] + -- + -- protected_type_body_declarative_part ::= + -- { protected_type_body_declarative_item } + -- + -- protected_type_body_declarative_item ::= + -- subprogram_declaration + -- | subprogram_body + -- | type_declaration + -- | subtype_declaration + -- | constant_declaration + -- | variable_declaration + -- | file_declaration + -- | alias_declaration + -- | attribute_declaration + -- | attribute_specification + -- | use_clause + -- | group_template_declaration + -- | group_declaration + function Parse_Protected_Type_Definition + (Ident : Name_Id; Loc : Location_Type) return Iir + is + Res : Iir; + Decl : Iir; + begin + Scan.Scan; + if Current_Token = Tok_Body then + Res := Create_Iir (Iir_Kind_Protected_Type_Body); + Scan.Scan; + Decl := Res; + else + Decl := Create_Iir (Iir_Kind_Type_Declaration); + Res := Create_Iir (Iir_Kind_Protected_Type_Declaration); + Set_Location (Res, Loc); + Set_Type (Decl, Res); + end if; + Set_Identifier (Decl, Ident); + Set_Location (Decl, Loc); + Parse_Declarative_Part (Res); + Expect (Tok_End); + Scan_Expect (Tok_Protected); + if Get_Kind (Res) = Iir_Kind_Protected_Type_Body then + Scan_Expect (Tok_Body); + end if; + Scan.Scan; + Check_End_Name (Decl); + return Decl; + end Parse_Protected_Type_Definition; + + -- precond : TYPE + -- postcond: a token + -- + -- [ §4.1 ] + -- type_definition ::= scalar_type_definition + -- | composite_type_definition + -- | access_type_definition + -- | file_type_definition + -- | protected_type_definition + -- + -- [ §3.1 ] + -- scalar_type_definition ::= enumeration_type_definition + -- | integer_type_definition + -- | floating_type_definition + -- | physical_type_definition + -- + -- [ §3.2 ] + -- composite_type_definition ::= array_type_definition + -- | record_type_definition + -- + -- [ §3.1.2 ] + -- integer_type_definition ::= range_constraint + -- + -- [ 3.1.4 ] + -- floating_type_definition ::= range_constraint + function Parse_Type_Declaration return Iir + is + Def : Iir; + Loc : Location_Type; + Ident : Name_Id; + Decl : Iir; + begin + -- The current token must be type. + if Current_Token /= Tok_Type then + raise Program_Error; + end if; + + -- Get the identifier + Scan_Expect (Tok_Identifier, + "an identifier is expected after 'type' keyword"); + Loc := Get_Token_Location; + Ident := Current_Identifier; + + Scan.Scan; + if Current_Token = Tok_Semi_Colon then + -- If there is a ';', this is an imcomplete type declaration. + Invalidate_Current_Token; + Decl := Create_Iir (Iir_Kind_Type_Declaration); + Set_Identifier (Decl, Ident); + Set_Location (Decl, Loc); + return Decl; + end if; + + if Current_Token /= Tok_Is then + Error_Msg_Parse ("'is' expected here"); + -- Act as if IS token was forgotten. + else + -- Eat IS token. + Scan.Scan; + end if; + + case Current_Token is + when Tok_Left_Paren => + -- This is an enumeration. + Def := Parse_Enumeration_Type_Definition; + Decl := Null_Iir; + when Tok_Range => + -- This is a range definition. + Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration); + Set_Identifier (Decl, Ident); + Set_Location (Decl, Loc); + Def := Parse_Range_Constraint; + Set_Type (Decl, Def); + if Current_Token = Tok_Units then + declare + Unit_Def : Iir; + begin + Unit_Def := Parse_Physical_Type_Definition; + if Current_Token = Tok_Identifier then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("simple_name not allowed here in vhdl87"); + end if; + Check_End_Name (Decl); + end if; + if Def /= Null_Iir then + Set_Type (Def, Unit_Def); + end if; + end; + end if; + when Tok_Array => + Def := Parse_Array_Definition; + Decl := Null_Iir; + when Tok_Record => + Decl := Create_Iir (Iir_Kind_Type_Declaration); + Set_Identifier (Decl, Ident); + Set_Location (Decl, Loc); + Set_Type (Decl, Parse_Record_Definition); + if Current_Token = Tok_Identifier then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("simple_name not allowed here in vhdl87"); + end if; + Check_End_Name (Decl); + end if; + when Tok_Access => + Def := Parse_Access_Definition; + Decl := Null_Iir; + when Tok_File => + Def := Parse_File_Type_Definition; + Decl := Null_Iir; + when Tok_Identifier => + if Current_Identifier = Name_Protected then + Error_Msg_Parse ("protected type not allowed in vhdl87/93"); + Decl := Parse_Protected_Type_Definition (Ident, Loc); + else + Error_Msg_Parse ("type '" & Name_Table.Image (Ident) & + "' cannot be defined from another type"); + Error_Msg_Parse ("(you should declare a subtype)"); + Decl := Create_Iir (Iir_Kind_Type_Declaration); + Eat_Tokens_Until_Semi_Colon; + end if; + when Tok_Protected => + if Flags.Vhdl_Std < Vhdl_00 then + Error_Msg_Parse ("protected type not allowed in vhdl87/93"); + end if; + Decl := Parse_Protected_Type_Definition (Ident, Loc); + when others => + Error_Msg_Parse + ("type definition starting with a keyword such as RANGE, ARRAY"); + Error_Msg_Parse + (" FILE, RECORD or '(' is expected here"); + Eat_Tokens_Until_Semi_Colon; + Decl := Create_Iir (Iir_Kind_Type_Declaration); + end case; + + if Decl = Null_Iir then + case Get_Kind (Def) is + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_File_Type_Definition => + Decl := Create_Iir (Iir_Kind_Type_Declaration); + Set_Type (Decl, Def); + when Iir_Kind_Array_Subtype_Definition => + Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration); + Set_Type (Decl, Def); + when others => + Error_Kind ("parse_type_declaration", Def); + end case; + end if; + Set_Identifier (Decl, Ident); + Set_Location (Decl, Loc); + + -- ';' is expected after end of type declaration + Expect (Tok_Semi_Colon); + Invalidate_Current_Token; + return Decl; + end Parse_Type_Declaration; + + -- precond : identifier + -- postcond: next token + -- + -- [ §4.2 ] + -- subtype_indication ::= + -- [ RESOLUTION_FUNCTION_name ] type_mark [ constraint ] + -- + -- [ §4.2 ] + -- constraint ::= range_constraint | index_constraint + -- + -- [ §3.2.1] + -- index_constraint ::= ( discrete_range { , discrete_range } ) + function Parse_Subtype_Indication (Name : Iir := Null_Iir) + return Iir + is + Type_Mark : Iir; + Def: Iir; + El: Iir; + Resolution_Function: Iir; + begin + -- FIXME: location. + Resolution_Function := Null_Iir; + + if Name /= Null_Iir then + Type_Mark := Name; + else + if Current_Token /= Tok_Identifier then + Error_Msg_Parse ("type mark expected in a subtype indication"); + raise Parse_Error; + end if; + Type_Mark := Parse_Name (Allow_Indexes => False); + end if; + + if Current_Token = Tok_Identifier then + Resolution_Function := Type_Mark; + Type_Mark := Parse_Type_Mark (Check_Paren => False); + end if; + + case Current_Token is + when Tok_Left_Paren => + -- Index_constraint. + Def := Create_Iir (Iir_Kind_Array_Subtype_Definition); + Set_Location (Def); + Set_Type_Mark (Def, Type_Mark); + Set_Resolution_Function (Def, Resolution_Function); + Set_Index_Subtype_List (Def, Create_Iir_List); + -- index_constraint ::= (discrete_range {, discrete_range} ) + loop + -- accept parenthesis or comma. + Scan.Scan; + El := Parse_Discrete_Range; + Append_Element (Get_Index_Subtype_List (Def), El); + exit when Current_Token = Tok_Right_Paren; + Expect (Tok_Comma); + end loop; + Scan.Scan; + + when Tok_Range => + -- range_constraint. + Def := Create_Iir (Iir_Kind_Subtype_Definition); + Location_Copy (Def, Type_Mark); + Set_Type_Mark (Def, Type_Mark); + Set_Range_Constraint (Def, Parse_Range_Constraint); + Set_Resolution_Function (Def, Resolution_Function); + + when others => + if Resolution_Function = Null_Iir then + Def := Type_Mark; + else + Def := Create_Iir (Iir_Kind_Subtype_Definition); + Location_Copy (Def, Type_Mark); + Set_Type_Mark (Def, Type_Mark); + Set_Resolution_Function (Def, Resolution_Function); + end if; + end case; + return Def; + end Parse_Subtype_Indication; + + -- precond : SUBTYPE + -- postcond: ';' + -- + -- [ §4.2 ] + -- subtype_declaration ::= SUBTYPE identifier IS subtype_indication ; + function Parse_Subtype_Declaration return Iir_Subtype_Declaration is + Decl: Iir_Subtype_Declaration; + Def: Iir; + begin + Decl := Create_Iir (Iir_Kind_Subtype_Declaration); + + Scan_Expect (Tok_Identifier); + Set_Identifier (Decl, Current_Identifier); + Set_Location (Decl); + + Scan_Expect (Tok_Is); + Scan.Scan; + Def := Parse_Subtype_Indication; + Set_Type (Decl, Def); + + Expect (Tok_Semi_Colon); + return Decl; + end Parse_Subtype_Declaration; + + -- precond : token (CONSTANT, SIGNAL, VARIABLE, FILE) + -- postcond: ; + -- + -- KIND can be iir_kind_constant_declaration, iir_kind_file_declaration + -- or iir_kind_variable_declaration + -- + -- [ §4.3.1 ] + -- object_declaration ::= constant_declaration + -- | signal_declaration + -- | variable_declaration + -- | file_declaration + -- + -- [ §4.3.1.1 ] + -- constant_declaration ::= + -- CONSTANT identifier_list : subtype_indication [ := expression ] + -- + -- [ §4.3.1.4 ] + -- file_declaration ::= + -- FILE identifier_list : subtype_indication [ file_open_information ] + -- + -- [ §4.3.1.4 ] + -- file_open_information ::= + -- [ OPEN FILE_OPEN_KIND_expression ] IS file_logical_name + -- + -- [ §4.3.1.4 ] + -- file_logical_name ::= STRING_expression + -- + -- [ §4.3.1.3 ] + -- variable_declaration ::= + -- [ SHARED ] VARIABLE identifier_list : subtype_indication + -- [ := expression ] + -- + -- [ §4.3.1.2 ] + -- signal_declaration ::= + -- SIGNAL identifier_list : subtype_information [ signal_kind ] + -- [ := expression ] + -- + -- [ §4.3.1.2 ] + -- signal_kind ::= REGISTER | BUS + -- + -- FIXME: file_open_information. + function Parse_Object_Declaration (Parent : Iir) return Iir + is + -- First and last element of the chain to be returned. + First, Last : Iir; + Object: Iir; + Object_Type: Iir; + Default_Value : Iir; + Mode: Iir_Mode; + Signal_Kind : Iir_Signal_Kind; + Open_Kind : Iir; + Logical_Name : Iir; + Proxy : Iir_Proxy; + Kind: Iir_Kind; + Shared : Boolean; + begin + Sub_Chain_Init (First, Last); + + -- object keyword was just scanned. + case Current_Token is + when Tok_Signal => + Kind := Iir_Kind_Signal_Declaration; + when Tok_Constant => + Kind := Iir_Kind_Constant_Declaration; + when Tok_File => + Kind := Iir_Kind_File_Declaration; + when Tok_Variable => + Kind := Iir_Kind_Variable_Declaration; + Shared := False; + when Tok_Shared => + Kind := Iir_Kind_Variable_Declaration; + Shared := True; + Scan_Expect (Tok_Variable); + when others => + raise Internal_Error; + end case; + + loop + -- object or "," was just scanned. + Object := Create_Iir (Kind); + if Kind = Iir_Kind_Variable_Declaration then + Set_Shared_Flag (Object, Shared); + end if; + Scan_Expect (Tok_Identifier); + Set_Identifier (Object, Current_Identifier); + Set_Location (Object); + Set_Parent (Object, Parent); + + Sub_Chain_Append (First, Last, Object); + + Scan.Scan; + exit when Current_Token = Tok_Colon; + if Current_Token /= Tok_Comma then + case Current_Token is + when Tok_Assign => + Error_Msg_Parse ("missign type in " & Disp_Name (Kind)); + exit; + when others => + Error_Msg_Parse + ("',' or ':' is expected after identifier in " + & Disp_Name (Kind)); + raise Expect_Error; + end case; + end if; + end loop; + + -- The colon was parsed. + Scan.Scan; + Object_Type := Parse_Subtype_Indication; + + if Kind = Iir_Kind_Signal_Declaration then + Signal_Kind := Parse_Signal_Kind; + end if; + + if Current_Token = Tok_Assign then + if Kind = Iir_Kind_File_Declaration then + Error_Msg_Parse + ("default expression not allowed for a file declaration"); + end if; + Scan.Scan; + Default_Value := Parse_Expression; + else + Default_Value := Null_Iir; + end if; + + if Kind = Iir_Kind_File_Declaration then + if Current_Token = Tok_Open then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("'open' and open kind expression not allowed in vhdl 87"); + end if; + Scan.Scan; + Open_Kind := Parse_Expression; + else + Open_Kind := Null_Iir; + end if; + + if Flags.Vhdl_Std = Vhdl_87 then + -- LRM 4.3.1.4 + -- The default mode is IN, if no mode is specified. + Mode := Iir_In_Mode; + else + -- GHDL: no mode for vhdl 93. + Mode := Iir_Unknown_Mode; + end if; + + Logical_Name := Null_Iir; + if Current_Token = Tok_Is then + Scan.Scan; + case Current_Token is + when Tok_In | Tok_Out | Tok_Inout => + if Flags.Vhdl_Std >= Vhdl_93 then + Error_Msg_Parse ("mode allowed only in vhdl 87"); + end if; + Mode := Parse_Mode (Iir_In_Mode); + if Mode = Iir_Inout_Mode then + Error_Msg_Parse ("inout mode not allowed for file"); + end if; + when others => + null; + end case; + Logical_Name := Parse_Expression; + elsif Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("file name expected (vhdl 87)"); + end if; + end if; + + Proxy := Null_Iir; + Object := First; + while Object /= Null_Iir loop + -- Type definitions are factorized. This is OK, but not done by + -- sem. + if Object = First then + Set_Type (Object, Object_Type); + else + -- FIXME: could avoid to create many proxies, by adding + -- a reference counter. + Proxy := Create_Iir (Iir_Kind_Proxy); + Set_Proxy (Proxy, First); + Set_Type (Object, Proxy); + end if; + if Kind = Iir_Kind_File_Declaration then + Set_Mode (Object, Mode); + Set_File_Open_Kind (Object, Open_Kind); + Set_File_Logical_Name (Object, Logical_Name); + end if; + if Kind /= Iir_Kind_File_Declaration then + Set_Default_Value (Object, Default_Value); + end if; + if Kind = Iir_Kind_Signal_Declaration then + Set_Signal_Kind (Object, Signal_Kind); + end if; + Object := Get_Chain (Object); + end loop; + Expect (Tok_Semi_Colon); + return First; + end Parse_Object_Declaration; + + -- precond : COMPONENT + -- postcond: ';' + -- + -- [ §4.5 ] + -- component_declaration ::= + -- COMPONENT identifier [ IS ] + -- [ LOCAL_generic_clause ] + -- [ LOCAL_port_clause ] + -- END COMPONENT [ COMPONENT_simple_name ] ; + function Parse_Component_Declaration + return Iir_Component_Declaration + is + Component: Iir_Component_Declaration; + begin + Component := Create_Iir (Iir_Kind_Component_Declaration); + Scan_Expect (Tok_Identifier, + "an identifier is expected after 'component'"); + Set_Identifier (Component, Current_Identifier); + Set_Location (Component); + Scan.Scan; + if Current_Token = Tok_Is then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("""is"" keyword is not allowed here by vhdl 87"); + end if; + Scan.Scan; + end if; + Parse_Generic_Port_Clauses (Component); + Check_End_Name (Tok_Component, Component); + return Component; + end Parse_Component_Declaration; + + -- precond : '[' + -- postcond: next token after ']' + -- + -- [ 2.3.2 ] + -- signature ::= [ [ type_mark { , type_mark } ] [ RETURN type_mark ] ] + function Parse_Signature return Iir_Signature + is + Res : Iir_Signature; + List : Iir_List; + begin + Expect (Tok_Left_Bracket); + Res := Create_Iir (Iir_Kind_Signature); + Set_Location (Res); + Scan.Scan; + -- List of type_marks. + if Current_Token = Tok_Identifier then + List := Create_Iir_List; + Set_Type_Marks_List (Res, List); + loop + Append_Element (List, Parse_Type_Mark (Check_Paren => True)); + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + end if; + if Current_Token = Tok_Return then + Scan.Scan; + Set_Return_Type (Res, Parse_Name); + end if; + Expect (Tok_Right_Bracket); + Scan.Scan; + return Res; + end Parse_Signature; + + -- precond : ALIAS + -- postcond: a token + -- + -- [ §4.3.3 ] + -- alias_declaration ::= + -- ALIAS alias_designator [ : subtype_indication ] + -- IS name [ signature ] ; + -- + -- [ §4.3.3 ] + -- alias_designator ::= identifier | character_literal | operator_symbol + -- + -- FIXME: signature + function Parse_Alias_Declaration return Iir + is + Res: Iir; + Loc : Location_Type; + Ident : Name_Id; + begin + -- accept ALIAS. + Scan.Scan; + Loc := Get_Token_Location; + case Current_Token is + when Tok_Identifier => + Ident := Current_Identifier; + when Tok_Character => + Ident := Current_Identifier; + when Tok_String => + Ident := Scan_To_Operator_Name (Get_Token_Location); + -- FIXME: vhdl87 + -- FIXME: operator symbol. + when others => + Error_Msg_Parse ("alias designator expected"); + end case; + Scan.Scan; + if Current_Token = Tok_Colon then + Scan.Scan; + Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); + Set_Type (Res, Parse_Subtype_Indication); + -- FIXME: nice message if token is ':=' ? + Expect (Tok_Is); + Scan.Scan; + Set_Name (Res, Parse_Name); + -- FIXME: emit error if token = '[' + elsif Current_Token = Tok_Is then + Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration); + Scan.Scan; + Set_Name (Res, Parse_Name (Allow_Indexes => False)); + if Current_Token = Tok_Left_Bracket then + Set_Signature (Res, Parse_Signature); + end if; + else + Error_Msg_Parse ("'is' or ':' expected"); + Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); + Eat_Tokens_Until_Semi_Colon; + end if; + + Set_Location (Res, Loc); + Set_Identifier (Res, Ident); + + return Res; + end Parse_Alias_Declaration; + + -- precond : FOR + -- postcond: ';' + -- + -- [ §5.2 ] + -- configuration_specification ::= + -- FOR component_specification binding_indication ; + function Parse_Configuration_Specification + return Iir_Configuration_Specification + is + Res : Iir_Configuration_Specification; + begin + Res := Create_Iir (Iir_Kind_Configuration_Specification); + Set_Location (Res); + Expect (Tok_For); + Scan.Scan; + Parse_Component_Specification (Res); + Set_Binding_Indication (Res, Parse_Binding_Indication); + Expect (Tok_Semi_Colon); + return Res; + end Parse_Configuration_Specification; + + -- precond : next token + -- postcond: next token + -- + -- [ § 5.2 ] + -- entity_class := ENTITY | ARCHITECTURE | CONFIGURATION | PROCEDURE + -- | FUNCTION | PACKAGE | TYPE | SUBTYPE | CONSTANT + -- | SIGNAL | VARIABLE | COMPONENT | LABEL | LITERAL + -- | UNITS | GROUP | FILE + function Parse_Entity_Class return Token_Type + is + Res : Token_Type; + begin + case Current_Token is + when Tok_Entity + | Tok_Architecture + | Tok_Configuration + | Tok_Procedure + | Tok_Function + | Tok_Package + | Tok_Type + | Tok_Subtype + | Tok_Constant + | Tok_Signal + | Tok_Variable + | Tok_Component + | Tok_Label => + null; + when Tok_Literal + | Tok_Units + | Tok_Group + | Tok_File => + null; + when others => + Error_Msg_Parse + (''' & Tokens.Image (Current_Token) & "' is not a entity class"); + end case; + Res := Current_Token; + Scan.Scan; + return Res; + end Parse_Entity_Class; + + function Parse_Entity_Class_Entry return Iir_Entity_Class + is + Res : Iir_Entity_Class; + begin + Res := Create_Iir (Iir_Kind_Entity_Class); + Set_Location (Res); + Set_Entity_Class (Res, Parse_Entity_Class); + return Res; + end Parse_Entity_Class_Entry; + + -- precond : next token + -- postcond: next token + -- + -- [ §5.1 ] + -- entity_designator ::= entity_tag [ signature ] + -- + -- entity_tag ::= simple_name | character_literal | operator_symbol + function Parse_Entity_Designator return Iir + is + Res : Iir; + Name : Iir; + begin + case Current_Token is + when Tok_Identifier => + Res := Create_Iir (Iir_Kind_Simple_Name); + Set_Location (Res); + Set_Identifier (Res, Current_Identifier); + when Tok_Character => + Res := Create_Iir (Iir_Kind_Character_Literal); + Set_Location (Res); + Set_Identifier (Res, Current_Identifier); + when Tok_String => + Res := Create_Iir (Iir_Kind_Operator_Symbol); + Set_Location (Res); + Set_Identifier (Res, Scan_To_Operator_Name (Get_Token_Location)); + when others => + Error_Msg_Parse ("identifier, character or string expected"); + raise Expect_Error; + end case; + Scan.Scan; + if Current_Token = Tok_Left_Bracket then + Name := Res; + Res := Parse_Signature; + Set_Name (Res, Name); + end if; + return Res; + end Parse_Entity_Designator; + + -- precond : next token + -- postcond: IS + -- + -- [ §5.1 ] + -- entity_name_list ::= entity_designator { , entity_designator } + -- | OTHERS + -- | ALL + procedure Parse_Entity_Name_List + (Attribute : Iir_Attribute_Specification) + is + List : Iir_List; + El : Iir; + begin + case Current_Token is + when Tok_All => + List := Iir_List_All; + Scan.Scan; + when Tok_Others => + List := Iir_List_Others; + Scan.Scan; + when others => + List := Create_Iir_List; + loop + El := Parse_Entity_Designator; + Append_Element (List, El); + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + end case; + Set_Entity_Name_List (Attribute, List); + if Current_Token = Tok_Colon then + Scan.Scan; + Set_Entity_Class (Attribute, Parse_Entity_Class); + else + Error_Msg_Parse + ("missing ':' and entity kind in attribute specification"); + end if; + end Parse_Entity_Name_List; + + -- precond : ATTRIBUTE + -- postcond: ';' + -- + -- [ 4.4 ] + -- attribute_declaration ::= ATTRIBUTE identifier : type_mark ; + -- + -- [ 5.1 ] + -- attribute_specification ::= + -- ATTRIBUTE attribute_designator OF entity_specification + -- IS expression ; + function Parse_Attribute return Iir + is + Loc : Location_Type; + Ident : Name_Id; + begin + Expect (Tok_Attribute); + Scan_Expect (Tok_Identifier); + Loc := Get_Token_Location; + Ident := Current_Identifier; + Scan.Scan; + case Current_Token is + when Tok_Colon => + declare + Res : Iir_Attribute_Declaration; + begin + Res := Create_Iir (Iir_Kind_Attribute_Declaration); + Set_Location (Res, Loc); + Set_Identifier (Res, Ident); + Scan.Scan; + Set_Type (Res, Parse_Type_Mark (Check_Paren => True)); + Expect (Tok_Semi_Colon); + return Res; + end; + when Tok_Of => + declare + Res : Iir_Attribute_Specification; + Designator : Iir_Simple_Name; + begin + Res := Create_Iir (Iir_Kind_Attribute_Specification); + Set_Location (Res, Loc); + Designator := Create_Iir (Iir_Kind_Simple_Name); + Set_Location (Designator, Loc); + Set_Identifier (Designator, Ident); + Set_Attribute_Designator (Res, Designator); + Scan.Scan; + Parse_Entity_Name_List (Res); + Expect (Tok_Is); + Scan.Scan; + Set_Expression (Res, Parse_Expression); + Expect (Tok_Semi_Colon); + return Res; + end; + when others => + Error_Msg_Parse ("':' or 'of' expected after identifier"); + return Null_Iir; + end case; + end Parse_Attribute; + + -- precond : GROUP + -- postcond: ';' + -- + -- [ §4.6 ] + -- group_template_declaration ::= + -- GROUP identifier IS (entity_class_entry_list) ; + -- + -- entity_class_entry_list ::= entity_class_entry { , entity_class_entry } + -- + -- entity_class_entry ::= entity_class [ <> ] + function Parse_Group return Iir is + Loc : Location_Type; + Ident : Name_Id; + begin + Expect (Tok_Group); + Scan_Expect (Tok_Identifier); + Loc := Get_Token_Location; + Ident := Current_Identifier; + Scan.Scan; + case Current_Token is + when Tok_Is => + declare + use Iir_Chains.Entity_Class_Entry_Chain_Handling; + Res : Iir_Group_Template_Declaration; + El : Iir_Entity_Class; + Last : Iir_Entity_Class; + begin + Res := Create_Iir (Iir_Kind_Group_Template_Declaration); + Set_Location (Res, Loc); + Set_Identifier (Res, Ident); + Scan_Expect (Tok_Left_Paren); + Scan.Scan; + Build_Init (Last); + loop + Append (Last, Res, Parse_Entity_Class_Entry); + if Current_Token = Tok_Box then + El := Create_Iir (Iir_Kind_Entity_Class); + Set_Location (El); + Set_Entity_Class (El, Tok_Box); + Append (Last, Res, El); + Scan.Scan; + if Current_Token = Tok_Comma then + Error_Msg_Parse + ("'<>' is allowed only for the last " + & "entity class entry"); + end if; + end if; + exit when Current_Token = Tok_Right_Paren; + Expect (Tok_Comma); + Scan.Scan; + end loop; + Scan_Expect (Tok_Semi_Colon); + return Res; + end; + when Tok_Colon => + declare + Res : Iir_Group_Declaration; + List : Iir_Group_Constituent_List; + begin + Res := Create_Iir (Iir_Kind_Group_Declaration); + Set_Location (Res, Loc); + Set_Identifier (Res, Ident); + Scan.Scan; + Set_Group_Template_Name + (Res, Parse_Name (Allow_Indexes => False)); + Expect (Tok_Left_Paren); + Scan.Scan; + List := Create_Iir_List; + Set_Group_Constituent_List (Res, List); + loop + Append_Element (List, Parse_Name (Allow_Indexes => False)); + exit when Current_Token = Tok_Right_Paren; + Expect (Tok_Comma); + Scan.Scan; + end loop; + Scan_Expect (Tok_Semi_Colon); + return Res; + end; + when others => + Error_Msg_Parse ("':' or 'is' expected here"); + return Null_Iir; + end case; + end Parse_Group; + + -- precond : next token + -- postcond: ':' + -- + -- [ §5.4 ] + -- signal_list ::= signal_name { , signal_name } + -- | OTHERS + -- | ALL + function Parse_Signal_List return Iir_List + is + Res : Iir_List; + begin + case Current_Token is + when Tok_Others => + Scan.Scan; + return Iir_List_Others; + when Tok_All => + Scan.Scan; + return Iir_List_All; + when others => + Res := Create_Iir_List; + loop + Append_Element (Res, Parse_Name); + exit when Current_Token = Tok_Colon; + Expect (Tok_Comma); + Scan.Scan; + end loop; + return Res; + end case; + end Parse_Signal_List; + + -- precond : DISCONNECT + -- postcond: ';' + -- + -- [ §5.4 ] + -- disconnection_specification ::= + -- DISCONNECT guarded_signal_specification AFTER time_expression ; + function Parse_Disconnection_Specification + return Iir_Disconnection_Specification + is + Res : Iir_Disconnection_Specification; + begin + Res := Create_Iir (Iir_Kind_Disconnection_Specification); + Set_Location (Res); + Expect (Tok_Disconnect); + Scan.Scan; + Set_Signal_List (Res, Parse_Signal_List); + Expect (Tok_Colon); + Scan.Scan; + Set_Type (Res, Parse_Name (Allow_Indexes => False)); + Expect (Tok_After); + Scan.Scan; + Set_Expression (Res, Parse_Expression); + return Res; + end Parse_Disconnection_Specification; + + -- precond : next token + -- postcond: next token + -- + -- [ §4 ] + -- declaration ::= type_declaration + -- | subtype_declaration + -- | object_declaration + -- | interface_declaration + -- | alias_declaration + -- | attribute_declaration + -- | component_declaration + -- | group_template_declaration + -- | group_declaration + -- | entity_declaration + -- | configuration_declaration + -- | subprogram_declaration + -- | package_declaration + procedure Parse_Declarative_Part (Parent : Iir) + is + use Declaration_Chain_Handling; + Last_Decl : Iir; + Decl : Iir; + begin + Build_Init (Last_Decl); + loop + Decl := Null_Iir; + case Current_Token is + when Tok_Invalid => + raise Internal_Error; + when Tok_Type => + Decl := Parse_Type_Declaration; + + -- LRM 2.5 Package declarations + -- If a package declarative item is a type declaration that is + -- a full type declaration whose type definition is a + -- protected_type definition, then that protected type + -- definition must not be a protected type body. + if Decl /= Null_Iir + and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Body + then + case Get_Kind (Parent) is + when Iir_Kind_Package_Declaration => + Error_Msg_Parse ("protected type body not allowed " + & "in package declaration", Decl); + when others => + null; + end case; + end if; + when Tok_Subtype => + Decl := Parse_Subtype_Declaration; + when Tok_Signal => + case Get_Kind (Parent) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + Error_Msg_Parse + ("signal declaration not allowed in subprogram body"); + when Iir_Kinds_Process_Statement => + Error_Msg_Parse + ("signal declaration not allowed in process"); + when others => + null; + end case; + Decl := Parse_Object_Declaration (Parent); + when Tok_Constant => + Decl := Parse_Object_Declaration (Parent); + when Tok_Variable => + -- FIXME: remove this message (already checked during sem). + case Get_Kind (Parent) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Block_Statement + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body => + -- FIXME: replace HERE with the kind of declaration + -- ie: "not allowed in a package" rather than "here". + Error_Msg_Parse ("variable declaration not allowed here"); + when others => + null; + end case; + Decl := Parse_Object_Declaration (Parent); + when Tok_Shared => + if Flags.Vhdl_Std <= Vhdl_87 then + Error_Msg_Parse ("shared variable not allowed in vhdl 87"); + end if; + Decl := Parse_Object_Declaration (Parent); + when Tok_File => + Decl := Parse_Object_Declaration (Parent); + when Tok_Function + | Tok_Procedure + | Tok_Pure + | Tok_Impure => + Decl := Parse_Subprogram_Declaration; + when Tok_Alias => + Decl := Parse_Alias_Declaration; + when Tok_Component => + case Get_Kind (Parent) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + Error_Msg_Parse + ("component declaration are not allowed here"); + when others => + null; + end case; + Decl := Parse_Component_Declaration; + when Tok_For => + case Get_Kind (Parent) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kinds_Process_Statement => + Error_Msg_Parse + ("configuration specification not allowed here"); + when others => + null; + end case; + Decl := Parse_Configuration_Specification; + when Tok_Attribute => + Decl := Parse_Attribute; + when Tok_Disconnect => + case Get_Kind (Parent) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kinds_Process_Statement => + Error_Msg_Parse + ("disconnect specification not allowed here"); + when others => + null; + end case; + Decl := Parse_Disconnection_Specification; + when Tok_Use => + Decl := Parse_Use_Clause; + when Tok_Group => + Decl := Parse_Group; + + when Tok_Identifier => + Error_Msg_Parse + ("object class keyword such as 'variable' is expected"); + Eat_Tokens_Until_Semi_Colon; + when Tok_Semi_Colon => + Error_Msg_Parse ("';' (semi colon) not allowed alone"); + Scan.Scan; + when others => + exit; + end case; + 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.Scan; + end if; + end loop; + end Parse_Declarative_Part; + + -- precond : ENTITY + -- postcond: ';' + -- + -- [ §1.1 ] + -- entity_declaration ::= + -- ENTITY identifier IS + -- entiy_header + -- entity_declarative_part + -- [ BEGIN + -- entity_statement_part ] + -- END [ ENTITY ] [ ENTITY_simple_name ] + -- + -- [ §1.1.1 ] + -- entity_header ::= + -- [ FORMAL_generic_clause ] + -- [ FORMAL_port_clause ] + procedure Parse_Entity_Declaration (Unit : Iir_Design_Unit) + is + Res: Iir_Entity_Declaration; + begin + Expect (Tok_Entity); + Res := Create_Iir (Iir_Kind_Entity_Declaration); + + -- Get identifier. + Scan_Expect (Tok_Identifier, + "an identifier is expected after ""entity"""); + Set_Identifier (Res, Current_Identifier); + Set_Location (Res); + + Scan_Expect (Tok_Is, "missing ""is"" after identifier"); + Scan.Scan; + + Parse_Generic_Port_Clauses (Res); + + Parse_Declarative_Part (Res); + + if Current_Token = Tok_Begin then + Scan.Scan; + Parse_Concurrent_Statements (Res); + end if; + + -- end keyword is expected to finish an entity declaration + Expect (Tok_End); + Set_End_Location (Unit); + + Scan.Scan; + if Current_Token = Tok_Entity then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("""entity"" keyword not allowed here by vhdl 87"); + end if; + Scan.Scan; + end if; + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + Invalidate_Current_Token; + Set_Library_Unit (Unit, Res); + end Parse_Entity_Declaration; + + -- [ §7.3.2 ] + -- choice ::= simple_expression + -- | discrete_range + -- | ELEMENT_simple_name + -- | OTHERS + function Parse_A_Choice (Expr: Iir) return Iir + is + A_Choice: Iir; + Expr1: Iir; + begin + if Expr = Null_Iir then + if Current_Token = Tok_Others then + A_Choice := Create_Iir (Iir_Kind_Choice_By_Others); + Set_Location (A_Choice); + Scan.Scan; + return A_Choice; + else + Expr1 := Parse_Expression; + end if; + else + Expr1 := Expr; + end if; + if Is_Range_Attribute_Name (Expr1) then + A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); + Location_Copy (A_Choice, Expr1); + Set_Expression (A_Choice, Expr1); + return A_Choice; + elsif Current_Token = Tok_To or else Current_Token = Tok_Downto then + A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); + Location_Copy (A_Choice, Expr1); + Set_Expression (A_Choice, Parse_Range_Right (Expr1)); + return A_Choice; +-- elsif Get_Kind (Expr1) in Iir_Kinds_Name then +-- A_Choice := Create_Iir (Iir_Kind_Choice_By_Name); +-- Location_Copy (A_Choice, Expr1); +-- Set_Name (A_Choice, Parse_Range_Type_Expression (Expr1)); +-- return A_Choice; + else + A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression); + Location_Copy (A_Choice, Expr1); + Set_Expression (A_Choice, Expr1); + return A_Choice; + end if; + end Parse_A_Choice; + + -- [ §7.3.2 ] + -- choices ::= choice { | choice } + -- + -- Leave tok_arrow as current token. + function Parse_Choices (Expr: Iir) return Iir + is + First, Last : Iir; + A_Choice: Iir; + Expr1 : Iir; + begin + Sub_Chain_Init (First, Last); + Expr1 := Expr; + loop + A_Choice := Parse_A_Choice (Expr1); + if First /= Null_Iir then + Set_Same_Alternative_Flag (A_Choice, True); + if Get_Kind (A_Choice) = Iir_Kind_Choice_By_Others then + Error_Msg_Parse ("'others' choice must be alone"); + end if; + end if; + Sub_Chain_Append (First, Last, A_Choice); + if Current_Token /= Tok_Bar then + return First; + end if; + Scan.Scan; + Expr1 := Null_Iir; + end loop; + end Parse_Choices; + + -- precond : '(' + -- postcond: next token + -- + -- This can be an expression or an aggregate. + -- + -- [ §7.3.2 ] + -- aggregate ::= ( element_association { , element_association } ) + -- + -- [ §7.3.2 ] + -- element_association ::= [ choices => ] expression + function Parse_Aggregate return Iir + is + use Iir_Chains.Association_Choices_Chain_Handling; + Expr: Iir; + Res: Iir_Aggregate; + Last : Iir; + Assoc: Iir; + Loc : Location_Type; + begin + Loc := Get_Token_Location; + Scan.Scan; + if Current_Token /= Tok_Others then + Expr := Parse_Expression; + case Current_Token is + when Tok_Comma + | Tok_Arrow + | Tok_Bar => + -- This is really an aggregate + null; + when Tok_Right_Paren => + -- This was just a braced expression. + -- Eat ')'. + Scan.Scan; + return Expr; + when Tok_Semi_Colon => + -- Surely a missing parenthesis. + -- FIXME: in case of multiple missing parenthesises, several + -- messages will be displayed + Error_Msg_Parse ("missing ')' for opening parenthesis at " + & Get_Location_Str (Loc, Filename => False)); + return Expr; + when others => + -- Surely a parse error... + null; + end case; + else + Expr := Null_Iir; + end if; + Res := Create_Iir (Iir_Kind_Aggregate); + if Expr /= Null_Iir then + Location_Copy (Res, Expr); + else + Set_Location (Res); + end if; + Build_Init (Last); + loop + if Current_Token = Tok_Others then + Assoc := Parse_A_Choice (Null_Iir); + Expect (Tok_Arrow); + Scan.Scan; + Expr := Parse_Expression; + else + if Expr = Null_Iir then + Expr := Parse_Expression; + end if; + if Expr = Null_Iir then + return Null_Iir; + end if; + case Current_Token is + when Tok_Comma + | Tok_Right_Paren => + Assoc := Create_Iir (Iir_Kind_Choice_By_None); + Location_Copy (Assoc, Expr); + when others => + Assoc := Parse_Choices (Expr); + Expect (Tok_Arrow); + Scan.Scan; + Expr := Parse_Expression; + end case; + end if; + Set_Associated (Assoc, Expr); + Append_Subchain (Last, Res, Assoc); + exit when Current_Token = Tok_Right_Paren; + Expect (Tok_Comma); + Scan.Scan; + Expr := Null_Iir; + end loop; + Scan.Scan; + return Res; + end Parse_Aggregate; + + -- precond : NEW + -- postcond: ??? + -- + -- [ §7.3.6] + -- allocator ::= NEW subtype_indication + -- | NEW qualified_expression + function Parse_Allocator return Iir is + Loc: Location_Type; + Res : Iir; + Expr: Iir; + begin + Loc := Get_Token_Location; + -- Accept 'new'. + Scan.Scan; + Expr := Parse_Name (Allow_Indexes => False); + if Get_Kind (Expr) /= Iir_Kind_Qualified_Expression then + -- This is a subtype_indication. + Res := Create_Iir (Iir_Kind_Allocator_By_Subtype); + Expr := Parse_Subtype_Indication (Expr); + else + Res := Create_Iir (Iir_Kind_Allocator_By_Expression); + end if; + Set_Location (Res, Loc); + Set_Expression (Res, Expr); + return Res; + end Parse_Allocator; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- primary ::= name + -- | literal + -- | aggregate + -- | function_call + -- | qualified_expression + -- | type_conversion + -- | allocator + -- | ( expression ) + -- + -- [ §7.3.1 ] + -- literal ::= numeric_literal + -- | enumeration_literal + -- | string_literal + -- | bit_string_literal + -- | NULL + -- + -- [ §7.3.1 ] + -- numeric_literal ::= abstract_literal + -- | physical_literal + -- + -- [ §13.4 ] + -- abstract_literal ::= decimal_literal | based_literal + -- + -- [ §3.1.3 ] + -- physical_literal ::= [ abstract_literal ] UNIT_name + function Parse_Primary return Iir_Expression + is + Res: Iir_Expression; + Int: Iir_Int64; + Fp: Iir_Fp64; + Loc: Location_Type; + begin + case Current_Token is + when Tok_Integer => + Int := Current_Iir_Int64; + Loc := Get_Token_Location; + Scan.Scan; + if Current_Token = Tok_Identifier then + -- physical literal + Res := Create_Iir (Iir_Kind_Physical_Int_Literal); + Set_Unit_Name (Res, Current_Text); + Scan.Scan; + else + -- integer literal + Res := Create_Iir (Iir_Kind_Integer_Literal); + end if; + Set_Location (Res, Loc); + Set_Value (Res, Int); + return Res; + when Tok_Real => + Fp := Current_Iir_Fp64; + Loc := Get_Token_Location; + Scan.Scan; + if Current_Token = Tok_Identifier then + -- physical literal + Res := Create_Iir (Iir_Kind_Physical_Fp_Literal); + Set_Unit_Name (Res, Current_Text); + Scan.Scan; + else + -- real literal + Res := Create_Iir (Iir_Kind_Floating_Point_Literal); + end if; + Set_Location (Res, Loc); + Set_Fp_Value (Res, Fp); + return Res; + when Tok_Identifier => + return Parse_Name (Allow_Indexes => True); + when Tok_Character => + Res := Current_Text; + Scan.Scan; + if Current_Token = Tok_Tick then + Error_Msg_Parse + ("prefix of an attribute can't be a character literal"); + -- skip tick. + Scan.Scan; + -- skip attribute designator + Scan.Scan; + end if; + return Res; + when Tok_Left_Paren => + return Parse_Aggregate; + when Tok_String => + return Parse_Name; + when Tok_Null => + Res := Create_Iir (Iir_Kind_Null_Literal); + Set_Location (Res); + Scan.Scan; + return Res; + when Tok_New => + return Parse_Allocator; + when Tok_Bit_String => + Res := Create_Iir (Iir_Kind_Bit_String_Literal); + Set_Location (Res); + Set_String_Id (Res, Current_String_Id); + Set_String_Length (Res, Current_String_Length); + case Current_Iir_Int64 is + when 1 => + Set_Bit_String_Base (Res, Base_2); + when 3 => + Set_Bit_String_Base (Res, Base_8); + when 4 => + Set_Bit_String_Base (Res, Base_16); + when others => + raise Internal_Error; + end case; + Scan.Scan; + return Res; + when Tok_Minus + | Tok_Plus => + Error_Msg_Parse + ("'-' and '+' are not allowed in primary, use parenthesis"); + return Parse_Simple_Expression; + when others => + Unexpected ("primary"); + return Null_Iir; + end case; + end Parse_Primary; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- factor ::= primary [ ** primary ] + -- | ABS primary + -- | NOT primary + function Parse_Factor return Iir_Expression is + Res, Tmp: Iir_Expression; + begin + case Current_Token is + when Tok_Abs => + Scan.Scan; + Res := Create_Iir (Iir_Kind_Absolute_Operator); + Set_Location (Res); + Set_Operand (Res, Parse_Primary); + return Res; + when Tok_Not => + Res := Create_Iir (Iir_Kind_Not_Operator); + Set_Location (Res); + Scan.Scan; + Set_Operand (Res, Parse_Primary); + return Res; + when others => + Tmp := Parse_Primary; + if Current_Token = Tok_Double_Star then + Res := Create_Iir (Iir_Kind_Exponentiation_Operator); + Set_Location (Res); + Scan.Scan; + Set_Left (Res, Tmp); + Set_Right (Res, Parse_Primary); + return Res; + else + return Tmp; + end if; + end case; + end Parse_Factor; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- term ::= factor { multiplying_operator factor } + -- + -- [ §7.2 ] + -- multiplying_operator ::= * | / | MOD | REM + function Parse_Term return Iir_Expression is + Res, Tmp: Iir_Expression; + begin + Res := Parse_Factor; + while Current_Token in Token_Multiplying_Operator_Type loop + case Current_Token is + when Tok_Star => + Tmp := Create_Iir (Iir_Kind_Multiplication_Operator); + when Tok_Slash => + Tmp := Create_Iir (Iir_Kind_Division_Operator); + when Tok_Mod => + Tmp := Create_Iir (Iir_Kind_Modulus_Operator); + when Tok_Rem => + Tmp := Create_Iir (Iir_Kind_Remainder_Operator); + when others => + raise Program_Error; + end case; + Set_Location (Tmp); + Set_Left (Tmp, Res); + Scan.Scan; + Set_Right (Tmp, Parse_Factor); + Res := Tmp; + end loop; + return Res; + end Parse_Term; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- simple_expression ::= [ sign ] term { adding_operator term } + -- + -- [ §7.2 ] + -- sign ::= + | - + -- + -- [ §7.2 ] + -- adding_operator ::= + | - | & + function Parse_Simple_Expression return Iir_Expression is + Res, Tmp: Iir_Expression; + begin + if Current_Token in Token_Sign_Type then + case Current_Token is + when Tok_Plus => + Res := Create_Iir (Iir_Kind_Identity_Operator); + when Tok_Minus => + Res := Create_Iir (Iir_Kind_Negation_Operator); + when others => + raise Program_Error; + end case; + Set_Location (Res); + Scan.Scan; + Set_Operand (Res, Parse_Term); + else + Res := Parse_Term; + end if; + while Current_Token in Token_Adding_Operator_Type loop + case Current_Token is + when Tok_Plus => + Tmp := Create_Iir (Iir_Kind_Addition_Operator); + when Tok_Minus => + Tmp := Create_Iir (Iir_Kind_Substraction_Operator); + when Tok_Ampersand => + Tmp := Create_Iir (Iir_Kind_Concatenation_Operator); + when others => + raise Program_Error; + end case; + Set_Location (Tmp); + Scan.Scan; + Set_Left (Tmp, Res); + Set_Right (Tmp, Parse_Term); + Res := Tmp; + end loop; + return Res; + end Parse_Simple_Expression; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- shift_expression ::= + -- simple_expression [ shift_operator simple_expression ] + -- + -- [ §7.2 ] + -- shift_operator ::= SLL | SRL | SLA | SRA | ROL | ROR + function Parse_Shift_Expression return Iir_Expression is + Res, Tmp: Iir_Expression; + begin + Tmp := Parse_Simple_Expression; + if Current_Token not in Token_Shift_Operator_Type then + return Tmp; + elsif Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("shift operators not allowed in vhdl 87"); + end if; + case Current_Token is + when Tok_Sll => + Res := Create_Iir (Iir_Kind_Sll_Operator); + when Tok_Sla => + Res := Create_Iir (Iir_Kind_Sla_Operator); + when Tok_Srl => + Res := Create_Iir (Iir_Kind_Srl_Operator); + when Tok_Sra => + Res := Create_Iir (Iir_Kind_Sra_Operator); + when Tok_Rol => + Res := Create_Iir (Iir_Kind_Rol_Operator); + when Tok_Ror => + Res := Create_Iir (Iir_Kind_Ror_Operator); + when others => + raise Program_Error; + end case; + Set_Location (Res); + Scan.Scan; + Set_Left (Res, Tmp); + Set_Right (Res, Parse_Simple_Expression); + return Res; + end Parse_Shift_Expression; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- relation ::= shift_expression [ relational_operator shift_expression ] + -- + -- [ §7.2 ] + -- relational_operator ::= = | /= | < | <= | > | >= + function Parse_Relation return Iir_Expression is + Res, Tmp: Iir_Expression; + begin + Tmp := Parse_Shift_Expression; + if Current_Token not in Token_Relational_Operator_Type then + return Tmp; + end if; + + -- This loop is just to handle errors such as a = b = c. + loop + case Current_Token is + when Tok_Equal => + Res := Create_Iir (Iir_Kind_Equality_Operator); + when Tok_Not_Equal => + Res := Create_Iir (Iir_Kind_Inequality_Operator); + when Tok_Less => + Res := Create_Iir (Iir_Kind_Less_Than_Operator); + when Tok_Less_Equal => + Res := Create_Iir (Iir_Kind_Less_Than_Or_Equal_Operator); + when Tok_Greater => + Res := Create_Iir (Iir_Kind_Greater_Than_Operator); + when Tok_Greater_Equal => + Res := Create_Iir (Iir_Kind_Greater_Than_Or_Equal_Operator); + when others => + raise Program_Error; + end case; + Set_Location (Res); + Scan.Scan; + Set_Left (Res, Tmp); + Set_Right (Res, Parse_Shift_Expression); + exit when Current_Token not in Token_Relational_Operator_Type; + Error_Msg_Parse + ("use parenthesis for consecutive relational expressions"); + Tmp := Res; + end loop; + return Res; + end Parse_Relation; + + -- precond : next token + -- postcond: next token + -- + -- [ §7.1 ] + -- expression ::= relation { AND relation } + -- | relation { OR relation } + -- | relation { XOR relation } + -- | relation [ NAND relation } + -- | relation [ NOR relation } + -- | relation { XNOR relation } + function Parse_Expression return Iir_Expression is + Res, Tmp: Iir_Expression; + + -- OP_TOKEN contains the operator combinaison. + Op_Token: Token_Type; + begin + Tmp := Parse_Relation; + Op_Token := Tok_Invalid; + loop + case Current_Token is + when Tok_And => + Res := Create_Iir (Iir_Kind_And_Operator); + when Tok_Or => + Res := Create_Iir (Iir_Kind_Or_Operator); + when Tok_Xor => + Res := Create_Iir (Iir_Kind_Xor_Operator); + when Tok_Nand => + Res := Create_Iir (Iir_Kind_Nand_Operator); + when Tok_Nor => + Res := Create_Iir (Iir_Kind_Nor_Operator); + when Tok_Xnor => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'xnor' keyword not allowed in vhdl 87"); + end if; + Res := Create_Iir (Iir_Kind_Xnor_Operator); + when others => + return Tmp; + end case; + + if Op_Token = Tok_Invalid then + Op_Token := Current_Token; + else + -- Check after the case, since current_token may not be an + -- operator... + -- TODO: avoid repetition of this message ? + if Op_Token = Tok_Nand or Op_Token = Tok_Nor then + Error_Msg_Parse ("sequence of 'nor' or 'nand' not allowed"); + Error_Msg_Parse ("('nor' and 'nand' are not associative)"); + end if; + if Op_Token /= Current_Token then + -- Expression is a sequence of relations, with the same + -- operator. + Error_Msg_Parse ("only one type of logical operators may be " + & "used to combine relation"); + end if; + end if; + + Set_Location (Res); + Scan.Scan; + + -- Catch errors for Ada programmers. + if Current_Token = Tok_Then or Current_Token = Tok_Else then + Error_Msg_Parse ("""or else"" and ""and then"" sequences " + & "are not allowed in vhdl"); + Error_Msg_Parse ("""and"" and ""or"" are short-circuit " + & "operators for BIT and BOOLEAN types"); + Scan.Scan; + end if; + + Set_Left (Res, Tmp); + Set_Right (Res, Parse_Relation); + Tmp := Res; + end loop; + end Parse_Expression; + + -- precond : next token + -- postcond: next token. + -- + -- [ §8.4 ] + -- waveform ::= waveform_element { , waveform_element } + -- | UNAFFECTED + -- + -- [ §8.4.1 ] + -- waveform_element ::= VALUE_expression [ AFTER TIME_expression ] + -- | NULL [ AFTER TIME_expression ] + function Parse_Waveform return Iir_Waveform_Element + is + Res: Iir_Waveform_Element; + We, Last_We : Iir_Waveform_Element; + begin + if Current_Token = Tok_Unaffected then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'unaffected' is not allowed in vhdl87"); + end if; + Scan.Scan; + return Null_Iir; + else + Sub_Chain_Init (Res, Last_We); + loop + We := Create_Iir (Iir_Kind_Waveform_Element); + Sub_Chain_Append (Res, Last_We, We); + Set_Location (We); + -- Note: NULL is handled as a null_literal. + Set_We_Value (We, Parse_Expression); + if Current_Token = Tok_After then + Scan.Scan; + Set_Time (We, Parse_Expression); + end if; + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + return Res; + end if; + end Parse_Waveform; + + -- precond : next token + -- postcond: next token + -- + -- [ §8.4 ] + -- delay_mechanism ::= TRANSPORT + -- | [ REJECT TIME_expression ] INERTIAL + procedure Parse_Delay_Mechanism (Assign: Iir) is + begin + if Current_Token = Tok_Transport then + Set_Delay_Mechanism (Assign, Iir_Transport_Delay); + Scan.Scan; + else + Set_Delay_Mechanism (Assign, Iir_Inertial_Delay); + if Current_Token = Tok_Reject then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("'reject' delay mechanism not allowed in vhdl 87"); + end if; + Scan.Scan; + Set_Reject_Time_Expression (Assign, Parse_Expression); + Expect (Tok_Inertial); + Scan.Scan; + elsif Current_Token = Tok_Inertial then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("'inertial' keyword not allowed in vhdl 87"); + end if; + Scan.Scan; + end if; + end if; + end Parse_Delay_Mechanism; + + -- precond : next token + -- postcond: next token + -- + -- [ §9.5 ] + -- options ::= [ GUARDED ] [ delay_mechanism ] + procedure Parse_Options (Stmt : in out Iir) is + begin + if Current_Token = Tok_Guarded then + Set_Guard (Stmt, Stmt); + Scan.Scan; + end if; + Parse_Delay_Mechanism (Stmt); + end Parse_Options; + + -- precond : next tkoen + -- postcond: ';' + -- + -- [ §9.5.1 ] + -- conditional_signal_assignment ::= + -- target <= options conditional_waveforms ; + -- + -- [ §9.5.1 ] + -- conditional_waveforms ::= + -- { waveform WHEN condition ELSE } + -- waveform [ WHEN condition ] + function Parse_Conditional_Signal_Assignment (Target: Iir) return Iir + is + use Iir_Chains.Conditional_Waveform_Chain_Handling; + Res: Iir; + Cond_Wf, Last_Cond_Wf : Iir_Conditional_Waveform; + begin + Res := Create_Iir (Iir_Kind_Concurrent_Conditional_Signal_Assignment); + Set_Target (Res, Target); + Location_Copy (Res, Get_Target (Res)); + + case Current_Token is + when Tok_Less_Equal => + null; + when Tok_Assign => + Error_Msg_Parse ("':=' not allowed in concurrent statement, " + & "replaced by '<='"); + when others => + Expect (Tok_Less_Equal); + end case; + Scan.Scan; + + Parse_Options (Res); + + Build_Init (Last_Cond_Wf); + loop + Cond_Wf := Create_Iir (Iir_Kind_Conditional_Waveform); + Append (Last_Cond_Wf, Res, Cond_Wf); + Set_Location (Cond_Wf); + Set_Waveform_Chain (Cond_Wf, Parse_Waveform); + exit when Current_Token /= Tok_When; + Scan.Scan; + Set_Condition (Cond_Wf, Parse_Expression); + if Current_Token /= Tok_Else then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("else missing in vhdl 87"); + end if; + exit; + end if; + Scan.Scan; + end loop; + Expect (Tok_Semi_Colon); + return Res; + end Parse_Conditional_Signal_Assignment; + + -- precond : WITH + -- postcond: ';' + -- + -- [ §9.5.2 ] + -- selected_signal_assignment ::= + -- WITH expresion SELECT + -- target <= options selected_waveforms ; + -- + -- [ §9.5.2 ] + -- selected_waveforms ::= + -- { waveform WHEN choices , } + -- waveform WHEN choices + function Parse_Selected_Signal_Assignment return Iir + is + use Iir_Chains.Selected_Waveform_Chain_Handling; + Res: Iir; + Assoc: Iir; + Wf_Chain : Iir_Waveform_Element; + Target : Iir; + Last : Iir; + begin + Scan.Scan; -- accept 'with' token. + Res := Create_Iir (Iir_Kind_Concurrent_Selected_Signal_Assignment); + Set_Location (Res); + Set_Expression (Res, Parse_Expression); + + Expect (Tok_Select, "after expression"); + Scan.Scan; + if Current_Token = Tok_Left_Paren then + Target := Parse_Aggregate; + else + Target := Parse_Name (Allow_Indexes => True); + end if; + Set_Target (Res, Target); + Expect (Tok_Less_Equal); + Scan.Scan; + + Parse_Options (Res); + + Build_Init (Last); + loop + Wf_Chain := Parse_Waveform; + Expect (Tok_When, "after waveform"); + Scan.Scan; + Assoc := Parse_Choices (Null_Iir); + Set_Associated (Assoc, Wf_Chain); + Append_Subchain (Last, Res, Assoc); + exit when Current_Token = Tok_Semi_Colon; + Expect (Tok_Comma, "after choice"); + Scan.Scan; + end loop; + return Res; + end Parse_Selected_Signal_Assignment; + + -- precond : next token + -- postcond: next token. + -- + -- [ §8.1 ] + -- sensitivity_list ::= SIGNAL_name { , SIGNAL_name } + procedure Parse_Sensitivity_List (List: Iir_Designator_List) + is + El : Iir; + begin + loop + El := Parse_Name (Allow_Indexes => True); + case Get_Kind (El) is + when Iir_Kind_Simple_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Attribute_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Indexed_Name => + null; + when others => + Error_Msg_Parse + ("only names are allowed in a sensitivity list"); + end case; + Append_Element (List, El); + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + end Parse_Sensitivity_List; + + -- precond : ASSERT + -- postcond: next token + -- Note: this fill an sequential or a concurrent statement. + -- + -- [ §8.2 ] + -- assertion ::= ASSERT condition + -- [ REPORT expression ] [ SEVERITY expression ] + procedure Parse_Assertion (Stmt: Iir) is + begin + Set_Location (Stmt); + Scan.Scan; + Set_Assertion_Condition (Stmt, Parse_Expression); + if Current_Token = Tok_Report then + Scan.Scan; + Set_Report_Expression (Stmt, Parse_Expression); + end if; + if Current_Token = Tok_Severity then + Scan.Scan; + Set_Severity_Expression (Stmt, Parse_Expression); + if Current_Token = Tok_Report then + -- Nice message in case of inversion. + Error_Msg_Parse + ("report expression must precede severity expression"); + Scan.Scan; + Set_Report_Expression (Stmt, Parse_Expression); + end if; + end if; + end Parse_Assertion; + + -- precond : REPORT + -- postcond: next token + -- + -- [ 8.3 ] + -- report_statement ::= REPORT expression [ SEVERITY expression ] + function Parse_Report_Statement return Iir_Report_Statement + is + Res : Iir_Report_Statement; + begin + Res := Create_Iir (Iir_Kind_Report_Statement); + Set_Location (Res); + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("report statement not allowed in vhdl87"); + end if; + Scan.Scan; + Set_Report_Expression (Res, Parse_Expression); + if Current_Token = Tok_Severity then + Scan.Scan; + Set_Severity_Expression (Res, Parse_Expression); + end if; + return Res; + end Parse_Report_Statement; + + -- precond : WAIT + -- postcond: ';' + -- + -- [ §8.1 ] + -- wait_statement ::= + -- [ label : ] WAIT [ sensitivity_clause ] [ condition_clause ] + -- [ timeout_clause ] ; + -- + -- [ §8.1 ] + -- sensitivity_clause ::= ON sensitivity_list + -- + -- [ §8.1 ] + -- condition_clause ::= UNTIL conditiion + -- + -- [ §8.1 ] + -- timeout_clause ::= FOR TIME_expression + function Parse_Wait_Statement return Iir_Wait_Statement + is + Res: Iir_Wait_Statement; + List: Iir_List; + begin + Res := Create_Iir (Iir_Kind_Wait_Statement); + Set_Location (Res); + Scan.Scan; + case Current_Token is + when Tok_On => + List := Create_Iir_List; + Set_Sensitivity_List (Res, List); + Scan.Scan; + Parse_Sensitivity_List (List); + when Tok_Until => + null; + when Tok_For => + null; + when Tok_Semi_Colon => + return Res; + when others => + Error_Msg_Parse ("'on', 'until', 'for' or ';' expected"); + Eat_Tokens_Until_Semi_Colon; + return Res; + end case; + case Current_Token is + when Tok_On => + Error_Msg_Parse ("only one sensitivity is allowed"); + -- FIXME: sync + return Res; + when Tok_Until => + Scan.Scan; + Set_Condition_Clause (Res, Parse_Expression); + when Tok_For => + null; + when Tok_Semi_Colon => + return Res; + when others => + Error_Msg_Parse ("'until', 'for' or ';' expected"); + Eat_Tokens_Until_Semi_Colon; + return Res; + end case; + case Current_Token is + when Tok_On => + Error_Msg_Parse ("only one sensitivity clause is allowed"); + -- FIXME: sync + return Res; + when Tok_Until => + Error_Msg_Parse ("only one condition clause is allowed"); + -- FIXME: sync + return Res; + when Tok_For => + Scan.Scan; + Set_Timeout_Clause (Res, Parse_Expression); + return Res; + when Tok_Semi_Colon => + return Res; + when others => + Error_Msg_Parse ("'for' or ';' expected"); + Eat_Tokens_Until_Semi_Colon; + return Res; + end case; + end Parse_Wait_Statement; + + -- precond : IF + -- postcond: next token. + -- + -- [ §8.7 ] + -- if_statement ::= + -- [ IF_label : ] + -- IF condition THEN + -- sequence_of_statements + -- { ELSIF condition THEN + -- sequence_of_statements } + -- [ ELSE + -- sequence_of_statements ] + -- END IF [ IF_label ] ; + -- + -- FIXME: end label. + function Parse_If_Statement (Parent : Iir) return Iir_If_Statement + is + Res: Iir_If_Statement; + Clause: Iir; + N_Clause: Iir; + begin + Res := Create_Iir (Iir_Kind_If_Statement); + Set_Location (Res); + Set_Parent (Res, Parent); + Scan.Scan; + Clause := Res; + loop + Set_Condition (Clause, Parse_Expression); + Expect (Tok_Then, "'then' is expected here"); + Scan.Scan; + Set_Sequential_Statement_Chain + (Clause, Parse_Sequential_Statements (Res)); + exit when Current_Token = Tok_End; + N_Clause := Create_Iir (Iir_Kind_Elsif); + Set_Location (N_Clause); + Set_Else_Clause (Clause, N_Clause); + Clause := N_Clause; + if Current_Token = Tok_Else then + Scan.Scan; + Set_Sequential_Statement_Chain + (Clause, Parse_Sequential_Statements (Res)); + exit; + elsif Current_Token = Tok_Elsif then + Scan.Scan; + else + Error_Msg_Parse ("'else' or 'elsif' expected"); + end if; + end loop; + Expect (Tok_End); + Scan_Expect (Tok_If); + Scan.Scan; + return Res; + end Parse_If_Statement; + + function Parenthesis_Name_To_Procedure_Call (Name: Iir; Kind : Iir_Kind) + return Iir + is + Res: Iir; + Call : Iir_Procedure_Call; + begin + Res := Create_Iir (Kind); + Location_Copy (Res, Name); + Call := Create_Iir (Iir_Kind_Procedure_Call); + Location_Copy (Call, Name); + Set_Procedure_Call (Res, Call); + case Get_Kind (Name) is + when Iir_Kind_Parenthesis_Name => + Set_Implementation (Call, Get_Prefix (Name)); + Set_Parameter_Association_Chain + (Call, Get_Association_Chain (Name)); + Free_Iir (Name); + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Set_Implementation (Call, Name); + when others => + raise Internal_Error; + end case; + return Res; + end Parenthesis_Name_To_Procedure_Call; + + -- precond : identifier + -- postcond: next token + -- + -- [ §8.9 ] + -- parameter_specification ::= identifier IN discrete_range + function Parse_Parameter_Specification (Parent : Iir) + return Iir_Iterator_Declaration + is + Decl : Iir_Iterator_Declaration; + begin + Decl := Create_Iir (Iir_Kind_Iterator_Declaration); + Set_Location (Decl); + Set_Parent (Decl, Parent); + Expect (Tok_Identifier); + Set_Identifier (Decl, Current_Identifier); + Scan_Expect (Tok_In); + Scan.Scan; + -- parse a range. + Set_Type (Decl, Parse_Range_Expression (Null_Iir, True)); + return Decl; + end Parse_Parameter_Specification; + + -- precond: '<=' + -- postcond: next token + -- + -- [ §8.4 ] + -- signal_assignment_statement ::= + -- [ label : ] target <= [ delay_mechanism ] waveform ; + function Parse_Signal_Assignment_Statement (Target : Iir) return Iir + is + Stmt : Iir; + Wave_Chain : Iir_Waveform_Element; + begin + Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement); + Location_Copy (Stmt, Target); + Set_Target (Stmt, Target); + Scan.Scan; + Parse_Delay_Mechanism (Stmt); + Wave_Chain := Parse_Waveform; + -- LRM 8.4 Signal assignment statement + -- It is an error is the reserved word UNAFFECTED appears as a + -- waveform in a (sequential) signa assignment statement. + if Wave_Chain = Null_Iir then + Error_Msg_Parse + ("'unaffected' is not allowed in a sequential statement"); + end if; + Set_Waveform_Chain (Stmt, Wave_Chain); + return Stmt; + end Parse_Signal_Assignment_Statement; + + -- precond: ':=' + -- postcond: next token + -- + -- [ §8.5 ] + -- variable_assignment_statement ::= + -- [ label : ] target := expression ; + function Parse_Variable_Assignment_Statement (Target : Iir) return Iir + is + Stmt : Iir; + begin + Stmt := Create_Iir (Iir_Kind_Variable_Assignment_Statement); + Location_Copy (Stmt, Target); + Set_Target (Stmt, Target); + Scan.Scan; + Set_Expression (Stmt, Parse_Expression); + return Stmt; + end Parse_Variable_Assignment_Statement; + + -- precond: next token + -- postcond: next token + -- + -- [ 8 ] + -- sequence_of_statement ::= { sequential_statement } + -- + -- [ 8 ] + -- sequential_statement ::= wait_statement + -- | assertion_statement + -- | report_statement + -- | signal_assignment_statement + -- | variable_assignment_statement + -- | procedure_call_statement + -- | if_statement + -- | case_statement + -- | loop_statement + -- | next_statement + -- | exit_statement + -- | return_statement + -- | null_statement + -- + -- [ 8.13 ] + -- null_statement ::= [ label : ] NULL ; + -- + -- [ 8.12 ] + -- return_statement ::= [ label : ] RETURN [ expression ] + -- + -- [ 8.10 ] + -- next_statement ::= [ label : ] NEXT [ LOOP_label ] [ WHEN condition ] ; + -- + -- [ 8.11 ] + -- exit_statement ::= [ label : ] EXIT [ LOOP_label ] [ WHEN condition ] ; + -- + -- [ 8.9 ] + -- loop_statement ::= + -- [ LOOP_label : ] + -- [ iteration_scheme ] LOOP + -- sequence_of_statements + -- END LOOP [ LOOP_label ] ; + -- + -- [ 8.9 ] + -- iteration_scheme ::= WHILE condition + -- | FOR LOOP_parameter_specification + -- + -- [ 8.8 ] + -- case_statement ::= + -- [ CASE_label : ] + -- CASE expression IS + -- case_statement_alternative + -- { case_statement_alternative } + -- END CASE [ CASE_label ] ; + -- + -- [ 8.8 ] + -- case_statement_alternative ::= WHEN choices => sequence_of_statements + -- + -- [ 8.2 ] + -- assertion_statement ::= [ label : ] assertion ; + -- + -- [ 8.3 ] + -- report_statement ::= [ label : ] REPORT expression SEVERITY expression ; + function Parse_Sequential_Assignment_Statement (Target : Iir) return Iir + is + Stmt : Iir; + Call : Iir; + begin + if Current_Token = Tok_Less_Equal then + return Parse_Signal_Assignment_Statement (Target); + elsif Current_Token = Tok_Assign then + return Parse_Variable_Assignment_Statement (Target); + elsif Current_Token = Tok_Semi_Colon then + return Parenthesis_Name_To_Procedure_Call + (Target, Iir_Kind_Procedure_Call_Statement); + else + Error_Msg_Parse ("""<="" or "":="" expected instead of " + & Image (Current_Token)); + Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); + Call := Create_Iir (Iir_Kind_Procedure_Call); + Set_Implementation (Call, Target); + Set_Procedure_Call (Stmt, Call); + Set_Location (Call); + Eat_Tokens_Until_Semi_Colon; + return Stmt; + end if; + end Parse_Sequential_Assignment_Statement; + + function Parse_Sequential_Statements (Parent : Iir) + return Iir + is + First_Stmt : Iir; + Last_Stmt : Iir; + Stmt: Iir; + Label: Name_Id; + Loc : Location_Type; + Target : Iir; + begin + First_Stmt := Null_Iir; + Last_Stmt := Null_Iir; + -- Expect a current_token. + loop + Loc := Get_Token_Location; + if Current_Token = Tok_Identifier then + Label := Current_Identifier; + Scan.Scan; + if Current_Token = Tok_Colon then + Scan.Scan; + else + Target := Create_Iir (Iir_Kind_Simple_Name); + Set_Identifier (Target, Label); + Set_Location (Target, Loc); + Label := Null_Identifier; + Target := Parse_Name_Suffix (Target, True); + Stmt := Parse_Sequential_Assignment_Statement (Target); + goto Has_Stmt; + end if; + else + Label := Null_Identifier; + end if; + + case Current_Token is + when Tok_Null => + Stmt := Create_Iir (Iir_Kind_Null_Statement); + Scan.Scan; + when Tok_Assert => + Stmt := Create_Iir (Iir_Kind_Assertion_Statement); + Parse_Assertion (Stmt); + when Tok_Report => + Stmt := Parse_Report_Statement; + when Tok_If => + Stmt := Parse_If_Statement (Parent); + Set_Label (Stmt, Label); + Set_Location (Stmt, Loc); + if Flags.Vhdl_Std >= Vhdl_93c then + Check_End_Name (Stmt); + end if; + when Tok_Identifier => -- | tok_left_paren + Stmt := Parse_Sequential_Assignment_Statement (Parse_Name); + when Tok_Left_Paren => + declare + Target : Iir; + begin + Target := Parse_Aggregate; + if Current_Token = Tok_Less_Equal then + Stmt := Parse_Signal_Assignment_Statement (Target); + elsif Current_Token = Tok_Assign then + Stmt := Parse_Variable_Assignment_Statement (Target); + else + Error_Msg_Parse ("'<=' or ':=' expected"); + return First_Stmt; + end if; + end; + when Tok_Return => + Stmt := Create_Iir (Iir_Kind_Return_Statement); + Scan.Scan; + if Current_Token /= Tok_Semi_Colon then + Set_Expression (Stmt, Parse_Expression); + end if; + when Tok_For => + Stmt := Create_Iir (Iir_Kind_For_Loop_Statement); + Set_Location (Stmt, Loc); + Set_Label (Stmt, Label); + Scan.Scan; + Set_Iterator_Scheme + (Stmt, Parse_Parameter_Specification (Stmt)); + Expect (Tok_Loop); + Scan.Scan; + Set_Sequential_Statement_Chain + (Stmt, Parse_Sequential_Statements (Stmt)); + Expect (Tok_End); + Scan_Expect (Tok_Loop); + Scan.Scan; + Check_End_Name (Stmt); + -- A loop statement can have a label, even in vhdl87. + Label := Null_Identifier; + when Tok_While + | Tok_Loop => + Stmt := Create_Iir (Iir_Kind_While_Loop_Statement); + Set_Location (Stmt); + Set_Label (Stmt, Label); + if Current_Token = Tok_While then + Scan.Scan; + Set_Condition (Stmt, Parse_Expression); + Expect (Tok_Loop); + end if; + Scan.Scan; + Set_Sequential_Statement_Chain + (Stmt, Parse_Sequential_Statements (Stmt)); + Expect (Tok_End); + Scan_Expect (Tok_Loop); + Scan.Scan; + Check_End_Name (Stmt); + -- A loop statement can have a label, even in vhdl87. + Label := Null_Identifier; + when Tok_Next + | Tok_Exit => + if Current_Token = Tok_Next then + Stmt := Create_Iir (Iir_Kind_Next_Statement); + else + Stmt := Create_Iir (Iir_Kind_Exit_Statement); + end if; + Scan.Scan; + if Current_Token = Tok_Identifier then + Set_Loop (Stmt, Current_Text); + Scan.Scan; + end if; + if Current_Token = Tok_When then + Scan.Scan; + Set_Condition (Stmt, Parse_Expression); + end if; + when Tok_Case => + declare + use Iir_Chains.Case_Statement_Alternative_Chain_Handling; + Assoc: Iir; + Last_Assoc : Iir; + begin + Stmt := Create_Iir (Iir_Kind_Case_Statement); + Set_Location (Stmt); + Set_Label (Stmt, Label); + Scan.Scan; + Set_Expression (Stmt, Parse_Expression); + Expect (Tok_Is); + Scan.Scan; + if Current_Token = Tok_End then + Error_Msg_Parse ("missing alternative in case statement"); + end if; + Build_Init (Last_Assoc); + while Current_Token /= Tok_End loop + Expect (Tok_When); + Scan.Scan; + if Current_Token = Tok_Arrow then + Error_Msg_Parse ("missing expression in alternative"); + else + Assoc := Parse_Choices (Null_Iir); + end if; + Expect (Tok_Arrow); + Scan.Scan; + Set_Associated + (Assoc, Parse_Sequential_Statements (Stmt)); + Append_Subchain (Last_Assoc, Stmt, Assoc); + end loop; + Scan_Expect (Tok_Case); + Scan.Scan; + if Flags.Vhdl_Std >= Vhdl_93c then + Check_End_Name (Stmt); + end if; + end; + when Tok_Wait => + Stmt := Parse_Wait_Statement; + when others => + return First_Stmt; + end case; + << Has_Stmt >> null; + Set_Parent (Stmt, Parent); + Set_Location (Stmt, Loc); + if Label /= Null_Identifier then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Sem + ("this statement can't have a label in vhdl 87", Stmt); + else + Set_Label (Stmt, Label); + end if; + end if; + Expect (Tok_Semi_Colon); + Scan.Scan; + + -- Append it to the chain. + if First_Stmt = Null_Iir then + First_Stmt := Stmt; + else + Set_Chain (Last_Stmt, Stmt); + end if; + Last_Stmt := Stmt; + end loop; + end Parse_Sequential_Statements; + + -- precond : PROCEDURE, FUNCTION, PURE or IMPURE. + -- postcond: ';' + -- + -- [ §2.1 ] + -- subprogram_declaration ::= subprogram_specification ; + -- + -- [ §2.1 ] + -- subprogram_specification ::= + -- PROCEDURE designator [ ( formal_parameter_list ) ] + -- | [ PURE | IMPURE ] FUNCTION designator [ ( formal_parameter_list ) ] + -- RETURN type_mark + -- + -- [ §2.2 ] + -- subprogram_body ::= + -- subprogram_specification IS + -- subprogram_declarative_part + -- BEGIN + -- subprogram_statement_part + -- END [ subprogram_kind ] [ designator ] ; + -- + -- [ §2.1 ] + -- designator ::= identifier | operator_symbol + -- + -- [ §2.1 ] + -- operator_symbol ::= string_literal + function Parse_Subprogram_Declaration return Iir + is + Subprg: Iir; + Subprg_Body : Iir; + Old : Iir; + begin + -- Create the node. + case Current_Token is + when Tok_Procedure => + Subprg := Create_Iir (Iir_Kind_Procedure_Declaration); + when Tok_Function + | Tok_Pure + | Tok_Impure => + Subprg := Create_Iir (Iir_Kind_Function_Declaration); + when others => + raise Internal_Error; + end case; + Set_Location (Subprg); + + case Current_Token is + when Tok_Procedure => + null; + when Tok_Function => + -- LRM93 2.1 + -- A function is impure if its specification contains the + -- reserved word IMPURE; otherwise it is said to be pure. + Set_Pure_Flag (Subprg, True); + when Tok_Pure + | Tok_Impure => + Set_Pure_Flag (Subprg, Current_Token = Tok_Pure); + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("'pure' and 'impure' are not allowed in vhdl 87"); + end if; + -- FIXME: what to do in case of error ?? + -- Eat PURE or IMPURE. + Scan.Scan; + Expect (Tok_Function, "'function' must follow 'pure' or 'impure'"); + when others => + raise Internal_Error; + end case; + + -- Eat PROCEDURE or FUNCTION. + Scan.Scan; + + if Current_Token = Tok_Identifier then + Set_Identifier (Subprg, Current_Identifier); + Set_Location (Subprg); + elsif Current_Token = Tok_String then + if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + -- LRM93 2.1 + -- A procedure designator is always an identifier. + Error_Msg_Parse ("a procedure name must be an identifier"); + end if; + -- LRM93 2.1 + -- A function designator is either an identifier or an operator + -- symbol. + Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location)); + Set_Location (Subprg); + else + -- Just to display a parse error. + Expect (Tok_Identifier); + end if; + + Scan.Scan; + if Current_Token = Tok_Left_Paren then + -- Parse the interface declaration. + Set_Interface_Declaration_Chain + (Subprg, + Parse_Interface_Chain (Iir_Kind_Constant_Interface_Declaration, + Subprg)); + end if; + + if Current_Token = Tok_Return then + if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + Error_Msg_Parse ("'return' not allowed for a procedure"); + Error_Msg_Parse ("(remove return part or define a function)"); + Scan.Scan; + Old := Parse_Type_Mark; + else + Scan.Scan; + Set_Return_Type (Subprg, Parse_Type_Mark (Check_Paren => True)); + end if; + else + if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then + Error_Msg_Parse ("'return' expected"); + end if; + end if; + + if Current_Token = Tok_Semi_Colon then + return Subprg; + end if; + if Get_Kind (Subprg) = 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); + + Expect (Tok_Is); + Scan.Scan; + Parse_Declarative_Part (Subprg_Body); + Expect (Tok_Begin); + Scan.Scan; + Set_Sequential_Statement_Chain + (Subprg_Body, Parse_Sequential_Statements (Subprg_Body)); + Expect (Tok_End); + Scan.Scan; + + 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 Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + Error_Msg_Parse ("'procedure' expected instead of 'function'"); + end if; + Scan.Scan; + when Tok_Procedure => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'procedure' not allowed here by vhdl 87"); + end if; + if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then + Error_Msg_Parse ("'function' expected instead of 'procedure'"); + end if; + Scan.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 + ("mispelling, 'end """ & Image_Identifier (Subprg) + & """;' expected"); + end if; + Scan.Scan; + when others => + null; + end case; + Expect (Tok_Semi_Colon); + return Subprg; + end Parse_Subprogram_Declaration; + + -- precond: PROCESS + -- postcond: null + -- + -- [ §9.2 ] + -- process_statement ::= + -- [ PROCESS_label : ] + -- [ POSTPONED ] PROCESS [ ( sensitivity_list ) ] [ IS ] + -- process_declarative_part + -- BEGIN + -- process_statement_part + -- END [ POSTPONED ] PROCESS [ PROCESS_label ] ; + -- + -- FIXME: POSTPONED + function Parse_Process_Statement + (Label: Name_Id; Loc : Location_Type; Is_Postponed : Boolean) + return Iir + is + Res: Iir; + Sensitivity_List : Iir_List; + begin + -- The PROCESS keyword was just scaned. + Scan.Scan; + + if Current_Token = Tok_Left_Paren then + Res := Create_Iir (Iir_Kind_Sensitized_Process_Statement); + Scan.Scan; + Sensitivity_List := Create_Iir_List; + Set_Sensitivity_List (Res, Sensitivity_List); + Parse_Sensitivity_List (Sensitivity_List); + Expect (Tok_Right_Paren); + Scan.Scan; + else + Res := Create_Iir (Iir_Kind_Process_Statement); + end if; + + Set_Location (Res, Loc); + Set_Label (Res, Label); + + if Current_Token = Tok_Is then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("""is"" not allowed here by vhdl 87"); + end if; + Scan.Scan; + end if; + + -- declarative part. + Parse_Declarative_Part (Res); + + Expect (Tok_Begin); + Scan.Scan; + + Set_Sequential_Statement_Chain (Res, Parse_Sequential_Statements (Res)); + + Expect (Tok_End); + Scan.Scan; + + if Current_Token = Tok_Postponed then + if not Is_Postponed then + -- LRM93 9.2 + -- If the reserved word POSTPONED appears at the end of a process + -- statement, the process must be a postponed process. + Error_Msg_Parse ("process is not a postponed process"); + end if; + Scan.Scan; + end if; + + if Current_Token = Tok_Semi_Colon then + Error_Msg_Parse ("""end"" must be followed by ""process"""); + else + Expect (Tok_Process); + Scan.Scan; + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + end if; + return Res; + end Parse_Process_Statement; + + -- precond : '(' + -- postcond: NEXT_TOKEN + -- + -- [ §4.3.2.2 ] + -- association_list ::= association_element { , association_element } + -- + -- [ §4.3.2.2 ] + -- association_element ::= [ formal_part => ] actual_part + -- + -- [ §4.3.2.2 ] + -- actual_part ::= actual_designator + -- | FUNCTION_name ( actual_designator ) + -- | type_mark ( actual_designator ) + -- + -- [ §4.3.2.2 ] + -- actual_designator ::= expression + -- | SIGNAL_name + -- | VARIABLE_name + -- | FILE_name + -- | OPEN + -- + -- [ §4.3.2.2 ] + -- formal_part ::= formal_designator + -- | FUNCTION_name ( formal_designator ) + -- | type_mark ( formal_designator ) + -- + -- [ §4.3.2.2 ] + -- formal_designator ::= GENERIC_name + -- | PORT_name + -- | PARAMETER_name + -- + -- Note: an actual part is parsed as an expression. + function Parse_Association_Chain return Iir + is + Res, Last: Iir; + El: Iir; + Formal: Iir; + Actual: Iir; + Nbr_Assocs : Natural; + begin + Sub_Chain_Init (Res, Last); + + Expect (Tok_Left_Paren); + Scan.Scan; + + if Current_Token = Tok_Right_Paren then + Error_Msg_Parse ("empty association list is not allowed"); + return Res; + end if; + + Nbr_Assocs := 1; + loop + -- Parse formal and actual. + Formal := Null_Iir; + if Current_Token /= Tok_Open then + Actual := Parse_Expression; + case Current_Token is + when Tok_To + | Tok_Downto => + Actual := Parse_Range_Expression (Actual); + if Nbr_Assocs /= 1 then + Error_Msg_Parse ("multi-dimensional slice is forbidden"); + end if; + when Tok_Arrow => + Formal := Actual; + Scan.Scan; + if Current_Token /= Tok_Open then + Actual := Parse_Expression; + end if; + when others => + null; + end case; + end if; + + if Current_Token = Tok_Open then + El := Create_Iir (Iir_Kind_Association_Element_Open); + Set_Location (El); + Scan.Scan; -- past open. + else + El := Create_Iir (Iir_Kind_Association_Element_By_Expression); + if Formal = Null_Iir then + Set_Location (El); + else + Location_Copy (El, Formal); + end if; + Set_Actual (El, Actual); + end if; + Set_Formal (El, Formal); + + Sub_Chain_Append (Res, Last, El); + exit when Current_Token = Tok_Right_Paren; + Expect (Tok_Comma); + Scan.Scan; + Nbr_Assocs := Nbr_Assocs + 1; + end loop; + Scan.Scan; + return Res; + end Parse_Association_Chain; + + -- precond : GENERIC + -- postcond: next token + -- + -- [ §5.2.1.2 ] + -- generic_map_aspect ::= GENERIC MAP ( GENERIC_association_list ) + function Parse_Generic_Map_Aspect return Iir is + begin + Expect (Tok_Generic); + Scan_Expect (Tok_Map); + Scan.Scan; + return Parse_Association_Chain; + end Parse_Generic_Map_Aspect; + + -- precond : PORT + -- postcond: next token + -- + -- [ §5.2.1.2 ] + -- port_map_aspect ::= PORT MAP ( PORT_association_list ) + function Parse_Port_Map_Aspect return Iir is + begin + Expect (Tok_Port); + Scan_Expect (Tok_Map); + Scan.Scan; + return Parse_Association_Chain; + end Parse_Port_Map_Aspect; + + -- precond : COMPONENT | ENTIY | CONFIGURATION + -- postcond : next_token + -- + -- instantiated_unit ::= + -- [ COMPONENT ] component_name + -- ENTITY entity_name [ ( architecture_identifier ) ] + -- CONFIGURATION configuration_name + function Parse_Instantiated_Unit return Iir + is + Res : Iir; + begin + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("component instantiation using keyword 'component', 'entity',"); + Error_Msg_Parse (" or 'configuration' is not allowed in vhdl87"); + end if; + + case Current_Token is + when Tok_Component => + Scan.Scan; + return Parse_Name (False); + when Tok_Entity => + Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity); + Set_Location (Res); + Scan.Scan; + Set_Entity (Res, Parse_Name (False)); + if Current_Token = Tok_Left_Paren then + Scan_Expect (Tok_Identifier); + Set_Architecture (Res, Current_Text); + Scan_Expect (Tok_Right_Paren); + Scan.Scan; + end if; + return Res; + when Tok_Configuration => + Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration); + Set_Location (Res); + Scan_Expect (Tok_Identifier); + Set_Configuration (Res, Parse_Name (False)); + return Res; + when others => + raise Internal_Error; + end case; + end Parse_Instantiated_Unit; + + -- precond : next token + -- postcond: ';' + -- + -- component_instantiation_statement ::= + -- INSTANTIATION_label : + -- instantiated_unit [ generic_map_aspect ] [ port_map_aspect ] ; + function Parse_Component_Instantiation (Name: Iir) + return Iir_Component_Instantiation_Statement is + Res: Iir_Component_Instantiation_Statement; + begin + Res := Create_Iir (Iir_Kind_Component_Instantiation_Statement); + Set_Location (Res); + + Set_Instantiated_Unit (Res, Name); + + if Current_Token = Tok_Generic then + Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); + end if; + if Current_Token = Tok_Port then + Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect); + end if; + Expect (Tok_Semi_Colon); + return Res; + end Parse_Component_Instantiation; + + -- precond : next token + -- postcond: next token + -- + -- [ §9.1 ] + -- block_header ::= [ generic_clause [ generic_map_aspect ; ] ] + -- [ port_clause [ port_map_aspect ; ] ] + function Parse_Block_Header return Iir_Block_Header is + Res : Iir_Block_Header; + begin + Res := Create_Iir (Iir_Kind_Block_Header); + Set_Location (Res); + if Current_Token = Tok_Generic then + Parse_Generic_Clause (Res); + if Current_Token = Tok_Generic then + Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); + Expect (Tok_Semi_Colon); + Scan.Scan; + end if; + end if; + if Current_Token = Tok_Port then + Parse_Port_Clause (Res); + if Current_Token = Tok_Port then + Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect); + Expect (Tok_Semi_Colon); + Scan.Scan; + end if; + end if; + return Res; + end Parse_Block_Header; + + -- precond : BLOCK + -- postcond: ';' + -- + -- [ §9.1 ] + -- block_statement ::= + -- BLOCK_label : + -- BLOCK [ ( GUARD_expression ) ] [ IS ] + -- block_header + -- block_declarative_part + -- BEGIN + -- block_statement_part + -- END BLOCK [ BLOCK_label ] ; + -- + -- [ §9.1 ] + -- block_declarative_part ::= { block_declarative_item } + -- + -- [ §9.1 ] + -- block_statement_part ::= { concurrent_statement } + function Parse_Block_Statement (Label: Name_Id; Loc : Location_Type) + return Iir_Block_Statement + is + Res : Iir_Block_Statement; + Guard : Iir_Guard_Signal_Declaration; + begin + if Label = Null_Identifier then + Error_Msg_Parse ("a block statement must have a label"); + end if; + + -- block was just parsed. + Res := Create_Iir (Iir_Kind_Block_Statement); + Set_Location (Res, Loc); + Set_Label (Res, Label); + Scan.Scan; + if Current_Token = Tok_Left_Paren then + Guard := Create_Iir (Iir_Kind_Guard_Signal_Declaration); + Set_Location (Guard); + Set_Guard_Decl (Res, Guard); + Scan.Scan; + Set_Guard_Expression (Guard, Parse_Expression); + Expect (Tok_Right_Paren, "a ')' is expected after guard expression"); + Scan.Scan; + end if; + if Current_Token = Tok_Is then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'is' not allowed here in vhdl87"); + end if; + Scan.Scan; + end if; + if Current_Token = Tok_Generic or Current_Token = Tok_Port then + Set_Block_Header (Res, Parse_Block_Header); + end if; + if Current_Token /= Tok_Begin then + Parse_Declarative_Part (Res); + end if; + Expect (Tok_Begin); + Scan.Scan; + Parse_Concurrent_Statements (Res); + Check_End_Name (Tok_Block, Res); + return Res; + end Parse_Block_Statement; + + -- precond : IF or FOR + -- postcond: ';' + -- + -- [ §9.7 ] + -- generate_statement ::= + -- GENERATE_label : generation_scheme GENERATE + -- [ { block_declarative_item } + -- BEGIN ] + -- { concurrent_statement } + -- END GENERATE [ GENERATE_label ] ; + -- + -- [ §9.7 ] + -- generation_scheme ::= + -- FOR GENERATE_parameter_specification + -- | IF condition + -- + -- FIXME: block_declarative item. + function Parse_Generate_Statement (Label : Name_Id; Loc : Location_Type) + return Iir_Generate_Statement + is + Res : Iir_Generate_Statement; + begin + if Label = Null_Identifier then + Error_Msg_Parse ("a generate statement must have a label"); + end if; + Res := Create_Iir (Iir_Kind_Generate_Statement); + Set_Location (Res, Loc); + Set_Label (Res, Label); + case Current_Token is + when Tok_For => + Scan.Scan; + Set_Generation_Scheme (Res, Parse_Parameter_Specification (Res)); + when Tok_If => + Scan.Scan; + Set_Generation_Scheme (Res, Parse_Expression); + when others => + raise Internal_Error; + end case; + Expect (Tok_Generate); + + Scan.Scan; + -- Check for a block declarative item. + case Current_Token is + when + -- subprogram_declaration + -- subprogram_body + Tok_Procedure + | Tok_Function + | Tok_Pure + | Tok_Impure + -- type_declaration + | Tok_Type + -- subtype_declaration + | Tok_Subtype + -- constant_declaration + | Tok_Constant + -- signal_declaration + | Tok_Signal + -- shared_variable_declaration + | Tok_Shared + | Tok_Variable + -- file_declaration + | Tok_File + -- alias_declaration + | Tok_Alias + -- component_declaration + | Tok_Component + -- attribute_declaration + -- attribute_specification + | Tok_Attribute + -- configuration_specification + | Tok_For + -- disconnection_specification + | Tok_Disconnect + -- use_clause + | Tok_Use + -- group_template_declaration + -- group_declaration + | Tok_Group + | Tok_Begin => + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("declarations not allowed in a generate in vhdl87"); + end if; + Parse_Declarative_Part (Res); + Expect (Tok_Begin); + Scan.Scan; + when others => + null; + end case; + + Parse_Concurrent_Statements (Res); + Expect (Tok_End); + Scan_Expect (Tok_Generate); + Scan.Scan; + + -- LRM93 9.7 + -- If a label appears at the end of a generate statement, it must repeat + -- the generate label. + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + return Res; + end Parse_Generate_Statement; + + -- precond : first token + -- postcond: END + -- + -- [ §9 ] + -- concurrent_statement ::= block_statement + -- | process_statement + -- | concurrent_procedure_call_statement + -- | concurrent_assertion_statement + -- | concurrent_signal_assignment_statement + -- | component_instantiation_statement + -- | generate_statement + -- + -- [ §9.4 ] + -- concurrent_assertion_statement ::= + -- [ label : ] [ POSTPONED ] assertion ; + -- + -- [ §9.3 ] + -- concurrent_procedure_call_statement ::= + -- [ label : ] [ POSTPONED ] procedure_call ; + -- + -- [ §9.5 ] + -- concurrent_signal_assignment_statement ::= + -- [ label : ] [ POSTPONED ] conditional_signal_assignment + -- | [ label : ] [ POSTPONED ] selected_signal_assignment + function Parse_Concurrent_Assignment (Target : Iir) return Iir + is + begin + case Current_Token is + when Tok_Less_Equal + | Tok_Assign => + -- This is a conditional signal assignment. + -- Error for ':=' is handled by the subprogram. + return Parse_Conditional_Signal_Assignment (Target); + when Tok_Semi_Colon => + -- a procedure call or a component instantiation. + -- Parse it as a procedure call, may be revert to a + -- component instantiation during sem. + Expect (Tok_Semi_Colon); + return Parenthesis_Name_To_Procedure_Call + (Target, Iir_Kind_Concurrent_Procedure_Call_Statement); + when others => + -- or a component instantiation. + return Parse_Component_Instantiation (Target); + end case; + end Parse_Concurrent_Assignment; + + procedure Parse_Concurrent_Statements (Parent : Iir) + is + Last_Stmt : Iir; + Stmt: Iir; + Label: Name_Id; + Id: Iir; + Postponed : Boolean; + Loc : Location_Type; + Target : Iir; + begin + -- begin was just parsed. + Last_Stmt := Null_Iir; + loop + Stmt := Null_Iir; + Label := Null_Identifier; + Postponed := False; + Loc := Get_Token_Location; + + -- Try to find a label. + if Current_Token = Tok_Identifier then + Label := Current_Identifier; + Scan.Scan; + if Current_Token = Tok_Colon then + -- The identifier is really a label. + Scan.Scan; + else + -- This is not a label. + Target := Create_Iir (Iir_Kind_Simple_Name); + Set_Location (Target, Loc); + Set_Identifier (Target, Label); + Label := Null_Identifier; + Target := Parse_Name_Suffix (Target); + Stmt := Parse_Concurrent_Assignment (Target); + goto Has_Stmt; + end if; + end if; + + if Current_Token = Tok_Postponed then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'postponed' is not allowed in vhdl 87"); + else + Postponed := True; + end if; + Scan.Scan; + end if; + + case Current_Token is + when Tok_End => + if Label /= Null_Identifier then + Error_Msg_Parse + ("no label is allowed before the 'end' keyword"); + end if; + return; + when Tok_Identifier => + Target := Parse_Name (Allow_Indexes => True); + Stmt := Parse_Concurrent_Assignment (Target); + if Get_Kind (Stmt) = Iir_Kind_Component_Instantiation_Statement + and then Postponed + then + Error_Msg_Parse ("'postponed' not allowed for " & + "an instantiation statement"); + Postponed := False; + end if; + when Tok_Left_Paren => + Id := Parse_Aggregate; + if Current_Token = Tok_Less_Equal then + -- This is a conditional signal assignment. + Stmt := Parse_Conditional_Signal_Assignment (Id); + else + Error_Msg_Parse ("'<=' expected after aggregate"); + Eat_Tokens_Until_Semi_Colon; + end if; + when Tok_Process => + Stmt := Parse_Process_Statement (Label, Loc, Postponed); + when Tok_Assert => + Stmt := Create_Iir (Iir_Kind_Concurrent_Assertion_Statement); + Parse_Assertion (Stmt); + Expect (Tok_Semi_Colon); + when Tok_With => + Stmt := Parse_Selected_Signal_Assignment; + when Tok_Block => + if Postponed then + Error_Msg_Parse + ("'postponed' is not allowed before 'block'"); + Postponed := False; + end if; + Stmt := Parse_Block_Statement (Label, Loc); + when Tok_If + | Tok_For => + if Postponed then + Error_Msg_Parse + ("'postponed' not allowed before a generate statement"); + Postponed := False; + end if; + Stmt := Parse_Generate_Statement (Label, Loc); + when Tok_Eof => + Error_Msg_Parse ("unexpected end of file, 'END;' expected"); + return; + when Tok_Component + | Tok_Entity + | Tok_Configuration => + if Postponed then + Error_Msg_Parse ("'postponed' not allowed before " & + "an instantiation statement"); + Postponed := False; + end if; + declare + Unit : Iir; + begin + Unit := Parse_Instantiated_Unit; + Stmt := Parse_Component_Instantiation (Unit); + end; + when others => + -- FIXME: improve message: + -- instead of 'unexpected token 'signal' in conc stmt list' + -- report: 'signal declarations are not allowed in conc stmt' + Unexpected ("concurrent statement list"); + Eat_Tokens_Until_Semi_Colon; + end case; + + << Has_Stmt >> null; + + -- stmt can be null in case of error. + if Stmt /= Null_Iir then + Set_Location (Stmt, Loc); + Set_Label (Stmt, Label); + Set_Parent (Stmt, Parent); + if Postponed then + Set_Postponed_Flag (Stmt, True); + end if; + -- Append it to the chain. + if Last_Stmt = Null_Iir then + Set_Concurrent_Statement_Chain (Parent, Stmt); + else + Set_Chain (Last_Stmt, Stmt); + end if; + Last_Stmt := Stmt; + end if; + + Scan.Scan; + end loop; + end Parse_Concurrent_Statements; + + -- precond : LIBRARY + -- postcond: ; + -- + -- [ §11.2 ] + -- library_clause ::= LIBRARY logical_name_list + function Parse_Library_Clause return Iir + is + First, Last : Iir; + Library: Iir_Library_Clause; + begin + Sub_Chain_Init (First, Last); + Expect (Tok_Library); + loop + Library := Create_Iir (Iir_Kind_Library_Clause); + Scan_Expect (Tok_Identifier); + Set_Identifier (Library, Current_Identifier); + Set_Location (Library); + Sub_Chain_Append (First, Last, Library); + Scan.Scan; + exit when Current_Token = Tok_Semi_Colon; + Expect (Tok_Comma); + end loop; + Scan.Scan; + return First; + end Parse_Library_Clause; + + -- precond : USE + -- postcond: ; + -- + -- [ §10.4 ] + -- use_clause ::= USE selected_name { , selected_name } + -- + -- FIXME: should be a list. + function Parse_Use_Clause return Iir_Use_Clause + is + Use_Clause: Iir_Use_Clause; + First, Last : Iir; + begin + First := Null_Iir; + Last := Null_Iir; + Scan.Scan; + loop + Use_Clause := Create_Iir (Iir_Kind_Use_Clause); + Set_Location (Use_Clause); + Expect (Tok_Identifier); + Set_Selected_Name (Use_Clause, Parse_Name); + + -- Chain use clauses. + if First = Null_Iir then + First := Use_Clause; + else + Set_Use_Clause_Chain (Last, Use_Clause); + end if; + Last := Use_Clause; + + exit when Current_Token = Tok_Semi_Colon; + Expect (Tok_Comma); + Scan.Scan; + end loop; + return First; + end Parse_Use_Clause; + + -- precond : ARCHITECTURE + -- postcond: ';' + -- + -- [ §1.2 ] + -- architecture_body ::= + -- ARCHITECTURE identifier OF ENTITY_name IS + -- architecture_declarative_part + -- BEGIN + -- architecture_statement_part + -- END [ ARCHITECTURE ] [ ARCHITECTURE_simple_name ] ; + procedure Parse_Architecture (Unit : Iir_Design_Unit) + is + Res: Iir_Architecture_Declaration; + begin + Expect (Tok_Architecture); + Res := Create_Iir (Iir_Kind_Architecture_Declaration); + + -- Get identifier. + Scan_Expect (Tok_Identifier); + Set_Identifier (Res, Current_Identifier); + Set_Location (Res); + Scan.Scan; + if Current_Token = Tok_Is then + Error_Msg_Parse ("architecture identifier is missing"); + else + Expect (Tok_Of); + Scan.Scan; + Set_Entity (Res, Parse_Name (False)); + Expect (Tok_Is); + end if; + + Scan.Scan; + Parse_Declarative_Part (Res); + + Expect (Tok_Begin); + Scan.Scan; + Parse_Concurrent_Statements (Res); + -- end was scanned. + Set_End_Location (Unit); + Scan.Scan; + 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; + Scan.Scan; + end if; + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + Set_Library_Unit (Unit, Res); + end Parse_Architecture; + + -- precond : next token + -- postcond: a token + -- + -- [ §5.2 ] + -- instantiation_list ::= INSTANTIATION_label { , INSTANTIATION_label } + -- | OTHERS + -- | ALL + function Parse_Instantiation_List return Iir_List + is + Res : Iir_List; + begin + case Current_Token is + when Tok_All => + Scan.Scan; + return Iir_List_All; + when Tok_Others => + Scan.Scan; + return Iir_List_Others; + when Tok_Identifier => + Res := Create_Iir_List; + loop + Append_Element (Res, Current_Text); + Scan.Scan; + exit when Current_Token /= Tok_Comma; + Expect (Tok_Comma); + Scan.Scan; + end loop; + return Res; + when others => + Error_Msg_Parse ("instantiation list expected"); + return Null_Iir_List; + end case; + end Parse_Instantiation_List; + + -- precond : next token + -- postcond: next token + -- + -- [ §5.2 ] + -- component_specification ::= instantiation_list : COMPONENT_name + procedure Parse_Component_Specification (Res : Iir) + is + List : Iir_List; + begin + List := Parse_Instantiation_List; + Set_Instantiation_List (Res, List); + Expect (Tok_Colon); + Scan_Expect (Tok_Identifier); + Set_Component_Name (Res, Parse_Name); + end Parse_Component_Specification; + + -- precond : next token + -- postcond: next token + -- + -- [ §5.2.1.1 ] + -- entity_aspect ::= ENTITY ENTITY_name [ ( ARCHITECTURE_identifier ) ] + -- | CONFIGURATION CONFIGURATION_name + -- | OPEN + function Parse_Entity_Aspect return Iir + is + Res : Iir; + begin + case Current_Token is + when Tok_Entity => + Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity); + Set_Location (Res); + Scan_Expect (Tok_Identifier); + Set_Entity (Res, Parse_Name (False)); + if Current_Token = Tok_Left_Paren then + Scan_Expect (Tok_Identifier); + Set_Architecture (Res, Current_Text); + Scan_Expect (Tok_Right_Paren); + Scan.Scan; + end if; + when Tok_Configuration => + Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration); + Set_Location (Res); + Scan_Expect (Tok_Identifier); + Set_Configuration (Res, Parse_Name (False)); + when Tok_Open => + Res := Create_Iir (Iir_Kind_Entity_Aspect_Open); + Set_Location (Res); + Scan.Scan; + when others => + -- FIXME: if the token is an identifier, try as if the 'entity' + -- keyword is missing. + Error_Msg_Parse + ("'entity', 'configuration' or 'open' keyword expected"); + end case; + return Res; + end Parse_Entity_Aspect; + + -- precond : next token + -- postcond: next token + -- + -- [ §5.2.1 ] + -- binding_indication ::= + -- [ USE entity_aspect ] + -- [ generic_map_aspect ] + -- [ port_map_aspect ] + function Parse_Binding_Indication return Iir_Binding_Indication + is + Res : Iir_Binding_Indication; + begin + case Current_Token is + when Tok_Use + | Tok_Generic + | Tok_Port => + null; + when others => + return Null_Iir; + end case; + Res := Create_Iir (Iir_Kind_Binding_Indication); + Set_Location (Res); + if Current_Token = Tok_Use then + Scan.Scan; + Set_Entity_Aspect (Res, Parse_Entity_Aspect); + end if; + if Current_Token = Tok_Generic then + Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); + end if; + if Current_Token = Tok_Port then + Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect); + end if; + return Res; + end Parse_Binding_Indication; + + -- precond : ':' after instantiation_list. + -- postcond: ';' + -- + -- [ §1.3.2 ] + -- component_configuration ::= + -- FOR component_specification + -- [ binding_indication ; ] + -- [ block_configuration ] + -- END FOR ; + function Parse_Component_Configuration (Loc : Location_Type; + Inst_List : Iir_List) + return Iir_Component_Configuration + is + Res : Iir_Component_Configuration; + begin + Res := Create_Iir (Iir_Kind_Component_Configuration); + Set_Location (Res, Loc); + + -- Component specification. + Set_Instantiation_List (Res, Inst_List); + Expect (Tok_Colon); + Scan_Expect (Tok_Identifier); + Set_Component_Name (Res, Parse_Name); + + case Current_Token is + when Tok_Use + | Tok_Generic + | Tok_Port => + Set_Binding_Indication (Res, Parse_Binding_Indication); + Expect (Tok_Semi_Colon); + Scan.Scan; + when others => + null; + end case; + if Current_Token = Tok_For then + Set_Block_Configuration (Res, Parse_Block_Configuration); + -- Eat ';'. + Scan.Scan; + end if; + Expect (Tok_End); + Scan_Expect (Tok_For); + Scan_Expect (Tok_Semi_Colon); + return Res; + end Parse_Component_Configuration; + + -- precond : FOR + -- postcond: ';' + -- + -- [ §1.3.1 ] + -- block_configuration ::= + -- FOR block_specification + -- { use_clause } + -- { configuration_item } + -- END FOR ; + -- + -- [ §1.3.1 ] + -- block_specification ::= + -- ARCHITECTURE_name + -- | BLOCK_STATEMENT_label + -- | GENERATE_STATEMENT_label [ ( index_specification ) ] + function Parse_Block_Configuration_Suffix (Loc : Location_Type; + Block_Spec : Iir) + return Iir + is + Res : Iir_Block_Configuration; + begin + Res := Create_Iir (Iir_Kind_Block_Configuration); + Set_Location (Res, Loc); + + Set_Block_Specification (Res, Block_Spec); + + -- Parse use clauses. + if Current_Token = Tok_Use then + declare + Last : Iir; + use Declaration_Chain_Handling; + begin + Build_Init (Last); + + while Current_Token = Tok_Use loop + Append_Subchain (Last, Res, Parse_Use_Clause); + -- Eat ';'. + Scan.Scan; + end loop; + end; + end if; + + -- Parse configuration item list + declare + use Iir_Chains.Configuration_Item_Chain_Handling; + Last : Iir; + begin + Build_Init (Last); + while Current_Token /= Tok_End loop + Append (Last, Res, Parse_Configuration_Item); + -- Eat ';'. + Scan.Scan; + end loop; + end; + Scan_Expect (Tok_For); + Scan_Expect (Tok_Semi_Colon); + return Res; + end Parse_Block_Configuration_Suffix; + + function Parse_Block_Configuration return Iir_Block_Configuration + is + Loc : Location_Type; + begin + Loc := Get_Token_Location; + Expect (Tok_For); + + -- Parse label. + Scan.Scan; + return Parse_Block_Configuration_Suffix (Loc, Parse_Name); + end Parse_Block_Configuration; + + -- precond : FOR + -- postcond: ';' + -- + -- [ §1.3.1 ] + -- configuration_item ::= block_configuration + -- | component_configuration + function Parse_Configuration_Item return Iir + is + Loc : Location_Type; + List : Iir_List; + El : Iir; + begin + Loc := Get_Token_Location; + Expect (Tok_For); + Scan.Scan; + + -- ALL and OTHERS are tokens from an instantiation list. + -- Thus, the rule is a component_configuration. + case Current_Token is + when Tok_All => + Scan.Scan; + return Parse_Component_Configuration (Loc, Iir_List_All); + when Tok_Others => + Scan.Scan; + return Parse_Component_Configuration (Loc, Iir_List_Others); + when Tok_Identifier => + El := Current_Text; + Scan.Scan; + case Current_Token is + when Tok_Colon => + -- The identifier was a label from an instantiation list. + List := Create_Iir_List; + Append_Element (List, El); + return Parse_Component_Configuration (Loc, List); + when Tok_Comma => + -- The identifier was a label from an instantiation list. + List := Create_Iir_List; + Append_Element (List, El); + loop + Scan_Expect (Tok_Identifier); + Append_Element (List, Current_Text); + Scan.Scan; + exit when Current_Token /= Tok_Comma; + end loop; + return Parse_Component_Configuration (Loc, List); + when Tok_Left_Paren => + El := Parse_Name_Suffix (El); + return Parse_Block_Configuration_Suffix (Loc, El); + when Tok_Use | Tok_For | Tok_End => + -- Possibilities for a block_configuration. + -- FIXME: should use 'when others' ? + return Parse_Block_Configuration_Suffix (Loc, El); + when others => + Error_Msg_Parse + ("block_configuration or component_configuration " + & "expected"); + raise Parse_Error; + end case; + when others => + Error_Msg_Parse ("configuration item expected"); + raise Parse_Error; + end case; + end Parse_Configuration_Item; + + -- precond : next token + -- postcond: next token + -- + -- [§ 1.3] + -- configuration_declarative_part ::= { configuration_declarative_item } + -- + -- [§ 1.3] + -- configuration_declarative_item ::= use_clause + -- | attribute_specification + -- | group_declaration + -- FIXME: attribute_specification, group_declaration + procedure Parse_Configuration_Declarative_Part (Parent : Iir) + is + use Declaration_Chain_Handling; + Last : Iir; + El : Iir; + begin + Build_Init (Last); + loop + case Current_Token is + when Tok_Invalid => + raise Internal_Error; + when Tok_Use => + Append_Subchain (Last, Parent, Parse_Use_Clause); + when Tok_Attribute => + El := Parse_Attribute; + if El /= Null_Iir then + if Get_Kind (El) /= Iir_Kind_Attribute_Specification then + Error_Msg_Parse + ("attribute declaration not allowed here"); + end if; + Append (Last, Parent, El); + end if; + when Tok_Group => + El := Parse_Group; + if El /= Null_Iir then + if Get_Kind (El) /= Iir_Kind_Group_Declaration then + Error_Msg_Parse + ("group template declaration not allowed here"); + end if; + Append (Last, Parent, El); + end if; + when others => + exit; + end case; + Scan.Scan; + end loop; + end Parse_Configuration_Declarative_Part; + + -- precond : CONFIGURATION + -- postcond: ';' + -- + -- [ §1.3 ] + -- configuration_declaration ::= + -- CONFIGURATION identifier OF ENTITY_name IS + -- configuration_declarative_part + -- block_configuration + -- END [ CONFIGURATION ] [ CONFIGURATION_simple_name ] ; + -- + -- [ §1.3 ] + -- configuration_declarative_part ::= { configuration_declarative_item } + procedure Parse_Configuration_Declaration (Unit : Iir_Design_Unit) + is + Res : Iir_Configuration_Declaration; + begin + if Current_Token /= Tok_Configuration then + raise Program_Error; + end if; + Res := Create_Iir (Iir_Kind_Configuration_Declaration); + + -- Get identifier. + Scan_Expect (Tok_Identifier); + Set_Identifier (Res, Current_Identifier); + Set_Location (Res); + Scan_Expect (Tok_Of); + Scan.Scan; + Set_Entity (Res, Parse_Name (False)); + Expect (Tok_Is); + + Scan.Scan; + Parse_Configuration_Declarative_Part (Res); + + Set_Block_Configuration (Res, Parse_Block_Configuration); + + Scan_Expect (Tok_End); + Set_End_Location (Unit); + -- end was scanned. + Scan.Scan; + if Current_Token = Tok_Configuration then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse + ("'configuration' keyword not allowed here by vhdl 87"); + end if; + Scan.Scan; + end if; + + -- LRM93 1.3 + -- If a simple name appears at the end of a configuration declaration, it + -- must repeat the identifier of the configuration declaration. + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + Set_Library_Unit (Unit, Res); + end Parse_Configuration_Declaration; + + -- precond : identifier + -- postcond: ';' + -- + -- [ §2.5 ] + -- package_declaration ::= + -- PACKAGE identifier IS + -- package_declarative_part + -- END [ PACKAGE ] [ PACKAGE_simple_name ] ; + procedure Parse_Package_Declaration (Unit : Iir_Design_Unit) + is + Res: Iir_Package_Declaration; + begin + Res := Create_Iir (Iir_Kind_Package_Declaration); + Set_Location (Res); + + -- Get identifier. + Expect (Tok_Identifier); + Set_Identifier (Res, Current_Identifier); + Scan_Expect (Tok_Is); + Scan.Scan; + + Parse_Declarative_Part (Res); + + Expect (Tok_End); + Set_End_Location (Unit); + Scan.Scan; + if Current_Token = Tok_Package then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'package' keyword not allowed here by vhdl 87"); + end if; + Scan.Scan; + end if; + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + Set_Library_Unit (Unit, Res); + end Parse_Package_Declaration; + + -- precond : BODY + -- postcond: ';' + -- + -- [ §2.6 ] + -- package_body ::= + -- PACKAGE BODY PACKAGE_simple_name IS + -- package_body_declarative_part + -- END [ PACKAGE BODY ] [ PACKAGE_simple_name ] ; + procedure Parse_Package_Body (Unit : Iir_Design_Unit) + is + Res: Iir; + begin + Res := Create_Iir (Iir_Kind_Package_Body); + Set_Location (Res); + + -- Get identifier. + Expect (Tok_Identifier); + Set_Identifier (Res, Current_Identifier); + Scan_Expect (Tok_Is); + Scan.Scan; + + Parse_Declarative_Part (Res); + + Expect (Tok_End); + Set_End_Location (Unit); + Scan.Scan; + if Current_Token = Tok_Package then + if Flags.Vhdl_Std = Vhdl_87 then + Error_Msg_Parse ("'package' keyword not allowed here by vhdl 87"); + end if; + Scan_Expect (Tok_Body); + Scan.Scan; + end if; + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + Set_Library_Unit (Unit, Res); + end Parse_Package_Body; + + -- Parse a design_unit. + -- The lexical scanner must have been initialized, but without a + -- current_token. + -- + -- [ §11.1 ] + -- design_unit ::= context_clause library_unit + -- + -- [ §11.3 ] + -- context_clause ::= { context_item } + -- + -- [ §11.3 ] + -- context_item ::= library_clause | use_clause + function Parse_Design_Unit return Iir_Design_Unit + is + Res: Iir_Design_Unit; + Unit: Iir; + begin + -- Internal check: there must be no current_token. + if Current_Token /= Tok_Invalid then + raise Internal_Error; + end if; + Scan.Scan; + if Current_Token = Tok_Eof then + return Null_Iir; + end if; + + -- Create the design unit node. + Res := Create_Iir (Iir_Kind_Design_Unit); + Set_Location (Res); + Set_Date_State (Res, Date_Extern); + + -- Parse context clauses + declare + use Context_Items_Chain_Handling; + Last : Iir; + Els : Iir; + begin + Build_Init (Last); + + loop + case Current_Token is + when Tok_Library => + Els := Parse_Library_Clause; + when Tok_Use => + Els := Parse_Use_Clause; + Scan.Scan; + when Tok_With => + -- Be Ada friendly. + Error_Msg_Parse ("'with' not allowed in context clause " + & "(try 'use' or 'library')"); + Els := Parse_Use_Clause; + Scan.Scan; + when others => + exit; + end case; + Append_Subchain (Last, Res, Els); + end loop; + end; + + -- Parse library unit + case Current_Token is + when Tok_Entity => + Parse_Entity_Declaration (Res); + when Tok_Architecture => + Parse_Architecture (Res); + when Tok_Package => + Scan.Scan; + if Current_Token = Tok_Body then + Scan.Scan; + Parse_Package_Body (Res); + else + Parse_Package_Declaration (Res); + end if; + when Tok_Configuration => + Parse_Configuration_Declaration (Res); + when others => + Error_Msg_Parse ("entity, architecture, package or configuration " + & "keyword expected"); + return Null_Iir; + end case; + Unit := Get_Library_Unit (Res); + Set_Design_Unit (Unit, Res); + Set_Identifier (Res, Get_Identifier (Unit)); + Set_Date (Res, Date_Parsed); + Invalidate_Current_Token; + return Res; + exception + when Expect_Error => + raise Compilation_Error; + end Parse_Design_Unit; + + -- [ §11.1 ] + -- design_file ::= design_unit { design_unit } + function Parse_Design_File return Iir_Design_File + is + Res : Iir_Design_File; + Design, Last_Design : Iir_Design_Unit; + begin + Res := Create_Iir (Iir_Kind_Design_File); + Set_Location (Res); + + Last_Design := Null_Iir; + loop + Design := Parse.Parse_Design_Unit; + exit when Design = Null_Iir; + Set_Design_File (Design, Res); + if Last_Design = Null_Iir then + Set_First_Design_Unit (Res, Design); + else + Set_Chain (Last_Design, Design); + end if; + Last_Design := Design; + Set_Last_Design_Unit (Res, Last_Design); + end loop; + if Last_Design = Null_Iir then + Error_Msg_Parse ("design file is empty (no design unit found)"); + end if; + return Res; + exception + when Parse_Error => + return Null_Iir; + end Parse_Design_File; +end Parse; |