aboutsummaryrefslogtreecommitdiffstats
path: root/sem_names.adb
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2014-11-04 20:14:19 +0100
committerTristan Gingold <tgingold@free.fr>2014-11-04 20:14:19 +0100
commit9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch)
tree575346e529b99e26382b4a06f6ff2caa0b391ab2 /sem_names.adb
parent184a123f91e07c927292d67462561dc84f3a920d (diff)
downloadghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz
ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2
ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip
Move sources to src/ subdirectory.
Diffstat (limited to 'sem_names.adb')
-rw-r--r--sem_names.adb3788
1 files changed, 0 insertions, 3788 deletions
diff --git a/sem_names.adb b/sem_names.adb
deleted file mode 100644
index 151e81708..000000000
--- a/sem_names.adb
+++ /dev/null
@@ -1,3788 +0,0 @@
--- Semantic analysis.
--- 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 Evaluation; use Evaluation;
-with Iirs_Utils; use Iirs_Utils;
-with Libraries;
-with Errorout; use Errorout;
-with Flags; use Flags;
-with Name_Table;
-with Std_Package; use Std_Package;
-with Types; use Types;
-with Iir_Chains; use Iir_Chains;
-with Std_Names;
-with Sem;
-with Sem_Scopes; use Sem_Scopes;
-with Sem_Expr; use Sem_Expr;
-with Sem_Stmts; use Sem_Stmts;
-with Sem_Decls; use Sem_Decls;
-with Sem_Assocs; use Sem_Assocs;
-with Sem_Types;
-with Sem_Psl;
-with Xrefs; use Xrefs;
-
-package body Sem_Names is
- -- Finish the semantization of NAME using RES as named entity.
- -- This is called when the semantization is finished and an uniq
- -- interpretation has been determined (RES).
- --
- -- Error messages are emitted here.
- function Finish_Sem_Name (Name : Iir; Res : Iir) return Iir;
-
- procedure Error_Overload (Expr: Iir) is
- begin
- Error_Msg_Sem ("can't resolve overload for " & Disp_Node (Expr), Expr);
- end Error_Overload;
-
- procedure Disp_Overload_List (List : Iir_List; Loc : Iir)
- is
- El : Iir;
- begin
- Error_Msg_Sem ("possible interpretations are:", Loc);
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
- case Get_Kind (El) is
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration
- | Iir_Kind_Implicit_Function_Declaration
- | Iir_Kind_Implicit_Procedure_Declaration =>
- Error_Msg_Sem (Disp_Subprg (El), El);
- when Iir_Kind_Function_Call =>
- El := Get_Implementation (El);
- Error_Msg_Sem (Disp_Subprg (El), El);
- when others =>
- Error_Msg_Sem (Disp_Node (El), El);
- end case;
- end loop;
- end Disp_Overload_List;
-
- -- Create an overload list.
- -- must be destroyed with free_iir.
- function Get_Overload_List return Iir_Overload_List
- is
- Res : Iir;
- begin
- Res := Create_Iir (Iir_Kind_Overload_List);
- return Res;
- end Get_Overload_List;
-
- function Create_Overload_List (List : Iir_List) return Iir_Overload_List
- is
- Res : Iir_Overload_List;
- begin
- Res := Get_Overload_List;
- Set_Overload_List (Res, List);
- return Res;
- end Create_Overload_List;
-
- procedure Free_Overload_List (N : in out Iir_Overload_List)
- is
- List : Iir_List;
- begin
- List := Get_Overload_List (N);
- Destroy_Iir_List (List);
- Free_Iir (N);
- N := Null_Iir;
- end Free_Overload_List;
-
- function Simplify_Overload_List (List : Iir_List) return Iir
- is
- Res : Iir;
- L1 : Iir_List;
- begin
- case Get_Nbr_Elements (List) is
- when 0 =>
- L1 := List;
- Destroy_Iir_List (L1);
- return Null_Iir;
- when 1 =>
- L1 := List;
- Res := Get_First_Element (List);
- Destroy_Iir_List (L1);
- return Res;
- when others =>
- return Create_Overload_List (List);
- end case;
- end Simplify_Overload_List;
-
- -- Return true if AN_IIR is an overload list.
- function Is_Overload_List (An_Iir: Iir) return Boolean is
- begin
- return Get_Kind (An_Iir) = Iir_Kind_Overload_List;
- end Is_Overload_List;
-
- -- From the list LIST of function or enumeration literal, extract the
- -- list of (return) types.
- -- If there is only one type, return it.
- -- If there is no types, return NULL.
- -- Otherwise, return the list as an overload list.
- function Create_List_Of_Types (List : Iir_List)
- return Iir
- is
- Res_List : Iir_List;
- Decl : Iir;
- begin
- -- Create the list of possible return types.
- Res_List := Create_Iir_List;
- for I in Natural loop
- Decl := Get_Nth_Element (List, I);
- exit when Decl = Null_Iir;
- case Get_Kind (Decl) is
- when Iir_Kinds_Function_Declaration =>
- Add_Element (Res_List, Get_Return_Type (Decl));
- when Iir_Kind_Enumeration_Literal
- | Iir_Kind_Function_Call
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Selected_Element =>
- Add_Element (Res_List, Get_Type (Decl));
- when others =>
- Error_Kind ("create_list_of_types", Decl);
- end case;
- end loop;
- return Simplify_Overload_List (Res_List);
- end Create_List_Of_Types;
-
- procedure Add_Result (Res : in out Iir; Decl : Iir)
- is
- Nres : Iir;
- Nres_List : Iir_List;
- begin
- if Decl = Null_Iir then
- return;
- end if;
- if Res = Null_Iir then
- Res := Decl;
- elsif Is_Overload_List (Res) then
- Append_Element (Get_Overload_List (Res), Decl);
- else
- Nres_List := Create_Iir_List;
- Nres := Create_Overload_List (Nres_List);
- Append_Element (Nres_List, Res);
- Append_Element (Nres_List, Decl);
- Res := Nres;
- end if;
- end Add_Result;
-
- -- Move elements of result list LIST to result list RES.
- -- Destroy LIST if necessary.
- procedure Add_Result_List (Res : in out Iir; List : Iir);
- pragma Unreferenced (Add_Result_List);
-
- procedure Add_Result_List (Res : in out Iir; List : Iir)
- is
- El : Iir;
- List_List : Iir_List;
- Res_List : Iir_List;
- begin
- if Res = Null_Iir then
- Res := List;
- elsif List = Null_Iir then
- null;
- elsif not Is_Overload_List (List) then
- Add_Result (Res, List);
- else
- if not Is_Overload_List (Res) then
- El := Res;
- Res := Get_Overload_List;
- Append_Element (Get_Overload_List (Res), El);
- end if;
- List_List := Get_Overload_List (List);
- Res_List := Get_Overload_List (Res);
- for I in Natural loop
- El := Get_Nth_Element (List_List, I);
- exit when El = Null_Iir;
- Append_Element (Res_List, El);
- end loop;
- Free_Iir (List);
- end if;
- end Add_Result_List;
-
- -- Free interpretations of LIST except KEEP.
- procedure Sem_Name_Free_Result (List : Iir; Keep : Iir)
- is
- procedure Sem_Name_Free (El : Iir) is
- begin
- case Get_Kind (El) is
- when Iir_Kind_Function_Call
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Selected_Element =>
- Sem_Name_Free (Get_Prefix (El));
- Free_Iir (El);
- when Iir_Kind_Attribute_Name =>
- Free_Iir (El);
- when Iir_Kinds_Function_Declaration
- | Iir_Kinds_Procedure_Declaration
- | Iir_Kind_Enumeration_Literal =>
- null;
- when Iir_Kinds_Denoting_Name =>
- null;
- when others =>
- Error_Kind ("sem_name_free", El);
- end case;
- end Sem_Name_Free;
-
- El : Iir;
- List_List : Iir_List;
- begin
- if List = Null_Iir then
- return;
- elsif not Is_Overload_List (List) then
- if List /= Keep then
- Sem_Name_Free (List);
- end if;
- else
- List_List := Get_Overload_List (List);
- for I in Natural loop
- El := Get_Nth_Element (List_List, I);
- exit when El = Null_Iir;
- if El /= Keep then
- Sem_Name_Free (El);
- end if;
- end loop;
- Free_Iir (List);
- end if;
- end Sem_Name_Free_Result;
-
- procedure Free_Parenthesis_Name (Name : Iir; Res : Iir)
- is
- Chain, Next_Chain : Iir;
- begin
- pragma Assert (Get_Kind (Res) /= Iir_Kind_Function_Call);
- Chain := Get_Association_Chain (Name);
- while Chain /= Null_Iir loop
- Next_Chain := Get_Chain (Chain);
- Free_Iir (Chain);
- Chain := Next_Chain;
- end loop;
- Free_Iir (Name);
- end Free_Parenthesis_Name;
-
- -- Find all named declaration whose identifier is ID in DECL_LIST and
- -- return it.
- -- The result can be NULL (if no such declaration exist),
- -- a declaration, or an overload_list containing all declarations.
- function Find_Declarations_In_List
- (Decl: Iir; Name : Iir_Selected_Name; Keep_Alias : Boolean)
- return Iir
- is
- Res: Iir := Null_Iir;
-
- -- If indentifier of DECL is ID, then add DECL in the result.
- procedure Handle_Decl (Decl : Iir; Id : Name_Id) is
- begin
- -- Use_clauses may appear in a declaration list.
- case Get_Kind (Decl) is
- when Iir_Kind_Use_Clause
- | Iir_Kind_Anonymous_Type_Declaration =>
- return;
- when Iir_Kind_Non_Object_Alias_Declaration =>
- if Get_Identifier (Decl) = Id then
- if Keep_Alias then
- Add_Result (Res, Decl);
- else
- Add_Result (Res, Get_Named_Entity (Get_Name (Decl)));
- end if;
- end if;
- when others =>
- if Get_Identifier (Decl) = Id then
- Add_Result (Res, Decl);
- end if;
- end case;
- end Handle_Decl;
-
- procedure Iterator_Decl is new Sem_Scopes.Iterator_Decl
- (Arg_Type => Name_Id, Handle_Decl => Handle_Decl);
- --procedure Iterator_Decl_List is new Sem_Scopes.Iterator_Decl_List
- -- (Arg_Type => Name_Id, Handle_Decl => Iterator_Decl);
- procedure Iterator_Decl_Chain is new Sem_Scopes.Iterator_Decl_Chain
- (Arg_Type => Name_Id, Handle_Decl => Iterator_Decl);
-
- Id : Name_Id;
- Decl_Body : Iir;
- begin
- Id := Get_Identifier (Name);
- case Get_Kind (Decl) is
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration =>
- Iterator_Decl_Chain (Get_Interface_Declaration_Chain (Decl), Id);
- when Iir_Kind_Entity_Declaration =>
- Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id);
- Iterator_Decl_Chain (Get_Port_Chain (Decl), Id);
- when Iir_Kind_Architecture_Body =>
- null;
- when Iir_Kind_Generate_Statement =>
- null;
- when Iir_Kind_Package_Declaration =>
- null;
- when Iir_Kind_Package_Instantiation_Declaration =>
- Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id);
- when Iir_Kind_Block_Statement =>
- declare
- Header : constant Iir := Get_Block_Header (Decl);
- begin
- if Header /= Null_Iir then
- Iterator_Decl_Chain (Get_Generic_Chain (Header), Id);
- Iterator_Decl_Chain (Get_Port_Chain (Header), Id);
- end if;
- end;
- when Iir_Kind_For_Loop_Statement =>
- Handle_Decl (Get_Parameter_Specification (Decl), Id);
- when Iir_Kind_Process_Statement
- | Iir_Kind_Sensitized_Process_Statement =>
- null;
- when others =>
- Error_Kind ("find_declarations_in_list", Decl);
- end case;
-
- case Get_Kind (Decl) is
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration =>
- Decl_Body := Get_Subprogram_Body (Decl);
- Iterator_Decl_Chain
- (Get_Declaration_Chain (Decl_Body), Id);
- Iterator_Decl_Chain
- (Get_Sequential_Statement_Chain (Decl_Body), Id);
- when Iir_Kind_Architecture_Body
- | Iir_Kind_Entity_Declaration
- | Iir_Kind_Generate_Statement
- | Iir_Kind_Block_Statement =>
- Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
- Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Decl), Id);
- when Iir_Kind_Package_Declaration
- | Iir_Kind_Package_Instantiation_Declaration =>
- Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
- when Iir_Kind_Process_Statement
- | Iir_Kind_Sensitized_Process_Statement =>
- Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
- Iterator_Decl_Chain (Get_Sequential_Statement_Chain (Decl), Id);
- when Iir_Kind_For_Loop_Statement =>
- null;
- when others =>
- Error_Kind ("find_declarations_in_list", Decl);
- end case;
- --if Res = Null_Iir then
- -- Error_Msg_Sem ("""" & Name_Table.Image (Id) & """ not defined in "
- -- & Disp_Node (Decl), Name);
- --end if;
- return Res;
- end Find_Declarations_In_List;
-
- -- Create an implicit_dereference node if PREFIX is of type access.
- -- Return PREFIX otherwise.
- -- PARENT is used if an implicit dereference node is created, to copy
- -- location from.
- function Insert_Implicit_Dereference (Prefix : Iir; Parent : Iir)
- return Iir
- is
- Prefix_Type : Iir;
- Res : Iir_Implicit_Dereference;
- begin
- Prefix_Type := Get_Type (Prefix);
-
- case Get_Kind (Prefix_Type) is
- when Iir_Kind_Access_Type_Definition
- | Iir_Kind_Access_Subtype_Definition =>
- null;
- when others =>
- return Prefix;
- end case;
- Check_Read (Prefix);
- Res := Create_Iir (Iir_Kind_Implicit_Dereference);
- Location_Copy (Res, Parent);
- Set_Type (Res, Get_Designated_Type (Prefix_Type));
- Set_Prefix (Res, Prefix);
- Set_Base_Name (Res, Res);
- Set_Expr_Staticness (Res, None);
- return Res;
- end Insert_Implicit_Dereference;
-
- -- If PREFIX is a function specification that cannot be converted to a
- -- function call (because of lack of association), return FALSE.
- function Maybe_Function_Call (Prefix : Iir) return Boolean
- is
- Inter : Iir;
- begin
- if Get_Kind (Prefix) not in Iir_Kinds_Function_Declaration then
- return True;
- end if;
- Inter := Get_Interface_Declaration_Chain (Prefix);
- while Inter /= Null_Iir loop
- if Get_Default_Value (Inter) = Null_Iir then
- return False;
- end if;
- Inter := Get_Chain (Inter);
- end loop;
- return True;
- end Maybe_Function_Call;
-
- procedure Name_To_Method_Object (Call : Iir; Name : Iir)
- is
- Prefix : Iir;
- Obj : Iir;
- begin
- if Get_Kind (Name) /= Iir_Kind_Selected_Name then
- return;
- end if;
-
- Prefix := Get_Prefix (Name);
- Obj := Get_Named_Entity (Prefix);
- if Obj /= Null_Iir
- and then Kind_In (Obj, Iir_Kind_Variable_Declaration,
- Iir_Kind_Interface_Variable_Declaration)
- and then Get_Type (Obj) /= Null_Iir
- then
- if Get_Kind (Get_Type (Obj)) /= Iir_Kind_Protected_Type_Declaration
- then
- Error_Msg_Sem ("type of the prefix should be a protected type",
- Prefix);
- return;
- end if;
- Set_Method_Object (Call, Obj);
- end if;
- end Name_To_Method_Object;
-
- -- NAME is the name of the function (and not the parenthesis name)
- function Sem_As_Function_Call (Name : Iir; Spec : Iir; Assoc_Chain : Iir)
- return Iir_Function_Call
- is
- Call : Iir_Function_Call;
- begin
- -- Check.
- pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name);
-
- Call := Create_Iir (Iir_Kind_Function_Call);
- Location_Copy (Call, Name);
- if Get_Kind (Name) = Iir_Kind_Parenthesis_Name then
- Set_Prefix (Call, Get_Prefix (Name));
- else
- Set_Prefix (Call, Name);
- end if;
- Name_To_Method_Object (Call, Name);
- Set_Implementation (Call, Spec);
- Set_Parameter_Association_Chain (Call, Assoc_Chain);
- Set_Type (Call, Get_Return_Type (Spec));
- Set_Base_Name (Call, Call);
- return Call;
- end Sem_As_Function_Call;
-
- -- If SPEC is a function specification, then return a function call,
- -- else return SPEC.
- function Maybe_Insert_Function_Call (Name : Iir; Spec : Iir) return Iir
- is
- begin
- if Get_Kind (Spec) in Iir_Kinds_Function_Declaration then
- return Sem_As_Function_Call (Name, Spec, Null_Iir);
- else
- return Spec;
- end if;
- end Maybe_Insert_Function_Call;
-
- -- If PTR_TYPE is not NULL_IIR, then return an implciti dereference to
- -- PREFIX, else return PREFIX.
- function Maybe_Insert_Dereference (Prefix : Iir; Ptr_Type : Iir) return Iir
- is
- Id : Iir;
- begin
- if Ptr_Type /= Null_Iir then
- Id := Create_Iir (Iir_Kind_Implicit_Dereference);
- Location_Copy (Id, Prefix);
- Set_Type (Id, Get_Designated_Type (Ptr_Type));
- Set_Prefix (Id, Prefix);
- Set_Base_Name (Id, Id);
- return Id;
- else
- return Prefix;
- end if;
- end Maybe_Insert_Dereference;
-
- procedure Finish_Sem_Indexed_Name (Expr : Iir)
- is
- Prefix : constant Iir := Get_Prefix (Expr);
- Prefix_Type : constant Iir := Get_Type (Prefix);
- Index_List : constant Iir_List := Get_Index_List (Expr);
- Index_Subtype : Iir;
- Index : Iir;
- Expr_Staticness : Iir_Staticness;
- begin
- Expr_Staticness := Locally;
-
- -- LRM93 §6.4: there must be one such expression for each index
- -- position of the array and each expression must be of the
- -- type of the corresponding index.
- -- Loop on the indexes.
- for I in Natural loop
- Index_Subtype := Get_Index_Type (Prefix_Type, I);
- exit when Index_Subtype = Null_Iir;
- Index := Get_Nth_Element (Index_List, I);
- -- The index_subtype can be an unconstrained index type.
- Index := Check_Is_Expression (Index, Index);
- if Index /= Null_Iir then
- Index := Sem_Expression (Index, Get_Base_Type (Index_Subtype));
- end if;
- if Index /= Null_Iir then
- if Get_Expr_Staticness (Index) = Locally
- and then Get_Type_Staticness (Index_Subtype) = Locally
- then
- Index := Eval_Expr_Check (Index, Index_Subtype);
- end if;
- Replace_Nth_Element (Get_Index_List (Expr), I, Index);
- Expr_Staticness := Min (Expr_Staticness,
- Get_Expr_Staticness (Index));
- else
- Expr_Staticness := None;
- end if;
- end loop;
-
- Set_Type (Expr, Get_Element_Subtype (Prefix_Type));
-
- -- An indexed name cannot be locally static.
- Set_Expr_Staticness
- (Expr, Min (Globally, Min (Expr_Staticness,
- Get_Expr_Staticness (Prefix))));
-
- -- LRM93 §6.1:
- -- a name is said to be a static name iff:
- -- The name is an indexed name whose prefix is a static name
- -- and every expression that appears as part of the name is a
- -- static expression.
- --
- -- a name is said to be a locally static name iif:
- -- The name is an indexed name whose prefix is a locally
- -- static name and every expression that appears as part
- -- of the name is a locally static expression.
- Set_Name_Staticness (Expr, Min (Expr_Staticness,
- Get_Name_Staticness (Prefix)));
-
- Set_Base_Name (Expr, Get_Base_Name (Prefix));
- end Finish_Sem_Indexed_Name;
-
- procedure Finish_Sem_Dereference (Res : Iir)
- is
- begin
- Set_Base_Name (Res, Res);
- Check_Read (Get_Prefix (Res));
- Set_Expr_Staticness (Res, None);
- Set_Name_Staticness (Res, None);
- end Finish_Sem_Dereference;
-
- procedure Finish_Sem_Slice_Name (Name : Iir_Slice_Name)
- is
- -- The prefix of the slice
- Prefix : constant Iir := Get_Prefix (Name);
- Prefix_Type : constant Iir := Get_Type (Prefix);
- Prefix_Base_Type : Iir;
- Prefix_Bt : constant Iir := Get_Base_Type (Prefix_Type);
- Index_List: Iir_List;
- Index_Type: Iir;
- Suffix: Iir;
- Slice_Type : Iir;
- Expr_Type : Iir;
- Staticness : Iir_Staticness;
- Prefix_Rng : Iir;
- begin
- Set_Base_Name (Name, Get_Base_Name (Prefix));
-
- -- LRM93 §6.5: the prefix of an indexed name must be appropriate
- -- for an array type.
- if Get_Kind (Prefix_Bt) /= Iir_Kind_Array_Type_Definition then
- Error_Msg_Sem ("slice can only be applied to an array", Name);
- return;
- end if;
-
- -- LRM93 §6.5:
- -- The prefix of a slice must be appropriate for a
- -- one-dimensionnal array object.
- Index_List := Get_Index_Subtype_List (Prefix_Type);
- if Get_Nbr_Elements (Index_List) /= 1 then
- Error_Msg_Sem ("slice prefix must be an unidimensional array", Name);
- return;
- end if;
-
- Index_Type := Get_Index_Type (Index_List, 0);
- Prefix_Rng := Eval_Static_Range (Index_Type);
-
- -- LRM93 6.5
- -- It is an error if either the bounds of the discrete range does not
- -- belong to the index range of the prefixing array, *unless* the slice
- -- is a null slice.
- --
- -- LRM93 6.5
- -- The slice is a null slice if the discrete range is a null range.
-
- -- LRM93 §6.5:
- -- The bounds of the discrete range [...] must be of the
- -- type of the index of the array.
- Suffix := Sem_Discrete_Range_Expression
- (Get_Suffix (Name), Index_Type, False);
- if Suffix = Null_Iir then
- return;
- end if;
- Suffix := Eval_Range_If_Static (Suffix);
- Set_Suffix (Name, Suffix);
-
- -- LRM93 §6.5:
- -- It is an error if the direction of the discrete range is not
- -- the same as that of the index range of the array denoted
- -- by the prefix of the slice name.
-
- -- Check this only if the type is a constrained type.
- if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition
- and then Get_Index_Constraint_Flag (Prefix_Type)
- and then Get_Expr_Staticness (Suffix) = Locally
- and then Prefix_Rng /= Null_Iir
- and then Get_Direction (Suffix) /= Get_Direction (Prefix_Rng)
- then
- if False and then Flags.Vhdl_Std = Vhdl_87 then
- -- emit a warning for a null slice.
- Warning_Msg_Sem
- ("direction mismatch results in a null slice", Name);
- end if;
- Error_Msg_Sem ("direction of the range mismatch", Name);
- end if;
-
- -- LRM93 §7.4.1
- -- A slice is never a locally static expression.
- case Get_Kind (Suffix) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Selected_Name =>
- Suffix := Get_Type (Suffix);
- Staticness := Get_Type_Staticness (Suffix);
- when Iir_Kind_Range_Expression
- | Iir_Kind_Range_Array_Attribute
- | Iir_Kind_Reverse_Range_Array_Attribute =>
- Staticness := Get_Expr_Staticness (Suffix);
- when others =>
- Error_Kind ("finish_sem_slice_name", Suffix);
- end case;
- Set_Expr_Staticness
- (Name, Min (Min (Staticness, Get_Expr_Staticness (Prefix)), Globally));
- Set_Name_Staticness
- (Name, Min (Staticness, Get_Name_Staticness (Prefix)));
-
- -- The type of the slice is a subtype of the base type whose
- -- range contraint is the slice itself.
- if Get_Kind (Suffix) in Iir_Kinds_Discrete_Type_Definition then
- Slice_Type := Suffix;
- else
- case Get_Kind (Get_Base_Type (Index_Type)) is
- when Iir_Kind_Integer_Type_Definition =>
- Slice_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
- when Iir_Kind_Enumeration_Type_Definition =>
- Slice_Type :=
- Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
- when others =>
- Error_Kind ("sem_expr: slice_name", Get_Base_Type (Index_Type));
- end case;
- Set_Range_Constraint (Slice_Type, Suffix);
- Set_Type_Staticness (Slice_Type, Staticness);
- Set_Base_Type (Slice_Type, Get_Base_Type (Index_Type));
- Set_Location (Slice_Type, Get_Location (Suffix));
- end if;
-
- Expr_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition);
- Set_Location (Expr_Type, Get_Location (Suffix));
- Set_Index_Subtype_List (Expr_Type, Create_Iir_List);
- Prefix_Base_Type := Get_Base_Type (Prefix_Type);
- Set_Base_Type (Expr_Type, Prefix_Base_Type);
- Set_Signal_Type_Flag (Expr_Type,
- Get_Signal_Type_Flag (Prefix_Base_Type));
- Append_Element (Get_Index_Subtype_List (Expr_Type), Slice_Type);
- Set_Element_Subtype (Expr_Type, Get_Element_Subtype (Prefix_Type));
- if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then
- Set_Resolution_Indication
- (Expr_Type, Get_Resolution_Indication (Prefix_Type));
- else
- Set_Resolution_Indication (Expr_Type, Null_Iir);
- end if;
- Set_Type_Staticness
- (Expr_Type, Min (Get_Type_Staticness (Prefix_Type),
- Get_Type_Staticness (Slice_Type)));
- Set_Type (Name, Expr_Type);
- Set_Slice_Subtype (Name, Expr_Type);
- Set_Index_Constraint_Flag (Expr_Type, True);
- Set_Constraint_State (Expr_Type, Fully_Constrained);
- if Is_Signal_Object (Prefix) then
- Sem_Types.Set_Type_Has_Signal (Expr_Type);
- end if;
- end Finish_Sem_Slice_Name;
-
- -- PREFIX is the name denoting the function declaration, and its analysis
- -- is already finished.
- procedure Finish_Sem_Function_Call (Call : Iir; Prefix : Iir)
- is
- Rtype : Iir;
- begin
- Set_Prefix (Call, Prefix);
- Set_Implementation (Call, Get_Named_Entity (Prefix));
-
- -- LRM08 8.1 Names
- -- The name is a simple name or seleted name that does NOT denote a
- -- function call [...]
- --
- -- GHDL: so function calls are never static names.
- Set_Name_Staticness (Call, None);
-
- -- FIXME: modify sem_subprogram_call to avoid such a type swap.
- Rtype := Get_Type (Call);
- Set_Type (Call, Null_Iir);
- if Sem_Subprogram_Call (Call, Null_Iir) = Null_Iir then
- Set_Type (Call, Rtype);
- end if;
- end Finish_Sem_Function_Call;
-
- function Sem_Type_Mark (Name : Iir; Incomplete : Boolean := False)
- return Iir
- is
- Atype : Iir;
- Res : Iir;
- begin
- -- The name must not have been analyzed.
- pragma Assert (Get_Type (Name) = Null_Iir);
-
- -- Analyze the name (if not already done).
- if Get_Named_Entity (Name) = Null_Iir then
- Sem_Name (Name);
- end if;
- Res := Finish_Sem_Name (Name);
-
- if Get_Kind (Res) in Iir_Kinds_Denoting_Name then
- -- Common correct case.
- Atype := Get_Named_Entity (Res);
- if Get_Kind (Atype) = Iir_Kind_Type_Declaration then
- Atype := Get_Type_Definition (Atype);
- elsif Get_Kind (Atype) = Iir_Kind_Subtype_Declaration then
- Atype := Get_Type (Atype);
- else
- Error_Msg_Sem
- ("a type mark must denote a type or a subtype", Name);
- Atype := Create_Error_Type (Atype);
- Set_Named_Entity (Res, Atype);
- end if;
- else
- if Get_Kind (Res) /= Iir_Kind_Error then
- Error_Msg_Sem
- ("a type mark must be a simple or expanded name", Name);
- end if;
- Res := Name;
- Atype := Create_Error_Type (Name);
- Set_Named_Entity (Res, Atype);
- end if;
-
- if not Incomplete then
- if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then
- Error_Msg_Sem
- ("invalid use of an incomplete type definition", Name);
- Atype := Create_Error_Type (Name);
- Set_Named_Entity (Res, Atype);
- end if;
- end if;
-
- Set_Type (Res, Atype);
-
- return Res;
- end Sem_Type_Mark;
-
- procedure Finish_Sem_Array_Attribute
- (Attr_Name : Iir; Attr : Iir; Param : Iir)
- is
- Parameter : Iir;
- Prefix_Type : Iir;
- Index_Type : Iir;
- Prefix : Iir;
- Prefix_Name : Iir;
- Staticness : Iir_Staticness;
- begin
- -- LRM93 14.1
- -- Parameter: A locally static expression of type universal_integer, the
- -- value of which must not exceed the dimensionality of A. If omitted,
- -- it defaults to 1.
- if Param = Null_Iir then
- Parameter := Universal_Integer_One;
- else
- Parameter := Sem_Expression
- (Param, Universal_Integer_Type_Definition);
- if Parameter = Null_Iir then
- Parameter := Universal_Integer_One;
- else
- if Get_Expr_Staticness (Parameter) /= Locally then
- Error_Msg_Sem ("parameter must be locally static", Parameter);
- Parameter := Universal_Integer_One;
- end if;
- end if;
- end if;
-
- Prefix_Name := Get_Prefix (Attr_Name);
- if Is_Type_Name (Prefix_Name) /= Null_Iir then
- Prefix := Sem_Type_Mark (Prefix_Name);
- else
- Prefix := Finish_Sem_Name (Prefix_Name, Get_Prefix (Attr));
- end if;
- Set_Prefix (Attr, Prefix);
-
- Prefix_Type := Get_Type (Prefix);
- if Is_Error (Prefix_Type) then
- return;
- end if;
-
- declare
- Dim : Iir_Int64;
- Indexes_List : constant Iir_List :=
- Get_Index_Subtype_List (Prefix_Type);
- begin
- Dim := Get_Value (Parameter);
- if Dim < 1 or else Dim > Iir_Int64 (Get_Nbr_Elements (Indexes_List))
- then
- Error_Msg_Sem ("parameter value out of bound", Attr);
- Parameter := Universal_Integer_One;
- Dim := 1;
- end if;
- Index_Type := Get_Index_Type (Indexes_List, Natural (Dim - 1));
- end;
-
- case Get_Kind (Attr) is
- when Iir_Kind_Left_Array_Attribute
- | Iir_Kind_Right_Array_Attribute
- | Iir_Kind_High_Array_Attribute
- | Iir_Kind_Low_Array_Attribute =>
- Set_Type (Attr, Index_Type);
- when Iir_Kind_Range_Array_Attribute
- | Iir_Kind_Reverse_Range_Array_Attribute =>
- Set_Type (Attr, Index_Type);
- when Iir_Kind_Length_Array_Attribute =>
- Set_Type (Attr, Convertible_Integer_Type_Definition);
- when Iir_Kind_Ascending_Array_Attribute =>
- Set_Type (Attr, Boolean_Type_Definition);
- when others =>
- raise Internal_Error;
- end case;
-
- pragma Assert (Get_Parameter (Attr) = Null_Iir);
-
- Set_Parameter (Attr, Parameter);
-
- -- If the corresponding type is known, save it so that it is not
- -- necessary to extract it from the object.
- if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition
- and then Get_Constraint_State (Prefix_Type) = Fully_Constrained
- then
- Set_Index_Subtype (Attr, Index_Type);
- end if;
-
- -- LRM 7.4.1
- -- A locally static range is either [...], or a range of the first form
- -- whose prefix denotes either a locally static subtype or an object
- -- that is of a locally static subtype.
-
- -- LRM 7.4.2
- -- A globally static range is either [...], or a range of the first form
- -- whose prefix denotes either a globally static subtype or an object
- -- that is of a globally static subtype.
- --
- -- A globally static subtype is either a globally static scalar subtype,
- -- a globally static array subtype, [...]
- --
- -- A globally static array subtype is a constrained array subtype
- -- formed by imposing on an unconstrained array type a globally static
- -- index constraint.
- Staticness := Get_Type_Staticness (Prefix_Type);
- if Flags.Vhdl_Std = Vhdl_93c
- and then Get_Kind (Prefix) not in Iir_Kinds_Type_Declaration
- then
- -- For 93c:
- -- if the prefix is a static expression, the staticness of the
- -- expression may be higher than the staticness of the type
- -- (eg: generic whose type is an unconstrained array).
- -- Also consider expression staticness.
- Staticness := Iir_Staticness'Max (Staticness,
- Get_Expr_Staticness (Prefix));
- end if;
- Set_Expr_Staticness (Attr, Staticness);
- end Finish_Sem_Array_Attribute;
-
- procedure Finish_Sem_Scalar_Type_Attribute
- (Attr_Name : Iir; Attr : Iir; Param : Iir)
- is
- Prefix : Iir;
- Prefix_Type : Iir;
- Prefix_Bt : Iir;
- Parameter : Iir;
- Param_Type : Iir;
- begin
- if Param = Null_Iir then
- Error_Msg_Sem (Disp_Node (Attr) & " requires a parameter", Attr);
- return;
- end if;
-
- Prefix := Get_Prefix (Attr);
- if Get_Kind (Prefix) = Iir_Kind_Attribute_Name then
- Prefix := Finish_Sem_Name (Prefix);
- Set_Prefix (Attr, Prefix);
- pragma Assert (Get_Kind (Prefix) = Iir_Kind_Base_Attribute);
- else
- Prefix := Sem_Type_Mark (Prefix);
- end if;
- Set_Prefix (Attr, Prefix);
- Free_Iir (Attr_Name);
- Prefix_Type := Get_Type (Prefix);
- Prefix_Bt := Get_Base_Type (Prefix_Type);
-
- case Get_Kind (Attr) is
- when Iir_Kind_Pos_Attribute =>
- -- LRM93 14.1
- -- Parameter: An expression whose type is the base type of T.
- Parameter := Sem_Expression (Param, Prefix_Bt);
- when Iir_Kind_Val_Attribute =>
- -- LRM93 14.1
- -- Parameter: An expression of any integer type.
- Param_Type := Get_Type (Param);
- if Is_Overload_List (Param_Type) then
- Parameter := Sem_Expression
- (Param, Universal_Integer_Type_Definition);
- else
- if Get_Kind (Get_Base_Type (Param_Type))
- /= Iir_Kind_Integer_Type_Definition
- then
- Error_Msg_Sem ("parameter must be an integer", Attr);
- return;
- end if;
- Parameter := Param;
- end if;
- when Iir_Kind_Succ_Attribute
- | Iir_Kind_Pred_Attribute
- | Iir_Kind_Leftof_Attribute
- | Iir_Kind_Rightof_Attribute =>
- -- LRM93 14.1
- -- Parameter: An expression whose type is the base type of T.
- Parameter := Sem_Expression (Param, Prefix_Bt);
- when Iir_Kind_Image_Attribute =>
- -- LRM93 14.1
- -- Parameter: An expression whose type is the base type of T.
- Parameter := Sem_Expression (Param, Prefix_Bt);
- when Iir_Kind_Value_Attribute =>
- -- Parameter: An expression of type string.
- Parameter := Sem_Expression (Param, String_Type_Definition);
- when others =>
- raise Internal_Error;
- end case;
- if Get_Parameter (Attr) /= Null_Iir then
- raise Internal_Error;
- end if;
- if Parameter = Null_Iir then
- Set_Parameter (Attr, Param);
- Set_Expr_Staticness (Attr, None);
- return;
- end if;
- Set_Parameter (Attr, Parameter);
- Set_Expr_Staticness (Attr, Min (Get_Type_Staticness (Prefix_Type),
- Get_Expr_Staticness (Parameter)));
- Set_Name_Staticness (Attr, Get_Expr_Staticness (Attr));
- end Finish_Sem_Scalar_Type_Attribute;
-
- procedure Finish_Sem_Signal_Attribute
- (Attr_Name : Iir; Attr : Iir; Parameter : Iir)
- is
- Param : Iir;
- Prefix : Iir;
- Prefix_Name : Iir;
- begin
- Prefix_Name := Get_Prefix (Attr_Name);
- Prefix := Finish_Sem_Name (Prefix_Name, Get_Prefix (Attr));
- Set_Prefix (Attr, Prefix);
- Free_Iir (Attr_Name);
-
- if Parameter = Null_Iir then
- return;
- end if;
- if Get_Kind (Attr) = Iir_Kind_Transaction_Attribute then
- Error_Msg_Sem ("'transaction does not allow a parameter", Attr);
- else
- Param := Sem_Expression (Parameter, Time_Subtype_Definition);
- if Param /= Null_Iir then
- -- LRM93 14.1
- -- Parameter: A static expression of type TIME [that evaluate
- -- to a nonnegative value.]
- if Get_Expr_Staticness (Param) = None then
- Error_Msg_Sem
- ("parameter of signal attribute must be static", Param);
- end if;
- Set_Parameter (Attr, Param);
- end if;
- end if;
- end Finish_Sem_Signal_Attribute;
-
- function Is_Type_Abstract_Numeric (Atype : Iir) return Boolean is
- begin
- case Get_Kind (Atype) is
- when Iir_Kind_Integer_Subtype_Definition
- | Iir_Kind_Integer_Type_Definition
- | Iir_Kind_Floating_Subtype_Definition
- | Iir_Kind_Floating_Type_Definition =>
- return True;
- when others =>
- return False;
- end case;
- end Is_Type_Abstract_Numeric;
-
- function Are_Types_Closely_Related (Type1, Type2 : Iir) return Boolean
- is
- Base_Type1 : constant Iir := Get_Base_Type (Type1);
- Base_Type2 : constant Iir := Get_Base_Type (Type2);
- Ant1, Ant2 : Boolean;
- Index_List1, Index_List2 : Iir_List;
- El1, El2 : Iir;
- begin
- -- LRM 7.3.5
- -- In particular, a type is closely related to itself.
- if Base_Type1 = Base_Type2 then
- return True;
- end if;
-
- -- LRM 7.3.5
- -- a) Abstract Numeric Types: Any abstract numeric type is closely
- -- related to any other abstract numeric type.
- Ant1 := Is_Type_Abstract_Numeric (Type1);
- Ant2 := Is_Type_Abstract_Numeric (Type2);
- if Ant1 and Ant2 then
- return True;
- end if;
- if Ant1 or Ant2 then
- return False;
- end if;
-
- -- LRM 7.3.5
- -- b) Array Types: Two array types are closely related if and only if
- -- The types have the same dimensionality; For each index position,
- -- the index types are either the same or are closely related; and
- -- The element types are the same.
- --
- -- No other types are closely related.
- if not (Get_Kind (Base_Type1) = Iir_Kind_Array_Type_Definition
- and then Get_Kind (Base_Type2) = Iir_Kind_Array_Type_Definition)
- then
- return False;
- end if;
- Index_List1 := Get_Index_Subtype_List (Base_Type1);
- Index_List2 := Get_Index_Subtype_List (Base_Type2);
- if Get_Nbr_Elements (Index_List1) /= Get_Nbr_Elements (Index_List2) then
- return False;
- end if;
- if Get_Base_Type (Get_Element_Subtype (Base_Type1))
- /= Get_Base_Type (Get_Element_Subtype (Base_Type2))
- then
- return False;
- end if;
- for I in Natural loop
- El1 := Get_Index_Type (Index_List1, I);
- exit when El1 = Null_Iir;
- El2 := Get_Index_Type (Index_List2, I);
- if not Are_Types_Closely_Related (El1, El2) then
- return False;
- end if;
- end loop;
- return True;
- end Are_Types_Closely_Related;
-
- function Sem_Type_Conversion (Loc : Iir; Type_Mark : Iir; Actual : Iir)
- return Iir
- is
- Conv_Type : constant Iir := Get_Type (Type_Mark);
- Conv: Iir_Type_Conversion;
- Expr: Iir;
- Staticness : Iir_Staticness;
- begin
- Conv := Create_Iir (Iir_Kind_Type_Conversion);
- Location_Copy (Conv, Loc);
- Set_Type_Mark (Conv, Type_Mark);
- Set_Type (Conv, Conv_Type);
- Set_Expression (Conv, Actual);
-
- -- Default staticness in case of error.
- Set_Expr_Staticness (Conv, None);
-
- -- Bail out if no actual (or invalid one).
- if Actual = Null_Iir then
- return Conv;
- end if;
-
- -- LRM93 7.3.5
- -- Furthermore, the operand of a type conversion is not allowed to be
- -- the literal null, an allocator, an aggregate, or a string literal.
- case Get_Kind (Actual) is
- when Iir_Kind_Null_Literal
- | Iir_Kind_Aggregate
- | Iir_Kind_String_Literal
- | Iir_Kind_Bit_String_Literal =>
- Error_Msg_Sem
- (Disp_Node (Actual) & " cannot be a type conversion operand",
- Actual);
- return Conv;
- when others =>
- -- LRM93 7.3.5
- -- The type of the operand of a type conversion must be
- -- determinable independent of the context (in particular,
- -- independent of the target type).
- Expr := Sem_Expression_Universal (Actual);
- if Expr = Null_Iir then
- return Conv;
- end if;
- if Get_Kind (Expr) in Iir_Kinds_Allocator then
- Error_Msg_Sem
- (Disp_Node (Expr) & " cannot be a type conversion operand",
- Expr);
- end if;
- Set_Expression (Conv, Expr);
- end case;
-
- -- LRM93 7.4.1 Locally Static Primaries.
- -- 9. a type conversion whose expression is a locally static expression.
- -- LRM93 7.4.2 Globally Static Primaries.
- -- 14. a type conversion whose expression is a globally static
- -- expression.
- if Expr /= Null_Iir then
- Staticness := Get_Expr_Staticness (Expr);
-
- -- If the type mark is not locally static, the expression cannot
- -- be locally static. This was clarified in VHDL 08, but a type
- -- mark that denotes an unconstrained array type, does not prevent
- -- the expression from being static.
- if Get_Kind (Conv_Type) not in Iir_Kinds_Array_Type_Definition
- or else Get_Constraint_State (Conv_Type) = Fully_Constrained
- then
- Staticness := Min (Staticness, Get_Type_Staticness (Conv_Type));
- end if;
-
- -- LRM87 7.4 Static Expressions
- -- A type conversion is not a locally static expression.
- if Flags.Vhdl_Std = Vhdl_87 then
- Staticness := Min (Globally, Staticness);
- end if;
- Set_Expr_Staticness (Conv, Staticness);
-
- if not Are_Types_Closely_Related (Conv_Type, Get_Type (Expr))
- then
- -- FIXME: should explain why the types are not closely related.
- Error_Msg_Sem
- ("conversion not allowed between not closely related types",
- Conv);
- -- Avoid error storm in evaluation.
- Set_Expr_Staticness (Conv, None);
- else
- Check_Read (Expr);
- end if;
- end if;
- return Conv;
- end Sem_Type_Conversion;
-
- -- OBJ is an 'impure' object (variable, signal or file) referenced at
- -- location LOC.
- -- Check the pure rules (LRM08 4 Subprograms and packages,
- -- LRM08 4.3 Subprograms bodies).
- procedure Sem_Check_Pure (Loc : Iir; Obj : Iir)
- is
- procedure Update_Impure_Depth (Subprg_Spec : Iir; Depth : Iir_Int32)
- is
- Bod : Iir;
- begin
- Bod := Get_Subprogram_Body (Subprg_Spec);
- if Bod = Null_Iir then
- return;
- end if;
- if Depth < Get_Impure_Depth (Bod) then
- Set_Impure_Depth (Bod, Depth);
- end if;
- end Update_Impure_Depth;
-
- procedure Error_Pure (Subprg : Iir; Obj : Iir)
- is
- begin
- Error_Msg_Sem
- ("reference to " & Disp_Node (Obj) & " violate pure rule for "
- & Disp_Node (Subprg), Loc);
- end Error_Pure;
-
- Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram;
- Subprg_Body : Iir;
- Parent : Iir;
- begin
- -- Apply only in subprograms.
- if Subprg = Null_Iir then
- return;
- end if;
- case Get_Kind (Subprg) is
- when Iir_Kinds_Process_Statement =>
- return;
- when Iir_Kind_Procedure_Declaration =>
- -- Exit now if already known as impure.
- if Get_Purity_State (Subprg) = Impure then
- return;
- end if;
- when Iir_Kind_Function_Declaration =>
- -- Exit now if impure.
- if Get_Pure_Flag (Subprg) = False then
- return;
- end if;
- when others =>
- Error_Kind ("sem_check_pure", Subprg);
- end case;
-
- -- Not all objects are impure.
- case Get_Kind (Obj) is
- when Iir_Kind_Object_Alias_Declaration
- | Iir_Kind_Guard_Signal_Declaration
- | Iir_Kind_Signal_Declaration
- | Iir_Kind_Variable_Declaration
- | Iir_Kind_Interface_File_Declaration =>
- null;
- when Iir_Kind_Interface_Variable_Declaration
- | Iir_Kind_Interface_Signal_Declaration =>
- -- When referenced as a formal name (FIXME: this is an
- -- approximation), the rules don't apply.
- if not Get_Is_Within_Flag (Get_Parent (Obj)) then
- return;
- end if;
- when Iir_Kind_File_Declaration =>
- -- LRM 93 2.2
- -- If a pure function is the parent of a given procedure, then
- -- that procedure must not contain a reference to an explicitly
- -- declared file object [...]
- --
- -- A pure function must not contain a reference to an explicitly
- -- declared file.
- if Flags.Vhdl_Std > Vhdl_93c then
- if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
- Error_Pure (Subprg, Obj);
- else
- Set_Purity_State (Subprg, Impure);
- Set_Impure_Depth (Get_Subprogram_Body (Subprg),
- Iir_Depth_Impure);
- end if;
- end if;
- return;
- when others =>
- return;
- end case;
-
- -- OBJ is declared in the immediate declarative part of the subprogram.
- Parent := Get_Parent (Obj);
- Subprg_Body := Get_Subprogram_Body (Subprg);
- if Parent = Subprg or else Parent = Subprg_Body then
- return;
- end if;
-
- -- Function.
- if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
- Error_Pure (Subprg, Obj);
- return;
- end if;
-
- case Get_Kind (Parent) is
- when Iir_Kind_Entity_Declaration
- | Iir_Kind_Architecture_Body
- | Iir_Kind_Package_Declaration
- | Iir_Kind_Package_Body
- | Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
- | Iir_Kinds_Process_Statement
- | Iir_Kind_Protected_Type_Body =>
- -- The procedure is impure.
- Set_Purity_State (Subprg, Impure);
- Set_Impure_Depth (Subprg_Body, Iir_Depth_Impure);
- return;
- when Iir_Kind_Function_Body
- | Iir_Kind_Procedure_Body =>
- Update_Impure_Depth
- (Subprg,
- Get_Subprogram_Depth (Get_Subprogram_Specification (Parent)));
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration =>
- Update_Impure_Depth (Subprg, Get_Subprogram_Depth (Parent));
- when others =>
- Error_Kind ("sem_check_pure(2)", Parent);
- end case;
- end Sem_Check_Pure;
-
- -- Set All_Sensitized_State to False iff OBJ is a signal declaration
- -- and the current subprogram is in a package body.
- procedure Sem_Check_All_Sensitized (Obj : Iir)
- is
- Subprg : Iir;
- begin
- -- We cares only of signals.
- if Get_Kind (Obj) /= Iir_Kind_Signal_Declaration then
- return;
- end if;
- -- We cares only of subprograms. Give up if we are in a process.
- Subprg := Sem_Stmts.Get_Current_Subprogram;
- if Subprg = Null_Iir
- or else Get_Kind (Subprg) not in Iir_Kinds_Subprogram_Declaration
- then
- return;
- end if;
- if Get_Kind (Get_Library_Unit (Sem.Get_Current_Design_Unit))
- = Iir_Kind_Package_Body
- then
- Set_All_Sensitized_State (Subprg, Invalid_Signal);
- else
- Set_All_Sensitized_State (Subprg, Read_Signal);
- end if;
- end Sem_Check_All_Sensitized;
-
- function Finish_Sem_Denoting_Name (Name : Iir; Res : Iir) return Iir
- is
- Prefix : Iir;
- begin
- case Iir_Kinds_Denoting_Name (Get_Kind (Name)) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Character_Literal
- | Iir_Kind_Operator_Symbol =>
- Xref_Ref (Name, Res);
- return Name;
- when Iir_Kind_Selected_Name =>
- Xref_Ref (Name, Res);
- Prefix := Get_Prefix (Name);
- loop
- pragma Assert (Get_Kind (Prefix) in Iir_Kinds_Denoting_Name);
- Xref_Ref (Prefix, Get_Named_Entity (Prefix));
- exit when Get_Kind (Prefix) /= Iir_Kind_Selected_Name;
- Prefix := Get_Prefix (Prefix);
- end loop;
- return Name;
- end case;
- end Finish_Sem_Denoting_Name;
-
- function Finish_Sem_Name_1 (Name : Iir; Res : Iir) return Iir
- is
- Prefix : Iir;
- Name_Prefix : Iir;
- Name_Res : Iir;
- begin
- case Get_Kind (Res) is
- when Iir_Kinds_Library_Unit_Declaration =>
- return Finish_Sem_Denoting_Name (Name, Res);
- when Iir_Kinds_Sequential_Statement
- | Iir_Kinds_Concurrent_Statement =>
- -- Label or part of an expanded name (for process, block
- -- and generate).
- return Finish_Sem_Denoting_Name (Name, Res);
- when Iir_Kinds_Object_Declaration
- | Iir_Kinds_Quantity_Declaration
- | Iir_Kind_Enumeration_Literal
- | Iir_Kind_Unit_Declaration =>
- Name_Res := Finish_Sem_Denoting_Name (Name, Res);
- Set_Base_Name (Name_Res, Res);
- Set_Name_Staticness (Name_Res, Get_Name_Staticness (Res));
- Set_Expr_Staticness (Name_Res, Get_Expr_Staticness (Res));
- Sem_Check_Pure (Name_Res, Res);
- Sem_Check_All_Sensitized (Res);
- Set_Type (Name_Res, Get_Type (Res));
- return Name_Res;
- when Iir_Kind_Attribute_Value =>
- pragma Assert (Get_Kind (Name) = Iir_Kind_Attribute_Name);
- Prefix := Finish_Sem_Name (Get_Prefix (Name));
- Set_Prefix (Name, Prefix);
- Set_Base_Name (Name, Res);
- Set_Type (Name, Get_Type (Res));
- Set_Name_Staticness (Name, Get_Name_Staticness (Res));
- Set_Expr_Staticness (Name, Get_Expr_Staticness (Res));
- return Name;
- when Iir_Kind_Type_Declaration
- | Iir_Kind_Subtype_Declaration
- | Iir_Kind_Component_Declaration
- | Iir_Kind_Group_Template_Declaration
- | Iir_Kind_Group_Declaration
- | Iir_Kind_Attribute_Declaration
- | Iir_Kind_Non_Object_Alias_Declaration
- | Iir_Kind_Library_Declaration
- | Iir_Kind_Interface_Package_Declaration =>
- Name_Res := Finish_Sem_Denoting_Name (Name, Res);
- Set_Base_Name (Name_Res, Res);
- return Name_Res;
- when Iir_Kinds_Function_Declaration =>
- Name_Res := Finish_Sem_Denoting_Name (Name, Res);
- Set_Type (Name_Res, Get_Return_Type (Res));
- return Name_Res;
- when Iir_Kinds_Procedure_Declaration =>
- return Finish_Sem_Denoting_Name (Name, Res);
- when Iir_Kind_Type_Conversion =>
- pragma Assert (Get_Kind (Name) = Iir_Kind_Parenthesis_Name);
- Set_Type_Mark (Res, Sem_Type_Mark (Get_Prefix (Name)));
- Free_Parenthesis_Name (Name, Res);
- return Res;
- when Iir_Kind_Indexed_Name
- | Iir_Kind_Selected_Element
- | Iir_Kind_Slice_Name
- | Iir_Kind_Dereference =>
- -- Fall through.
- null;
- when Iir_Kind_Implicit_Dereference =>
- -- The name may not have a prefix.
- Prefix := Finish_Sem_Name (Name, Get_Prefix (Res));
- Set_Prefix (Res, Prefix);
- Finish_Sem_Dereference (Res);
- return Res;
- when Iir_Kind_Function_Call =>
- case Get_Kind (Name) is
- when Iir_Kind_Parenthesis_Name =>
- Prefix := Finish_Sem_Name
- (Get_Prefix (Name), Get_Implementation (Res));
- Finish_Sem_Function_Call (Res, Prefix);
- Free_Iir (Name);
- when Iir_Kinds_Denoting_Name =>
- Prefix := Finish_Sem_Name (Name, Get_Implementation (Res));
- Finish_Sem_Function_Call (Res, Prefix);
- when others =>
- Error_Kind ("Finish_Sem_Name(function call)", Name);
- end case;
- return Res;
- when Iir_Kinds_Array_Attribute =>
- if Get_Parameter (Res) = Null_Iir then
- Finish_Sem_Array_Attribute (Name, Res, Null_Iir);
- end if;
- if Get_Kind (Name) = Iir_Kind_Attribute_Name then
- Free_Iir (Name);
- else
- Free_Iir (Get_Prefix (Name));
- Free_Parenthesis_Name (Name, Res);
- end if;
- return Res;
- when Iir_Kinds_Scalar_Type_Attribute
- | Iir_Kind_Image_Attribute
- | Iir_Kind_Value_Attribute =>
- if Get_Parameter (Res) = Null_Iir then
- Finish_Sem_Scalar_Type_Attribute (Name, Res, Null_Iir);
- else
- Free_Parenthesis_Name (Name, Res);
- end if;
- return Res;
- when Iir_Kinds_Signal_Value_Attribute =>
- null;
- when Iir_Kinds_Signal_Attribute =>
- if Get_Parameter (Res) = Null_Iir then
- Finish_Sem_Signal_Attribute (Name, Res, Null_Iir);
- else
- Free_Parenthesis_Name (Name, Res);
- end if;
- return Res;
- when Iir_Kinds_Type_Attribute =>
- Free_Iir (Name);
- return Res;
- when Iir_Kind_Base_Attribute =>
- return Res;
- when Iir_Kind_Simple_Name_Attribute
- | Iir_Kind_Path_Name_Attribute
- | Iir_Kind_Instance_Name_Attribute =>
- Free_Iir (Name);
- return Res;
- when Iir_Kind_Psl_Expression =>
- return Res;
- when Iir_Kind_Psl_Declaration =>
- return Name;
- when Iir_Kind_Element_Declaration
- | Iir_Kind_Error =>
- -- Certainly an error!
- return Res;
- when others =>
- Error_Kind ("finish_sem_name", Res);
- end case;
-
- -- Finish prefix.
- Prefix := Get_Prefix (Res);
- Name_Prefix := Get_Prefix (Name);
- Prefix := Finish_Sem_Name_1 (Name_Prefix, Prefix);
- Set_Prefix (Res, Prefix);
-
- case Get_Kind (Res) is
- when Iir_Kind_Indexed_Name =>
- Finish_Sem_Indexed_Name (Res);
- Free_Parenthesis_Name (Name, Res);
- when Iir_Kind_Slice_Name =>
- Finish_Sem_Slice_Name (Res);
- Free_Parenthesis_Name (Name, Res);
- when Iir_Kind_Selected_Element =>
- pragma Assert (Get_Kind (Name) = Iir_Kind_Selected_Name);
- Xref_Ref (Res, Get_Selected_Element (Res));
- Set_Name_Staticness (Res, Get_Name_Staticness (Prefix));
- Set_Expr_Staticness (Res, Get_Expr_Staticness (Prefix));
- Set_Base_Name (Res, Get_Base_Name (Prefix));
- Free_Iir (Name);
- when Iir_Kind_Dereference =>
- pragma Assert (Get_Kind (Name) = Iir_Kind_Selected_By_All_Name);
- Finish_Sem_Dereference (Res);
- Free_Iir (Name);
- when Iir_Kinds_Signal_Value_Attribute =>
- Sem_Name_Free_Result (Name, Res);
- when others =>
- Error_Kind ("finish_sem_name(2)", Res);
- end case;
- return Res;
- end Finish_Sem_Name_1;
-
- function Finish_Sem_Name (Name : Iir; Res : Iir) return Iir
- is
- Old_Res : Iir;
- begin
- if Get_Kind (Res) /= Iir_Kind_Implicit_Dereference then
- Old_Res := Get_Named_Entity (Name);
- if Old_Res /= Null_Iir and then Old_Res /= Res then
- pragma Assert (Is_Overload_List (Old_Res));
- Sem_Name_Free_Result (Old_Res, Res);
- end if;
- Set_Named_Entity (Name, Res);
- end if;
- return Finish_Sem_Name_1 (Name, Res);
- end Finish_Sem_Name;
-
- function Finish_Sem_Name (Name : Iir) return Iir is
- begin
- return Finish_Sem_Name_1 (Name, Get_Named_Entity (Name));
- end Finish_Sem_Name;
-
- -- LRM93 6.2
- -- The evaluation of a simple name has no other effect than to determine
- -- the named entity denoted by the name.
- --
- -- NAME may be a simple name, a strig literal or a character literal.
- -- GHDL: set interpretation of NAME (possibly an overload list) or
- -- error_mark for unknown names.
- -- If SOFT is TRUE, then no error message is reported in case of failure.
- procedure Sem_Simple_Name (Name : Iir; Keep_Alias : Boolean; Soft : Boolean)
- is
- Id : constant Name_Id := Get_Identifier (Name);
- Interpretation: Name_Interpretation_Type;
- Res: Iir;
- Res_List : Iir_List;
- N : Natural;
- begin
- Interpretation := Get_Interpretation (Id);
-
- if not Valid_Interpretation (Interpretation) then
- -- Unknown name.
- if not Soft then
- Error_Msg_Sem
- ("no declaration for """ & Image_Identifier (Name) & """", Name);
- end if;
- Res := Error_Mark;
- elsif not Valid_Interpretation (Get_Next_Interpretation (Interpretation))
- then
- -- One simple interpretation.
- Res := Get_Declaration (Interpretation);
-
- -- For a design unit, return the library unit
- if Get_Kind (Res) = Iir_Kind_Design_Unit then
- -- FIXME: should replace interpretation ?
- Libraries.Load_Design_Unit (Res, Name);
- Sem.Add_Dependence (Res);
- Res := Get_Library_Unit (Res);
- end if;
-
- -- Check visibility.
- if not Get_Visible_Flag (Res) then
- if Flag_Relaxed_Rules
- and then Get_Kind (Res) in Iir_Kinds_Object_Declaration
- and then Valid_Interpretation (Get_Under_Interpretation (Id))
- then
- Res := Get_Declaration (Get_Under_Interpretation (Id));
- else
- if not Soft then
- Error_Msg_Sem
- (Disp_Node (Res) & " is not visible here", Name);
- end if;
- -- Even if a named entity was found, return an error_mark.
- -- Indeed, the named entity found is certainly the one being
- -- semantized, and the semantization may be uncomplete.
- Res := Error_Mark;
- end if;
- end if;
-
- if not Keep_Alias
- and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration
- then
- Set_Alias_Declaration (Name, Res);
- Res := Get_Named_Entity (Get_Name (Res));
- end if;
- else
- -- Name is overloaded.
- Res_List := Create_Iir_List;
- N := 0;
- -- The SEEN_FLAG is used to get only one meaning which can be reached
- -- through several pathes (such as aliases).
- while Valid_Interpretation (Interpretation) loop
- if Keep_Alias then
- Res := Get_Declaration (Interpretation);
- else
- Res := Get_Non_Alias_Declaration (Interpretation);
- end if;
- if not Get_Seen_Flag (Res) then
- Set_Seen_Flag (Res, True);
- N := N + 1;
- Append_Element (Res_List, Res);
- end if;
- Interpretation := Get_Next_Interpretation (Interpretation);
- end loop;
-
- -- FIXME: there can be only one element (a function and its alias!).
-
- -- Clear SEEN_FLAG.
- for I in 0 .. N - 1 loop
- Res := Get_Nth_Element (Res_List, I);
- Set_Seen_Flag (Res, False);
- end loop;
-
- Res := Create_Overload_List (Res_List);
- end if;
-
- Set_Base_Name (Name, Res);
- Set_Named_Entity (Name, Res);
- end Sem_Simple_Name;
-
- -- LRM93 §6.3
- -- Selected Names.
- procedure Sem_Selected_Name (Name: Iir; Keep_Alias : Boolean := False)
- is
- Suffix : constant Name_Id := Get_Identifier (Name);
- Prefix_Name : constant Iir := Get_Prefix (Name);
- Prefix_Loc : constant Location_Type := Get_Location (Prefix_Name);
-
- Prefix: Iir;
- Res : Iir;
-
- -- Semantize SUB_NAME.NAME as an expanded name (ie, NAME is declared
- -- within SUB_NAME). This is possible only if the expanded name is
- -- analyzed within the context of SUB_NAME.
- procedure Sem_As_Expanded_Name (Sub_Name : Iir)
- is
- Sub_Res : Iir;
- begin
- if Get_Is_Within_Flag (Sub_Name) then
- Sub_Res := Find_Declarations_In_List (Sub_Name, Name, Keep_Alias);
- if Sub_Res /= Null_Iir then
- Add_Result (Res, Sub_Res);
- end if;
- end if;
- end Sem_As_Expanded_Name;
-
- -- LRM93 §6.3
- -- For a selected name that is used to denote a record element,
- -- the suffix must be a simple name denoting an element of a
- -- record object or value. The prefix must be appropriate for the
- -- type of this object or value.
- --
- -- Semantize SUB_NAME.NAME as a selected element.
- procedure Sem_As_Selected_Element (Sub_Name : Iir)
- is
- Base_Type : Iir;
- Ptr_Type : Iir;
- Rec_El : Iir;
- R : Iir;
- Se : Iir;
- begin
- -- FIXME: if not is_expr (sub_name) return.
- Base_Type := Get_Base_Type (Get_Type (Sub_Name));
- if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then
- Ptr_Type := Base_Type;
- Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
- else
- Ptr_Type := Null_Iir;
- end if;
-
- if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then
- return;
- end if;
-
- Rec_El := Find_Name_In_List
- (Get_Elements_Declaration_List (Base_Type), Suffix);
- if Rec_El = Null_Iir then
- return;
- end if;
-
- if not Maybe_Function_Call (Sub_Name) then
- return;
- end if;
-
- R := Maybe_Insert_Function_Call (Prefix_Name, Sub_Name);
- R := Maybe_Insert_Dereference (R, Ptr_Type);
-
- Se := Create_Iir (Iir_Kind_Selected_Element);
- Location_Copy (Se, Name);
- Set_Prefix (Se, R);
- Set_Type (Se, Get_Type (Rec_El));
- Set_Selected_Element (Se, Rec_El);
- Set_Base_Name (Se, Get_Object_Prefix (R, False));
- Add_Result (Res, Se);
- end Sem_As_Selected_Element;
-
- procedure Error_Selected_Element (Prefix_Type : Iir)
- is
- Base_Type : Iir;
- begin
- Base_Type := Get_Base_Type (Prefix_Type);
- if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then
- Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
- end if;
- if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then
- Error_Msg_Sem
- (Disp_Node (Prefix) & " does not designate a record", Name);
- else
- Error_Msg_Sem
- ("no element """ & Name_Table.Image (Suffix)
- & """ in " & Disp_Node (Base_Type), Name);
- end if;
- end Error_Selected_Element;
-
- procedure Sem_As_Protected_Item (Sub_Name : Iir)
- is
- Prot_Type : constant Iir := Get_Type (Sub_Name);
- Method : Iir;
- begin
- -- LRM98 12.3 Visibility
- -- s) For a subprogram declared immediately within a given protected
- -- type declaration: at the place of the suffix in a selected
- -- name whose prefix denotes an object of the protected type.
- Method := Get_Declaration_Chain (Prot_Type);
- while Method /= Null_Iir loop
- case Get_Kind (Method) is
- when Iir_Kind_Function_Declaration |
- Iir_Kind_Procedure_Declaration =>
- if Get_Identifier (Method) = Suffix then
- Add_Result (Res, Method);
- end if;
- when Iir_Kind_Attribute_Specification
- | Iir_Kind_Use_Clause =>
- null;
- when others =>
- Error_Kind ("sem_as_protected_item", Method);
- end case;
- Method := Get_Chain (Method);
- end loop;
- end Sem_As_Protected_Item;
-
- procedure Error_Protected_Item (Prot_Type : Iir) is
- begin
- Error_Msg_Sem
- ("no method " & Name_Table.Image (Suffix) & " in "
- & Disp_Node (Prot_Type), Name);
- end Error_Protected_Item;
- begin
- -- Analyze prefix.
- Sem_Name (Prefix_Name);
- Prefix := Get_Named_Entity (Prefix_Name);
- if Prefix = Error_Mark then
- Set_Named_Entity (Name, Prefix);
- return;
- end if;
-
- Res := Null_Iir;
-
- case Get_Kind (Prefix) is
- when Iir_Kind_Overload_List =>
- -- LRM93 6.3
- -- If, according to the visibility rules, there is at
- -- least one possible interpretation of the prefix of a
- -- selected name as the name of an enclosing entity
- -- interface, architecture, subprogram, block statement,
- -- process statement, generate statement, or loop
- -- statement, then the only interpretations considered are
- -- those of the immediately preceding paragraph.
- --
- -- In this case, the selected name is always interpreted
- -- as an expanded name. In particular, no interpretations
- -- of the prefix as a function call are considered.
- declare
- Prefix_List : Iir_List;
- El : Iir;
- begin
- -- So, first try as expanded name.
- Prefix_List := Get_Overload_List (Prefix);
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
- Sem_As_Expanded_Name (El);
- end loop;
-
- -- If no expanded name are found, try as selected element.
- if Res = Null_Iir then
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
- Sem_As_Selected_Element (El);
- end loop;
- end if;
- end;
- if Res = Null_Iir then
- Error_Msg_Sem ("no suffix """ & Name_Table.Image (Suffix)
- & """ for overloaded selected name", Name);
- end if;
- when Iir_Kind_Library_Declaration =>
- -- LRM93 6.3
- -- An expanded name denotes a primary unit constained in a design
- -- library if the prefix denotes the library and the suffix is the
- -- simple name if a primary unit whose declaration is contained
- -- in that library.
- -- An expanded name is not allowed for a secondary unit,
- -- particularly for an architecture body.
- -- GHDL: FIXME: error message more explicit
- Res := Libraries.Load_Primary_Unit (Prefix, Suffix, Name);
- if Res = Null_Iir then
- Error_Msg_Sem
- ("primary unit """ & Name_Table.Image (Suffix)
- & """ not found in " & Disp_Node (Prefix), Name);
- else
- Sem.Add_Dependence (Res);
- Res := Get_Library_Unit (Res);
- end if;
- when Iir_Kind_Process_Statement
- | Iir_Kind_Procedure_Declaration
- | Iir_Kind_Sensitized_Process_Statement
- | Iir_Kind_Architecture_Body
- | Iir_Kind_Entity_Declaration
- | Iir_Kind_Package_Declaration
- | Iir_Kind_Package_Instantiation_Declaration
- | Iir_Kind_Generate_Statement
- | Iir_Kind_Block_Statement
- | Iir_Kind_For_Loop_Statement =>
- -- LRM93 §6.3
- -- An expanded name denotes a named entity declared immediatly
- -- within a named construct if the prefix that is an entity
- -- interface, an architecture, a subprogram, a block statement,
- -- a process statement, a generate statement, or a loop
- -- statement, and the suffix is the simple name, character
- -- literal, or operator symbol of an named entity whose
- -- declaration occurs immediatly within that construct.
- if Get_Kind (Prefix) = Iir_Kind_Design_Unit then
- Libraries.Load_Design_Unit (Prefix, Name);
- Sem.Add_Dependence (Prefix);
- Prefix := Get_Library_Unit (Prefix);
- -- Modified only for xrefs, since a design_unit points to
- -- the first context clause, while a library unit points to
- -- the identifier.
- Set_Named_Entity (Get_Prefix (Name), Prefix);
- end if;
-
- Res := Find_Declarations_In_List (Prefix, Name, Keep_Alias);
-
- if Res = Null_Iir then
- Error_Msg_Sem
- ("no declaration for """ & Name_Table.Image (Suffix)
- & """ in " & Disp_Node (Prefix), Name);
- else
- -- LRM93 §6.3
- -- This form of expanded name is only allowed within the
- -- construct itself.
- if not Kind_In (Prefix,
- Iir_Kind_Package_Declaration,
- Iir_Kind_Package_Instantiation_Declaration)
- and then not Get_Is_Within_Flag (Prefix)
- then
- Error_Msg_Sem
- ("this expanded name is only allowed within the construct",
- Prefix_Loc);
- -- Hum, keep res.
- end if;
- end if;
- when Iir_Kind_Function_Declaration =>
- Sem_As_Expanded_Name (Prefix);
- if Res = Null_Iir then
- Sem_As_Selected_Element (Prefix);
- end if;
- if Res = Null_Iir then
- Error_Selected_Element (Get_Return_Type (Prefix));
- end if;
- when Iir_Kinds_Object_Declaration
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Selected_Element
- | Iir_Kind_Dereference
- | Iir_Kind_Implicit_Dereference
- | Iir_Kind_Attribute_Value
- | Iir_Kind_Function_Call =>
- if Get_Kind (Get_Type (Prefix))
- = Iir_Kind_Protected_Type_Declaration
- then
- Sem_As_Protected_Item (Prefix);
- if Res = Null_Iir then
- Error_Protected_Item (Prefix);
- end if;
- else
- Sem_As_Selected_Element (Prefix);
- if Res = Null_Iir then
- Error_Selected_Element (Get_Type (Prefix));
- end if;
- end if;
- when Iir_Kind_Type_Declaration
- | Iir_Kind_Subtype_Declaration
- | Iir_Kind_Concurrent_Procedure_Call_Statement
- | Iir_Kind_Component_Instantiation_Statement
- | Iir_Kind_Slice_Name =>
- Error_Msg_Sem
- (Disp_Node (Prefix) & " cannot be selected by name", Prefix_Loc);
-
- when others =>
- Error_Kind ("sem_selected_name(2)", Prefix);
- end case;
- if Res = Null_Iir then
- Res := Error_Mark;
- end if;
- Set_Named_Entity (Name, Res);
- end Sem_Selected_Name;
-
- -- If ASSOC_LIST has one element, which is an expression without formal,
- -- return the actual, else return NULL_IIR.
- function Get_One_Actual (Assoc_Chain : Iir) return Iir
- is
- Assoc : Iir;
- begin
- -- Only one actual ?
- if Assoc_Chain = Null_Iir or else Get_Chain (Assoc_Chain) /= Null_Iir
- then
- return Null_Iir;
- end if;
-
- -- Not 'open' association element ?
- Assoc := Assoc_Chain;
- if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then
- return Null_Iir;
- end if;
-
- -- Not an association (ie no formal) ?
- if Get_Formal (Assoc) /= Null_Iir then
- return Null_Iir;
- end if;
-
- return Get_Actual (Assoc);
- end Get_One_Actual;
-
- function Slice_Or_Index (Actual : Iir) return Iir_Kind is
- begin
- -- But it may be a slice name.
- case Get_Kind (Actual) is
- when Iir_Kind_Range_Array_Attribute
- | Iir_Kind_Reverse_Range_Array_Attribute
- | Iir_Kind_Subtype_Declaration
- | Iir_Kind_Type_Declaration
- | Iir_Kind_Range_Expression =>
- return Iir_Kind_Slice_Name;
- when others =>
- if Is_Range_Attribute_Name (Actual) then
- return Iir_Kind_Slice_Name;
- end if;
- end case;
- -- By default, this is an indexed name.
- return Iir_Kind_Indexed_Name;
- end Slice_Or_Index;
-
- -- Check whether association chain ASSOCS may be interpreted as indexes.
- function Index_Or_Not (Assocs : Iir) return Iir_Kind
- is
- El : Iir;
- begin
- El := Assocs;
- while El /= Null_Iir loop
- case Get_Kind (El) is
- when Iir_Kind_Association_Element_By_Expression =>
- if Get_Formal (El) /= Null_Iir then
- return Iir_Kind_Error;
- end if;
- when others =>
- -- Only expression are allowed.
- return Iir_Kind_Error;
- end case;
- El := Get_Chain (El);
- end loop;
- return Iir_Kind_Indexed_Name;
- end Index_Or_Not;
-
- function Sem_Index_Specification (Name : Iir_Parenthesis_Name; Itype : Iir)
- return Iir
- is
- Actual : Iir;
- Kind : Iir_Kind;
- Res : Iir;
- begin
- -- FIXME: reuse Sem_Name for the whole analysis ?
-
- Actual := Get_One_Actual (Get_Association_Chain (Name));
- if Actual = Null_Iir then
- Error_Msg_Sem ("only one index specification is allowed", Name);
- return Null_Iir;
- end if;
- case Get_Kind (Actual) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Selected_Name =>
- Sem_Name (Actual);
- Kind := Slice_Or_Index (Get_Named_Entity (Actual));
- -- FIXME: semantization to be finished.
- --Maybe_Finish_Sem_Name (Actual);
- when others =>
- Kind := Slice_Or_Index (Actual);
- end case;
-
- Res := Create_Iir (Kind);
- Location_Copy (Res, Name);
- case Kind is
- when Iir_Kind_Indexed_Name =>
- Actual := Sem_Expression (Actual, Itype);
- if Actual = Null_Iir then
- return Null_Iir;
- end if;
- Check_Read (Actual);
- if Get_Expr_Staticness (Actual) < Globally then
- Error_Msg_Sem ("index must be a static expression", Name);
- end if;
- Set_Index_List (Res, Create_Iir_List);
- Append_Element (Get_Index_List (Res), Actual);
- when Iir_Kind_Slice_Name =>
- Actual := Sem_Discrete_Range_Expression (Actual, Itype, False);
- if Actual = Null_Iir then
- return Null_Iir;
- end if;
- if Get_Expr_Staticness (Actual) < Globally then
- Error_Msg_Sem ("index must be a static expression", Name);
- end if;
- Set_Suffix (Res, Actual);
- when others =>
- raise Internal_Error;
- end case;
- Free_Parenthesis_Name (Name, Res);
- return Res;
- end Sem_Index_Specification;
-
- procedure Sem_Parenthesis_Name (Name : Iir_Parenthesis_Name)
- is
- Prefix: Iir;
- Prefix_Name : Iir;
- Res : Iir;
- Assoc_Chain : Iir;
-
- Slice_Index_Kind : Iir_Kind;
-
- -- If FINISH is TRUE, then display error message in case of error.
- function Sem_As_Indexed_Or_Slice_Name (Sub_Name : Iir; Finish : Boolean)
- return Iir
- is
- Base_Type : Iir;
- Ptr_Type : Iir;
- P : Iir;
- R : Iir;
- begin
- if Slice_Index_Kind = Iir_Kind_Error then
- if Finish then
- Error_Msg_Sem ("prefix is not a function name", Name);
- end if;
- -- No way.
- return Null_Iir;
- end if;
-
- -- Only values can be indexed or sliced.
- -- Catch errors such as slice of a type conversion.
- if not Is_Object_Name (Sub_Name)
- and then Get_Kind (Sub_Name) not in Iir_Kinds_Function_Declaration
- then
- if Finish then
- Error_Msg_Sem ("prefix is not an array value (found "
- & Disp_Node (Sub_Name) & ")", Name);
- end if;
- return Null_Iir;
- end if;
-
- -- Extract type of prefix, handle possible implicit deference.
- Base_Type := Get_Base_Type (Get_Type (Sub_Name));
- if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then
- Ptr_Type := Base_Type;
- Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
- else
- Ptr_Type := Null_Iir;
- end if;
-
- if Get_Kind (Base_Type) /= Iir_Kind_Array_Type_Definition then
- if Finish then
- Error_Msg_Sem ("type of prefix is not an array", Name);
- end if;
- return Null_Iir;
- end if;
- if Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) /=
- Get_Chain_Length (Assoc_Chain)
- then
- if Finish then
- Error_Msg_Sem
- ("number of indexes mismatches array dimension", Name);
- end if;
- return Null_Iir;
- end if;
-
- if not Maybe_Function_Call (Sub_Name) then
- if Finish then
- Error_Msg_Sem ("missing parameters for function call", Name);
- end if;
- return Null_Iir;
- end if;
-
- P := Maybe_Insert_Function_Call (Prefix_Name, Sub_Name);
- P := Maybe_Insert_Dereference (P, Ptr_Type);
-
- R := Create_Iir (Slice_Index_Kind);
- Location_Copy (R, Name);
- Set_Prefix (R, P);
- Set_Base_Name (R, Get_Object_Prefix (P));
-
- case Slice_Index_Kind is
- when Iir_Kind_Slice_Name =>
- Set_Suffix (R, Get_Actual (Assoc_Chain));
- Set_Type (R, Get_Base_Type (Get_Type (P)));
- when Iir_Kind_Indexed_Name =>
- declare
- Idx_El : Iir;
- Idx_List : Iir_List;
- begin
- Idx_List := Create_Iir_List;
- Set_Index_List (R, Idx_List);
- Idx_El := Assoc_Chain;
- while Idx_El /= Null_Iir loop
- Append_Element (Idx_List, Get_Actual (Idx_El));
- Idx_El := Get_Chain (Idx_El);
- end loop;
- end;
- Set_Type (R, Get_Element_Subtype (Base_Type));
- when others =>
- raise Internal_Error;
- end case;
-
- return R;
- end Sem_As_Indexed_Or_Slice_Name;
-
- -- Sem parenthesis name when the prefix is a function declaration.
- -- Can be either a function call (and the expression is the actual) or
- -- a slice/index of the result of a call without actual.
- procedure Sem_Parenthesis_Function (Sub_Name : Iir) is
- Used : Boolean;
- R : Iir;
- Match : Boolean;
- begin
- Used := False;
- if Get_Kind (Sub_Name) in Iir_Kinds_Function_Declaration then
- Sem_Association_Chain
- (Get_Interface_Declaration_Chain (Sub_Name),
- Assoc_Chain, False, Missing_Parameter, Name, Match);
- if Match then
- Add_Result
- (Res,
- Sem_As_Function_Call (Prefix_Name, Sub_Name, Assoc_Chain));
- Used := True;
- end if;
- end if;
- if Get_Kind (Sub_Name) not in Iir_Kinds_Procedure_Declaration then
- R := Sem_As_Indexed_Or_Slice_Name (Sub_Name, False);
- if R /= Null_Iir then
- Add_Result (Res, R);
- Used := True;
- end if;
- end if;
- if not Used then
- Sem_Name_Free_Result (Sub_Name, Null_Iir);
- end if;
- end Sem_Parenthesis_Function;
-
- procedure Error_Parenthesis_Function (Spec : Iir)
- is
- Match : Boolean;
- begin
- Error_Msg_Sem
- ("cannot match " & Disp_Node (Prefix) & " with actuals", Name);
- -- Display error message.
- Sem_Association_Chain
- (Get_Interface_Declaration_Chain (Spec),
- Assoc_Chain, True, Missing_Parameter, Name, Match);
- end Error_Parenthesis_Function;
-
- Actual : Iir;
- Actual_Expr : Iir;
- begin
- -- The prefix is a function name, a type mark or an array.
- Prefix_Name := Get_Prefix (Name);
- Sem_Name (Prefix_Name);
- Prefix := Get_Named_Entity (Prefix_Name);
- if Prefix = Error_Mark then
- Set_Named_Entity (Name, Error_Mark);
- return;
- end if;
- Res := Null_Iir;
-
- Assoc_Chain := Get_Association_Chain (Name);
- Actual := Get_One_Actual (Assoc_Chain);
-
- if Get_Kind (Prefix) = Iir_Kind_Type_Declaration
- or else Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration
- then
- -- A type conversion. The prefix is a type mark.
-
- if Actual = Null_Iir then
- -- More than one actual. Keep only the first.
- Error_Msg_Sem
- ("type conversion allows only one expression", Name);
- end if;
-
- -- This is certainly the easiest case: the prefix is not overloaded,
- -- so the result can be computed.
- Set_Named_Entity (Name, Sem_Type_Conversion (Name, Prefix, Actual));
- return;
- end if;
-
- -- Select between slice or indexed name.
- Actual_Expr := Null_Iir;
- if Actual /= Null_Iir then
- if Get_Kind (Actual) in Iir_Kinds_Name
- or else Get_Kind (Actual) = Iir_Kind_Attribute_Name
- then
- -- Maybe a discrete range name.
- Sem_Name (Actual);
- Actual_Expr := Get_Named_Entity (Actual);
- if Actual_Expr = Error_Mark then
- Set_Named_Entity (Name, Actual_Expr);
- return;
- end if;
- -- Decides between sliced or indexed name to actual.
- Slice_Index_Kind := Slice_Or_Index (Actual_Expr);
- elsif Get_Kind (Actual) = Iir_Kind_Range_Expression then
- -- This can only be a slice.
- Slice_Index_Kind := Iir_Kind_Slice_Name;
- -- Actual_Expr :=
- -- Sem_Discrete_Range_Expression (Actual, Null_Iir, False);
- -- Set_Actual (Assoc_Chain, Actual_Expr);
- else
- Slice_Index_Kind := Iir_Kind_Indexed_Name;
- end if;
- else
- -- FIXME: improve error message for multi-dim slice ?
- Slice_Index_Kind := Index_Or_Not (Assoc_Chain);
- end if;
-
- if Slice_Index_Kind /= Iir_Kind_Slice_Name then
- if Sem_Actual_Of_Association_Chain (Assoc_Chain) = False then
- Actual := Null_Iir;
- else
- Actual := Get_One_Actual (Assoc_Chain);
- end if;
- end if;
-
- case Get_Kind (Prefix) is
- when Iir_Kind_Overload_List =>
- declare
- El : Iir;
- Prefix_List : Iir_List;
- begin
- Prefix_List := Get_Overload_List (Prefix);
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
- Sem_Parenthesis_Function (El);
- end loop;
- end;
- if Res = Null_Iir then
- Error_Msg_Sem
- ("no overloaded function found matching "
- & Disp_Node (Prefix_Name), Name);
- end if;
- when Iir_Kinds_Function_Declaration =>
- Sem_Parenthesis_Function (Prefix);
- if Res = Null_Iir then
- Error_Parenthesis_Function (Prefix);
- end if;
-
- when Iir_Kinds_Object_Declaration
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Slice_Name
- | Iir_Kind_Dereference
- | Iir_Kind_Implicit_Dereference
- | Iir_Kind_Selected_Element
- | Iir_Kind_Attribute_Value
- | Iir_Kind_Function_Call =>
- Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True));
-
- when Iir_Kinds_Array_Attribute =>
- if Actual /= Null_Iir then
- Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Actual);
- Set_Named_Entity (Name, Prefix);
- else
- Error_Msg_Sem ("bad attribute parameter", Name);
- Set_Named_Entity (Name, Error_Mark);
- end if;
- return;
-
- when Iir_Kinds_Scalar_Type_Attribute
- | Iir_Kind_Image_Attribute
- | Iir_Kind_Value_Attribute =>
- if Get_Parameter (Prefix) /= Null_Iir then
- -- Attribute already has a parameter, the expression
- -- is either a slice or an index.
- Add_Result
- (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True));
- elsif Actual /= Null_Iir then
- Finish_Sem_Scalar_Type_Attribute (Prefix_Name, Prefix, Actual);
- Set_Named_Entity (Name, Prefix);
- return;
- else
- Error_Msg_Sem ("bad attribute parameter", Name);
- Set_Named_Entity (Name, Error_Mark);
- return;
- end if;
-
- when Iir_Kind_Type_Declaration
- | Iir_Kind_Subtype_Declaration =>
- Error_Msg_Sem
- ("subprogram name is a type mark (missing apostrophe)", Name);
-
- when Iir_Kind_Stable_Attribute
- | Iir_Kind_Quiet_Attribute
- | Iir_Kind_Delayed_Attribute =>
- if Actual /= Null_Iir then
- Finish_Sem_Signal_Attribute (Prefix_Name, Prefix, Actual);
- Set_Named_Entity (Name, Prefix);
- else
- Error_Msg_Sem ("bad attribute parameter", Name);
- Set_Named_Entity (Name, Error_Mark);
- end if;
- return;
-
- when Iir_Kinds_Procedure_Declaration =>
- Error_Msg_Sem ("function name is a procedure", Name);
-
- when Iir_Kinds_Process_Statement
- | Iir_Kind_Component_Declaration
- | Iir_Kind_Type_Conversion =>
- Error_Msg_Sem
- (Disp_Node (Prefix) & " cannot be indexed or sliced", Name);
- Res := Null_Iir;
-
- when Iir_Kind_Psl_Declaration =>
- Res := Sem_Psl.Sem_Psl_Name (Name);
-
- when Iir_Kinds_Library_Unit_Declaration =>
- Error_Msg_Sem ("function name is a design unit", Name);
-
- when others =>
- Error_Kind ("sem_parenthesis_name", Prefix);
- end case;
-
- if Res = Null_Iir then
- Res := Error_Mark;
- end if;
- Set_Named_Entity (Name, Res);
- end Sem_Parenthesis_Name;
-
- procedure Sem_Selected_By_All_Name (Name : Iir_Selected_By_All_Name)
- is
- Prefix : Iir;
- Prefix_Name : Iir;
- Res : Iir;
-
- procedure Sem_As_Selected_By_All_Name (Sub_Name : Iir)
- is
- Base_Type : Iir;
- R, R1 : Iir;
- begin
- -- Only accept prefix of access type.
- Base_Type := Get_Base_Type (Get_Type (Sub_Name));
- if Get_Kind (Base_Type) /= Iir_Kind_Access_Type_Definition then
- return;
- end if;
-
- if not Maybe_Function_Call (Sub_Name) then
- return;
- end if;
-
- R1 := Maybe_Insert_Function_Call (Get_Prefix (Name), Sub_Name);
-
- R := Create_Iir (Iir_Kind_Dereference);
- Location_Copy (R, Name);
- Set_Prefix (R, R1);
- -- FIXME: access subtype.
- Set_Type (R, Get_Designated_Type (Base_Type));
- Add_Result (Res, R);
- end Sem_As_Selected_By_All_Name;
- begin
- Prefix := Get_Prefix (Name);
- Sem_Name (Prefix);
- Prefix_Name := Prefix;
- Prefix := Get_Named_Entity (Prefix);
- if Prefix = Null_Iir then
- return;
- end if;
- Res := Null_Iir;
-
- case Get_Kind (Prefix) is
- when Iir_Kind_Overload_List =>
- declare
- Prefix_List : Iir_List;
- El : Iir;
- begin
- Prefix_List := Get_Overload_List (Prefix);
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
- Sem_As_Selected_By_All_Name (El);
- end loop;
- end;
- when Iir_Kinds_Object_Declaration
- | Iir_Kind_Selected_Element
- | Iir_Kind_Dereference
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Function_Call =>
- Sem_As_Selected_By_All_Name (Prefix);
- when Iir_Kinds_Function_Declaration =>
- Prefix := Sem_As_Function_Call (Name => Prefix_Name,
- Spec => Prefix,
- Assoc_Chain => Null_Iir);
- Sem_As_Selected_By_All_Name (Prefix);
- when Iir_Kind_Error =>
- Set_Named_Entity (Name, Error_Mark);
- return;
- when others =>
- Error_Kind ("sem_selected_by_all_name", Prefix);
- end case;
- if Res = Null_Iir then
- Error_Msg_Sem ("prefix is not an access", Name);
- Res := Error_Mark;
- end if;
- Set_Named_Entity (Name, Res);
- end Sem_Selected_By_All_Name;
-
- function Sem_Base_Attribute (Attr : Iir_Attribute_Name) return Iir
- is
- Prefix_Name : Iir;
- Prefix : Iir;
- Res : Iir;
- Base_Type : Iir;
- Type_Decl : Iir;
- begin
- Prefix_Name := Finish_Sem_Name (Get_Prefix (Attr));
- -- FIXME: handle error
- Prefix := Get_Named_Entity (Prefix_Name);
- case Get_Kind (Prefix) is
- when Iir_Kind_Type_Declaration =>
- Base_Type := Get_Type_Definition (Prefix);
- when Iir_Kind_Subtype_Declaration =>
- Base_Type := Get_Base_Type (Get_Type (Prefix));
- -- Get the first subtype. FIXME: ref?
- Type_Decl := Get_Type_Declarator (Base_Type);
- if Get_Kind (Type_Decl) = Iir_Kind_Anonymous_Type_Declaration then
- Base_Type := Get_Subtype_Definition (Type_Decl);
- end if;
- when others =>
- Error_Msg_Sem
- ("prefix of 'base attribute must be a type or a subtype", Attr);
- return Error_Mark;
- end case;
- Res := Create_Iir (Iir_Kind_Base_Attribute);
- Location_Copy (Res, Attr);
- Set_Prefix (Res, Prefix_Name);
- Set_Type (Res, Base_Type);
- return Res;
- end Sem_Base_Attribute;
-
- function Sem_User_Attribute (Attr : Iir_Attribute_Name) return Iir
- is
- Prefix : Iir;
- Value : Iir;
- Attr_Id : Name_Id;
- Spec : Iir_Attribute_Specification;
- begin
- Prefix := Get_Named_Entity (Get_Prefix (Attr));
-
- -- LRM93 6.6
- -- If the attribute name denotes an alias, then the attribute name
- -- denotes an attribute of the aliased name and not the alias itself,
- -- except when the attribute designator denotes any of the predefined
- -- attributes 'simple_name, 'path_name, or 'instance_name.
- if Get_Kind (Prefix) = Iir_Kind_Object_Alias_Declaration then
- -- GHDL: according to 4.3.3, the name cannot be an alias.
- Prefix := Strip_Denoting_Name (Get_Name (Prefix));
- end if;
-
- -- LRM93 6.6
- -- If the attribute designator denotes a user-defined attribute, the
- -- prefix cannot denote a subelement or a slice of an object.
- case Get_Kind (Prefix) is
- when Iir_Kind_Selected_By_All_Name
- | Iir_Kind_Selected_Name
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Slice_Name =>
- Error_Msg_Sem ("prefix of user defined attribute cannot be an "
- & "object subelement", Attr);
- return Error_Mark;
- when Iir_Kind_Dereference =>
- Error_Msg_Sem ("prefix of user defined attribute cannot be an "
- & "anonymous object", Attr);
- return Error_Mark;
- when Iir_Kinds_Object_Declaration
- | Iir_Kind_Type_Declaration
- | Iir_Kind_Subtype_Declaration
- | Iir_Kinds_Function_Declaration
- | Iir_Kinds_Procedure_Declaration
- | Iir_Kind_Enumeration_Literal
- | Iir_Kind_Unit_Declaration
- | Iir_Kinds_Sequential_Statement
- | Iir_Kinds_Concurrent_Statement
- | Iir_Kind_Component_Declaration
- | Iir_Kinds_Library_Unit_Declaration =>
- -- FIXME: to complete
- null;
- when others =>
- Error_Kind ("sem_user_attribute", Prefix);
- end case;
-
- Attr_Id := Get_Identifier (Attr);
- Value := Get_Attribute_Value_Chain (Prefix);
- while Value /= Null_Iir loop
- Spec := Get_Attribute_Specification (Value);
- exit when Get_Identifier (Get_Attribute_Designator (Spec)) = Attr_Id;
- Value := Get_Chain (Value);
- end loop;
- if Value = Null_Iir then
- Error_Msg_Sem
- (Disp_Node (Prefix) & " was not annotated with attribute '"
- & Name_Table.Image (Attr_Id) & ''', Attr);
- if Attr_Id = Std_Names.Name_First or Attr_Id = Std_Names.Name_Last
- then
- -- Nice (?) message for Ada users.
- Error_Msg_Sem
- ("(you may use 'high, 'low, 'left or 'right attribute)", Attr);
- end if;
- return Error_Mark;
- end if;
-
- Xref_Ref (Attr, Value);
-
- return Value;
- end Sem_User_Attribute;
-
- -- The prefix of scalar type attributes is a type name (or 'base), and
- -- therefore isn't overloadable. So at the end of the function, the
- -- analyze is finished.
- function Sem_Scalar_Type_Attribute (Attr : Iir_Attribute_Name)
- return Iir
- is
- use Std_Names;
- Prefix_Name : constant Iir := Get_Prefix (Attr);
- Id : constant Name_Id := Get_Identifier (Attr);
- Prefix : Iir;
- Prefix_Type : Iir;
- Res : Iir;
- begin
- Prefix := Get_Named_Entity (Prefix_Name);
-
- -- LRM93 14.1
- -- Prefix: Any discrete or physical type of subtype T.
- case Get_Kind (Prefix) is
- when Iir_Kind_Type_Declaration =>
- Prefix_Type := Get_Type_Definition (Prefix);
- when Iir_Kind_Subtype_Declaration =>
- Prefix_Type := Get_Type (Prefix);
- when Iir_Kind_Base_Attribute =>
- Prefix_Type := Get_Type (Prefix);
- when others =>
- Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id)
- & " attribute must be a type", Attr);
- return Error_Mark;
- end case;
-
- case Id is
- when Name_Image
- | Name_Value =>
- if Get_Kind (Prefix_Type) not in Iir_Kinds_Scalar_Type_Definition
- then
- Error_Msg_Sem
- ("prefix of '" & Name_Table.Image (Id)
- & " attribute must be a scalar type", Attr);
- Error_Msg_Sem
- ("found " & Disp_Node (Prefix_Type)
- & " defined at " & Disp_Location (Prefix_Type), Attr);
- return Error_Mark;
- end if;
- when others =>
- case Get_Kind (Prefix_Type) is
- when Iir_Kinds_Discrete_Type_Definition
- | Iir_Kind_Physical_Subtype_Definition
- | Iir_Kind_Physical_Type_Definition =>
- null;
- when others =>
- Error_Msg_Sem
- ("prefix of '" & Name_Table.Image (Id)
- & " attribute must be discrete or physical type", Attr);
- Error_Msg_Sem
- ("found " & Disp_Node (Prefix_Type)
- & " defined at " & Disp_Location (Prefix_Type), Attr);
- return Error_Mark;
- end case;
- end case;
-
- -- Create the resulting node.
- case Get_Identifier (Attr) is
- when Name_Pos =>
- Res := Create_Iir (Iir_Kind_Pos_Attribute);
- when Name_Val =>
- Res := Create_Iir (Iir_Kind_Val_Attribute);
- when Name_Succ =>
- Res := Create_Iir (Iir_Kind_Succ_Attribute);
- when Name_Pred =>
- Res := Create_Iir (Iir_Kind_Pred_Attribute);
- when Name_Leftof =>
- Res := Create_Iir (Iir_Kind_Leftof_Attribute);
- when Name_Rightof =>
- Res := Create_Iir (Iir_Kind_Rightof_Attribute);
- when Name_Image =>
- Res := Create_Iir (Iir_Kind_Image_Attribute);
- when Name_Value =>
- Res := Create_Iir (Iir_Kind_Value_Attribute);
- when others =>
- raise Internal_Error;
- end case;
- Location_Copy (Res, Attr);
- Set_Prefix (Res, Prefix_Name);
- Set_Base_Name (Res, Res);
-
- case Get_Identifier (Attr) is
- when Name_Pos =>
- -- LRM93 14.1
- -- Result type: universal_integer.
- Set_Type (Res, Convertible_Integer_Type_Definition);
- when Name_Val =>
- -- LRM93 14.1
- -- Result type: the base type of T
- Set_Type (Res, Get_Base_Type (Prefix_Type));
- when Name_Succ
- | Name_Pred
- | Name_Leftof
- | Name_Rightof =>
- -- LRM93 14.1
- -- Result type: the base type of T.
- Set_Type (Res, Get_Base_Type (Prefix_Type));
- when Name_Image =>
- -- LRM93 14.1
- -- Result type: type string
- Set_Type (Res, String_Type_Definition);
- when Name_Value =>
- -- LRM93 14.1
- -- Result type: the base type of T.
- Set_Type (Res, Get_Base_Type (Prefix_Type));
- when others =>
- raise Internal_Error;
- end case;
- return Res;
- end Sem_Scalar_Type_Attribute;
-
- -- Analyze attributes whose prefix is a type or a subtype and result is
- -- a value (not a function).
- function Sem_Predefined_Type_Attribute (Attr : Iir_Attribute_Name)
- return Iir
- is
- use Std_Names;
- Prefix_Name : constant Iir := Get_Prefix (Attr);
- Id : constant Name_Id := Get_Identifier (Attr);
- Res : Iir;
- Prefix : Iir;
- Prefix_Type : Iir;
- begin
- case Id is
- when Name_Left =>
- Res := Create_Iir (Iir_Kind_Left_Type_Attribute);
- when Name_Right =>
- Res := Create_Iir (Iir_Kind_Right_Type_Attribute);
- when Name_High =>
- Res := Create_Iir (Iir_Kind_High_Type_Attribute);
- when Name_Low =>
- Res := Create_Iir (Iir_Kind_Low_Type_Attribute);
- when Name_Ascending =>
- Res := Create_Iir (Iir_Kind_Ascending_Type_Attribute);
- when Name_Range
- | Name_Reverse_Range =>
- Error_Msg_Sem
- ("prefix of range attribute must be an array type or object",
- Attr);
- return Error_Mark;
- when others =>
- Error_Msg_Sem ("Attribute '" & Name_Table.Image (Id)
- & " not valid on this type", Attr);
- return Error_Mark;
- end case;
- Location_Copy (Res, Attr);
- Set_Base_Name (Res, Res);
-
- Prefix := Get_Named_Entity (Prefix_Name);
- case Get_Kind (Prefix) is
- when Iir_Kind_Range_Array_Attribute
- | Iir_Kind_Reverse_Range_Array_Attribute =>
- Prefix := Finish_Sem_Name (Prefix_Name, Prefix);
- Prefix_Type := Get_Type (Prefix);
- Set_Expr_Staticness (Res, Get_Expr_Staticness (Prefix));
- when Iir_Kind_Base_Attribute =>
- -- Base_Attribute is already finished.
- Prefix_Type := Get_Type (Prefix);
- Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type));
- when others =>
- Prefix := Sem_Type_Mark (Prefix_Name);
- Prefix_Type := Get_Type (Prefix);
- Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type));
- end case;
- Set_Prefix (Res, Prefix);
-
- case Get_Identifier (Attr) is
- when Name_Ascending =>
- -- LRM93 14.1
- -- Result Type: type boolean.
- Set_Type (Res, Boolean_Type_Definition);
- when others =>
- -- LRM 14.1
- -- Result Type: Same type as T.
- Set_Type (Res, Prefix_Type);
- end case;
- return Res;
- end Sem_Predefined_Type_Attribute;
-
- -- Called for attributes Length, Left, Right, High, Low, Range,
- -- Reverse_Range, Ascending.
- -- FIXME: handle overload
- function Sem_Array_Attribute_Name (Attr : Iir_Attribute_Name) return Iir
- is
- use Std_Names;
- Prefix: Iir;
- Prefix_Name : constant Iir := Get_Prefix (Attr);
- Prefix_Type : Iir;
- Res : Iir;
- Res_Type : Iir;
- begin
- Prefix := Get_Named_Entity (Prefix_Name);
-
- -- LRM93 14.1
- -- Prefix: Any prefix A that is appropriate for an array object, or an
- -- alias thereof, or that denotes a constrained array subtype.
- case Get_Kind (Prefix) is
- when Iir_Kind_Dereference
- | Iir_Kinds_Object_Declaration
- | Iir_Kind_Function_Call
- | Iir_Kind_Selected_Element
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Slice_Name
- | Iir_Kind_Attribute_Value
- | Iir_Kind_Image_Attribute =>
- -- FIXME: list of expr.
- Prefix_Type := Get_Type (Prefix);
- case Get_Kind (Prefix_Type) is
- when Iir_Kind_Access_Type_Definition
- | Iir_Kind_Access_Subtype_Definition =>
- declare
- Designated_Type : Iir;
- begin
- Designated_Type :=
- Get_Designated_Type (Get_Base_Type (Prefix_Type));
- Prefix := Insert_Implicit_Dereference (Prefix, Attr);
- Prefix_Type := Designated_Type;
- end;
- when Iir_Kinds_Array_Type_Definition =>
- null;
- when others =>
- Error_Msg_Sem ("object prefix must be an array", Attr);
- return Error_Mark;
- end case;
- when Iir_Kind_Subtype_Declaration
- | Iir_Kind_Type_Declaration
- | Iir_Kind_Base_Attribute =>
- Prefix_Type := Get_Type (Prefix);
- if not Is_Fully_Constrained_Type (Prefix_Type) then
- Error_Msg_Sem ("prefix type is not constrained", Attr);
- -- We continue using the unconstrained array type.
- -- At least, this type is valid; and even if the array was
- -- constrained, the base type would be the same.
- end if;
- when Iir_Kind_Range_Array_Attribute
- | Iir_Kind_Reverse_Range_Array_Attribute =>
- -- For names such as pfx'Range'Left.
- -- Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Null_Iir);
- Prefix_Type := Get_Type (Prefix);
- when Iir_Kind_Process_Statement =>
- Error_Msg_Sem
- (Disp_Node (Prefix) & " is not an appropriate prefix for '"
- & Name_Table.Image (Get_Identifier (Attr))
- & " attribute",
- Attr);
- return Error_Mark;
- when others =>
- Error_Msg_Sem ("prefix must denote an array object or type", Attr);
- return Error_Mark;
- end case;
-
- case Get_Kind (Prefix_Type) is
- when Iir_Kinds_Scalar_Type_Definition =>
- -- Note: prefix is a scalar type or subtype.
- return Sem_Predefined_Type_Attribute (Attr);
- when Iir_Kinds_Array_Type_Definition =>
- null;
- when others =>
- Error_Msg_Sem
- ("prefix of '"
- & Name_Table.Image (Get_Identifier (Attr))
- & " attribute must denote a constrained array subtype",
- Attr);
- return Error_Mark;
- end case;
-
- -- Type of the attribute. This is correct unless there is a parameter,
- -- and furthermore 'range and 'reverse_range has to be handled
- -- specially because the result is a range and not a value.
- Res_Type := Get_Index_Type (Get_Index_Subtype_List (Prefix_Type), 0);
-
- -- Create the node for the attribute.
- case Get_Identifier (Attr) is
- when Name_Left =>
- Res := Create_Iir (Iir_Kind_Left_Array_Attribute);
- when Name_Right =>
- Res := Create_Iir (Iir_Kind_Right_Array_Attribute);
- when Name_High =>
- Res := Create_Iir (Iir_Kind_High_Array_Attribute);
- when Name_Low =>
- Res := Create_Iir (Iir_Kind_Low_Array_Attribute);
- when Name_Range =>
- Res := Create_Iir (Iir_Kind_Range_Array_Attribute);
- when Name_Reverse_Range =>
- Res := Create_Iir (Iir_Kind_Reverse_Range_Array_Attribute);
- when Name_Length =>
- Res := Create_Iir (Iir_Kind_Length_Array_Attribute);
- -- FIXME: Error if ambiguous
- Res_Type := Convertible_Integer_Type_Definition;
- when Name_Ascending =>
- Res := Create_Iir (Iir_Kind_Ascending_Array_Attribute);
- -- FIXME: Error if ambiguous
- Res_Type := Boolean_Type_Definition;
- when others =>
- raise Internal_Error;
- end case;
- Location_Copy (Res, Attr);
- Set_Prefix (Res, Prefix);
- Set_Type (Res, Res_Type);
- return Res;
- end Sem_Array_Attribute_Name;
-
- function Sem_Signal_Signal_Attribute
- (Attr : Iir_Attribute_Name; Kind : Iir_Kind)
- return Iir
- is
- Res : Iir;
- Prefix : Iir;
- begin
- Prefix := Get_Named_Entity (Get_Prefix (Attr));
- Res := Create_Iir (Kind);
- if Kind = Iir_Kind_Delayed_Attribute then
- Set_Type (Res, Get_Type (Prefix));
- elsif Kind = Iir_Kind_Transaction_Attribute then
- Set_Type (Res, Bit_Type_Definition);
- else
- Set_Type (Res, Boolean_Type_Definition);
- end if;
- Set_Base_Name (Res, Res);
-
- if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then
- -- LRM93 2.1.1.2 / LRM08 4.2.2.3
- --
- -- It is an error if signal-valued attributes 'STABLE , 'QUIET,
- -- 'TRANSACTION, and 'DELAYED of formal signal paramaters of any
- -- mode are read within a subprogram.
- case Get_Kind (Get_Parent (Prefix)) is
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration =>
- Error_Msg_Sem
- ("'" & Name_Table.Image (Get_Identifier (Attr)) &
- " is not allowed for a signal parameter", Attr);
- when others =>
- null;
- end case;
- end if;
- Sem_Stmts.Add_Declaration_For_Implicit_Signal (Res);
- return Res;
- end Sem_Signal_Signal_Attribute;
-
- function Sem_Signal_Attribute (Attr : Iir_Attribute_Name) return Iir
- is
- use Std_Names;
- Prefix: Iir;
- Res : Iir;
- Base : Iir;
- begin
- Prefix := Get_Named_Entity (Get_Prefix (Attr));
- Base := Get_Object_Prefix (Prefix);
- case Get_Kind (Base) is
- when Iir_Kind_Signal_Declaration
- | Iir_Kind_Interface_Signal_Declaration
- | Iir_Kind_Guard_Signal_Declaration
- | Iir_Kinds_Signal_Attribute =>
- null;
- when others =>
- Error_Msg_Sem
- ("prefix of '"
- & Name_Table.Image (Get_Identifier (Attr))
- & " attribute must denote a signal", Attr);
- return Error_Mark;
- end case;
- case Get_Identifier (Attr) is
- when Name_Stable =>
- Res := Sem_Signal_Signal_Attribute
- (Attr, Iir_Kind_Stable_Attribute);
- when Name_Quiet =>
- Res := Sem_Signal_Signal_Attribute
- (Attr, Iir_Kind_Quiet_Attribute);
- when Name_Delayed =>
- Res := Sem_Signal_Signal_Attribute
- (Attr, Iir_Kind_Delayed_Attribute);
- when Name_Transaction =>
- Res := Sem_Signal_Signal_Attribute
- (Attr, Iir_Kind_Transaction_Attribute);
- when Name_Event =>
- Res := Create_Iir (Iir_Kind_Event_Attribute);
- Set_Type (Res, Boolean_Type_Definition);
- when Name_Active =>
- Res := Create_Iir (Iir_Kind_Active_Attribute);
- Set_Type (Res, Boolean_Type_Definition);
- when Name_Last_Value =>
- Res := Create_Iir (Iir_Kind_Last_Value_Attribute);
- Set_Type (Res, Get_Type (Prefix));
- when Name_Last_Event =>
- Res := Create_Iir (Iir_Kind_Last_Event_Attribute);
- Set_Type (Res, Time_Type_Definition);
- when Name_Last_Active =>
- Res := Create_Iir (Iir_Kind_Last_Active_Attribute);
- Set_Type (Res, Time_Type_Definition);
- when Name_Driving_Value =>
- Res := Create_Iir (Iir_Kind_Driving_Value_Attribute);
- Set_Type (Res, Get_Type (Prefix));
- -- FIXME: check restrictions.
- when Name_Driving =>
- Res := Create_Iir (Iir_Kind_Driving_Attribute);
- Set_Type (Res, Boolean_Type_Definition);
- -- FIXME: check restrictions.
- when others =>
- -- Not yet implemented attribute, or really an internal error.
- raise Internal_Error;
- end case;
- Location_Copy (Res, Attr);
-
- -- LRM 4.3.2
- -- The value of an object is said to be read when one of the following
- -- conditions is satisfied:
- -- [...]
- -- * When the object is a signal and the value of any of its predefined
- -- attributes 'STABLE, 'QUIET, 'DELAYED, 'TRANSACTION, 'EVENT,
- -- 'ACTIVE, 'LAST_EVENT, 'LAST_ACTIVE, or 'LAST_VALUE is read.
-
- -- LRM 14.1
- -- S'Driving Restrictions:
- -- S'Driving_Value Restrictions:
- -- This attribute is available only from within a process, a
- -- concurrent statement with an equivalent process, or a subprogram.
- -- If the prefix denotes a port, it is an error if the port does not
- -- have a mode of INOUT, OUT or BUFFER. It is also an error if the
- -- attribute name appears in a subprogram body that is not a declarative
- -- item contained within a process statement and the prefix is not a
- -- formal parameter of the given subprogram or of a parent of that
- -- subprogram. Finally, it is an error if the prefix denotes a
- -- subprogram formal parameter whose mode is not INOUT or OUT, or if
- -- S'Driving is False at the time of the evaluation of S'Driving_Value.
- case Get_Kind (Res) is
- when Iir_Kind_Stable_Attribute
- | Iir_Kind_Quiet_Attribute
- | Iir_Kind_Delayed_Attribute
- | Iir_Kind_Transaction_Attribute
- | Iir_Kind_Event_Attribute
- | Iir_Kind_Active_Attribute
- | Iir_Kind_Last_Event_Attribute
- | Iir_Kind_Last_Active_Attribute
- | Iir_Kind_Last_Value_Attribute =>
- Check_Read (Prefix);
- when Iir_Kind_Driving_Attribute
- | Iir_Kind_Driving_Value_Attribute =>
- -- FIXME: complete checks.
- if Get_Current_Concurrent_Statement = Null_Iir then
- Error_Msg_Sem
- ("'driving or 'driving_value is available only within a "
- & "concurrent statement", Attr);
- else
- case Get_Kind (Get_Current_Concurrent_Statement) is
- when Iir_Kinds_Process_Statement
- | Iir_Kind_Concurrent_Conditional_Signal_Assignment
- | Iir_Kind_Concurrent_Selected_Signal_Assignment
- | Iir_Kind_Concurrent_Procedure_Call_Statement =>
- null;
- when others =>
- Error_Msg_Sem
- ("'driving or 'driving_value not available within "
- & "this concurrent statement", Attr);
- end case;
- end if;
-
- case Get_Kind (Base) is
- when Iir_Kind_Signal_Declaration =>
- null;
- when Iir_Kind_Interface_Signal_Declaration =>
- case Get_Mode (Base) is
- when Iir_Buffer_Mode
- | Iir_Inout_Mode
- | Iir_Out_Mode =>
- null;
- when others =>
- Error_Msg_Sem
- ("mode of 'driving or 'driving_value prefix must "
- & "be out, inout or buffer", Attr);
- end case;
- when others =>
- Error_Msg_Sem
- ("bad prefix for 'driving or 'driving_value", Attr);
- end case;
- when others =>
- null;
- end case;
-
- -- According to LRM 7.4, signal attributes are not static expressions
- -- since the prefix (a signal) is not a static expression.
- Set_Expr_Staticness (Res, None);
-
- -- LRM 6.1
- -- A name is said to be a static name if and only if at least one of
- -- the following conditions holds:
- -- [...]
- -- - The name is a attribute name whose prefix is a static signal name
- -- and whose suffix is one of the predefined attributes 'DELAYED,
- -- 'STABLE, 'QUIET or 'TRANSACTION.
- -- According to LRM 6.1, attributes are not static names.
- if Flags.Vhdl_Std = Vhdl_93c or Flags.Vhdl_Std >= Vhdl_02 then
- case Get_Kind (Res) is
- when Iir_Kind_Stable_Attribute
- | Iir_Kind_Quiet_Attribute
- | Iir_Kind_Delayed_Attribute
- | Iir_Kind_Transaction_Attribute =>
- Set_Name_Staticness (Res, Get_Name_Staticness (Prefix));
- when others =>
- Set_Name_Staticness (Res, None);
- end case;
- else
- Set_Name_Staticness (Res, None);
- end if;
-
- Set_Prefix (Res, Prefix);
-
- -- Set has_active_flag when activity is read.
- case Get_Kind (Res) is
- when Iir_Kind_Quiet_Attribute
- | Iir_Kind_Transaction_Attribute
- | Iir_Kind_Active_Attribute
- | Iir_Kind_Last_Active_Attribute =>
- Set_Has_Active_Flag (Base, True);
- when others =>
- null;
- end case;
-
- return Res;
- end Sem_Signal_Attribute;
-
- -- 'Simple_name, 'instance_name and 'path_name.
- function Sem_Name_Attribute (Attr : Iir_Attribute_Name) return Iir
- is
- use Std_Names;
- Prefix_Name : constant Iir := Get_Prefix (Attr);
- Prefix: Iir;
- Res : Iir;
- Attr_Type : Iir;
- begin
- Prefix := Get_Named_Entity (Prefix_Name);
- Set_Prefix (Attr, Finish_Sem_Name (Prefix_Name, Prefix));
-
- -- LRM 14.1 Predefined attributes
- -- E'SIMPLE_NAME
- -- Prefix: Any named entity as defined in 5.1
- -- E'INSTANCE_NAME
- -- Prefix: Any named entity other than the local ports and generics
- -- of a component declaration.
- -- E'PATH_NAME
- -- Prefix: Any named entity other than the local ports and generics
- -- of a component declaration.
- case Get_Kind (Prefix) is
- when Iir_Kind_Procedure_Declaration
- | Iir_Kind_Implicit_Procedure_Declaration
- | Iir_Kind_Function_Declaration
- | Iir_Kind_Implicit_Function_Declaration
- | Iir_Kind_Type_Declaration
- | Iir_Kind_Subtype_Declaration
- | Iir_Kind_Constant_Declaration
- | Iir_Kind_Signal_Declaration
- | Iir_Kind_Variable_Declaration
- | Iir_Kind_Interface_Variable_Declaration
- | Iir_Kind_Iterator_Declaration
- | Iir_Kind_Component_Declaration
- | Iir_Kinds_Concurrent_Statement
- | Iir_Kinds_Sequential_Statement
- | Iir_Kind_Enumeration_Literal
- | Iir_Kind_Group_Declaration
- | Iir_Kind_Group_Template_Declaration
- | Iir_Kind_File_Declaration
- | Iir_Kinds_Library_Unit_Declaration
- | Iir_Kind_Non_Object_Alias_Declaration =>
- null;
-
- when Iir_Kind_Interface_Signal_Declaration
- | Iir_Kind_Interface_Constant_Declaration =>
- if Get_Identifier (Attr) /= Name_Simple_Name
- and then Get_Kind (Get_Parent (Prefix))
- = Iir_Kind_Component_Declaration
- then
- Error_Msg_Sem
- ("local ports or generics of a component cannot be a prefix",
- Attr);
- end if;
- when others =>
- Error_Msg_Sem (Disp_Node (Prefix) & " is not a named entity",
- Attr);
- end case;
-
- case Get_Identifier (Attr) is
- when Name_Simple_Name =>
- Res := Create_Iir (Iir_Kind_Simple_Name_Attribute);
- Eval_Simple_Name (Get_Identifier (Prefix));
- Set_Simple_Name_Identifier (Res, Name_Table.Get_Identifier);
- Attr_Type := Create_Unidim_Array_By_Length
- (String_Type_Definition,
- Iir_Int64 (Name_Table.Name_Length),
- Attr);
- Set_Simple_Name_Subtype (Res, Attr_Type);
- Set_Expr_Staticness (Res, Locally);
-
- when Name_Path_Name =>
- Res := Create_Iir (Iir_Kind_Path_Name_Attribute);
- Set_Expr_Staticness (Res, Globally);
- Attr_Type := String_Type_Definition;
-
- when Name_Instance_Name =>
- Res := Create_Iir (Iir_Kind_Instance_Name_Attribute);
- Set_Expr_Staticness (Res, Globally);
- Attr_Type := String_Type_Definition;
-
- when others =>
- raise Internal_Error;
- end case;
-
- Location_Copy (Res, Attr);
- Set_Prefix (Res, Prefix_Name);
- Set_Type (Res, Attr_Type);
- return Res;
- end Sem_Name_Attribute;
-
- procedure Sem_Attribute_Name (Attr : Iir_Attribute_Name)
- is
- use Std_Names;
- Prefix : Iir;
- Res : Iir;
- Sig : Iir_Signature;
- begin
- -- LRM93 6.6 Attribute names
- -- The meaning of the prefix of an attribute name must be determinable
- -- independently of the attribute designator and independently of the
- -- fact that it is the prefix of an attribute.
- Prefix := Get_Prefix (Attr);
-
- -- LRM93 6.6
- -- If the prefix of an attribute name denotes an alias, then the
- -- attribute name denotes an attribute of the aliased name and not the
- -- alias itself, except when the attribute designator denotes any of
- -- the predefined attributes 'Simple_Name, 'Path_Name or 'Instance_Name.
- -- If the prefix of an attribute name denotes an alias and the
- -- attribute designator denotes any of the predefined attributes
- -- 'Simple_Name, 'Path_Name or 'Instance_Name, then the attribute name
- -- denotes the attribute of the alias and not of the aliased name.
- if Flags.Vhdl_Std > Vhdl_87
- and then Get_Identifier (Attr) in Name_Id_Name_Attributes
- then
- Sem_Name (Prefix, True);
- else
- Sem_Name (Prefix, False);
- end if;
- Prefix := Get_Named_Entity (Prefix);
-
- if Prefix = Error_Mark then
- Set_Named_Entity (Attr, Prefix);
- return;
- end if;
-
- -- LRM93 6.6
- -- A signature may follow the prefix if and only if the prefix denotes
- -- a subprogram or enumeration literal, or an alias thereof.
- -- In this case, the signature is required to match (see Section 2.3.2)
- -- the parameter and result type profile of exactly one visible
- -- subprogram or enumeration literal, as is appropriate to the prefix.
- -- GHDL: this is done by Sem_Signature.
- Sig := Get_Attribute_Signature (Attr);
- if Sig /= Null_Iir then
- Prefix := Sem_Signature (Prefix, Sig);
- if Prefix = Null_Iir then
- Set_Named_Entity (Attr, Error_Mark);
- return;
- end if;
- Set_Named_Entity (Get_Prefix (Attr), Prefix);
- end if;
-
- if Get_Kind (Prefix) = Iir_Kind_Overload_List then
- -- FIXME: this should be allowed.
- Error_Msg_Sem ("prefix of attribute is overloaded", Attr);
- Set_Named_Entity (Attr, Error_Mark);
- return;
- end if;
-
- -- Set_Prefix (Attr, Finish_Sem_Name (Get_Prefix (Attr), Prefix));
-
- case Get_Identifier (Attr) is
- when Name_Base =>
- Res := Sem_Base_Attribute (Attr);
- when Name_Image
- | Name_Value =>
- if Flags.Vhdl_Std > Vhdl_87 then
- Res := Sem_Scalar_Type_Attribute (Attr);
- else
- Res := Sem_User_Attribute (Attr);
- end if;
-
- when Name_Pos
- | Name_Val
- | Name_Succ
- | Name_Pred
- | Name_Rightof
- | Name_Leftof =>
- Res := Sem_Scalar_Type_Attribute (Attr);
-
- when Name_Length
- | Name_Left
- | Name_Right
- | Name_High
- | Name_Low
- | Name_Range
- | Name_Reverse_Range =>
- Res := Sem_Array_Attribute_Name (Attr);
-
- when Name_Ascending =>
- if Flags.Vhdl_Std > Vhdl_87 then
- Res := Sem_Array_Attribute_Name (Attr);
- else
- Res := Sem_User_Attribute (Attr);
- end if;
-
- when Name_Stable
- | Name_Event
- | Name_Last_Value
- | Name_Delayed
- | Name_Quiet
- | Name_Transaction
- | Name_Active
- | Name_Last_Active
- | Name_Last_Event =>
- Res := Sem_Signal_Attribute (Attr);
-
- when Name_Driving
- | Name_Driving_Value =>
- if Flags.Vhdl_Std > Vhdl_87 then
- Res := Sem_Signal_Attribute (Attr);
- else
- Res := Sem_User_Attribute (Attr);
- end if;
-
- when Name_Simple_Name
- | Name_Path_Name
- | Name_Instance_Name =>
- if Flags.Vhdl_Std > Vhdl_87 then
- Res := Sem_Name_Attribute (Attr);
- else
- Res := Sem_User_Attribute (Attr);
- end if;
-
- when others =>
- Res := Sem_User_Attribute (Attr);
- end case;
-
- if Res = Null_Iir then
- Error_Kind ("sem_attribute_name", Attr);
- end if;
- Set_Named_Entity (Attr, Res);
- end Sem_Attribute_Name;
-
- -- LRM93 §6
- procedure Sem_Name (Name : Iir; Keep_Alias : Boolean := False) is
- begin
- -- Exit now if NAME was already semantized.
- if Get_Named_Entity (Name) /= Null_Iir then
- return;
- end if;
-
- case Get_Kind (Name) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Character_Literal
- | Iir_Kind_Operator_Symbol =>
- -- String_Literal may be a symbol_operator.
- Sem_Simple_Name (Name, Keep_Alias, Soft => False);
- when Iir_Kind_Selected_Name =>
- Sem_Selected_Name (Name, Keep_Alias);
- when Iir_Kind_Parenthesis_Name =>
- Sem_Parenthesis_Name (Name);
- when Iir_Kind_Selected_By_All_Name =>
- Sem_Selected_By_All_Name (Name);
- when Iir_Kind_Attribute_Name =>
- Sem_Attribute_Name (Name);
- when others =>
- Error_Kind ("sem_name", Name);
- end case;
- end Sem_Name;
-
- procedure Sem_Name_Soft (Name : Iir)
- is
- begin
- -- Exit now if NAME was already semantized.
- if Get_Named_Entity (Name) /= Null_Iir then
- return;
- end if;
-
- case Get_Kind (Name) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Operator_Symbol =>
- -- String_Literal may be a symbol_operator.
- Sem_Simple_Name (Name, False, Soft => True);
- when others =>
- Error_Kind ("sem_name_soft", Name);
- end case;
- end Sem_Name_Soft;
-
- procedure Sem_Name_Clean (Name : Iir)
- is
- N : Iir;
- Next_N : Iir;
- Named_Entity : Iir;
- Atype : Iir;
- begin
- N := Name;
- while N /= Null_Iir loop
- case Get_Kind (N) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Operator_Symbol =>
- Next_N := Null_Iir;
- when others =>
- Error_Kind ("sem_name_clean", N);
- end case;
-
- -- Clear and free overload lists of Named_entity and type.
- Named_Entity := Get_Named_Entity (N);
- Set_Named_Entity (N, Null_Iir);
- if Named_Entity /= Null_Iir
- and then Is_Overload_List (Named_Entity)
- then
- Free_Iir (Named_Entity);
- end if;
-
- Atype := Get_Type (N);
- Set_Type (N, Null_Iir);
- if Atype /= Null_Iir
- and then Is_Overload_List (Atype)
- then
- Free_Iir (Atype);
- end if;
-
- N := Next_N;
- end loop;
- end Sem_Name_Clean;
-
- -- Remove procedure specification from LIST.
- function Remove_Procedures_From_List (Expr : Iir) return Iir
- is
- El : Iir;
- P : Natural;
- List : Iir_List;
- begin
- if not Is_Overload_List (Expr) then
- return Expr;
- end if;
- List := Get_Overload_List (Expr);
- P := 0;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
- case Get_Kind (El) is
- when Iir_Kinds_Procedure_Declaration =>
- null;
- when Iir_Kinds_Function_Declaration =>
- if Maybe_Function_Call (El) then
- Replace_Nth_Element (List, P, El);
- P := P + 1;
- end if;
- when others =>
- Replace_Nth_Element (List, P, El);
- P := P + 1;
- end case;
- end loop;
- case P is
- when 0 =>
- Free_Iir (Expr);
- return Null_Iir;
- when 1 =>
- El := Get_First_Element (List);
- Free_Iir (Expr);
- return El;
- when others =>
- Set_Nbr_Elements (List, P);
- return Expr;
- end case;
- end Remove_Procedures_From_List;
-
- -- Convert name EXPR to an expression (ie, create function call).
- -- A_TYPE is the expected type of the expression.
- -- Returns NULL_IIR in case of error.
- function Name_To_Expression (Name : Iir; A_Type : Iir) return Iir
- is
- Ret_Type : Iir;
- Res_Type : Iir;
- Expr : Iir;
- Expr_List : Iir_List;
- Res : Iir;
- El : Iir;
- begin
- Expr := Get_Named_Entity (Name);
- if Get_Kind (Expr) = Iir_Kind_Error then
- return Null_Iir;
- end if;
- if Check_Is_Expression (Expr, Name) = Null_Iir then
- return Null_Iir;
- end if;
-
- -- Note: EXPR may contain procedure names...
- Expr := Remove_Procedures_From_List (Expr);
- Set_Named_Entity (Name, Expr);
- if Expr = Null_Iir then
- Error_Msg_Sem ("procedure name " & Disp_Node (Name)
- & " cannot be used as expression", Name);
- return Null_Iir;
- end if;
-
- if not Is_Overload_List (Expr) then
- Res := Finish_Sem_Name (Name);
- pragma Assert (Res /= Null_Iir);
- if A_Type /= Null_Iir then
- Res_Type := Get_Type (Res);
- if Res_Type = Null_Iir then
- return Null_Iir;
- end if;
- if not Are_Basetypes_Compatible (Get_Base_Type (Res_Type), A_Type)
- then
- Error_Not_Match (Res, A_Type, Name);
- return Null_Iir;
- end if;
- -- Fall through.
- end if;
- else
- -- EXPR is an overloaded name.
- Expr_List := Get_Overload_List (Expr);
-
- if A_Type /= Null_Iir then
- -- Find the name returning A_TYPE.
- Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (Expr_List, I);
- exit when El = Null_Iir;
- if Are_Basetypes_Compatible (Get_Base_Type (Get_Type (El)),
- A_Type)
- then
- Add_Result (Res, El);
- end if;
- end loop;
- if Res = Null_Iir then
- Error_Not_Match (Name, A_Type, Name);
- return Null_Iir;
- elsif Is_Overload_List (Res) then
- Error_Overload (Name);
- Disp_Overload_List (Get_Overload_List (Res), Name);
- return Null_Iir;
- else
- -- Free results
- Sem_Name_Free_Result (Expr, Res);
-
- Ret_Type := Get_Type (Name);
- if Ret_Type /= Null_Iir then
- pragma Assert (Is_Overload_List (Ret_Type));
- Free_Overload_List (Ret_Type);
- end if;
-
- Set_Named_Entity (Name, Res);
- Res := Finish_Sem_Name (Name);
- -- Fall through.
- end if;
- else
- -- Create a list of type.
- Ret_Type := Create_List_Of_Types (Expr_List);
- if Ret_Type = Null_Iir or else not Is_Overload_List (Ret_Type) then
- -- There is either no types or one type for
- -- several meanings.
- Error_Overload (Name);
- Disp_Overload_List (Expr_List, Name);
- --Free_Iir (Ret_Type);
- return Null_Iir;
- end if;
- Set_Type (Name, Ret_Type);
- return Name;
- end if;
- end if;
-
- -- NAME has only one meaning, which is RES.
- case Get_Kind (Res) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Character_Literal
- | Iir_Kind_Selected_Name =>
- Expr := Get_Named_Entity (Res);
- case Get_Kind (Expr) is
- when Iir_Kind_Implicit_Function_Declaration
- | Iir_Kind_Function_Declaration =>
- if Maybe_Function_Call (Expr) then
- Expr := Sem_As_Function_Call (Res, Expr, Null_Iir);
- if Get_Kind (Expr) /= Iir_Kind_Function_Call then
- raise Internal_Error;
- end if;
- Finish_Sem_Function_Call (Expr, Res);
- return Expr;
- else
- Error_Msg_Sem
- (Disp_Node (Expr) & " requires parameters", Res);
- Set_Type (Res, Get_Type (Expr));
- Set_Expr_Staticness (Res, None);
- return Res;
- end if;
- when others =>
- null;
- end case;
- Set_Type (Res, Get_Type (Expr));
- Set_Expr_Staticness (Res, Get_Expr_Staticness (Expr));
- --Set_Name_Staticness (Name, Get_Name_Staticness (Expr));
- --Set_Base_Name (Name, Get_Base_Name (Expr));
- return Res;
- when Iir_Kind_Function_Call
- | Iir_Kind_Selected_Element
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Slice_Name
- | Iir_Kind_Type_Conversion
- | Iir_Kind_Attribute_Name =>
- return Eval_Expr_If_Static (Res);
- when Iir_Kind_Dereference =>
- -- Never static.
- return Res;
- when Iir_Kinds_Array_Attribute =>
- -- FIXME: exclude range and reverse_range.
- return Eval_Expr_If_Static (Res);
- when Iir_Kinds_Signal_Attribute
- | Iir_Kinds_Signal_Value_Attribute =>
- -- Never static
- return Res;
- when Iir_Kinds_Type_Attribute
- | Iir_Kinds_Scalar_Type_Attribute
- | Iir_Kind_Image_Attribute
- | Iir_Kind_Value_Attribute
- | Iir_Kind_Simple_Name_Attribute
- | Iir_Kind_Path_Name_Attribute
- | Iir_Kind_Instance_Name_Attribute =>
- return Eval_Expr_If_Static (Res);
- when Iir_Kind_Parenthesis_Name
- | Iir_Kind_Selected_By_All_Name =>
- raise Internal_Error;
- when others =>
- Error_Kind ("name_to_expression", Res);
- end case;
- end Name_To_Expression;
-
- function Name_To_Range (Name : Iir) return Iir
- is
- Expr : Iir;
- begin
- Expr := Get_Named_Entity (Name);
- if Get_Kind (Expr) = Iir_Kind_Error then
- return Error_Mark;
- end if;
-
- case Get_Kind (Expr) is
- when Iir_Kind_Subtype_Declaration
- | Iir_Kind_Type_Declaration =>
- Expr := Sem_Type_Mark (Name);
- Set_Expr_Staticness
- (Expr, Get_Type_Staticness (Get_Type (Expr)));
- return Expr;
- when Iir_Kind_Range_Array_Attribute
- | Iir_Kind_Reverse_Range_Array_Attribute =>
- if Get_Parameter (Expr) = Null_Iir then
- Finish_Sem_Array_Attribute (Name, Expr, Null_Iir);
- end if;
- if Get_Kind (Name) = Iir_Kind_Attribute_Name then
- Free_Iir (Name);
- else
- Free_Iir (Get_Prefix (Name));
- Free_Parenthesis_Name (Name, Expr);
- end if;
- return Expr;
- when others =>
- Error_Msg_Sem ("name " & Disp_Node (Name)
- & " doesn't denote a range", Name);
- return Error_Mark;
- end case;
- end Name_To_Range;
-
- function Is_Object_Name (Name : Iir) return Boolean is
- begin
- case Get_Kind (Name) is
- when Iir_Kind_Object_Alias_Declaration
- | Iir_Kind_Signal_Declaration
- | Iir_Kind_Guard_Signal_Declaration
- | Iir_Kind_Variable_Declaration
- | Iir_Kind_File_Declaration
- | Iir_Kind_Constant_Declaration
- | Iir_Kind_Iterator_Declaration
- | Iir_Kind_Interface_Constant_Declaration
- | Iir_Kind_Interface_Variable_Declaration
- | Iir_Kind_Interface_Signal_Declaration
- | Iir_Kind_Interface_File_Declaration
- | Iir_Kind_Slice_Name
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Selected_Element
- | Iir_Kind_Implicit_Dereference
- | Iir_Kind_Dereference
- | Iir_Kind_Attribute_Value
- | Iir_Kind_Function_Call
- | Iir_Kinds_Attribute =>
- return True;
- when Iir_Kind_Simple_Name
- | Iir_Kind_Selected_Name =>
- return False;
- when others =>
- return False;
- end case;
- end Is_Object_Name;
-
- function Name_To_Object (Name : Iir) return Iir is
- begin
- case Get_Kind (Name) is
- when Iir_Kind_Object_Alias_Declaration
- | Iir_Kind_Signal_Declaration
- | Iir_Kind_Guard_Signal_Declaration
- | Iir_Kind_Variable_Declaration
- | Iir_Kind_File_Declaration
- | Iir_Kind_Constant_Declaration
- | Iir_Kind_Iterator_Declaration
- | Iir_Kind_Interface_Constant_Declaration
- | Iir_Kind_Interface_Variable_Declaration
- | Iir_Kind_Interface_Signal_Declaration
- | Iir_Kind_Interface_File_Declaration
- | Iir_Kind_Slice_Name
- | Iir_Kind_Indexed_Name
- | Iir_Kind_Selected_Element
- | Iir_Kind_Implicit_Dereference
- | Iir_Kind_Dereference
- | Iir_Kind_Attribute_Value
- | Iir_Kind_Function_Call
- | Iir_Kinds_Signal_Attribute =>
- return Name;
- when Iir_Kind_Simple_Name
- | Iir_Kind_Selected_Name =>
- return Name_To_Object (Get_Named_Entity (Name));
- when others =>
- return Null_Iir;
- end case;
- end Name_To_Object;
-
- function Create_Error_Name (Orig : Iir) return Iir
- is
- Res : Iir;
- begin
- Res := Create_Iir (Iir_Kind_Error);
- Set_Expr_Staticness (Res, None);
- Set_Error_Origin (Res, Orig);
- Location_Copy (Res, Orig);
- return Res;
- end Create_Error_Name;
-
- function Sem_Denoting_Name (Name: Iir) return Iir
- is
- Res: Iir;
- begin
- pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name);
-
- Sem_Name (Name);
- Res := Get_Named_Entity (Name);
-
- case Get_Kind (Res) is
- when Iir_Kind_Error =>
- -- A message must have been displayed.
- return Name;
- when Iir_Kind_Overload_List =>
- Error_Overload (Res);
- Set_Named_Entity (Name, Create_Error_Name (Name));
- return Name;
- when Iir_Kinds_Concurrent_Statement
- | Iir_Kinds_Sequential_Statement
- | Iir_Kind_Type_Declaration
- | Iir_Kind_Subtype_Declaration
- | Iir_Kind_Enumeration_Literal
- | Iir_Kind_Unit_Declaration
- | Iir_Kind_Group_Template_Declaration
- | Iir_Kind_Group_Declaration
- | Iir_Kind_Attribute_Declaration
- | Iir_Kinds_Object_Declaration
- | Iir_Kind_Entity_Declaration
- | Iir_Kind_Configuration_Declaration
- | Iir_Kind_Package_Declaration
- | Iir_Kind_Package_Instantiation_Declaration
- | Iir_Kind_Interface_Package_Declaration
- | Iir_Kind_Library_Declaration
- | Iir_Kinds_Subprogram_Declaration
- | Iir_Kind_Component_Declaration =>
- Res := Finish_Sem_Name (Name, Res);
- pragma Assert (Get_Kind (Res) in Iir_Kinds_Denoting_Name);
- return Res;
- when Iir_Kind_Selected_Element =>
- -- An error (to be diagnosticed by the caller).
- return Name;
- when others =>
- Error_Kind ("sem_denoting_name", Res);
- end case;
- end Sem_Denoting_Name;
-
- function Sem_Terminal_Name (Name : Iir) return Iir
- is
- Res : Iir;
- Ent : Iir;
- begin
- Res := Sem_Denoting_Name (Name);
- Ent := Get_Named_Entity (Res);
- if Get_Kind (Ent) /= Iir_Kind_Terminal_Declaration then
- Error_Class_Match (Name, "terminal");
- Set_Named_Entity (Res, Create_Error_Name (Name));
- end if;
- return Res;
- end Sem_Terminal_Name;
-
- procedure Error_Class_Match (Name : Iir; Class_Name : String)
- is
- Ent : constant Iir := Get_Named_Entity (Name);
- begin
- if Is_Error (Ent) then
- Error_Msg_Sem (Class_Name & " name expected", Name);
- else
- Error_Msg_Sem
- (Class_Name & " name expected, found "
- & Disp_Node (Get_Named_Entity (Name)), Name);
- end if;
- end Error_Class_Match;
-end Sem_Names;