-- 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 Libraries; with Flags; use Flags; with Types; use Types; with Errorout; use Errorout; with Evaluation; use Evaluation; with Sem; with Sem_Expr; use Sem_Expr; with Sem_Scopes; use Sem_Scopes; with Sem_Names; use Sem_Names; with Sem_Decls; with Sem_Inst; with Name_Table; with Std_Names; with Iirs_Utils; use Iirs_Utils; with Std_Package; use Std_Package; with Ieee.Std_Logic_1164; with Xrefs; use Xrefs; package body Sem_Types is -- Mark the resolution function (this may be required by the back-end to -- generate resolver). procedure Mark_Resolution_Function (Subtyp : Iir) is Func : Iir_Function_Declaration; begin if not Get_Resolved_Flag (Subtyp) then return; end if; Func := Has_Resolution_Function (Subtyp); -- Maybe the type is resolved through its elements. if Func /= Null_Iir then Set_Resolution_Function_Flag (Func, True); end if; end Mark_Resolution_Function; procedure Set_Type_Has_Signal (Atype : Iir) is Orig : Iir; begin -- Sanity check: ATYPE can be a signal type (eg: not an access type) if not Get_Signal_Type_Flag (Atype) then -- Do not crash since this may be called on an erroneous design. return; end if; -- If the type is already marked, nothing to do. if Get_Has_Signal_Flag (Atype) then return; end if; -- This type is used to declare a signal. Set_Has_Signal_Flag (Atype, True); -- If this type was instantiated, also mark the origin. Orig := Sem_Inst.Get_Origin (Atype); if Orig /= Null_Iir then Set_Type_Has_Signal (Orig); end if; -- Mark resolution function, and for composite types, also mark type -- of elements. case Get_Kind (Atype) is when Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Physical_Type_Definition | Iir_Kind_Floating_Type_Definition => null; when Iir_Kinds_Scalar_Subtype_Definition | Iir_Kind_Record_Subtype_Definition => Set_Type_Has_Signal (Get_Base_Type (Atype)); Mark_Resolution_Function (Atype); when Iir_Kind_Array_Subtype_Definition => Set_Type_Has_Signal (Get_Base_Type (Atype)); Mark_Resolution_Function (Atype); Set_Type_Has_Signal (Get_Element_Subtype (Atype)); when Iir_Kind_Array_Type_Definition => Set_Type_Has_Signal (Get_Element_Subtype (Atype)); when Iir_Kind_Record_Type_Definition => declare El_List : constant Iir_List := Get_Elements_Declaration_List (Atype); El : Iir; begin for I in Natural loop El := Get_Nth_Element (El_List, I); exit when El = Null_Iir; Set_Type_Has_Signal (Get_Type (El)); end loop; end; when Iir_Kind_Error => null; when Iir_Kind_Incomplete_Type_Definition => -- No need to copy the flag. null; when others => Error_Kind ("set_type_has_signal(2)", Atype); end case; end Set_Type_Has_Signal; -- Sem a range expression that appears in an integer, real or physical -- type definition. -- -- Both left and right bounds must be of the same type class, ie -- integer types, or if INT_ONLY is false, real types. -- However, the two bounds need not have the same type. function Sem_Type_Range_Expression (Expr : Iir; Int_Only : Boolean) return Iir is Left, Right: Iir; Bt_L_Kind, Bt_R_Kind : Iir_Kind; begin Left := Sem_Expression_Universal (Get_Left_Limit (Expr)); Right := Sem_Expression_Universal (Get_Right_Limit (Expr)); if Left = Null_Iir or Right = Null_Iir then return Null_Iir; end if; -- Emit error message for overflow and replace with a value to avoid -- error storm. if Get_Kind (Left) = Iir_Kind_Overflow_Literal then Error_Msg_Sem ("overflow in left bound", Left); Left := Build_Extreme_Value (Get_Direction (Expr) = Iir_Downto, Left); end if; if Get_Kind (Right) = Iir_Kind_Overflow_Literal then Error_Msg_Sem ("overflow in right bound", Right); Right := Build_Extreme_Value (Get_Direction (Expr) = Iir_To, Right); end if; Set_Left_Limit (Expr, Left); Set_Right_Limit (Expr, Right); Set_Expr_Staticness (Expr, Min (Get_Expr_Staticness (Left), Get_Expr_Staticness (Right))); Bt_L_Kind := Get_Kind (Get_Base_Type (Get_Type (Left))); Bt_R_Kind := Get_Kind (Get_Base_Type (Get_Type (Right))); if Int_Only then if Bt_L_Kind /= Iir_Kind_Integer_Type_Definition and then Bt_R_Kind = Iir_Kind_Integer_Type_Definition then Error_Msg_Sem ("left bound must be an integer expression", Left); return Null_Iir; end if; if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition and then Bt_L_Kind = Iir_Kind_Integer_Type_Definition then Error_Msg_Sem ("right bound must be an integer expression", Left); return Null_Iir; end if; if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition and then Bt_L_Kind /= Iir_Kind_Integer_Type_Definition then Error_Msg_Sem ("each bound must be an integer expression", Expr); return Null_Iir; end if; else if Bt_L_Kind /= Bt_R_Kind then Error_Msg_Sem ("left and right bounds must be of the same type class", Expr); return Null_Iir; end if; case Bt_L_Kind is when Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition => null; when others => -- Enumeration range are not allowed to define a new type. Error_Msg_Sem ("bad range type, only integer or float is allowed", Expr); return Null_Iir; end case; end if; return Expr; end Sem_Type_Range_Expression; function Create_Integer_Type (Loc : Iir; Constraint : Iir; Decl : Iir) return Iir is Ntype: Iir_Integer_Subtype_Definition; Ndef: Iir_Integer_Type_Definition; begin Ntype := Create_Iir (Iir_Kind_Integer_Subtype_Definition); Location_Copy (Ntype, Loc); Ndef := Create_Iir (Iir_Kind_Integer_Type_Definition); Location_Copy (Ndef, Loc); Set_Base_Type (Ndef, Ndef); Set_Type_Declarator (Ndef, Decl); Set_Type_Staticness (Ndef, Locally); Set_Signal_Type_Flag (Ndef, True); Set_Base_Type (Ntype, Ndef); Set_Type_Declarator (Ntype, Decl); Set_Range_Constraint (Ntype, Constraint); Set_Type_Staticness (Ntype, Get_Expr_Staticness (Constraint)); Set_Resolved_Flag (Ntype, False); Set_Signal_Type_Flag (Ntype, True); if Get_Type_Staticness (Ntype) /= Locally then Error_Msg_Sem ("range constraint of type must be locally static", Decl); end if; return Ntype; end Create_Integer_Type; function Range_Expr_To_Type_Definition (Expr : Iir; Decl: Iir) return Iir is Rng : Iir; Res : Iir; Base_Type : Iir; begin if Sem_Type_Range_Expression (Expr, False) = Null_Iir then return Null_Iir; end if; Rng := Eval_Range_If_Static (Expr); if Get_Expr_Staticness (Rng) /= Locally then -- FIXME: create an artificial range to avoid error storm ? null; end if; case Get_Kind (Get_Base_Type (Get_Type (Get_Left_Limit (Rng)))) is when Iir_Kind_Integer_Type_Definition => Res := Create_Integer_Type (Expr, Rng, Decl); when Iir_Kind_Floating_Type_Definition => declare Ntype: Iir_Floating_Subtype_Definition; Ndef: Iir_Floating_Type_Definition; begin Ntype := Create_Iir (Iir_Kind_Floating_Subtype_Definition); Location_Copy (Ntype, Expr); Ndef := Create_Iir (Iir_Kind_Floating_Type_Definition); Location_Copy (Ndef, Expr); Set_Base_Type (Ndef, Ndef); Set_Type_Declarator (Ndef, Decl); Set_Type_Staticness (Ndef, Get_Expr_Staticness (Expr)); Set_Signal_Type_Flag (Ndef, True); Set_Base_Type (Ntype, Ndef); Set_Type_Declarator (Ntype, Decl); Set_Range_Constraint (Ntype, Rng); Set_Resolved_Flag (Ntype, False); Set_Type_Staticness (Ntype, Get_Expr_Staticness (Expr)); Set_Signal_Type_Flag (Ntype, True); Res := Ntype; end; when others => -- sem_range_expression should catch such errors. raise Internal_Error; end case; -- A type and a subtype were declared. The type of the bounds are now -- used for the implicit subtype declaration. But the type of the -- bounds aren't of the type of the type declaration (this is 'obvious' -- because they exist before the type declaration). Override their -- type. This is doable without destroying information as they are -- either literals (of type convertible_xx_type_definition) or an -- evaluated literal. -- -- Overriding makes these implicit subtype homogenous with explicit -- subtypes. Base_Type := Get_Base_Type (Res); Set_Type (Rng, Base_Type); Set_Type (Get_Left_Limit (Rng), Base_Type); Set_Type (Get_Right_Limit (Rng), Base_Type); return Res; end Range_Expr_To_Type_Definition; function Create_Physical_Literal (Val : Iir_Int64; Unit : Iir) return Iir is Lit : Iir; begin Lit := Create_Iir (Iir_Kind_Physical_Int_Literal); Set_Value (Lit, Val); Set_Unit_Name (Lit, Unit); Set_Expr_Staticness (Lit, Locally); Set_Type (Lit, Get_Type (Unit)); Location_Copy (Lit, Unit); return Lit; end Create_Physical_Literal; -- Analyze a physical type definition. Create a subtype. function Sem_Physical_Type_Definition (Range_Expr: Iir; Decl : Iir) return Iir_Physical_Subtype_Definition is Unit: Iir_Unit_Declaration; Unit_Name : Iir; Def : Iir_Physical_Type_Definition; Sub_Type: Iir_Physical_Subtype_Definition; Range_Expr1: Iir; Val : Iir; Lit : Iir_Physical_Int_Literal; begin Def := Get_Type (Range_Expr); -- LRM93 4.1 -- The simple name declared by a type declaration denotes the -- declared type, unless the type declaration declares both a base -- type and a subtype of the base type, in which case the simple name -- denotes the subtype, and the base type is anonymous. Set_Type_Declarator (Def, Decl); Set_Base_Type (Def, Def); Set_Resolved_Flag (Def, False); Set_Type_Staticness (Def, Locally); Set_Signal_Type_Flag (Def, True); -- Set the type definition of the type declaration (it was currently the -- range expression). Do it early so that the units can be referenced -- by expanded names. Set_Type_Definition (Decl, Def); -- LRM93 3.1.3 -- Each bound of a range constraint that is used in a physical type -- definition must be a locally static expression of some integer type -- but the two bounds need not have the same integer type. case Get_Kind (Range_Expr) is when Iir_Kind_Range_Expression => Range_Expr1 := Sem_Type_Range_Expression (Range_Expr, True); when others => Error_Kind ("sem_physical_type_definition", Range_Expr); end case; if Range_Expr1 /= Null_Iir then if Get_Expr_Staticness (Range_Expr1) /= Locally then Error_Msg_Sem ("range constraint for a physical type must be static", Range_Expr1); Range_Expr1 := Null_Iir; else Range_Expr1 := Eval_Range_If_Static (Range_Expr1); end if; end if; -- Create the subtype. Sub_Type := Create_Iir (Iir_Kind_Physical_Subtype_Definition); Location_Copy (Sub_Type, Range_Expr); Set_Base_Type (Sub_Type, Def); Set_Signal_Type_Flag (Sub_Type, True); -- Analyze the primary unit. Unit := Get_Unit_Chain (Def); Unit_Name := Build_Simple_Name (Unit, Unit); Lit := Create_Physical_Literal (1, Unit_Name); Set_Physical_Unit_Value (Unit, Lit); Sem_Scopes.Add_Name (Unit); Set_Type (Unit, Def); Set_Expr_Staticness (Unit, Locally); Set_Name_Staticness (Unit, Locally); Set_Visible_Flag (Unit, True); Xref_Decl (Unit); if Range_Expr1 /= Null_Iir then declare -- Convert an integer literal to a physical literal. -- This is used to convert bounds. function Lit_To_Phys_Lit (Lim : Iir_Integer_Literal) return Iir_Physical_Int_Literal is Res : Iir_Physical_Int_Literal; begin Res := Create_Iir (Iir_Kind_Physical_Int_Literal); Location_Copy (Res, Lim); Set_Type (Res, Def); Set_Value (Res, Get_Value (Lim)); Set_Unit_Name (Res, Get_Primary_Unit_Name (Def)); Set_Expr_Staticness (Res, Locally); Set_Literal_Origin (Res, Lim); return Res; end Lit_To_Phys_Lit; Phys_Range : Iir_Range_Expression; begin -- Create the physical range. Phys_Range := Create_Iir (Iir_Kind_Range_Expression); Location_Copy (Phys_Range, Range_Expr1); Set_Type (Phys_Range, Def); Set_Direction (Phys_Range, Get_Direction (Range_Expr1)); Set_Left_Limit (Phys_Range, Lit_To_Phys_Lit (Get_Left_Limit (Range_Expr1))); Set_Right_Limit (Phys_Range, Lit_To_Phys_Lit (Get_Right_Limit (Range_Expr1))); Set_Expr_Staticness (Phys_Range, Get_Expr_Staticness (Range_Expr1)); Set_Range_Constraint (Sub_Type, Phys_Range); -- This must be locally... Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (Range_Expr1)); -- FIXME: the original range is not used. Reuse it ? Free_Iir (Range_Expr); end; end if; Set_Resolved_Flag (Sub_Type, False); -- Analyze secondary units. Unit := Get_Chain (Unit); while Unit /= Null_Iir loop Sem_Scopes.Add_Name (Unit); Val := Sem_Expression (Get_Physical_Literal (Unit), Def); if Val /= Null_Iir then Set_Physical_Literal (Unit, Val); Val := Eval_Physical_Literal (Val); Set_Physical_Unit_Value (Unit, Val); -- LRM93 §3.1 -- The position number of unit names need not lie within the range -- specified by the range constraint. -- GHDL: this was not true in VHDL87. -- GHDL: This is not so simple if 1 is not included in the range. if False and then Flags.Vhdl_Std = Vhdl_87 and then Range_Expr1 /= Null_Iir then if not Eval_Int_In_Range (Get_Value (Unit), Range_Expr1) then Error_Msg_Sem ("physical literal does not lie within the range", Unit); end if; end if; else -- Avoid errors storm. Set_Physical_Literal (Unit, Get_Primary_Unit (Def)); Set_Physical_Unit_Value (Unit, Lit); end if; Set_Type (Unit, Def); Set_Expr_Staticness (Unit, Locally); Set_Name_Staticness (Unit, Locally); Sem_Scopes.Name_Visible (Unit); Xref_Decl (Unit); Unit := Get_Chain (Unit); end loop; return Sub_Type; end Sem_Physical_Type_Definition; -- Return true iff decl is std.textio.text function Is_Text_Type_Declaration (Decl : Iir_Type_Declaration) return Boolean is use Std_Names; P : Iir; begin if Get_Identifier (Decl) /= Name_Text then return False; end if; P := Get_Parent (Decl); if Get_Kind (P) /= Iir_Kind_Package_Declaration or else Get_Identifier (P) /= Name_Textio then return False; end if; -- design_unit, design_file, library_declaration. P := Get_Library (Get_Design_File (Get_Design_Unit (P))); if P /= Libraries.Std_Library then return False; end if; return True; end Is_Text_Type_Declaration; procedure Check_No_File_Type (El_Type : Iir; Loc : Iir) is begin case Get_Kind (El_Type) is when Iir_Kind_File_Type_Definition => Error_Msg_Sem ("element of file type is not allowed in a composite type", Loc); when others => null; end case; end Check_No_File_Type; -- Semantize the array_element type of array type DEF. -- Set resolved_flag of DEF. procedure Sem_Array_Element (Def : Iir) is El_Type : Iir; begin El_Type := Get_Element_Subtype_Indication (Def); El_Type := Sem_Subtype_Indication (El_Type); if El_Type = Null_Iir then Set_Type_Staticness (Def, None); Set_Resolved_Flag (Def, False); return; end if; Set_Element_Subtype_Indication (Def, El_Type); El_Type := Get_Type_Of_Subtype_Indication (El_Type); Set_Element_Subtype (Def, El_Type); Check_No_File_Type (El_Type, Def); Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (El_Type)); -- LRM93 §3.2.1.1 -- The same requirement exists [must define a constrained -- array subtype] [...] for the element subtype indication -- of an array type definition, if the type of the array -- element is itself an array type. if Vhdl_Std < Vhdl_08 and then not Is_Fully_Constrained_Type (El_Type) then Error_Msg_Sem ("array element of unconstrained " & Disp_Node (El_Type) & " is not allowed", Def); end if; Set_Resolved_Flag (Def, Get_Resolved_Flag (El_Type)); end Sem_Array_Element; procedure Sem_Protected_Type_Declaration (Type_Decl : Iir_Type_Declaration) is Decl : Iir_Protected_Type_Declaration; El : Iir; begin Decl := Get_Type_Definition (Type_Decl); Set_Base_Type (Decl, Decl); Set_Resolved_Flag (Decl, False); Set_Signal_Type_Flag (Decl, False); Set_Type_Staticness (Decl, None); -- LRM 10.3 Visibility -- [...] except in the declaration of a design_unit or a protected type -- declaration, in which case it starts immediatly after the reserved -- word is occuring after the identifier of the design unit or -- protected type declaration. Set_Visible_Flag (Type_Decl, True); -- LRM 10.1 -- n) A protected type declaration, together with the corresponding -- body. Open_Declarative_Region; Sem_Decls.Sem_Declaration_Chain (Decl); El := Get_Declaration_Chain (Decl); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Use_Clause | Iir_Kind_Attribute_Specification => null; when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => declare Inter : Iir; Inter_Type : Iir; begin Inter := Get_Interface_Declaration_Chain (El); while Inter /= Null_Iir loop Inter_Type := Get_Type (Inter); if Inter_Type /= Null_Iir and then Get_Signal_Type_Flag (Inter_Type) = False and then Get_Kind (Inter_Type) /= Iir_Kind_Protected_Type_Declaration then Error_Msg_Sem ("formal parameter method must not be " & "access or file type", Inter); end if; Inter := Get_Chain (Inter); end loop; if Get_Kind (El) = Iir_Kind_Function_Declaration then Inter_Type := Get_Return_Type (El); if Inter_Type /= Null_Iir and then Get_Signal_Type_Flag (Inter_Type) = False then Error_Msg_Sem ("method return type must not be access of file", El); end if; end if; end; when others => Error_Msg_Sem (Disp_Node (El) & " are not allowed in protected type declaration", El); end case; El := Get_Chain (El); end loop; Close_Declarative_Region; end Sem_Protected_Type_Declaration; procedure Sem_Protected_Type_Body (Bod : Iir) is Inter : Name_Interpretation_Type; Type_Decl : Iir; Decl : Iir; El : Iir; begin -- LRM 3.5 Protected types. -- Each protected type declaration appearing immediatly within a given -- declaration region must have exactly one corresponding protected type -- body appearing immediatly within the same declarative region and -- textually subsequent to the protected type declaration. -- -- Similarly, each protected type body appearing immediatly within a -- given declarative region must have exactly one corresponding -- protected type declaration appearing immediatly within the same -- declarative region and textually prior to the protected type body. Inter := Get_Interpretation (Get_Identifier (Bod)); if Valid_Interpretation (Inter) and then Is_In_Current_Declarative_Region (Inter) then Type_Decl := Get_Declaration (Inter); if Get_Kind (Type_Decl) = Iir_Kind_Type_Declaration then Decl := Get_Type_Definition (Type_Decl); else Decl := Null_Iir; end if; else Decl := Null_Iir; end if; if Decl /= Null_Iir and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Declaration then Set_Protected_Type_Declaration (Bod, Decl); if Get_Protected_Type_Body (Decl) /= Null_Iir then Error_Msg_Sem ("protected type body already declared for " & Disp_Node (Decl), Bod); Error_Msg_Sem ("(previous body)", Get_Protected_Type_Body (Decl)); Decl := Null_Iir; elsif not Get_Visible_Flag (Type_Decl) then -- Can this happen ? Error_Msg_Sem ("protected type declaration not yet visible", Bod); Error_Msg_Sem ("(location of protected type declaration)", Decl); Decl := Null_Iir; else Set_Protected_Type_Body (Decl, Bod); end if; else Error_Msg_Sem ("no protected type declaration for this body", Bod); if Decl /= Null_Iir then Error_Msg_Sem ("(found " & Disp_Node (Decl) & " declared here)", Decl); Decl := Null_Iir; end if; end if; -- LRM 10.1 -- n) A protected type declaration, together with the corresponding -- body. Open_Declarative_Region; if Decl /= Null_Iir then Xref_Body (Bod, Decl); Add_Protected_Type_Declarations (Decl); end if; Sem_Decls.Sem_Declaration_Chain (Bod); El := Get_Declaration_Chain (Bod); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Implicit_Procedure_Declaration | Iir_Kind_Implicit_Function_Declaration => null; when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => null; when Iir_Kind_Type_Declaration | Iir_Kind_Anonymous_Type_Declaration => null; when Iir_Kind_Subtype_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_File_Declaration => null; when Iir_Kind_Object_Alias_Declaration | Iir_Kind_Non_Object_Alias_Declaration => null; when Iir_Kind_Attribute_Declaration | Iir_Kind_Attribute_Specification | Iir_Kind_Use_Clause | Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration => null; when others => Error_Msg_Sem (Disp_Node (El) & " not allowed in a protected type body", El); end case; El := Get_Chain (El); end loop; Sem_Decls.Check_Full_Declaration (Bod, Bod); -- LRM 3.5.2 Protected type bodies -- Each subprogram declaration appearing in a given protected type -- declaration shall have a corresponding subprogram body appearing in -- the corresponding protected type body. if Decl /= Null_Iir then Sem_Decls.Check_Full_Declaration (Decl, Bod); end if; Close_Declarative_Region; end Sem_Protected_Type_Body; -- Return the constraint state from CONST (the initial state) and ATYPE, -- as if ATYPE was a new element of a record. function Update_Record_Constraint (Const : Iir_Constraint; Atype : Iir) return Iir_Constraint is begin if Get_Kind (Atype) not in Iir_Kinds_Composite_Type_Definition then return Const; end if; case Const is when Fully_Constrained | Unconstrained => if Get_Constraint_State (Atype) = Const then return Const; else return Partially_Constrained; end if; when Partially_Constrained => return Partially_Constrained; end case; end Update_Record_Constraint; function Get_Array_Constraint (Def : Iir) return Iir_Constraint is El_Type : constant Iir := Get_Element_Subtype (Def); Index : constant Boolean := Get_Kind (Def) = Iir_Kind_Array_Subtype_Definition and then Get_Index_Constraint_Flag (Def); begin if Get_Kind (El_Type) in Iir_Kinds_Composite_Type_Definition then case Get_Constraint_State (El_Type) is when Fully_Constrained => if Index then return Fully_Constrained; else return Partially_Constrained; end if; when Partially_Constrained => return Partially_Constrained; when Unconstrained => if not Index then return Unconstrained; else return Partially_Constrained; end if; end case; else if Index then return Fully_Constrained; else return Unconstrained; end if; end if; end Get_Array_Constraint; function Sem_Enumeration_Type_Definition (Def: Iir; Decl: Iir) return Iir is begin Set_Base_Type (Def, Def); Set_Type_Staticness (Def, Locally); Set_Signal_Type_Flag (Def, True); -- Makes all literal visible. declare El: Iir; Literal_List: Iir_List; Only_Characters : Boolean := True; begin Literal_List := Get_Enumeration_Literal_List (Def); for I in Natural loop El := Get_Nth_Element (Literal_List, I); exit when El = Null_Iir; Set_Expr_Staticness (El, Locally); Set_Name_Staticness (El, Locally); Set_Type (El, Def); Set_Enumeration_Decl (El, El); Sem.Compute_Subprogram_Hash (El); Sem_Scopes.Add_Name (El); Name_Visible (El); Xref_Decl (El); if Only_Characters and then not Name_Table.Is_Character (Get_Identifier (El)) then Only_Characters := False; end if; end loop; Set_Only_Characters_Flag (Def, Only_Characters); end; Set_Resolved_Flag (Def, False); Create_Range_Constraint_For_Enumeration_Type (Def); -- Identifier IEEE.Std_Logic_1164.Std_Ulogic. if Get_Identifier (Decl) = Std_Names.Name_Std_Ulogic and then Get_Parent (Decl) = Ieee.Std_Logic_1164.Std_Logic_1164_Pkg then Ieee.Std_Logic_1164.Std_Ulogic_Type := Def; end if; return Def; end Sem_Enumeration_Type_Definition; function Sem_Record_Type_Definition (Def: Iir) return Iir is -- Semantized type of previous element Last_Type : Iir; El_List : constant Iir_List := Get_Elements_Declaration_List (Def); El: Iir; El_Type : Iir; Resolved_Flag : Boolean; Staticness : Iir_Staticness; Constraint : Iir_Constraint; begin -- LRM 10.1 -- 5. A record type declaration, Open_Declarative_Region; Resolved_Flag := True; Last_Type := Null_Iir; Staticness := Locally; Constraint := Fully_Constrained; Set_Signal_Type_Flag (Def, True); for I in Natural loop El := Get_Nth_Element (El_List, I); exit when El = Null_Iir; El_Type := Get_Subtype_Indication (El); if El_Type /= Null_Iir then -- Be careful for a declaration list (r,g,b: integer). El_Type := Sem_Subtype_Indication (El_Type); Set_Subtype_Indication (El, El_Type); El_Type := Get_Type_Of_Subtype_Indication (El_Type); Last_Type := El_Type; else El_Type := Last_Type; end if; if El_Type /= Null_Iir then Set_Type (El, El_Type); Check_No_File_Type (El_Type, El); if not Get_Signal_Type_Flag (El_Type) then Set_Signal_Type_Flag (Def, False); end if; -- LRM93 3.2.1.1 -- The same requirement [must define a constrained array -- subtype] exits for the subtype indication of an -- element declaration, if the type of the record -- element is an array type. if Vhdl_Std < Vhdl_08 and then not Is_Fully_Constrained_Type (El_Type) then Error_Msg_Sem ("element declaration of unconstrained " & Disp_Node (El_Type) & " is not allowed", El); end if; Resolved_Flag := Resolved_Flag and Get_Resolved_Flag (El_Type); Staticness := Min (Staticness, Get_Type_Staticness (El_Type)); Constraint := Update_Record_Constraint (Constraint, El_Type); else Staticness := None; end if; Sem_Scopes.Add_Name (El); Name_Visible (El); Xref_Decl (El); end loop; Close_Declarative_Region; Set_Base_Type (Def, Def); Set_Resolved_Flag (Def, Resolved_Flag); Set_Type_Staticness (Def, Staticness); Set_Constraint_State (Def, Constraint); return Def; end Sem_Record_Type_Definition; function Sem_Unbounded_Array_Type_Definition (Def: Iir) return Iir is Index_List : constant Iir_List := Get_Index_Subtype_Definition_List (Def); Index_Type : Iir; begin Set_Base_Type (Def, Def); for I in Natural loop Index_Type := Get_Nth_Element (Index_List, I); exit when Index_Type = Null_Iir; Index_Type := Sem_Type_Mark (Index_Type); Replace_Nth_Element (Index_List, I, Index_Type); Index_Type := Get_Type (Index_Type); if Get_Kind (Index_Type) not in Iir_Kinds_Discrete_Type_Definition then Error_Msg_Sem ("an index type of an array must be a discrete type", Index_Type); -- FIXME: disp type Index_Type ? end if; end loop; Set_Index_Subtype_List (Def, Index_List); Sem_Array_Element (Def); Set_Constraint_State (Def, Get_Array_Constraint (Def)); -- According to LRM93 7.4.1, an unconstrained array type is not static. Set_Type_Staticness (Def, None); return Def; end Sem_Unbounded_Array_Type_Definition; -- Return the subtype declaration corresponding to the base type of ATYPE -- (for integer and real types), or the type for enumerated types. To say -- that differently, it returns the type or subtype which defines the -- original range. function Get_First_Subtype_Declaration (Atype : Iir) return Iir is Base_Type : constant Iir := Get_Base_Type (Atype); Base_Decl : constant Iir := Get_Type_Declarator (Base_Type); begin if Get_Kind (Base_Type) = Iir_Kind_Enumeration_Type_Definition then pragma Assert (Get_Kind (Base_Decl) = Iir_Kind_Type_Declaration); return Base_Decl; else return Get_Type_Declarator (Get_Subtype_Definition (Base_Decl)); end if; end Get_First_Subtype_Declaration; function Sem_Constrained_Array_Type_Definition (Def: Iir; Decl: Iir) return Iir is Index_Type : Iir; Index_Name : Iir; Index_List : Iir_List; Base_Index_List : Iir_List; El_Type : Iir; Staticness : Iir_Staticness; -- array_type_definition, which is the same as the subtype, -- but without any constraint in the indexes. Base_Type: Iir; begin -- LRM08 5.3.2.1 Array types -- A constrained array definition similarly defines both an array -- type and a subtype of this type. -- - The array type is an implicitely declared anonymous type, -- this type is defined by an (implicit) unbounded array -- definition in which the element subtype indication either -- denotes the base type of the subtype denoted by the element -- subtype indication of the constrained array definition, if -- that subtype is a composite type, or otherwise is the -- element subtype indication of the constrained array -- definition, and in which the type mark of each index subtype -- definition denotes the subtype defined by the corresponding -- discrete range. -- - The array subtype is the subtype obtained by imposition of -- the index constraint on the array type and if the element -- subtype indication of the constrained array definition -- denotes a fully or partially constrained composite subtype, -- imposition of the constraint of that subtype as an array -- element constraint on the array type. -- FIXME: all indexes must be either constrained or -- unconstrained. -- If all indexes are unconstrained, this is really a type -- otherwise, this is a subtype. -- Create a definition for the base type of subtype DEF. Base_Type := Create_Iir (Iir_Kind_Array_Type_Definition); Location_Copy (Base_Type, Def); Set_Base_Type (Base_Type, Base_Type); Set_Type_Declarator (Base_Type, Decl); Base_Index_List := Create_Iir_List; Set_Index_Subtype_Definition_List (Base_Type, Base_Index_List); Set_Index_Subtype_List (Base_Type, Base_Index_List); Staticness := Locally; Index_List := Get_Index_Constraint_List (Def); for I in Natural loop Index_Type := Get_Nth_Element (Index_List, I); exit when Index_Type = Null_Iir; Index_Name := Sem_Discrete_Range_Integer (Index_Type); if Index_Name /= Null_Iir then Index_Name := Range_To_Subtype_Indication (Index_Name); else -- Avoid errors. Index_Name := Build_Simple_Name (Natural_Subtype_Declaration, Index_Type); Set_Type (Index_Name, Natural_Subtype_Definition); end if; Replace_Nth_Element (Index_List, I, Index_Name); Index_Type := Get_Index_Type (Index_Name); Staticness := Min (Staticness, Get_Type_Staticness (Index_Type)); -- Set the index subtype definition for the array base type. if Get_Kind (Index_Name) in Iir_Kinds_Denoting_Name then Index_Type := Index_Name; else pragma Assert (Get_Kind (Index_Name) in Iir_Kinds_Subtype_Definition); Index_Type := Get_Subtype_Type_Mark (Index_Name); if Index_Type = Null_Iir then -- From a range expression like '1 to 4' or from an attribute -- name. declare Subtype_Decl : constant Iir := Get_First_Subtype_Declaration (Index_Name); begin Index_Type := Build_Simple_Name (Subtype_Decl, Index_Name); Set_Type (Index_Type, Get_Type (Subtype_Decl)); end; end if; end if; Append_Element (Base_Index_List, Index_Type); end loop; Set_Index_Subtype_List (Def, Index_List); -- Element type. Set_Element_Subtype_Indication (Base_Type, Get_Element_Subtype (Def)); Sem_Array_Element (Base_Type); El_Type := Get_Element_Subtype (Base_Type); Set_Element_Subtype (Def, El_Type); Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Base_Type)); -- According to LRM93 §7.4.1, an unconstrained array type -- is not static. Set_Type_Staticness (Base_Type, None); Set_Type_Staticness (Def, Min (Staticness, Get_Type_Staticness (El_Type))); Set_Type_Declarator (Base_Type, Decl); Set_Resolved_Flag (Base_Type, Get_Resolved_Flag (Def)); Set_Index_Constraint_Flag (Def, True); Set_Constraint_State (Def, Get_Array_Constraint (Def)); Set_Constraint_State (Base_Type, Get_Array_Constraint (Base_Type)); Set_Base_Type (Def, Base_Type); Set_Subtype_Type_Mark (Def, Null_Iir); return Def; end Sem_Constrained_Array_Type_Definition; function Sem_Access_Type_Definition (Def: Iir) return Iir is D_Type : Iir; begin D_Type := Sem_Subtype_Indication (Get_Designated_Subtype_Indication (Def), True); Set_Designated_Subtype_Indication (Def, D_Type); D_Type := Get_Type_Of_Subtype_Indication (D_Type); if D_Type /= Null_Iir then case Get_Kind (D_Type) is when Iir_Kind_Incomplete_Type_Definition => Append_Element (Get_Incomplete_Type_List (D_Type), Def); when Iir_Kind_File_Type_Definition => -- LRM 3.3 -- The designated type must not be a file type. Error_Msg_Sem ("designated type must not be a file type", Def); when others => null; end case; Set_Designated_Type (Def, D_Type); end if; Set_Base_Type (Def, Def); Set_Type_Staticness (Def, None); Set_Resolved_Flag (Def, False); Set_Signal_Type_Flag (Def, False); return Def; end Sem_Access_Type_Definition; function Sem_File_Type_Definition (Def: Iir; Decl: Iir) return Iir is Type_Mark : Iir; begin Type_Mark := Sem_Type_Mark (Get_File_Type_Mark (Def)); Set_File_Type_Mark (Def, Type_Mark); Type_Mark := Get_Type (Type_Mark); if Get_Kind (Type_Mark) = Iir_Kind_Error then null; elsif Get_Signal_Type_Flag (Type_Mark) = False then -- LRM 3.4 -- The base type of this subtype must not be a file type -- or an access type. -- If the base type is a composite type, it must not -- contain a subelement of an access type. Error_Msg_Sem (Disp_Node (Type_Mark) & " cannot be a file type", Def); elsif Get_Kind (Type_Mark) in Iir_Kinds_Array_Type_Definition then -- LRM 3.4 -- If the base type is an array type, it must be a one -- dimensional array type. if not Is_One_Dimensional_Array_Type (Type_Mark) then Error_Msg_Sem ("multi-dimensional " & Disp_Node (Type_Mark) & " cannot be a file type", Def); end if; end if; Set_Base_Type (Def, Def); Set_Resolved_Flag (Def, False); Set_Text_File_Flag (Def, Is_Text_Type_Declaration (Decl)); Set_Signal_Type_Flag (Def, False); Set_Type_Staticness (Def, None); return Def; end Sem_File_Type_Definition; function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir is begin case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition => return Sem_Enumeration_Type_Definition (Def, Decl); when Iir_Kind_Range_Expression => if Get_Type (Def) /= Null_Iir then return Sem_Physical_Type_Definition (Def, Decl); else return Range_Expr_To_Type_Definition (Def, Decl); end if; when Iir_Kind_Range_Array_Attribute | Iir_Kind_Attribute_Name | Iir_Kind_Parenthesis_Name => if Get_Type (Def) /= Null_Iir then return Sem_Physical_Type_Definition (Def, Decl); end if; -- Nb: the attribute is expected to be a 'range or -- a 'reverse_range attribute. declare Res : Iir; begin Res := Sem_Discrete_Range_Expression (Def, Null_Iir, True); if Res = Null_Iir then return Null_Iir; end if; -- This cannot be a floating range. return Create_Integer_Type (Def, Res, Decl); end; when Iir_Kind_Array_Subtype_Definition => return Sem_Constrained_Array_Type_Definition (Def, Decl); when Iir_Kind_Array_Type_Definition => return Sem_Unbounded_Array_Type_Definition (Def); when Iir_Kind_Record_Type_Definition => return Sem_Record_Type_Definition (Def); when Iir_Kind_Access_Type_Definition => return Sem_Access_Type_Definition (Def); when Iir_Kind_File_Type_Definition => return Sem_File_Type_Definition (Def, Decl); when Iir_Kind_Protected_Type_Declaration => Sem_Protected_Type_Declaration (Decl); return Def; when others => Error_Kind ("sem_type_definition", Def); return Def; end case; end Sem_Type_Definition; function Range_To_Subtype_Indication (A_Range: Iir) return Iir is Sub_Type: Iir; Range_Type : Iir; begin case Get_Kind (A_Range) is when Iir_Kind_Range_Expression | Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => -- Create a sub type. Range_Type := Get_Type (A_Range); when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => return A_Range; when Iir_Kinds_Discrete_Type_Definition => -- A_RANGE is already a subtype definition. return A_Range; when others => Error_Kind ("range_to_subtype_indication", A_Range); return Null_Iir; end case; case Get_Kind (Range_Type) is when Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Enumeration_Subtype_Definition => Sub_Type := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); when Iir_Kind_Integer_Type_Definition | Iir_Kind_Integer_Subtype_Definition => Sub_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition); when Iir_Kind_Floating_Type_Definition | Iir_Kind_Floating_Subtype_Definition => Sub_Type := Create_Iir (Iir_Kind_Floating_Subtype_Definition); when others => raise Internal_Error; end case; Location_Copy (Sub_Type, A_Range); Set_Range_Constraint (Sub_Type, A_Range); Set_Base_Type (Sub_Type, Get_Base_Type (Range_Type)); Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (A_Range)); Set_Signal_Type_Flag (Sub_Type, True); return Sub_Type; end Range_To_Subtype_Indication; -- Return TRUE iff FUNC is a resolution function for ATYPE. function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean is Decl: Iir; Decl_Type : Iir; Ret_Type : Iir; begin -- LRM93 2.4 -- A resolution function must be a [pure] function; if Get_Kind (Func) not in Iir_Kinds_Function_Declaration then return False; end if; Decl := Get_Interface_Declaration_Chain (Func); -- LRM93 2.4 -- moreover, it must have a single input parameter of class constant if Decl = Null_Iir or else Get_Chain (Decl) /= Null_Iir then return False; end if; if Get_Kind (Decl) /= Iir_Kind_Interface_Constant_Declaration then return False; end if; -- LRM93 2.4 -- that is a one-dimensional, unconstrained array Decl_Type := Get_Type (Decl); if Get_Kind (Decl_Type) /= Iir_Kind_Array_Type_Definition then return False; end if; if not Is_One_Dimensional_Array_Type (Decl_Type) then return False; end if; -- LRM93 2.4 -- whose element type is that of the resolved signal. -- The type of the return value of the function must also be that of -- the signal. Ret_Type := Get_Return_Type (Func); if Get_Base_Type (Get_Element_Subtype (Decl_Type)) /= Get_Base_Type (Ret_Type) then return False; end if; if Atype /= Null_Iir and then Get_Base_Type (Ret_Type) /= Get_Base_Type (Atype) then return False; end if; -- LRM93 2.4 -- A resolution function must be a [pure] function; if Flags.Vhdl_Std >= Vhdl_93 and then Get_Pure_Flag (Func) = False then if Atype /= Null_Iir then Error_Msg_Sem ("resolution " & Disp_Node (Func) & " must be pure", Atype); end if; return False; end if; return True; end Is_A_Resolution_Function; -- Note: this sets resolved_flag. procedure Sem_Resolution_Function (Name : Iir; Atype : Iir) is Func : Iir; Res: Iir; El : Iir; List : Iir_List; Has_Error : Boolean; Name1 : Iir; begin Sem_Name (Name); Func := Get_Named_Entity (Name); if Func = Error_Mark then return; end if; Res := Null_Iir; if Is_Overload_List (Func) then List := Get_Overload_List (Func); Has_Error := False; for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; if Is_A_Resolution_Function (El, Atype) then if Res /= Null_Iir then if not Has_Error then Has_Error := True; Error_Msg_Sem ("can't resolve overload for resolution function", Atype); Error_Msg_Sem ("candidate functions are:", Atype); Error_Msg_Sem (" " & Disp_Subprg (Func), Func); end if; Error_Msg_Sem (" " & Disp_Subprg (El), El); else Res := El; end if; end if; end loop; Free_Overload_List (Func); if Has_Error then return; end if; Set_Named_Entity (Name, Res); else if Is_A_Resolution_Function (Func, Atype) then Res := Func; end if; end if; if Res = Null_Iir then Error_Msg_Sem ("no matching resolution function for " & Disp_Node (Name), Atype); else Name1 := Finish_Sem_Name (Name); Mark_Subprogram_Used (Res); Set_Resolved_Flag (Atype, True); Set_Resolution_Indication (Atype, Name1); end if; end Sem_Resolution_Function; -- Analyze the constraint DEF + RESOLUTION for type TYPE_MARK. The -- result is always a subtype definition. function Sem_Subtype_Constraint (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir; -- DEF is an incomplete subtype_indication or array_constraint, -- TYPE_MARK is the base type of the subtype_indication. function Sem_Array_Constraint (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir is El_Type : constant Iir := Get_Element_Subtype (Type_Mark); Res : Iir; Type_Index, Subtype_Index: Iir; Base_Type : Iir; El_Def : Iir; Staticness : Iir_Staticness; Error_Seen : Boolean; Type_Index_List : Iir_List; Subtype_Index_List : Iir_List; Resolv_Func : Iir := Null_Iir; Resolv_El : Iir := Null_Iir; Resolv_Ind : Iir; begin if Resolution /= Null_Iir then -- A resolution indication is present. case Get_Kind (Resolution) is when Iir_Kinds_Denoting_Name => Resolv_Func := Resolution; when Iir_Kind_Array_Element_Resolution => Resolv_El := Get_Resolution_Indication (Resolution); when Iir_Kind_Record_Resolution => Error_Msg_Sem ("record resolution not allowed for array subtype", Resolution); when others => Error_Kind ("sem_array_constraint(resolution)", Resolution); end case; end if; if Def = Null_Iir then -- There is no element_constraint. pragma Assert (Resolution /= Null_Iir); Res := Copy_Subtype_Indication (Type_Mark); else case Get_Kind (Def) is when Iir_Kind_Subtype_Definition => -- This is the case of "subtype new_array is [func] old_array". -- def must be a constrained array. if Get_Range_Constraint (Def) /= Null_Iir then Error_Msg_Sem ("cannot use a range constraint for array types", Def); return Copy_Subtype_Indication (Type_Mark); end if; -- LRM08 6.3 Subtype declarations -- -- If the subtype indication does not include a constraint, the -- subtype is the same as that denoted by the type mark. if Resolution = Null_Iir then -- FIXME: is it reachable ? Free_Name (Def); return Type_Mark; end if; Res := Copy_Subtype_Indication (Type_Mark); Location_Copy (Res, Def); Free_Name (Def); -- No element constraint. El_Def := Null_Iir; when Iir_Kind_Array_Subtype_Definition => -- Case of a constraint for an array. -- Check each index constraint against array type. Base_Type := Get_Base_Type (Type_Mark); Set_Base_Type (Def, Base_Type); El_Def := Get_Element_Subtype (Def); Staticness := Get_Type_Staticness (El_Type); Error_Seen := False; Type_Index_List := Get_Index_Subtype_Definition_List (Base_Type); Subtype_Index_List := Get_Index_Constraint_List (Def); -- LRM08 5.3.2.2 -- If an array constraint of the first form (including an index -- constraint) applies to a type or subtype, then the type or -- subtype shall be an unconstrained or partially constrained -- array type with no index constraint applying to the index -- subtypes, or an access type whose designated type is such -- a type. if Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition and then Get_Index_Constraint_Flag (Type_Mark) then Error_Msg_Sem ("constrained array cannot be re-constrained", Def); end if; if Subtype_Index_List = Null_Iir_List then -- Array is not constrained. Set_Index_Constraint_Flag (Def, False); Set_Index_Subtype_List (Def, Type_Index_List); else for I in Natural loop Type_Index := Get_Nth_Element (Type_Index_List, I); Subtype_Index := Get_Nth_Element (Subtype_Index_List, I); exit when Type_Index = Null_Iir and Subtype_Index = Null_Iir; if Type_Index = Null_Iir then Error_Msg_Sem ("subtype has more indexes than " & Disp_Node (Type_Mark) & " defined at " & Disp_Location (Type_Mark), Subtype_Index); -- Forget extra indexes. Set_Nbr_Elements (Subtype_Index_List, I); exit; end if; if Subtype_Index = Null_Iir then if not Error_Seen then Error_Msg_Sem ("subtype has less indexes than " & Disp_Node (Type_Mark) & " defined at " & Disp_Location (Type_Mark), Def); Error_Seen := True; end if; else Subtype_Index := Sem_Discrete_Range_Expression (Subtype_Index, Get_Index_Type (Type_Index), True); if Subtype_Index /= Null_Iir then Subtype_Index := Range_To_Subtype_Indication (Subtype_Index); Staticness := Min (Staticness, Get_Type_Staticness (Get_Type_Of_Subtype_Indication (Subtype_Index))); end if; end if; if Subtype_Index = Null_Iir then -- Create a fake subtype from type_index. -- FIXME: It is too fake. Subtype_Index := Type_Index; Staticness := None; end if; if Error_Seen then Append_Element (Subtype_Index_List, Subtype_Index); else Replace_Nth_Element (Subtype_Index_List, I, Subtype_Index); end if; end loop; Set_Index_Subtype_List (Def, Subtype_Index_List); Set_Index_Constraint_Flag (Def, True); end if; Set_Type_Staticness (Def, Staticness); Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark)); Res := Def; when others => -- LRM93 3.2.1.1 / LRM08 5.3.2.2 -- Index Constraints and Discrete Ranges -- -- If an index constraint appears after a type mark [...] -- The type mark must denote either an unconstrained array -- type, or an access type whose designated type is such -- an array type. Error_Msg_Sem ("only unconstrained array type may be contrained " &"by index", Def); Error_Msg_Sem (" (type mark is " & Disp_Node (Type_Mark) & ")", Type_Mark); return Type_Mark; end case; end if; -- Element subtype. if Resolv_El /= Null_Iir or else El_Def /= Null_Iir then El_Def := Sem_Subtype_Constraint (El_Def, El_Type, Resolv_El); end if; if El_Def = Null_Iir then El_Def := Get_Element_Subtype (Type_Mark); end if; Set_Element_Subtype (Res, El_Def); Set_Constraint_State (Res, Get_Array_Constraint (Res)); if Resolv_Func /= Null_Iir then Sem_Resolution_Function (Resolv_Func, Res); elsif Resolv_El /= Null_Iir then Set_Resolution_Indication (Res, Resolution); -- FIXME: may a resolution indication for a record be incomplete ? Set_Resolved_Flag (Res, Get_Resolved_Flag (El_Def)); elsif Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition then Resolv_Ind := Get_Resolution_Indication (Type_Mark); if Resolv_Ind /= Null_Iir then case Get_Kind (Resolv_Ind) is when Iir_Kinds_Denoting_Name => Error_Kind ("sem_array_constraint(resolution)", Resolv_Ind); when Iir_Kind_Array_Element_Resolution => -- Already applied to the element. Resolv_Ind := Null_Iir; when others => Error_Kind ("sem_array_constraint(resolution2)", Resolv_Ind); end case; Set_Resolution_Indication (Res, Resolv_Ind); end if; Set_Resolved_Flag (Res, Get_Resolved_Flag (Type_Mark)); end if; return Res; end Sem_Array_Constraint; function Reparse_As_Record_Element_Constraint (Name : Iir) return Iir is Prefix : Iir; Parent : Iir; El : Iir; begin if Get_Kind (Name) /= Iir_Kind_Parenthesis_Name then Error_Msg_Sem ("record element constraint expected", Name); return Null_Iir; else Prefix := Get_Prefix (Name); Parent := Name; while Get_Kind (Prefix) = Iir_Kind_Parenthesis_Name loop Parent := Prefix; Prefix := Get_Prefix (Prefix); end loop; if Get_Kind (Prefix) /= Iir_Kind_Simple_Name then Error_Msg_Sem ("record element name must be a simple name", Prefix); return Null_Iir; else El := Create_Iir (Iir_Kind_Record_Element_Constraint); Location_Copy (El, Prefix); Set_Identifier (El, Get_Identifier (Prefix)); Set_Type (El, Name); Set_Prefix (Parent, Null_Iir); Free_Name (Prefix); return El; end if; end if; end Reparse_As_Record_Element_Constraint; function Reparse_As_Record_Constraint (Def : Iir) return Iir is Res : Iir; Chain : Iir; El_List : Iir_List; El : Iir; begin if Get_Prefix (Def) /= Null_Iir then raise Internal_Error; end if; Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); Location_Copy (Res, Def); El_List := Create_Iir_List; Set_Elements_Declaration_List (Res, El_List); Chain := Get_Association_Chain (Def); while Chain /= Null_Iir loop if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression or else Get_Formal (Chain) /= Null_Iir then Error_Msg_Sem ("badly formed record constraint", Chain); else El := Reparse_As_Record_Element_Constraint (Get_Actual (Chain)); if El /= Null_Iir then Append_Element (El_List, El); end if; end if; Chain := Get_Chain (Chain); end loop; return Res; end Reparse_As_Record_Constraint; function Reparse_As_Array_Constraint (Def : Iir; Def_Type : Iir) return Iir is Parent : Iir; Name : Iir; Prefix : Iir; Res : Iir; Chain : Iir; El_List : Iir_List; Def_El_Type : Iir; begin Name := Def; Prefix := Get_Prefix (Name); Parent := Null_Iir; while Prefix /= Null_Iir and then Get_Kind (Prefix) = Iir_Kind_Parenthesis_Name loop Parent := Name; Name := Prefix; Prefix := Get_Prefix (Name); end loop; -- Detach prefix. if Parent /= Null_Iir then Set_Prefix (Parent, Null_Iir); end if; Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Location_Copy (Res, Name); Chain := Get_Association_Chain (Name); if Get_Kind (Chain) = Iir_Kind_Association_Element_Open then if Get_Chain (Chain) /= Null_Iir then Error_Msg_Sem ("'open' must be alone", Chain); end if; else El_List := Create_Iir_List; Set_Index_Constraint_List (Res, El_List); while Chain /= Null_Iir loop if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression or else Get_Formal (Chain) /= Null_Iir then Error_Msg_Sem ("bad form of array constraint", Chain); else Append_Element (El_List, Get_Actual (Chain)); end if; Chain := Get_Chain (Chain); end loop; end if; Def_El_Type := Get_Element_Subtype (Def_Type); if Parent /= Null_Iir then case Get_Kind (Def_El_Type) is when Iir_Kinds_Array_Type_Definition => Set_Element_Subtype_Indication (Res, Reparse_As_Array_Constraint (Def, Def_El_Type)); when others => Error_Kind ("reparse_as_array_constraint", Def_El_Type); end case; end if; return Res; end Reparse_As_Array_Constraint; function Sem_Record_Constraint (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir is Res : Iir; El_List, Tm_El_List : Iir_List; El : Iir; Tm_El : Iir; Tm_El_Type : Iir; El_Type : Iir; Res_List : Iir_List; Index_List : Iir_List; Index_El : Iir; begin Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); Location_Copy (Res, Def); Set_Base_Type (Res, Get_Base_Type (Type_Mark)); Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark)); if Get_Kind (Type_Mark) = Iir_Kind_Record_Subtype_Definition then Set_Resolution_Indication (Res, Get_Resolution_Indication (Type_Mark)); end if; case Get_Kind (Def) is when Iir_Kind_Subtype_Definition => Free_Name (Def); Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark)); Set_Constraint_State (Res, Get_Constraint_State (Type_Mark)); El_List := Null_Iir_List; when Iir_Kind_Array_Subtype_Definition => -- Record constraints are parsed as array constraints. if Get_Kind (Def) /= Iir_Kind_Array_Subtype_Definition then raise Internal_Error; end if; Index_List := Get_Index_Constraint_List (Def); El_List := Create_Iir_List; Set_Elements_Declaration_List (Res, El_List); for I in Natural loop Index_El := Get_Nth_Element (Index_List, I); exit when Index_El = Null_Iir; El := Reparse_As_Record_Element_Constraint (Index_El); if El /= Null_Iir then Append_Element (El_List, El); end if; end loop; when Iir_Kind_Record_Subtype_Definition => El_List := Get_Elements_Declaration_List (Def); Set_Elements_Declaration_List (Res, El_List); when others => Error_Kind ("sem_record_constraint", Def); end case; Res_List := Null_Iir_List; if Resolution /= Null_Iir then case Get_Kind (Resolution) is when Iir_Kinds_Denoting_Name => null; when Iir_Kind_Record_Subtype_Definition => Res_List := Get_Elements_Declaration_List (Resolution); when Iir_Kind_Array_Subtype_Definition => Error_Msg_Sem ("resolution indication must be an array element resolution", Resolution); when others => Error_Kind ("sem_record_constraint(resolution)", Resolution); end case; end if; Tm_El_List := Get_Elements_Declaration_List (Type_Mark); if El_List /= Null_Iir_List or Res_List /= Null_Iir_List then declare Nbr_Els : constant Natural := Get_Nbr_Elements (Tm_El_List); Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir); Res_Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir); Pos : Natural; Constraint : Iir_Constraint; begin -- Fill ELS. if El_List /= Null_Iir_List then for I in Natural loop El := Get_Nth_Element (El_List, I); exit when El = Null_Iir; Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El)); if Tm_El = Null_Iir then Error_Msg_Sem (Disp_Node (Type_Mark) & "has no " & Disp_Node (El), El); else Set_Element_Declaration (El, Tm_El); Pos := Natural (Get_Element_Position (Tm_El)); if Els (Pos) /= Null_Iir then Error_Msg_Sem (Disp_Node (El) & " was already constrained", El); Error_Msg_Sem (" (location of previous constrained)", Els (Pos)); else Els (Pos) := El; Set_Parent (El, Res); end if; El_Type := Get_Type (El); Tm_El_Type := Get_Type (Tm_El); if Get_Kind (El_Type) = Iir_Kind_Parenthesis_Name then case Get_Kind (Tm_El_Type) is when Iir_Kinds_Array_Type_Definition => El_Type := Reparse_As_Array_Constraint (El_Type, Tm_El_Type); when Iir_Kind_Record_Type_Definition | Iir_Kind_Record_Subtype_Definition => El_Type := Reparse_As_Record_Constraint (El_Type); when others => Error_Msg_Sem ("only composite types may be constrained", El_Type); end case; end if; Set_Type (El, El_Type); end if; end loop; Destroy_Iir_List (El_List); end if; -- Fill Res_Els. if Res_List /= Null_Iir_List then for I in Natural loop El := Get_Nth_Element (Res_List, I); exit when El = Null_Iir; Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El)); if Tm_El = Null_Iir then Error_Msg_Sem (Disp_Node (Type_Mark) & "has no " & Disp_Node (El), El); else Pos := Natural (Get_Element_Position (Tm_El)); if Res_Els (Pos) /= Null_Iir then Error_Msg_Sem (Disp_Node (El) & " was already resolved", El); Error_Msg_Sem (" (location of previous constrained)", Els (Pos)); else Res_Els (Pos) := Get_Element_Declaration (El); end if; end if; --Free_Iir (El); end loop; Destroy_Iir_List (Res_List); end if; -- Build elements list. El_List := Create_Iir_List; Set_Elements_Declaration_List (Res, El_List); Constraint := Fully_Constrained; for I in Els'Range loop Tm_El := Get_Nth_Element (Tm_El_List, I); if Els (I) = Null_Iir and Res_Els (I) = Null_Iir then El := Tm_El; else if Els (I) = Null_Iir then El := Create_Iir (Iir_Kind_Record_Element_Constraint); Location_Copy (El, Tm_El); Set_Element_Declaration (El, Tm_El); Set_Element_Position (El, Get_Element_Position (Tm_El)); El_Type := Null_Iir; else El := Els (I); El_Type := Get_Type (El); end if; El_Type := Sem_Subtype_Constraint (El_Type, Get_Type (Tm_El), Res_Els (I)); Set_Type (El, El_Type); end if; Append_Element (El_List, El); Constraint := Update_Record_Constraint (Constraint, Get_Type (El)); end loop; Set_Constraint_State (Res, Constraint); end; else Set_Elements_Declaration_List (Res, Tm_El_List); Set_Constraint_State (Res, Get_Constraint_State (Type_Mark)); end if; Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark)); if Resolution /= Null_Iir and then Get_Kind (Resolution) in Iir_Kinds_Denoting_Name then Sem_Resolution_Function (Resolution, Res); end if; return Res; end Sem_Record_Constraint; -- Return a scalar subtype definition (even in case of error). function Sem_Range_Constraint (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir is Res : Iir; A_Range : Iir; Tolerance : Iir; begin if Def = Null_Iir then Res := Copy_Subtype_Indication (Type_Mark); elsif Get_Kind (Def) /= Iir_Kind_Subtype_Definition then -- FIXME: find the correct sentence from LRM -- GHDL: subtype_definition may also be used just to add -- a resolution function. Error_Msg_Sem ("only scalar types may be constrained by range", Def); Error_Msg_Sem (" (type mark is " & Disp_Node (Type_Mark) & ")", Type_Mark); Res := Copy_Subtype_Indication (Type_Mark); else Tolerance := Get_Tolerance (Def); if Get_Range_Constraint (Def) = Null_Iir and then Resolution = Null_Iir and then Tolerance = Null_Iir then -- This defines an alias, and must have been handled just -- before the case statment. raise Internal_Error; end if; -- There are limits. Create a new subtype. if Get_Kind (Type_Mark) = Iir_Kind_Enumeration_Type_Definition then Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); else Res := Create_Iir (Get_Kind (Type_Mark)); end if; Location_Copy (Res, Def); Set_Base_Type (Res, Get_Base_Type (Type_Mark)); Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); A_Range := Get_Range_Constraint (Def); if A_Range = Null_Iir then A_Range := Get_Range_Constraint (Type_Mark); else A_Range := Sem_Range_Expression (A_Range, Type_Mark, True); if A_Range = Null_Iir then -- Avoid error propagation. A_Range := Get_Range_Constraint (Type_Mark); end if; end if; Set_Range_Constraint (Res, A_Range); Set_Type_Staticness (Res, Get_Expr_Staticness (A_Range)); Free_Name (Def); Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark)); if Tolerance /= Null_Iir then -- LRM93 4.2 Subtype declarations -- It is an error in this case the subtype is not a nature -- type -- -- FIXME: should be moved into sem_subtype_indication if Get_Kind (Res) /= Iir_Kind_Floating_Subtype_Definition then Error_Msg_Sem ("tolerance allowed only for floating subtype", Tolerance); else -- LRM93 4.2 Subtype declarations -- If the subtype indication includes a tolerance aspect, then -- the string expression must be a static expression Tolerance := Sem_Expression (Tolerance, String_Type_Definition); if Tolerance /= Null_Iir and then Get_Expr_Staticness (Tolerance) /= Locally then Error_Msg_Sem ("tolerance must be a static string", Tolerance); end if; Set_Tolerance (Res, Tolerance); end if; end if; end if; if Resolution /= Null_Iir then -- LRM08 6.3 Subtype declarations. if Get_Kind (Resolution) not in Iir_Kinds_Denoting_Name then Error_Msg_Sem ("resolution indication must be a function name", Resolution); else Sem_Resolution_Function (Resolution, Res); end if; end if; return Res; end Sem_Range_Constraint; function Sem_Subtype_Constraint (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir is begin case Get_Kind (Type_Mark) is when Iir_Kind_Array_Subtype_Definition | Iir_Kind_Array_Type_Definition => return Sem_Array_Constraint (Def, Type_Mark, Resolution); when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Enumeration_Type_Definition=> return Sem_Range_Constraint (Def, Type_Mark, Resolution); when Iir_Kind_Record_Type_Definition | Iir_Kind_Record_Subtype_Definition => return Sem_Record_Constraint (Def, Type_Mark, Resolution); when Iir_Kind_Access_Type_Definition | Iir_Kind_Access_Subtype_Definition => -- LRM93 4.2 -- A subtype indication denoting an access type [or a file type] -- may not contain a resolution function. if Resolution /= Null_Iir then Error_Msg_Sem ("resolution function not allowed for an access type", Def); end if; case Get_Kind (Def) is when Iir_Kind_Subtype_Definition => Free_Name (Def); return Copy_Subtype_Indication (Type_Mark); when Iir_Kind_Array_Subtype_Definition => -- LRM93 3.3 -- The only form of constraint that is allowed after a name -- of an access type in a subtype indication is an index -- constraint. declare Sub_Type : Iir; Base_Type : Iir; Res : Iir; begin Base_Type := Get_Designated_Type (Type_Mark); Sub_Type := Sem_Array_Constraint (Def, Base_Type, Null_Iir); Res := Create_Iir (Iir_Kind_Access_Subtype_Definition); Location_Copy (Res, Def); Set_Base_Type (Res, Type_Mark); Set_Designated_Subtype_Indication (Res, Sub_Type); Set_Signal_Type_Flag (Res, False); return Res; end; when others => raise Internal_Error; end case; when Iir_Kind_File_Type_Definition => -- LRM08 6.3 Subtype declarations -- A subtype indication denoting a subtype of [...] a file -- type [...] shall not contain a constraint. if Get_Kind (Def) /= Iir_Kind_Subtype_Definition or else Get_Range_Constraint (Def) /= Null_Iir then Error_Msg_Sem ("file types can't be constrained", Def); return Type_Mark; end if; -- LRM93 4.2 -- A subtype indication denoting [an access type or] a file type -- may not contain a resolution function. if Resolution /= Null_Iir then Error_Msg_Sem ("resolution function not allowed for file types", Def); return Type_Mark; end if; Free_Name (Def); return Type_Mark; when Iir_Kind_Protected_Type_Declaration => -- LRM08 6.3 Subtype declarations -- A subtype indication denoting a subtype of [...] a protected -- type [...] shall not contain a constraint. if Get_Kind (Def) /= Iir_Kind_Subtype_Definition or else Get_Range_Constraint (Def) /= Null_Iir then Error_Msg_Sem ("protected types can't be constrained", Def); return Type_Mark; end if; -- LRM08 6.3 Subtype declarations -- A subtype indication denoting [...] a protected type shall -- not contain a resolution function. if Resolution /= Null_Iir then Error_Msg_Sem ("resolution function not allowed for file types", Def); return Type_Mark; end if; Free_Name (Def); return Type_Mark; when others => Error_Kind ("sem_subtype_constraint", Type_Mark); return Type_Mark; end case; end Sem_Subtype_Constraint; function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False) return Iir is Type_Mark_Name : Iir; Type_Mark: Iir; Res : Iir; begin -- LRM08 6.3 Subtype declarations -- -- If the subtype indication does not include a constraint, the subtype -- is the same as that denoted by the type mark. if Get_Kind (Def) in Iir_Kinds_Denoting_Name then Type_Mark := Sem_Type_Mark (Def, Incomplete); return Type_Mark; end if; -- Semantize the type mark. Type_Mark_Name := Get_Subtype_Type_Mark (Def); Type_Mark_Name := Sem_Type_Mark (Type_Mark_Name); Set_Subtype_Type_Mark (Def, Type_Mark_Name); Type_Mark := Get_Type (Type_Mark_Name); -- FIXME: incomplete type ? if Get_Kind (Type_Mark) = Iir_Kind_Error then -- FIXME: handle inversion such as "subtype BASETYPE RESOLV", which -- should emit "resolution function must precede type name". -- Discard the subtype definition and only keep the type mark. return Type_Mark_Name; end if; Res := Sem_Subtype_Constraint (Def, Type_Mark, Get_Resolution_Indication (Def)); Set_Subtype_Type_Mark (Res, Type_Mark_Name); return Res; end Sem_Subtype_Indication; function Copy_Subtype_Indication (Def : Iir) return Iir is Res : Iir; begin case Get_Kind (Def) is when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition => Res := Create_Iir (Get_Kind (Def)); Set_Range_Constraint (Res, Get_Range_Constraint (Def)); Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); when Iir_Kind_Enumeration_Type_Definition => Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); Set_Range_Constraint (Res, Get_Range_Constraint (Def)); when Iir_Kind_Access_Subtype_Definition | Iir_Kind_Access_Type_Definition => Res := Create_Iir (Iir_Kind_Access_Subtype_Definition); Set_Designated_Type (Res, Get_Designated_Type (Def)); when Iir_Kind_Array_Type_Definition => Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Type_Staticness (Res, Get_Type_Staticness (Def)); Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); Set_Index_Constraint_List (Res, Null_Iir_List); Set_Index_Subtype_List (Res, Get_Index_Subtype_Definition_List (Def)); Set_Element_Subtype (Res, Get_Element_Subtype (Def)); Set_Index_Constraint_Flag (Res, False); Set_Constraint_State (Res, Get_Constraint_State (Def)); when Iir_Kind_Array_Subtype_Definition => Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def)); Set_Element_Subtype (Res, Get_Element_Subtype (Def)); Set_Index_Constraint_Flag (Res, Get_Index_Constraint_Flag (Def)); Set_Constraint_State (Res, Get_Constraint_State (Def)); when Iir_Kind_Record_Type_Definition | Iir_Kind_Record_Subtype_Definition => Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); Set_Type_Staticness (Res, Get_Type_Staticness (Def)); if Get_Kind (Def) = Iir_Kind_Record_Subtype_Definition then Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); end if; Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); Set_Constraint_State (Res, Get_Constraint_State (Def)); Set_Elements_Declaration_List (Res, Get_Elements_Declaration_List (Def)); when others => -- FIXME: todo (protected type ?) Error_Kind ("copy_subtype_indication", Def); end case; Location_Copy (Res, Def); Set_Base_Type (Res, Get_Base_Type (Def)); Set_Type_Staticness (Res, Get_Type_Staticness (Def)); Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Def)); return Res; end Copy_Subtype_Indication; function Sem_Subnature_Indication (Def: Iir) return Iir is Nature_Mark: Iir; Res : Iir; begin -- LRM 4.8 Nature declatation -- -- If the subnature indication does not include a constraint, the -- subnature is the same as that denoted by the type mark. case Get_Kind (Def) is when Iir_Kind_Scalar_Nature_Definition => -- Used for reference declared by a nature return Def; when Iir_Kinds_Denoting_Name => Nature_Mark := Sem_Denoting_Name (Def); Res := Get_Named_Entity (Nature_Mark); if Get_Kind (Res) /= Iir_Kind_Scalar_Nature_Definition then Error_Class_Match (Nature_Mark, "nature"); raise Program_Error; -- TODO else return Nature_Mark; end if; when others => raise Program_Error; -- TODO end case; end Sem_Subnature_Indication; end Sem_Types;