synth: handle concatenation of unbounded types. Fix #1993

9 files changed, 64 insertions, 111 deletions

diff --git a/src/synth/elab-vhdl_errors.ads b/src/synth/elab-vhdl_errors.ads
index d4cd19a24..4d9d2788e 100644
--- a/src/synth/elab-vhdl_errors.ads
+++ b/src/synth/elab-vhdl_errors.ads
@@ -26,6 +26,7 @@ package Elab.Vhdl_Errors is
    procedure Error_Msg_Elab (Loc : Location_Type;
                              Msg : String;
                              Args : Earg_Arr := No_Eargs);
+
    --  procedure Warning_Msg_Synth (Loc : Location_Type;
    --                               Msg : String;
    --                               Arg1 : Earg_Type);
diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb
index 0933e772e..d105fc730 100644
--- a/src/synth/elab-vhdl_expr.adb
+++ b/src/synth/elab-vhdl_expr.adb
@@ -16,6 +16,7 @@
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
 
+with Types; use Types;
 with Name_Table;
 with Std_Names;
 with Str_Table;
@@ -35,42 +36,12 @@ with Elab.Debugger;
 with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
 with Synth.Vhdl_Oper; use Synth.Vhdl_Oper;
 with Synth.Vhdl_Aggr;
+with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
 
 with Grt.Types;
 with Grt.To_Strings;
 
 package body Elab.Vhdl_Expr is
-   function Get_Value_Memtyp (V : Valtyp) return Memtyp is
-   begin
-      case V.Val.Kind is
-         when Value_Memory =>
-            return (V.Typ, V.Val.Mem);
-         when Value_Const =>
-            return Get_Memtyp (V);
-         when Value_Alias =>
-            declare
-               Res : Memtyp;
-            begin
-               Res := Get_Value_Memtyp ((V.Val.A_Typ, V.Val.A_Obj));
-               return (V.Typ, Res.Mem + V.Val.A_Off.Mem_Off);
-            end;
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Get_Value_Memtyp;
-
-   function Get_Static_Discrete (V : Valtyp) return Int64 is
-   begin
-      case V.Val.Kind is
-         when Value_Memory =>
-            return Read_Discrete (V);
-         when Value_Const =>
-            return Read_Discrete (Get_Memtyp (V));
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Get_Static_Discrete;
-
    function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc;
                                 Atype : Node;
                                 Dim : Dim_Type) return Bound_Type
@@ -464,6 +435,11 @@ package body Elab.Vhdl_Expr is
       return Res;
    end Index_To_Offset;
 
+   procedure Check_Matching_Bounds (L, R : Type_Acc; Loc : Node) is
+   begin
+      null;
+   end Check_Matching_Bounds;
+
    --  Return the bounds of a one dimensional array/vector type and the
    --  width of the element.
    procedure Get_Onedimensional_Array_Bounds
@@ -482,26 +458,30 @@ package body Elab.Vhdl_Expr is
    end Get_Onedimensional_Array_Bounds;
 
    function Create_Onedimensional_Array_Subtype
-     (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc
+     (Btyp : Type_Acc; Bnd : Bound_Type; El_Typ : Type_Acc) return Type_Acc
    is
       Res : Type_Acc;
       Bnds : Bound_Array_Acc;
    begin
       case Btyp.Kind is
          when Type_Vector =>
+            pragma Assert (El_Typ.Kind in Type_Nets);
             Res := Create_Vector_Type (Bnd, Btyp.Vec_El);
          when Type_Unbounded_Vector =>
+            pragma Assert (El_Typ.Kind in Type_Nets);
             Res := Create_Vector_Type (Bnd, Btyp.Uvec_El);
          when Type_Array =>
             pragma Assert (Btyp.Abounds.Ndim = 1);
+            pragma Assert (Is_Bounded_Type (Btyp.Arr_El));
             Bnds := Create_Bound_Array (1);
             Bnds.D (1) := Bnd;
             Res := Create_Array_Type (Bnds, Btyp.Arr_El);
          when Type_Unbounded_Array =>
             pragma Assert (Btyp.Uarr_Ndim = 1);
+            pragma Assert (Is_Bounded_Type (El_Typ));
             Bnds := Create_Bound_Array (1);
             Bnds.D (1) := Bnd;
-            Res := Create_Array_Type (Bnds, Btyp.Uarr_El);
+            Res := Create_Array_Type (Bnds, El_Typ);
          when others =>
             raise Internal_Error;
       end case;
@@ -846,7 +826,7 @@ package body Elab.Vhdl_Expr is
 
                --  Fixed slice.
                Dest_Typ := Create_Onedimensional_Array_Subtype
-                 (Dest_Typ, Res_Bnd);
+                 (Dest_Typ, Res_Bnd, El_Typ);
                Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off;
                Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off;
             end;
@@ -881,7 +861,8 @@ package body Elab.Vhdl_Expr is
                Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ);
                Exec_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ,
                                    Res_Bnd, Sl_Off);
