Build all Static_Construct aggregate statically.

6 files changed, 204 insertions, 133 deletions

diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index a9ea3b18f..201ad1e95 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -496,36 +496,28 @@ package body Evaluation is
       end case;
    end Eval_Pos_In_Range;
 
-   function Aggregate_To_Simple_Aggregate (Aggr : Iir) return Iir
+   procedure Build_Array_Choices_Vector
+     (Vect : out Iir_Array; Choice_Range : Iir; Choices_Chain : Iir)
    is
-      Aggr_Type : constant Iir := Get_Type (Aggr);
-      Index_Type : constant Iir := Get_Index_Type (Aggr_Type, 0);
-      Index_Range : constant Iir := Eval_Static_Range (Index_Type);
-      Len : constant Iir_Int64 := Eval_Discrete_Range_Length (Index_Range);
-      List : Iir_List;
+      pragma Assert (Vect'First = 0);
+      pragma Assert (Vect'Length = Eval_Discrete_Range_Length (Choice_Range));
       Assoc : Iir;
-      Assoc_Expr : Iir;
+      Choice : Iir;
       Cur_Pos : Natural;
-
-      procedure Set_Element (Pos : Natural; El : Iir) is
-      begin
-         pragma Assert (Get_Nth_Element (List, Pos) = Null_Iir);
-         Replace_Nth_Element (List, Pos, El);
-      end Set_Element;
    begin
-      List := Create_Iir_List;
-      for I in 1 .. Len loop
-         Append_Element (List, Null_Iir);
-      end loop;
+      --  Initialize Vect (to correctly handle 'others').
+      Vect := (others => Null_Iir);
 
-      Assoc := Get_Association_Choices_Chain (Aggr);
+      Assoc := Choices_Chain;
       Cur_Pos := 0;
+      Choice := Null_Iir;
       while Is_Valid (Assoc) loop
-         Assoc_Expr := Get_Associated_Expr (Assoc);
-         Assoc_Expr := Eval_Static_Expr (Assoc_Expr);
+         if not Get_Same_Alternative_Flag (Assoc) then
+            Choice := Assoc;
+         end if;
          case Iir_Kinds_Array_Choice (Get_Kind (Assoc)) is
             when Iir_Kind_Choice_By_None =>
-               Set_Element (Cur_Pos, Assoc_Expr);
+               Vect (Cur_Pos) := Choice;
                Cur_Pos := Cur_Pos + 1;
             when Iir_Kind_Choice_By_Range =>
                declare
@@ -533,33 +525,67 @@ package body Evaluation is
                   Rng_Start : Iir;
                   Rng_Len : Iir_Int64;
                begin
-                  if Get_Direction (Rng) = Get_Direction (Index_Range) then
+                  if Get_Direction (Rng) = Get_Direction (Choice_Range) then
                      Rng_Start := Get_Left_Limit (Rng);
                   else
                      Rng_Start := Get_Right_Limit (Rng);
                   end if;
                   Cur_Pos := Natural
-                    (Eval_Pos_In_Range (Index_Range, Rng_Start));
+                    (Eval_Pos_In_Range (Choice_Range, Rng_Start));
                   Rng_Len := Eval_Discrete_Range_Length (Rng);
                   for I in 1 .. Rng_Len loop
-                     Set_Element (Cur_Pos, Assoc_Expr);
+                     Vect (Cur_Pos) := Choice;
                      Cur_Pos := Cur_Pos + 1;
                   end loop;
                end;
             when Iir_Kind_Choice_By_Expression =>
                Cur_Pos := Natural
-                 (Eval_Pos_In_Range (Index_Range,
+                 (Eval_Pos_In_Range (Choice_Range,
                                      Get_Choice_Expression (Assoc)));
-               Set_Element (Cur_Pos, Assoc_Expr);
+               Vect (Cur_Pos) := Choice;
             when Iir_Kind_Choice_By_Others =>
-               for I in 1 .. Len loop
-                  if Get_Nth_Element (List, Natural (I - 1)) = Null_Iir then
-                     Set_Element (Natural (I - 1), Assoc_Expr);
+               for I in Vect'Range loop
+                  if Vect (I) = Null_Iir then
+                     Vect (I) := Choice;
                   end if;
                end loop;
          end case;
          Assoc := Get_Chain (Assoc);
       end loop;
+   end Build_Array_Choices_Vector;
+
+   function Aggregate_To_Simple_Aggregate (Aggr : Iir) return Iir
+   is
+      Aggr_Type : constant Iir := Get_Type (Aggr);
+      Index_Type : constant Iir := Get_Index_Type (Aggr_Type, 0);
+      Index_Range : constant Iir := Eval_Static_Range (Index_Type);
+      Len : constant Iir_Int64 := Eval_Discrete_Range_Length (Index_Range);
+      Assocs : constant Iir := Get_Association_Choices_Chain (Aggr);
+      Vect : Iir_Array (0 .. Natural (Len - 1));
+      List : Iir_List;
+      Assoc : Iir;
+      Expr : Iir;
+   begin
+      Assoc := Assocs;
+      while Is_Valid (Assoc) loop
+         if not Get_Same_Alternative_Flag (Assoc) then
+            Expr := Get_Associated_Expr (Assoc);
+            if Get_Kind (Get_Type (Expr))
+              in Iir_Kinds_Scalar_Type_Definition
+            then
+               Expr := Eval_Static_Expr (Expr);
+               Set_Associated_Expr (Assoc, Expr);
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      Build_Array_Choices_Vector (Vect, Index_Range, Assocs);
+
+      List := Create_Iir_List;
+      for I in Vect'Range loop
+         Append_Element (List, Get_Associated_Expr (Vect (I)));
+      end loop;
 
       return Build_Simple_Aggregate (List, Aggr, Aggr_Type);
    end Aggregate_To_Simple_Aggregate;
diff --git a/src/vhdl/evaluation.ads b/src/vhdl/evaluation.ads
index 95eb0202f..7490996c9 100644
--- a/src/vhdl/evaluation.ads
+++ b/src/vhdl/evaluation.ads
@@ -142,6 +142,13 @@ package Evaluation is
    --  Create a Iir_Kind_Overflow node of type EXPR_TYPE for ORIGIN.
    function Build_Overflow (Origin : Iir; Expr_Type : Iir) return Iir;
 
+   --  Fill VECT with choices from CHOICES_CHAIN: each position of CHOICE_RANGE
+   --  is associated with its corresponding choice from CHOICES_CHAIN.
+   --  VECT bounds must be 0 .. Len - 1, where Len is the length of
+   --  CHOICE_RANGE.
+   procedure Build_Array_Choices_Vector
+     (Vect : out Iir_Array; Choice_Range : Iir; Choices_Chain : Iir);
+
    --  Create an array subtype from LEN and BASE_TYPE, according to rules
    --  of LRM93 7.3.2.2. (which are the same as LRM93 7.2.4).
    function Create_Unidim_Array_By_Length
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 5d407a3e6..f12ef8661 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -1054,6 +1054,21 @@ package body Iirs_Utils is
       return Get_Nbr_Elements (Get_Index_Subtype_List (Array_Type));
    end Get_Nbr_Dimensions;
 
+   function Are_Bounds_Locally_Static (Array_Type : Iir) return Boolean
+   is
+      Indexes : constant Iir_List := Get_Index_Subtype_List (Array_Type);
+      Index : Iir;
+   begin
+      for I in Natural loop
+         Index := Get_Index_Type (Indexes, I);
+         exit when Index = Null_Iir;
+         if Get_Type_Staticness (Index) /= Locally then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Are_Bounds_Locally_Static;
+
    function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir
    is
       Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp);
diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads
index 39d56a8ff..771172fca 100644
--- a/src/vhdl/iirs_utils.ads
+++ b/src/vhdl/iirs_utils.ads
@@ -223,6 +223,9 @@ package Iirs_Utils is
    --  Number of dimensions (1..n) for ARRAY_TYPE.
    function Get_Nbr_Dimensions (Array_Type : Iir) return Natural;
 
+   --  Return True iff the all bounds of ARRAY_TYPE are locally static.
+   function Are_Bounds_Locally_Static (Array_Type : Iir) return Boolean;
+
    --  Return the type or subtype definition of the SUBTYP type mark.
    function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir;
 
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 6b7624358..60189caa4 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -2904,6 +2904,9 @@ package body Sem_Expr is
       Rec_El_Index : Natural;
       Expr_Staticness : Iir_Staticness;
    begin
+      --  Not yet handled.
+      Set_Aggregate_Expand_Flag (Aggr, False);
+
       Ok := True;
       Assoc_Chain := Get_Association_Choices_Chain (Aggr);
       Matches := (others => Null_Iir);
@@ -3340,6 +3343,11 @@ package body Sem_Expr is
       --  Analyze aggregate elements.
       if Constrained then
          Expr_Staticness := Get_Type_Staticness (Index_Type);
+         if Expr_Staticness /= Locally then
+            --  Cannot be statically built as the bounds are not known and
+            --  must be checked at run-time.
+            Set_Aggregate_Expand_Flag (Aggr, False);
+         end if;
       else
          Expr_Staticness := Locally;
       end if;
@@ -3364,8 +3372,8 @@ package body Sem_Expr is
          begin
             El := Assoc_Chain;
             while El /= Null_Iir loop
-               Expr := Get_Associated_Expr (El);
-               if Expr /= Null_Iir then
+               if not Get_Same_Alternative_Flag (El) then
+                  Expr := Get_Associated_Expr (El);
                   Expr := Sem_Expression (Expr, Element_Type);
                   if Expr /= Null_Iir then
                      El_Staticness := Get_Expr_Staticness (Expr);
@@ -3396,38 +3404,40 @@ package body Sem_Expr is
       else
          --  A sub-aggregate: recurse.
          declare
-            Assoc : Iir;
+            Sub_Aggr : Iir;
          begin
-            Assoc := Null_Iir;
             Choice := Assoc_Chain;
             while Choice /= Null_Iir loop
-               if Get_Associated_Expr (Choice) /= Null_Iir then
-                  Assoc := Get_Associated_Expr (Choice);
-               end if;
-               case Get_Kind (Assoc) is
-                  when Iir_Kind_Aggregate =>
-                     Sem_Array_Aggregate_Type_1
-                       (Assoc, A_Type, Infos, Constrained, Dim + 1);
-                  when Iir_Kind_String_Literal8 =>
-                     if Dim + 1 = Get_Nbr_Elements (Index_List) then
+               if not Get_Same_Alternative_Flag (Choice) then
+                  Sub_Aggr := Get_Associated_Expr (Choice);
+                  case Get_Kind (Sub_Aggr) is
+                     when Iir_Kind_Aggregate =>
                         Sem_Array_Aggregate_Type_1
-                          (Assoc, A_Type, Infos, Constrained, Dim + 1);
-                     else
-                        Error_Msg_Sem
-                          (+Assoc, "string literal not allowed here");
+                          (Sub_Aggr, A_Type, Infos, Constrained, Dim + 1);
+                        if not Get_Aggregate_Expand_Flag (Sub_Aggr) then
+                           Set_Aggregate_Expand_Flag (Aggr, False);
+                        end if;
+                     when Iir_Kind_String_Literal8 =>
+                        if Dim + 1 = Get_Nbr_Elements (Index_List) then
+                           Sem_Array_Aggregate_Type_1
+                             (Sub_Aggr, A_Type, Infos, Constrained, Dim + 1);
+                        else
+                           Error_Msg_Sem
+                             (+Sub_Aggr, "string literal not allowed here");
+                           Infos (Dim + 1).Error := True;
+                        end if;
+                     when others =>
+                        Error_Msg_Sem (+Sub_Aggr, "sub-aggregate expected");
                         Infos (Dim + 1).Error := True;
-                     end if;
-                  when others =>
-                     Error_Msg_Sem (+Assoc, "sub-aggregate expected");
-                     Infos (Dim + 1).Error := True;
-               end case;
+                  end case;
+               end if;
                Choice := Get_Chain (Choice);
             end loop;
          end;
       end if;
-      Set_Expr_Staticness (Aggr, Min (Get_Expr_Staticness (Aggr),
-                                      Min (Expr_Staticness,
-                                           Choice_Staticness)));
+      Expr_Staticness := Min (Get_Expr_Staticness (Aggr),
+                              Min (Expr_Staticness, Choice_Staticness));
+      Set_Expr_Staticness (Aggr, Expr_Staticness);
    end Sem_Array_Aggregate_Type_1;
 
    --  Analyze an array aggregate whose type is AGGR_TYPE.
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 661b95af2..aeffd32ea 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -73,7 +73,6 @@ package body Trans.Chap7 is
 
       --  Handle only constrained to unconstrained conversion.
       pragma Assert (Get_Kind (Res_Type) in Iir_Kinds_Array_Type_Definition);
-      pragma Assert (Get_Constraint_State (Res_Type) = Unconstrained);
 
       Expr_Info := Get_Info (Expr_Type);
       Res_Info := Get_Info (Res_Type);
@@ -167,56 +166,61 @@ package body Trans.Chap7 is
       end loop;
    end Translate_Static_String_Literal8_Inner;
 
-   procedure Translate_Static_Aggregate_1 (List    : in out O_Array_Aggr_List;
-                                           Aggr    : Iir;
-                                           Info    : Iir;
-                                           El_Type : Iir)
+   procedure Translate_Static_Array_Aggregate_1
+     (List : in out O_Array_Aggr_List;
+      Aggr : Iir;
+      Aggr_Type : Iir;
+      Dim : Positive)
    is
-      N_Info : constant Iir := Get_Sub_Aggregate_Info (Info);
-      Assoc  : Iir;
-      Sub    : Iir;
+      Nbr_Dims  : constant Natural := Get_Nbr_Dimensions (Aggr_Type);
+      El_Type   : constant Iir := Get_Element_Subtype (Aggr_Type);
    begin
       case Get_Kind (Aggr) is
          when Iir_Kind_Aggregate =>
-            Assoc := Get_Association_Choices_Chain (Aggr);
-            while Assoc /= Null_Iir loop
-               Sub := Get_Associated_Expr (Assoc);
-               case Get_Kind (Assoc) is
-                  when Iir_Kind_Choice_By_None =>
-                     if N_Info = Null_Iir then
-                        New_Array_Aggr_El
-                          (List, Translate_Static_Expression (Sub, El_Type));
-                     else
-                        Translate_Static_Aggregate_1
-                          (List, Sub, N_Info, El_Type);
-                     end if;
-                  when others =>
-                     Error_Kind ("translate_static_aggregate_1(2)", Assoc);
-               end case;
-               Assoc := Get_Chain (Assoc);
-            end loop;
+            declare
+               Index_Type : constant Iir :=
+                 Get_Index_Type (Aggr_Type, Dim - 1);
+               Index_Range : constant Iir := Eval_Static_Range (Index_Type);
+               Len : constant Iir_Int64 :=
+                 Eval_Discrete_Range_Length (Index_Range);
+               Assocs : constant Iir := Get_Association_Choices_Chain (Aggr);
+               Vect : Iir_Array (0 .. Integer (Len - 1));
+            begin
+               Build_Array_Choices_Vector (Vect, Index_Range, Assocs);
+
+               if Dim = Nbr_Dims then
+                  for I in Vect'Range loop
+                     New_Array_Aggr_El
+                       (List,
+                        Translate_Static_Expression
+                          (Get_Associated_Expr (Vect (I)), El_Type));
+                  end loop;
+               else
+                  for I in Vect'Range loop
+                     Translate_Static_Array_Aggregate_1
+                       (List, Get_Associated_Expr (Vect (I)),
+                        Aggr_Type, Dim + 1);
+                  end loop;
+               end if;
+            end;
          when Iir_Kind_String_Literal8 =>
-            if N_Info /= Null_Iir then
-               raise Internal_Error;
-            end if;
+            pragma Assert (Dim = Nbr_Dims);
             Translate_Static_String_Literal8_Inner (List, Aggr, El_Type);
          when others =>
-            Error_Kind ("translate_static_aggregate_1", Aggr);
+            Error_Kind ("translate_static_array_aggregate_1", Aggr);
       end case;
-   end Translate_Static_Aggregate_1;
+   end Translate_Static_Array_Aggregate_1;
 
    function Translate_Static_Aggregate (Aggr : Iir) return O_Cnode
    is
       Aggr_Type : constant Iir := Get_Type (Aggr);
-      El_Type   : constant Iir := Get_Element_Subtype (Aggr_Type);
       List      : O_Array_Aggr_List;
       Res       : O_Cnode;
    begin
       Chap3.Translate_Anonymous_Type_Definition (Aggr_Type);
       Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
 
-      Translate_Static_Aggregate_1
-        (List, Aggr, Get_Aggregate_Info (Aggr), El_Type);
+      Translate_Static_Array_Aggregate_1 (List, Aggr, Aggr_Type, 1);
       Finish_Array_Aggr (List, Res);
       return Res;
    end Translate_Static_Aggregate;
@@ -416,7 +420,8 @@ package body Trans.Chap7 is
       return Res;
    end Translate_Static_String;
 
-   function Translate_String_Literal (Str : Iir; Res_Type : Iir) return O_Enode
+   function Translate_Composite_Literal (Str : Iir; Res_Type : Iir)
+                                        return O_Enode
    is
       Str_Type : constant Iir := Get_Type (Str);
       Is_Static : Boolean;
@@ -427,7 +432,7 @@ package body Trans.Chap7 is
       R        : O_Enode;
    begin
       if Get_Constraint_State (Str_Type) = Fully_Constrained
-        and then Get_Type_Staticness (Get_Index_Type (Str_Type, 0)) = Locally
+        and then Are_Bounds_Locally_Static (Str_Type)
       then
          Chap3.Create_Array_Subtype (Str_Type);
          case Get_Kind (Str) is
@@ -438,11 +443,12 @@ package body Trans.Chap7 is
             when Iir_Kind_Simple_Name_Attribute =>
                Res := Translate_Static_String
                  (Get_Type (Str), Get_Simple_Name_Identifier (Str));
+            when Iir_Kind_Aggregate =>
+               Res := Translate_Static_Aggregate (Str);
             when others =>
                raise Internal_Error;
          end case;
-         Is_Static :=
-           Get_Type_Staticness (Get_Index_Type (Res_Type, 0)) = Locally;
+         Is_Static := Are_Bounds_Locally_Static (Res_Type);
 
          if Is_Static then
             Res := Translate_Static_Implicit_Conv (Res, Str_Type, Res_Type);
@@ -465,7 +471,7 @@ package body Trans.Chap7 is
            (Translate_Non_Static_String_Literal (Str), Str_Type, Res_Type,
             Mode_Value, Str);
       end if;
-   end Translate_String_Literal;
+   end Translate_Composite_Literal;
 
    function Translate_Numeric_Literal (Expr : Iir; Res_Type : O_Tnode)
                                       return O_Cnode is
@@ -3775,54 +3781,58 @@ package body Trans.Chap7 is
          when Iir_Kind_String_Literal8
             | Iir_Kind_Simple_Aggregate
             | Iir_Kind_Simple_Name_Attribute =>
-            return Translate_String_Literal (Expr, Res_Type);
+            return Translate_Composite_Literal (Expr, Res_Type);
 
          when Iir_Kind_Aggregate =>
-            declare
-               Aggr_Type : Iir;
-               Tinfo     : Type_Info_Acc;
-               Mres      : Mnode;
-            begin
-               --  Extract the type of the aggregate.  Use the type of the
-               --  context if it is fully constrained.
-               Aggr_Type := Expr_Type;
-               if Rtype /= Null_Iir
-                 and then Is_Fully_Constrained_Type (Rtype)
-               then
-                  Aggr_Type := Rtype;
-               else
-                  pragma Assert (Is_Fully_Constrained_Type (Expr_Type));
-                  null;
-               end if;
+            if Get_Aggregate_Expand_Flag (Expr) then
+               return Translate_Composite_Literal (Expr, Res_Type);
+            else
+               declare
+                  Aggr_Type : Iir;
+                  Tinfo     : Type_Info_Acc;
+                  Mres      : Mnode;
+               begin
+                  --  Extract the type of the aggregate.  Use the type of the
+                  --  context if it is fully constrained.
+                  Aggr_Type := Expr_Type;
+                  if Rtype /= Null_Iir
+                    and then Is_Fully_Constrained_Type (Rtype)
+                  then
+                     Aggr_Type := Rtype;
+                  else
+                     pragma Assert (Is_Fully_Constrained_Type (Expr_Type));
+                     null;
+                  end if;
 
-               if Get_Kind (Aggr_Type) = Iir_Kind_Array_Subtype_Definition
-               then
-                  Chap3.Create_Array_Subtype (Aggr_Type);
-               end if;
+                  if Get_Kind (Aggr_Type) = Iir_Kind_Array_Subtype_Definition
+                  then
+                     Chap3.Create_Array_Subtype (Aggr_Type);
+                  end if;
 
-               --  FIXME: this may be not necessary
-               Tinfo := Get_Info (Aggr_Type);
+                  --  FIXME: this may be not necessary
+                  Tinfo := Get_Info (Aggr_Type);
 
-               --  The result area has to be created
-               if Is_Complex_Type (Tinfo) then
-                  Mres := Create_Temp (Tinfo);
-                  Chap4.Allocate_Complex_Object
-                    (Aggr_Type, Alloc_Stack, Mres);
-               else
-                  --  if thin array/record:
-                  --    create result
-                  Mres := Create_Temp (Tinfo);
-               end if;
+                  --  The result area has to be created
+                  if Is_Complex_Type (Tinfo) then
+                     Mres := Create_Temp (Tinfo);
+                     Chap4.Allocate_Complex_Object
+                       (Aggr_Type, Alloc_Stack, Mres);
+                  else
+                     --  if thin array/record:
+                     --    create result
+                     Mres := Create_Temp (Tinfo);
+                  end if;
 
-               Translate_Aggregate (Mres, Aggr_Type, Expr);
-               Res := M2E (Mres);
+                  Translate_Aggregate (Mres, Aggr_Type, Expr);
+                  Res := M2E (Mres);
 
-               if Rtype /= Null_Iir and then Aggr_Type /= Rtype then
-                  Res := Translate_Implicit_Conv
-                    (Res, Aggr_Type, Rtype, Mode_Value, Expr);
-               end if;
-               return Res;
-            end;
+                  if Rtype /= Null_Iir and then Aggr_Type /= Rtype then
+                     Res := Translate_Implicit_Conv
+                       (Res, Aggr_Type, Rtype, Mode_Value, Expr);
+                  end if;
+                  return Res;
+               end;
+            end if;
 
          when Iir_Kind_Null_Literal =>
             declare