synth: improve handling of 2008 aggregates

1 files changed, 142 insertions, 27 deletions

diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb
index 533dedf05..650510e0e 100644
--- a/src/synth/synth-vhdl_aggr.adb
+++ b/src/synth/synth-vhdl_aggr.adb
@@ -24,6 +24,7 @@ with Netlists.Utils; use Netlists.Utils;
 with Netlists.Builders; use Netlists.Builders;
 
 with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Nodes_Utils;
 
 with Elab.Memtype; use Elab.Memtype;
 with Elab.Vhdl_Types; use Elab.Vhdl_Types;
@@ -114,6 +115,7 @@ package body Synth.Vhdl_Aggr is
       end case;
    end Fill_Stride;
 
+   --  VEC1_P is true iff RES(1) is a vector (and not an element).
    procedure Fill_Array_Aggregate (Syn_Inst : Synth_Instance_Acc;
                                    Aggr : Node;
                                    Res : Valtyp_Array_Acc;
@@ -122,7 +124,8 @@ package body Synth.Vhdl_Aggr is
                                    Strides : Stride_Array;
                                    Dim : Dim_Type;
                                    Const_P : out Boolean;
-                                   Err_P : out boolean)
+                                   Err_P : out Boolean;
+                                   Vec1_P : out Boolean)
    is
       Bound : constant Bound_Type := Get_Array_Bound (Typ);
       El_Typ : constant Type_Acc := Get_Array_Element (Typ);
@@ -153,6 +156,7 @@ package body Synth.Vhdl_Aggr is
       is
          Sub_Const : Boolean;
          Sub_Err : Boolean;
+         Sub_Vec1 : Boolean;
          Val : Valtyp;
       begin
          Nbr_Els := Nbr_Els + 1;
@@ -165,9 +169,10 @@ package body Synth.Vhdl_Aggr is
          else
             Fill_Array_Aggregate
               (Syn_Inst, Value, Res, El_Typ, Pos, Strides, Dim + 1,
-               Sub_Const, Sub_Err);
+               Sub_Const, Sub_Err, Sub_Vec1);
             Const_P := Const_P and Sub_Const;
             Err_P := Err_P or Sub_Err;
+            Vec1_P := Vec1_P or Sub_Vec1;
          end if;
       end Set_Elem;
 
@@ -190,6 +195,9 @@ package body Synth.Vhdl_Aggr is
          if Const_P and then not Is_Static (Val.Val) then
             Const_P := False;
          end if;
+         if Pos = 1 then
+            Vec1_P := True;
+         end if;
       end Set_Vector;
 
       Pos : Nat32;
@@ -198,6 +206,7 @@ package body Synth.Vhdl_Aggr is
       Nbr_Els := 0;
       Const_P := True;
       Err_P := False;
+      Vec1_P := False;
 
       if Get_Kind (Aggr) = Iir_Kind_String_Literal8 then
          declare
@@ -454,6 +463,35 @@ package body Synth.Vhdl_Aggr is
       return Res;
    end Valtyp_Array_To_Net;
 
+   function Valtyp_Array_To_Valtyp (Ctxt : Context_Acc;
+                                    Tab_Res : Valtyp_Array;
+                                    Res_Typ : Type_Acc;
+                                    Const_P : Boolean) return Valtyp
+   is
+      Res : Valtyp;
+   begin
+      if Const_P then
+         declare
+            Off : Size_Type;
+         begin
+            Res := Create_Value_Memory (Res_Typ, Current_Pool);
+            Off := 0;
+            for I in Tab_Res'Range loop
+               if Tab_Res (I).Val /= null then
+                  --  There can be holes due to sub-arrays.
+                  Write_Value (Res.Val.Mem + Off, Tab_Res (I));
+                  Off := Off + Tab_Res (I).Typ.Sz;
+               end if;
+            end loop;
+            pragma Assert (Off = Res_Typ.Sz);
+         end;
+      else
+         Res := Create_Value_Net
+           (Valtyp_Array_To_Net (Ctxt, Tab_Res), Res_Typ);
+      end if;
+      return Res;
+   end Valtyp_Array_To_Valtyp;
+
    function Synth_Aggregate_Array (Syn_Inst : Synth_Instance_Acc;
                                    Aggr : Node;
                                    Aggr_Typ : Type_Acc) return Valtyp
@@ -464,57 +502,132 @@ package body Synth.Vhdl_Aggr is
       Tab_Res : Valtyp_Array_Acc;
       Const_P : Boolean;
       Err_P : Boolean;
+      Vec1_P : Boolean;
       Res_Typ : Type_Acc;
+      El_Typ : Type_Acc;
       Res : Valtyp;
    begin
       Tab_Res := new Valtyp_Array(1 .. Nat32 (Flen));
       Tab_Res.all := (others => No_Valtyp);
 
       Fill_Array_Aggregate (Syn_Inst, Aggr, Tab_Res,
-                            Aggr_Typ, 1, Strides, 1, Const_P, Err_P);
+                            Aggr_Typ, 1, Strides, 1, Const_P, Err_P, Vec1_P);
       if Err_P then
          return No_Valtyp;
       end if;
 
-
       case Type_Vectors_Arrays (Aggr_Typ.Kind) is
          when Type_Array
            | Type_Vector =>
             Res_Typ := Aggr_Typ;
          when Type_Array_Unbounded =>
             --  TODO: check all element types have the same bounds ?