-               return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd);
+               return Create_Onedimensional_Array_Subtype
+                 (Pfx_Typ, Res_Bnd, El_Typ);
             end;
          when Iir_Kind_Indexed_Name =>
             declare
diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads
index 77231b1a4..723f5bf91 100644
--- a/src/synth/elab-vhdl_expr.ads
+++ b/src/synth/elab-vhdl_expr.ads
@@ -16,8 +16,6 @@
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
 
-with Types; use Types;
-
 with Vhdl.Nodes; use Vhdl.Nodes;
 
 with Elab.Vhdl_Context; use Elab.Vhdl_Context;
@@ -25,12 +23,6 @@ with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
 with Elab.Vhdl_Values; use Elab.Vhdl_Values;
 
 package Elab.Vhdl_Expr is
-   --  For a static value V, return the value.
-   function Get_Static_Discrete (V : Valtyp) return Int64;
-
-   --  Return the memory (as a memtyp) of static value V.
-   function Get_Value_Memtyp (V : Valtyp) return Memtyp;
-
    --  Return the bounds of a one dimensional array/vector type and the
    --  width of the element.
    procedure Get_Onedimensional_Array_Bounds
@@ -38,7 +30,9 @@ package Elab.Vhdl_Expr is
 
    --  Create an array subtype from bound BND.
    function Create_Onedimensional_Array_Subtype
-     (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc;
+     (Btyp : Type_Acc; Bnd : Bound_Type; El_Typ : Type_Acc) return Type_Acc;
+
+   procedure Check_Matching_Bounds (L, R : Type_Acc; Loc : Node);
 
    --  Return the type of EXPR without evaluating it.
    function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb
index cc52cd0f4..8b431b21c 100644
--- a/src/synth/synth-static_oper.adb
+++ b/src/synth/synth-static_oper.adb
@@ -27,6 +27,7 @@ with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164;
 with Elab.Vhdl_Values; use Elab.Vhdl_Values;
 with Elab.Memtype; use Elab.Memtype;
 with Elab.Vhdl_Files;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
 
 with Netlists; use Netlists;
 
@@ -297,14 +298,18 @@ package body Synth.Static_Oper is
                  Iir_Index32 (Get_Bound_Length (Left.Typ, 1));
                R_Len : constant Iir_Index32 :=
                  Iir_Index32 (Get_Bound_Length (Right.Typ, 1));
+               Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ);
+               Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ);
                Bnd : Bound_Type;
                Res_St : Type_Acc;
                Res : Memtyp;
             begin
+               Check_Matching_Bounds (Le_Typ, Re_Typ, Expr);
                Bnd := Synth.Vhdl_Oper.Create_Bounds_From_Length
                  (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0),
                   L_Len + R_Len);
-               Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd);
+               Res_St := Create_Onedimensional_Array_Subtype
+                 (Res_Typ, Bnd, Le_Typ);
                Res := Create_Memory (Res_St);
                if Left.Typ.Sz > 0 then
                   Copy_Memory (Res.Mem, Left.Mem, Left.Typ.Sz);
@@ -318,13 +323,16 @@ package body Synth.Static_Oper is
             declare
                Rlen : constant Iir_Index32 :=
                  Get_Array_Flat_Length (Right.Typ);
+               Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ);
                Bnd : Bound_Type;
                Res_St : Type_Acc;
                Res : Memtyp;
             begin
+               Check_Matching_Bounds (Left.Typ, Right.Typ, Expr);
                Bnd := Synth.Vhdl_Oper.Create_Bounds_From_Length
                  (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 1 + Rlen);
-               Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd);
+               Res_St := Create_Onedimensional_Array_Subtype
+                 (Res_Typ, Bnd, Re_Typ);
                Res := Create_Memory (Res_St);
                Copy_Memory (Res.Mem, Left.Mem, Left.Typ.Sz);
                Copy_Memory (Res.Mem + Left.Typ.Sz,
@@ -334,13 +342,16 @@ package body Synth.Static_Oper is
          when Iir_Predefined_Array_Element_Concat =>
             declare
                Llen : constant Iir_Index32 := Get_Array_Flat_Length (Left.Typ);
+               Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ);
                Bnd : Bound_Type;
                Res_St : Type_Acc;
                Res : Memtyp;
             begin
+               Check_Matching_Bounds (Le_Typ, Right.Typ, Expr);
                Bnd := Synth.Vhdl_Oper.Create_Bounds_From_Length
                  (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), Llen + 1);
