vhdl: reduce use of is_anonymous_type_definition

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.