-            Res_Typ := Create_Array_From_Array_Unbounded
-              (Aggr_Typ, Tab_Res (1).Typ);
+            if Flen = 0 then
+               --  No bounds for the elements...
+               Res_Typ := Create_Array_From_Array_Unbounded
+                 (Aggr_Typ, Aggr_Typ.Arr_El);
+            else
+               --  Humm, is it a vector or an element ?
+               El_Typ := Tab_Res (1).Typ;
+               if Vec1_P then
+                  El_Typ := El_Typ.Arr_El;
+               end if;
+               Res_Typ := Create_Array_From_Array_Unbounded (Aggr_Typ, El_Typ);
+            end if;
          when Type_Unbounded_Vector
            | Type_Unbounded_Array =>
             raise Internal_Error;
       end case;
 
-      if Const_P then
-         declare
-            Off : Size_Type;
-         begin
-            Res := Create_Value_Memory (Res_Typ, Current_Pool);
-            Off := 0;
-            for I in Tab_Res'Range loop
-               if Tab_Res (I).Val /= null then
-                  --  There can be holes due to sub-arrays.
-                  Write_Value (Res.Val.Mem + Off, Tab_Res (I));
-                  Off := Off + Tab_Res (I).Typ.Sz;
-               end if;
-            end loop;
-            pragma Assert (Off = Res_Typ.Sz);
-         end;
-      else
-         Res := Create_Value_Net
-           (Valtyp_Array_To_Net (Ctxt, Tab_Res.all), Res_Typ);
-      end if;
+      Res := Valtyp_Array_To_Valtyp (Ctxt, Tab_Res.all, Res_Typ, Const_P);
 
       Free_Valtyp_Array (Tab_Res);
 
       return Res;
    end Synth_Aggregate_Array;
 
+   function Synth_Aggregate_Array_Concat (Syn_Inst : Synth_Instance_Acc;
+                                          Aggr : Node;
+                                          Aggr_Typ : Type_Acc) return Valtyp
+   is
+      Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+      Assoc_Chain : constant Node := Get_Association_Choices_Chain (Aggr);
+      Flen : constant Natural :=
+        Vhdl.Nodes_Utils.Get_Chain_Length (Assoc_Chain);
+      El_Typ : constant Type_Acc := Aggr_Typ.Uarr_El;
+      Assoc : Node;
+      Value : Node;
+      Val : Valtyp;
+      Len : Uns32;
+      Tab_Res : Valtyp_Array_Acc;
+      Const_P : Boolean;
+      Err_P : Boolean;
+      Res_Typ : Type_Acc;
+      Res : Valtyp;
+      Pos : Nat32;
+      Bnd: Bound_Type;
+   begin
+      Tab_Res := new Valtyp_Array(1 .. Nat32 (Flen));
+      Tab_Res.all := (others => No_Valtyp);
+
+      Len := 0;
+      Pos := Tab_Res'First;
+      Const_P := True;
+      Assoc := Assoc_Chain;
+      while Is_Valid (Assoc) loop
+         --  If there is a choice expression/range, then the array is
+         --  bounded.
+         pragma Assert (Get_Kind (Assoc) = Iir_Kind_Choice_By_None);
+         Value := Get_Associated_Expr (Assoc);
+         if Get_Element_Type_Flag (Assoc) then
+            Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ);
+            Val := Synth_Subtype_Conversion
+              (Syn_Inst, Val, El_Typ, False, Value);
+            Len := Len + 1;
+         else
+            Val := Synth_Expression_With_Basetype (Syn_Inst, Value);
+            if Val.Typ /= null then
+               Len := Len + Get_Bound_Length (Val.Typ);
+            end if;
+         end if;
+
+         Tab_Res (Pos) := Val;
+         Pos := Pos + 1;
+
+         if Val = No_Valtyp then
+            Err_P := True;
+         else
+            if Const_P and then not Is_Static (Val.Val) then
+               Const_P := False;
+            end if;
+         end if;
+
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      if Err_P then
+         return No_Valtyp;
+      end if;
+
+      --  Create the result type.
+      Bnd := Create_Bounds_From_Length
+        (Aggr_Typ.Uarr_Idx.Drange, Iir_Index32 (Len));
+      case Aggr_Typ.Kind is
+         when Type_Unbounded_Vector =>
+            Res_Typ := Create_Vector_Type (Bnd, El_Typ);
+         when Type_Unbounded_Array =>
+            Res_Typ := Create_Array_Type (Bnd, True, El_Typ);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Res := Valtyp_Array_To_Valtyp (Ctxt, Tab_Res.all, Res_Typ, Const_P);
+
+      Free_Valtyp_Array (Tab_Res);
+
+      return Res;
+   end Synth_Aggregate_Array_Concat;
+
    function Synth_Aggregate_Record (Syn_Inst : Synth_Instance_Acc;
                                     Aggr : Node;
                                     Aggr_Type : Type_Acc) return Valtyp
@@ -580,7 +693,8 @@ package body Synth.Vhdl_Aggr is
    begin
       case Aggr_Type.Kind is
          when Type_Unbounded_Array
-            | Type_Unbounded_Vector =>
+           | Type_Unbounded_Vector
+           | Type_Array_Unbounded =>
             declare
                Res_Type : Type_Acc;
             begin
@@ -595,7 +709,8 @@ package body Synth.Vhdl_Aggr is
                     | Type_Unbounded_Array =>
                      --  The only possibility is vector elements.
                      pragma Assert (Res_Type.Ulast);
-                     raise Internal_Error;
+                     return Synth_Aggregate_Array_Concat (Syn_Inst, Aggr,
+                                                          Res_Type);
                   when others =>
                      raise Internal_Error;
                end case;