-               Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd);
+               Res_St := Create_Onedimensional_Array_Subtype
+                 (Res_Typ, Bnd, Le_Typ);
                Res := Create_Memory (Res_St);
                Copy_Memory (Res.Mem, Left.Mem, Left.Typ.Sz);
                Copy_Memory (Res.Mem + Left.Typ.Sz,
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index c7eb117b6..83143a082 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -957,50 +957,6 @@ package body Synth.Vhdl_Expr is
       return Off;
    end Dyn_Index_To_Offset;
 
-   --  Return the bounds of a one dimensional array/vector type and the
-   --  width of the element.
-   procedure Get_Onedimensional_Array_Bounds
-     (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc) is
-   begin
-      case Typ.Kind is
-         when Type_Vector =>
-            El_Typ := Typ.Vec_El;
-            Bnd := Typ.Vbound;
-         when Type_Array =>
-            El_Typ := Typ.Arr_El;
-            Bnd := Typ.Abounds.D (1);
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Get_Onedimensional_Array_Bounds;
-
-   function Create_Onedimensional_Array_Subtype
-     (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc
-   is
-      Res : Type_Acc;
-      Bnds : Bound_Array_Acc;
-   begin
-      case Btyp.Kind is
-         when Type_Vector =>
-            Res := Create_Vector_Type (Bnd, Btyp.Vec_El);
-         when Type_Unbounded_Vector =>
-            Res := Create_Vector_Type (Bnd, Btyp.Uvec_El);
-         when Type_Array =>
-            pragma Assert (Btyp.Abounds.Ndim = 1);
-            Bnds := Create_Bound_Array (1);
-            Bnds.D (1) := Bnd;
-            Res := Create_Array_Type (Bnds, Btyp.Arr_El);
-         when Type_Unbounded_Array =>
-            pragma Assert (Btyp.Uarr_Ndim = 1);
-            Bnds := Create_Bound_Array (1);
-            Bnds.D (1) := Bnd;
-            Res := Create_Array_Type (Bnds, Btyp.Uarr_El);
-         when others =>
-            raise Internal_Error;
-      end case;
-      return Res;
-   end Create_Onedimensional_Array_Subtype;
-
    procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc;
                                  Name : Node;
                                  Pfx_Type : Type_Acc;
diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads
index 33b908de3..5591234bb 100644
--- a/src/synth/synth-vhdl_expr.ads
+++ b/src/synth/synth-vhdl_expr.ads
@@ -58,15 +58,6 @@ package Synth.Vhdl_Expr is
    --  False means either not positive or unknown.
    function Is_Positive (V : Valtyp) return Boolean;
 
-   --  Return the bounds of a one dimensional array/vector type and the
-   --  width of the element.
-   procedure Get_Onedimensional_Array_Bounds
-     (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc);
-
-   --  Create an array subtype from bound BND.
-   function Create_Onedimensional_Array_Subtype
-     (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc;
-
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32);
    procedure From_Bit (Enum : Int64; Val : out Uns32);
    procedure To_Logic
diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb
index cd6f55e2a..ff3685978 100644
--- a/src/synth/synth-vhdl_insts.adb
+++ b/src/synth/synth-vhdl_insts.adb
@@ -46,6 +46,7 @@ with Elab.Memtype; use Elab.Memtype;
 with Elab.Vhdl_Files;
 with Elab.Debugger;
 with Elab.Vhdl_Errors;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
 
 with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
 with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
@@ -667,7 +668,8 @@ package body Synth.Vhdl_Insts is
                   raise Internal_Error;
                end if;
                Off := Off + Sl_Off.Net_Off;
-               Typ := Create_Onedimensional_Array_Subtype (Typ, Res_Bnd);
+               Typ := Create_Onedimensional_Array_Subtype
+                 (Typ, Res_Bnd, El_Typ);
             end;
          when others =>
             Vhdl.Errors.Error_Kind ("synth_individual_prefix", Formal);
diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb
index cc6c978b8..a3a4a46c2 100644
--- a/src/synth/synth-vhdl_oper.adb
+++ b/src/synth/synth-vhdl_oper.adb
@@ -34,6 +34,7 @@ with Netlists.Utils;
 
 with Elab.Memtype; use Elab.Memtype;
 with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
 
 with Synth.Errors; use Synth.Errors;
 with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
@@ -986,9 +987,12 @@ package body Synth.Vhdl_Oper is
          when Iir_Predefined_Array_Element_Concat =>
             declare
                L : constant Net := Get_Net (Ctxt, Left);
+               Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ);
                Bnd : Bound_Type;
+               Res_Typ : Type_Acc;
                N : Net;
             begin
+               Check_Matching_Bounds (Le_Typ, Right.Typ, Expr);
                N := Build2_Concat2 (Ctxt, L, Get_Net (Ctxt, Right));
                Set_Location (N, Expr);
                Bnd := Create_Bounds_From_Length
@@ -996,15 +1000,19 @@ package body Synth.Vhdl_Oper is
                   Get_Index_Type (Get_Type (Expr), 0),
                   Iir_Index32 (Get_Bound_Length (Left.Typ, 1) + 1));
 
