-- 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 GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils;
with Vhdl.Tokens; use Vhdl.Tokens;
with Vhdl.Scanner; use Vhdl.Scanner;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
with Vhdl.Errors; use Vhdl.Errors;
with Std_Names; use Std_Names;
with Flags; use Flags;
with Vhdl.Parse_Psl;
with Str_Table;
with Vhdl.Xrefs;
with Vhdl.Elocations; use Vhdl.Elocations;
with PSL.Types; use PSL.Types;
-- 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 Vhdl.Parse is
-- current_token must be valid.
-- Leaves a token.
function Parse_Primary return Iir_Expression;
function Parse_Use_Clause return Iir_Use_Clause;
function Parse_Association_List return Iir;
function Parse_Association_List_In_Parenthesis 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_Subprogram_Declaration return Iir;
function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir;
function Parse_Subnature_Indication return Iir;
function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : 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; Package_Parent : Iir);
function Parse_Tolerance_Aspect_Opt return Iir;
function Parse_Package (Parent : Iir) return Iir;
function Parse_Simultaneous_If_Statement (Label : Name_Id;
Label_Loc : Location_Type;
If_Loc : Location_Type;
First_Cond : Iir) return Iir;
function Parse_Simultaneous_Case_Statement
(Label : Name_Id; Loc : Location_Type; Expr : Iir) return Iir;
-- Maximum number of nested parenthesis, before generating an error.
Max_Parenthesis_Depth : constant Natural := 1000;
-- Current number of open parenthesis (in expressions).
Parenthesis_Depth : Natural := 0;
-- Copy the current location into an iir.
procedure Set_Location (Node : Iir) is
begin
Set_Location (Node, Get_Token_Location);
end Set_Location;
-- Disp a message during parse
-- The location of the current token is automatically displayed before
-- the message.
procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type) is
begin
Report_Msg (Msgid_Error, Errorout.Parse, Get_Token_Coord,
Msg, (1 => Arg1));
end Error_Msg_Parse;
procedure Error_Msg_Parse (Msg: String; Args : Earg_Arr := No_Eargs) is
begin
Report_Msg (Msgid_Error, Errorout.Parse, Get_Token_Coord, Msg, Args);
end Error_Msg_Parse;
procedure Error_Msg_Parse (Loc : Location_Type;
Msg: String;
Args : Earg_Arr := No_Eargs) is
begin
Report_Msg (Msgid_Error, Errorout.Parse, +Loc, Msg, Args);
end Error_Msg_Parse;
procedure Unexpected (Where: String) is
begin
Error_Msg_Parse ("unexpected token %t in a " & Where, +Current_Token);
end Unexpected;
procedure Expect_Error (Token: Token_Type; Msg: String := "")
is
Loc : Location_Type;
begin
case Token is
when Tok_Semi_Colon
| Tok_Right_Paren
| Tok_Comma =>
Loc := Get_Prev_Location;
when others =>
Loc := Get_Token_Location;
end case;
if Msg'Length > 0 then
Report_Start_Group;
Error_Msg_Parse (Loc, Msg, Args => No_Eargs);
Error_Msg_Parse (Loc, "(found: %t)", (1 => +Current_Token));
Report_End_Group;
elsif Current_Token = Tok_Identifier then
Error_Msg_Parse (Loc, "%t is expected instead of %i",
(+Token, +Current_Identifier));
else
Error_Msg_Parse
(Loc, "%t is expected instead of %t", (+Token, +Current_Token));
end if;
end Expect_Error;
-- 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
begin
if Current_Token /= Token then
Expect_Error (Token, Msg);
end if;
end Expect;
procedure Expect_Scan (Token: Token_Type; Msg: String := "") is
begin
if Current_Token = Token then
-- Skip token.
Scan;
else
Expect_Error (Token, Msg);
end if;
end Expect_Scan;
-- Expect the identifier for node RES.
procedure Scan_Identifier (Res : Iir) is
begin
Set_Location (Res);
if Current_Token = Tok_Identifier then
Set_Identifier (Res, Current_Identifier);
-- Skip identifier.
Scan;
else
Expect (Tok_Identifier);
end if;
end Scan_Identifier;
-- 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 ("misspelling, %i expected", +Name);
else
Set_End_Has_Identifier (Decl, True);
Xrefs.Xref_End (Get_Token_Location, Decl);
end if;
end if;
-- Skip identifier.
Scan;
end Check_End_Name;
procedure Check_End_Name (Decl : Iir) is
begin
Check_End_Name (Get_Identifier (Decl), Decl);
end Check_End_Name;
-- Skip the reserved identifier after 'end'.
procedure Scan_End_Token (Tok : Token_Type; Decl : Iir) is
begin
if Current_Token /= Tok then
Error_Msg_Parse ("""end"" must be followed by %t", +Tok);
case Current_Token is
when Tok_If
| Tok_Loop
| Tok_Case
| Tok_Process =>
-- Mismatching token.
Scan;
when others =>
null;
end case;
else
Set_End_Has_Reserved_Id (Decl, True);
-- Skip tok.
Scan;
end if;
end Scan_End_Token;
-- 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
-- Skip 'end'.
Scan;
Scan_End_Token (Tok, Decl);
Check_End_Name (Decl);
end if;
end Check_End_Name;
procedure Skip_Until_Semi_Colon is
begin
loop
case Current_Token is
when Tok_Semi_Colon
| Tok_Eof =>
exit;
when others =>
Scan;
end case;
end loop;
end Skip_Until_Semi_Colon;
procedure Resync_To_End_Of_Statement is
begin
loop
case Current_Token is
when Tok_Eof
| Tok_Semi_Colon
| Tok_End =>
exit;
when Tok_If
| Tok_Else
| Tok_Case
| Tok_For
| Tok_While
| Tok_Loop
| Tok_Wait
| Tok_Assert =>
-- Sequential statement.
exit;
when Tok_Process
| Tok_Block =>
-- Concurrent statement.
exit;
when others =>
Scan;
end case;
end loop;
end Resync_To_End_Of_Statement;
procedure Resync_To_End_Of_Declaration is
begin
loop
case Current_Token is
when Tok_Eof =>
exit;
when Tok_Semi_Colon =>
Scan;
exit;
when Tok_End
| Tok_Begin =>
-- End of current block.
exit;
when Tok_Signal
| Tok_Variable
| Tok_Constant
| Tok_File
| Tok_Alias
| Tok_Type
| Tok_Subtype
| Tok_Use
| Tok_Component
| Tok_Attribute
| Tok_Group
| Tok_For
| Tok_Disconnect
| Tok_Shared
| Tok_Impure
| Tok_Pure
| Tok_Function
| Tok_Procedure
| Tok_Package =>
-- Start of a new declaration
exit;
when others =>
-- Eat.
Scan;
end case;
end loop;
end Resync_To_End_Of_Declaration;
procedure Resync_To_Next_Unit is
begin
-- Resync.
loop
case Current_Token is
when Tok_Eof =>
exit;
when Tok_Semi_Colon =>
-- Skip ';'.
Scan;
exit;
when Tok_Library
| Tok_Use
| Tok_Architecture
| Tok_Entity
| Tok_Package
| Tok_Configuration
| Tok_Context =>
-- Possible start of a new unit.
exit;
when others =>
Scan;
end case;
end loop;
end Resync_To_Next_Unit;
procedure Skip_Until_Closing_Parenthesis
is
Level : Natural;
begin
Level := 0;
-- Skip '('.
Scan;
loop
case Current_Token is
when Tok_Right_Paren =>
if Level = 0 then
-- Skip ')'.
Scan;
exit;
end if;
Level := Level - 1;
when Tok_Left_Paren =>
Level := Level + 1;
when Tok_Eof
| Tok_Semi_Colon
| Tok_End
| Tok_Then
| Tok_Else
| Tok_Loop =>
exit;
when others =>
null;
end case;
Scan;
end loop;
end Skip_Until_Closing_Parenthesis;
-- Return True if at the end of the list, False if there is another
-- interface.
function Resync_To_End_Of_Interface return Boolean
is
Nested : Natural;
begin
Nested := 0;
loop
case Current_Token is
when Tok_End
| Tok_Port
| Tok_Is
| Tok_Begin
| Tok_Eof =>
-- Certainly comes after interface list.
return True;
when Tok_Left_Paren =>
Nested := Nested + 1;
when Tok_Right_Paren =>
if Nested = 0 then
-- Skip ')'.
Scan;
return True;
end if;
Nested := Nested - 1;
when Tok_Semi_Colon =>
if Nested = 0 then
-- Skip ';'.
Scan;
return False;
end if;
when Tok_Signal
| Tok_Variable
| Tok_Constant
| Tok_File
| Tok_Function
| Tok_Procedure
| Tok_Type
| Tok_Package =>
-- Next interface ?
return False;
when Tok_Colon
| Tok_Identifier
| Tok_In
| Tok_Out
| Tok_Inout
| Tok_Buffer
| Tok_Linkage =>
-- Certainly part of an interface.
null;
when others =>
null;
end case;
-- Skip token.
Scan;
end loop;
end Resync_To_End_Of_Interface;
procedure Error_Missing_Semi_Colon (Msg : String) is
begin
Error_Msg_Parse (Get_Prev_Location, "missing "";"" at end of " & Msg);
end Error_Missing_Semi_Colon;
-- Expect and scan ';' emit an error message using MSG if not present.
procedure Scan_Semi_Colon (Msg : String) is
begin
if Current_Token /= Tok_Semi_Colon then
Error_Missing_Semi_Colon (Msg);
else
Scan;
end if;
end Scan_Semi_Colon;
procedure Scan_Semi_Colon_Declaration (Msg : String) is
begin
if Current_Token = Tok_Semi_Colon then
-- Skip ';'.
Scan;
else
Error_Missing_Semi_Colon (Msg);
Resync_To_End_Of_Declaration;
end if;
end Scan_Semi_Colon_Declaration;
procedure Scan_Semi_Colon_Unit (Msg : String) is
begin
if Current_Token = Tok_Semi_Colon then
-- Skip ';'.
Scan;
else
Error_Missing_Semi_Colon (Msg);
Resync_To_Next_Unit;
end if;
end Scan_Semi_Colon_Unit;
function Create_Error_Node (Orig : Iir := Null_Iir) return Iir
is
Res : Iir;
begin
Res := Create_Error (Orig);
if Orig = Null_Iir then
Set_Location (Res);
end if;
return Res;
end Create_Error_Node;
-- precond : next token
-- postcond: next token.
--
-- [ LRM93 4.3.2 ]
-- mode ::= IN | OUT | INOUT | BUFFER | LINKAGE
--
-- If there is no mode, DEFAULT is returned.
function Parse_Mode return Iir_Mode is
begin
case Current_Token is
when Tok_In =>
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;
return Iir_Inout_Mode;
end if;
return Iir_In_Mode;
when Tok_Out =>
Scan;
return Iir_Out_Mode;
when Tok_Inout =>
Scan;
return Iir_Inout_Mode;
when Tok_Linkage =>
Scan;
return Iir_Linkage_Mode;
when Tok_Buffer =>
Scan;
return Iir_Buffer_Mode;
when others =>
-- Cannot happen.
raise Internal_Error;
end case;
end Parse_Mode;
-- precond : next token
-- postcond: next token
--
-- [ LRM93 4.3.1.2 ]
-- signal_kind ::= REGISTER | BUS
--
-- If there is no signal_kind, then no_signal_kind is returned.
procedure Parse_Signal_Kind
(Is_Guarded : out Boolean; Signal_Kind : out Iir_Signal_Kind) is
begin
if Current_Token = Tok_Bus then
-- Eat 'bus'
Scan;
Is_Guarded := True;
Signal_Kind := Iir_Bus_Kind;
elsif Current_Token = Tok_Register then
-- Eat 'register'
Scan;
Is_Guarded := True;
Signal_Kind := Iir_Register_Kind;
else
Is_Guarded := False;
-- Avoid uninitialized variable.
Signal_Kind := Iir_Bus_Kind;
end if;
end Parse_Signal_Kind;
-- precond : TO, DOWNTO
-- 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.
--
-- [ LRM93 3.1 ]
-- range_constraint ::= RANGE range
--
-- [ LRM93 3.1 ]
-- range ::= RANGE_attribute_name
-- | simple_expression direction simple_expression
--
-- direction ::= TO | DOWNTO
function Parse_Range_Expression (Left : Iir) return Iir
is
Res : Iir;
begin
Res := Create_Iir (Iir_Kind_Range_Expression);
if Left /= Null_Iir then
Set_Left_Limit_Expr (Res, Left);
Location_Copy (Res, Left);
end if;
case Current_Token is
when Tok_To =>
Set_Direction (Res, Dir_To);
when Tok_Downto =>
Set_Direction (Res, Dir_Downto);
when others =>
raise Internal_Error;
end case;
-- Skip 'to' or 'downto'.
Scan;
Set_Right_Limit_Expr (Res, Parse_Expression (Prio_Simple));
return Res;
end Parse_Range_Expression;
-- precond: next token
-- postcond: next token
function Parse_Range return Iir
is
Left: Iir;
begin
Left := Parse_Expression (Prio_Simple);
case Current_Token is
when Tok_To
| Tok_Downto =>
return Parse_Range_Expression (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 Create_Error_Node (Left);
end case;
end Parse_Range;
-- precond: next token (after RANGE)
-- postcond: next token
function Parse_Range_Constraint return Iir is
begin
if Current_Token = Tok_Box then
Error_Msg_Parse ("range constraint required");
Scan;
return Null_Iir;
end if;
return Parse_Range;
end Parse_Range_Constraint;
-- precond: next token (after RANGE)
-- postcond: next token
function Parse_Range_Constraint_Of_Subtype_Indication
(Type_Mark : Iir;
Resolution_Indication : Iir := Null_Iir)
return Iir
is
Def : Iir;
begin
Def := Create_Iir (Iir_Kind_Subtype_Definition);
if Type_Mark /= Null_Iir then
Location_Copy (Def, Type_Mark);
Set_Subtype_Type_Mark (Def, Type_Mark);
else
Set_Location (Def);
end if;
Set_Range_Constraint (Def, Parse_Range_Constraint);
Set_Resolution_Indication (Def, Resolution_Indication);
Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt);
return Def;
end Parse_Range_Constraint_Of_Subtype_Indication;
-- precond: next token
-- postcond: next token
--
-- [ LRM93 3.2.1 ]
-- discrete_range ::= discrete_subtype_indication | range
function Parse_Discrete_Range return Iir
is
Left: Iir;
begin
Left := Parse_Expression (Prio_Simple);
case Current_Token is
when Tok_To
| Tok_Downto =>
return Parse_Range_Expression (Left);
when Tok_Range =>
return Parse_Subtype_Indication (Left);
when others =>
-- Either a /range/_attribute_name or a type_mark.
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_Id : String8_Id;
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
(+Loc, "%s is not an operator symbol", (1 => +((Str_Id, Len))));
end Bad_Operator_Symbol;
procedure Check_Vhdl93 is
begin
if Flags.Vhdl_Std = Vhdl_87 then
Error_Msg_Parse
(+Loc, "%s is not a vhdl87 operator symbol",
(1 => +((Str_Id, Len))));
end if;
end Check_Vhdl93;
Id : Name_Id;
C1, C2, C3, C4 : Character;
begin
C1 := Str_Table.Char_String8 (Str_Id, 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_Table.Char_String8 (Str_Id, 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 '?' =>
if Vhdl_Std < Vhdl_08 then
Bad_Operator_Symbol;
Id := Name_Op_Condition;
elsif C2 = '?' then
Id := Name_Op_Condition;
elsif C2 = '=' then
Id := Name_Op_Match_Equality;
elsif C2 = '<' then
Id := Name_Op_Match_Less;
elsif C2 = '>' then
Id := Name_Op_Match_Greater;
else
Bad_Operator_Symbol;
Id := Name_Op_Condition;
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_Table.Char_String8 (Str_Id, 2);
C3 := Str_Table.Char_String8 (Str_Id, 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 '?' =>
if Vhdl_Std < Vhdl_08 then
Bad_Operator_Symbol;
Id := Name_Op_Match_Less_Equal;
else
if C2 = '<' and C3 = '=' then
Id := Name_Op_Match_Less_Equal;
elsif C2 = '>' and C3 = '=' then
Id := Name_Op_Match_Greater_Equal;
elsif C2 = '/' and C3 = '=' then
Id := Name_Op_Match_Inequality;
else
Bad_Operator_Symbol;
Id := Name_Op_Match_Less_Equal;
end if;
end if;
when others =>
Id := Name_And;
Bad_Operator_Symbol;
end case;
when 4 =>
-- nand, xnor
C2 := Str_Table.Char_String8 (Str_Id, 2);
C3 := Str_Table.Char_String8 (Str_Id, 3);
C4 := Str_Table.Char_String8 (Str_Id, 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
(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) return Iir
is
Id : Name_Id;
Res : Iir;
begin
Id := Str_To_Operator_Name
(Get_String8_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;
-- [ LRM93 6.6 ]
-- attribute_name ::=
-- prefix [ signature ] ' attribute_designator [ ( expression ) ]
--
function Parse_Attribute_Name (Prefix : Iir) return Iir
is
Res : Iir;
begin
case Current_Token is
when Tok_Range | Tok_Identifier =>
null;
when Tok_Across
| Tok_Through
| Tok_Reference
| Tok_Tolerance =>
-- AMS reserved words.
null;
when Tok_Subtype =>
if Vhdl_Std < Vhdl_08 then
Error_Msg_Parse
("'subtype attribute is not allowed before vhdl08");
end if;
when others =>
return Null_Iir;
end case;
Res := Create_Iir (Iir_Kind_Attribute_Name);
Set_Identifier (Res, Current_Identifier);
Set_Location (Res);
if Get_Kind (Prefix) = Iir_Kind_Signature then
Set_Attribute_Signature (Res, Prefix);
-- Transfer the prefix from the signature to the attribute.
Set_Prefix (Res, Get_Signature_Prefix (Prefix));
Set_Signature_Prefix (Prefix, Null_Iir);
else
Set_Prefix (Res, Prefix);
end if;
return Res;
end Parse_Attribute_Name;
-- precond : next token
-- postcond: next token
--
-- [ LRM93 6.1 ]
-- name ::= simple_name
-- | operator_symbol
-- | selected_name
-- | indexed_name
-- | slice_name
-- | attribute_name
--
-- [ LRM93 6.2 ]
-- simple_name ::= identifier
--
-- [ LRM93 6.5 ]
-- slice_name ::= prefix ( discrete_range )
--
-- [ LRM93 6.3 ]
-- selected_name ::= prefix . suffix
--
-- [ LRM93 6.1 ]
-- prefix ::= name
-- | function_call
--
-- [ LRM93 6.3 ]
-- suffix ::= simple_name
-- | character_literal
-- | operator_symbol
-- | ALL
--
-- [ LRM93 3.2.1 ]
-- discrete_range ::= DISCRETE_subtype_indication | range
--
-- [ LRM93 3.1 ]
-- range ::= RANGE_attribute_name
-- | simple_expression direction simple_expression
--
-- [ LRM93 3.1 ]
-- direction ::= TO | DOWNTO
--
-- [ LRM93 6.6 ]
-- attribute_designator ::= ATTRIBUTE_simple_name
--
-- Note: in order to simplify the parsing, this function may return a
-- signature without attribute designator. Signatures may appear at 3
-- places:
-- - in attribute name
-- - in alias declaration
-- - in entity designator
function Parse_Name_Suffix (Pfx : Iir;
Allow_Indexes: Boolean := True;
Allow_Signature : Boolean := False)
return Iir
is
Res: Iir;
Prefix: Iir;
begin
Res := Pfx;
loop
Prefix := Res;
case Current_Token is
when Tok_Left_Bracket =>
if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then
Prefix := String_To_Operator_Symbol (Prefix);
end if;
-- There is a signature. They are normally followed by an
-- attribute.
Res := Parse_Signature;
Set_Signature_Prefix (Res, Prefix);
when Tok_Tick =>
-- There is an attribute.
if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then
Prefix := String_To_Operator_Symbol (Prefix);
end if;
-- Skip '''.
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;
else
Res := Parse_Attribute_Name (Prefix);
if Res = Null_Iir then
Error_Msg_Parse ("attribute identifier expected after '");
return Create_Error_Node (Prefix);
end if;
-- accept the identifier.
Scan;
end if;
when Tok_Left_Paren =>
if not Allow_Indexes then
return Res;
end if;
if Get_Kind (Prefix) = Iir_Kind_String_Literal8 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_List_In_Parenthesis);
when Tok_Dot =>
if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then
Prefix := String_To_Operator_Symbol (Prefix);
end if;
-- Skip '.'.
Scan;
case Current_Token is
when Tok_All =>
Res := Create_Iir (Iir_Kind_Selected_By_All_Name);
Set_Location (Res);
Set_Prefix (Res, Prefix);
-- Skip 'all'.
Scan;
when Tok_Identifier
| Tok_Character =>
Res := Create_Iir (Iir_Kind_Selected_Name);
Set_Location (Res);
Set_Prefix (Res, Prefix);
Set_Identifier (Res, Current_Identifier);
-- Skip identifier/character.
Scan;
when Tok_String =>
Res := Create_Iir (Iir_Kind_Selected_Name);
Set_Location (Res);
Set_Prefix (Res, Prefix);
Set_Identifier
(Res, Scan_To_Operator_Name (Get_Token_Location));
-- Skip string.
Scan;
when others =>
Error_Msg_Parse
("identifier or ""all"" is expected after '.'");
Res := Prefix;
end case;
when others =>
if not Allow_Signature
and then Get_Kind (Res) = Iir_Kind_Signature
then
-- Not as a name.
Error_Msg_Parse ("signature name not expected here");
Prefix := Get_Signature_Prefix (Res);
Set_Signature_Prefix (Res, Null_Iir);
Free_Iir (Res);
Res := Prefix;
