diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/vhdl-canon.adb | 22 | ||||
| -rw-r--r-- | src/vhdl/vhdl-nodes.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_decls.adb | 10 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_expr.adb | 17 | ||||
| -rw-r--r-- | src/vhdl/vhdl-utils.adb | 17 | ||||
| -rw-r--r-- | src/vhdl/vhdl-utils.ads | 5 |
6 files changed, 40 insertions, 34 deletions
diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index d5d65a157..6cb8ca5c0 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -74,7 +74,7 @@ package body Vhdl.Canon is Conf : Iir_Block_Configuration); procedure Canon_Subtype_Indication (Def : Iir); - procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir); + procedure Canon_Subtype_Indication_If_Owned (Decl : Iir); function Canon_Conditional_Signal_Assignment (Conc_Stmt : Iir; Proc : Iir; Parent : Iir; Clear : Boolean) return Iir; @@ -3143,12 +3143,14 @@ package body Vhdl.Canon is case Get_Kind (Def) is when Iir_Kind_Array_Subtype_Definition => declare - Indexes : constant Iir_Flist := Get_Index_Subtype_List (Def); + Indexes : constant Iir_Flist := Get_Index_Constraint_List (Def); Index : Iir; begin for I in Flist_First .. Flist_Last (Indexes) loop - Index := Get_Index_Type (Indexes, I); - Canon_Subtype_Indication_If_Anonymous (Index); + Index := Get_Nth_Element (Indexes, I); + if Is_Proper_Subtype_Indication (Index) then + Canon_Subtype_Indication (Index); + end if; end loop; end; when Iir_Kind_Integer_Subtype_Definition @@ -3172,12 +3174,12 @@ package body Vhdl.Canon is end case; end Canon_Subtype_Indication; - procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir) is + procedure Canon_Subtype_Indication_If_Owned (Decl : Iir) is begin - if Is_Anonymous_Type_Definition (Def) then - Canon_Subtype_Indication (Def); + if Has_Owned_Subtype_Indication (Decl) then + Canon_Subtype_Indication (Get_Subtype_Indication (Decl)); end if; - end Canon_Subtype_Indication_If_Anonymous; + end Canon_Subtype_Indication_If_Owned; -- Return the new package declaration (if any). function Canon_Package_Instantiation_Declaration (Decl : Iir) return Iir @@ -3262,7 +3264,7 @@ package body Vhdl.Canon is | Iir_Kind_Signal_Declaration | Iir_Kind_Constant_Declaration => if Canon_Flag_Expressions then - Canon_Subtype_Indication_If_Anonymous (Get_Type (Decl)); + Canon_Subtype_Indication_If_Owned (Decl); Canon_Expression (Get_Default_Value (Decl)); end if; @@ -3657,7 +3659,7 @@ package body Vhdl.Canon is if Canon_Flag_Expressions then Inter := Chain; while Inter /= Null_Iir loop - Canon_Subtype_Indication_If_Anonymous (Get_Type (Inter)); + Canon_Subtype_Indication_If_Owned (Inter); Canon_Expression (Get_Default_Value (Inter)); Inter := Get_Chain (Inter); end loop; diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index a1efaf81f..80d8b091b 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -4417,8 +4417,7 @@ package Vhdl.Nodes is -- Get/Set_Subtype_Indication (Field5) -- -- Only for Iir_Kind_Allocator_By_Subtype: - -- Same as subtype indication but set when the allocator defines a new - -- subtype. Used to track when an anonymous subtype is created. + -- Same as subtype indication but owned. -- Get/Set_Allocator_Subtype (Field3) -- -- To ease analysis: set to the designated type (either the type of the diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index 32daadeb6..a84435fa9 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -852,7 +852,7 @@ package body Vhdl.Sem_Decls is return; end if; - if not Is_Anonymous_Type_Definition (Def) then + if Is_Proper_Subtype_Indication (Ind) then if Get_Kind (Def) /= Iir_Kind_Protected_Type_Declaration and then Get_Kind (Def) /= Iir_Kind_Interface_Type_Definition then @@ -2128,15 +2128,17 @@ package body Vhdl.Sem_Decls is return; end if; - if not Is_Anonymous_Nature_Definition (Def) then + if not Is_Proper_Subnature_Indication (Ind) then -- There is no added constraints and therefore the subtype -- declaration is in fact an alias of the type. Create a copy so -- that it has its own type declarator. - raise Internal_Error; + -- FIXME: is it needed ? + null; + else + Set_Nature_Declarator (Def, Decl); end if; Set_Nature (Decl, Def); - Set_Nature_Declarator (Def, Decl); Name_Visible (Decl); end Sem_Subnature_Declaration; diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 332a11dfc..6ae3f818b 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -4571,7 +4571,8 @@ package body Vhdl.Sem_Expr is -- Analyze an allocator by expression or an allocator by subtype. function Sem_Allocator (Expr : Iir; A_Type : Iir) return Iir is - Arg: Iir; + Arg : Iir; + Ind : Iir; Arg_Type : Iir; begin Set_Expr_Staticness (Expr, None); @@ -4594,16 +4595,14 @@ package body Vhdl.Sem_Expr is when Iir_Kind_Allocator_By_Subtype => -- Analyze subtype indication. - Arg := Get_Subtype_Indication (Expr); - Arg := Sem_Types.Sem_Subtype_Indication (Arg); - Set_Subtype_Indication (Expr, Arg); - Arg := Get_Type_Of_Subtype_Indication (Arg); + Ind := Get_Subtype_Indication (Expr); + Ind := Sem_Types.Sem_Subtype_Indication (Ind); + Set_Subtype_Indication (Expr, Ind); + Set_Allocator_Subtype (Expr, Ind); + Arg := Get_Type_Of_Subtype_Indication (Ind); if Arg = Null_Iir or else Is_Error (Arg) then return Null_Iir; end if; - if Is_Anonymous_Type_Definition (Arg) then - Set_Allocator_Subtype (Expr, Get_Subtype_Indication (Expr)); - end if; -- LRM93 7.3.6 -- If an allocator includes a subtype indication and if the @@ -4618,7 +4617,7 @@ package body Vhdl.Sem_Expr is -- LRM93 7.3.6 -- A subtype indication that is part of an allocator must -- not include a resolution function. - if Is_Anonymous_Type_Definition (Arg) + if Is_Proper_Subtype_Indication (Ind) and then Get_Kind (Arg) /= Iir_Kind_Access_Subtype_Definition and then Get_Resolution_Indication (Arg) /= Null_Iir then diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index fa5f31ee8..084e39e5a 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -1124,11 +1124,6 @@ package body Vhdl.Utils is return Get_Type_Declarator (Def) = Null_Iir; end Is_Anonymous_Type_Definition; - function Is_Anonymous_Nature_Definition (Def : Iir) return Boolean is - begin - return Get_Nature_Declarator (Def) = Null_Iir; - end Is_Anonymous_Nature_Definition; - function Is_Array_Type (Def : Iir) return Boolean is begin return Get_Kind (Def) in Iir_Kinds_Array_Type_Definition; @@ -1337,6 +1332,18 @@ package body Vhdl.Utils is end case; end Is_Proper_Subtype_Indication; + function Is_Proper_Subnature_Indication (Def : Iir) return Boolean is + begin + case Get_Kind (Def) is + when Iir_Kinds_Subnature_Definition => + return True; + when Iir_Kinds_Denoting_Name => + return False; + when others => + Error_Kind ("is_proper_subnature_indication", Def); + end case; + end Is_Proper_Subnature_Indication; + function Has_Owned_Subtype_Indication (Decl : Iir) return Boolean is Def : Iir; diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads index 8dba4e221..4ff81b011 100644 --- a/src/vhdl/vhdl-utils.ads +++ b/src/vhdl/vhdl-utils.ads @@ -190,10 +190,6 @@ package Vhdl.Utils is function Is_Anonymous_Type_Definition (Def : Iir) return Boolean; pragma Inline (Is_Anonymous_Type_Definition); - -- Likewise but for natures. - function Is_Anonymous_Nature_Definition (Def : Iir) return Boolean; - pragma Inline (Is_Anonymous_Nature_Definition); - -- Return TRUE iff DEF is a fully constrained type (or subtype) definition. function Is_Fully_Constrained_Type (Def : Iir) return Boolean; @@ -261,6 +257,7 @@ package Vhdl.Utils is -- Return True iff DEF defines a new subtype indication, not just an -- existing name (like a name). function Is_Proper_Subtype_Indication (Def : Iir) return Boolean; + function Is_Proper_Subnature_Indication (Def : Iir) return Boolean; -- Return True iff the subtype indication of DECL is defined/owned by -- DECL. |