-               return Create_Value_Net
-                 (N, Create_Onedimensional_Array_Subtype (Left_Typ, Bnd));
+               Res_Typ := Create_Onedimensional_Array_Subtype
+                 (Left_Typ, Bnd, Le_Typ);
+               return Create_Value_Net (N, Res_Typ);
             end;
          when Iir_Predefined_Element_Array_Concat =>
             declare
                R : constant Net := Get_Net (Ctxt, Right);
+               Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ);
                Bnd : Bound_Type;
+               Res_Typ : Type_Acc;
                N : Net;
             begin
+               Check_Matching_Bounds (Left.Typ, Re_Typ, Expr);
                N := Build2_Concat2 (Ctxt, Get_Net (Ctxt, Left), R);
                Set_Location (N, Expr);
                Bnd := Create_Bounds_From_Length
@@ -1012,29 +1020,37 @@ package body Synth.Vhdl_Oper is
                   Get_Index_Type (Get_Type (Expr), 0),
                   Iir_Index32 (Get_Bound_Length (Right.Typ, 1) + 1));
 
-               return Create_Value_Net
-                 (N, Create_Onedimensional_Array_Subtype (Right_Typ, Bnd));
+               Res_Typ := Create_Onedimensional_Array_Subtype
+                 (Right_Typ, Bnd, Re_Typ);
+               return Create_Value_Net (N, Res_Typ);
             end;
          when Iir_Predefined_Element_Element_Concat =>
             declare
                N : Net;
                Bnd : Bound_Type;
+               Res_Typ : Type_Acc;
             begin
+               Check_Matching_Bounds (Left.Typ, Right.Typ, Expr);
                N := Build2_Concat2
                  (Ctxt, Get_Net (Ctxt, Left), Get_Net (Ctxt, Right));
                Set_Location (N, Expr);
                Bnd := Create_Bounds_From_Length
                  (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2);
-               return Create_Value_Net
-                 (N, Create_Onedimensional_Array_Subtype (Expr_Typ, Bnd));
+               Res_Typ := Create_Onedimensional_Array_Subtype
+                 (Expr_Typ, Bnd, Left.Typ);
+               return Create_Value_Net (N, Res_Typ);
             end;
          when Iir_Predefined_Array_Array_Concat =>
             declare
+               Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ);
+               Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ);
                L : constant Net := Get_Net (Ctxt, Left);
                R : constant Net := Get_Net (Ctxt, Right);
                Bnd : Bound_Type;
+               Res_Typ : Type_Acc;
                N : Net;
             begin
+               Check_Matching_Bounds (Le_Typ, Re_Typ, Expr);
                N := Build2_Concat2 (Ctxt, L, R);
                Set_Location (N, Expr);
                Bnd := Create_Bounds_From_Length
@@ -1043,8 +1059,9 @@ package body Synth.Vhdl_Oper is
                   Iir_Index32 (Get_Bound_Length (Left.Typ, 1)
                                  + Get_Bound_Length (Right.Typ, 1)));
 
-               return Create_Value_Net
-                 (N, Create_Onedimensional_Array_Subtype (Expr_Typ, Bnd));
+               Res_Typ := Create_Onedimensional_Array_Subtype
+                 (Expr_Typ, Bnd, Le_Typ);
+               return Create_Value_Net (N, Res_Typ);
             end;
          when Iir_Predefined_Integer_Plus =>
             return Synth_Int_Dyadic (Id_Add);
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index 3d8c7bba2..b28c6f0f5 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -44,7 +44,7 @@ with PSL.NFAs;
 with Elab.Memtype; use Elab.Memtype;
 with Elab.Vhdl_Heap;
 with Elab.Vhdl_Types; use Elab.Vhdl_Types;
-with Elab.Vhdl_Expr;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
 with Elab.Debugger;
 
 with Synth.Errors; use Synth.Errors;
@@ -219,7 +219,7 @@ package body Synth.Vhdl_Stmts is
                if Sl_Voff = No_Net then
                   --  Fixed slice.
                   Dest_Typ := Create_Onedimensional_Array_Subtype
-                    (Dest_Typ, Res_Bnd);
+                    (Dest_Typ, Res_Bnd, El_Typ);
                   Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off;
                   Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off;
                else