synth: unconstrained arrays.

5 files changed, 71 insertions, 17 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index f1f41c32a..7f3afb623 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -63,6 +63,26 @@ package body Synth.Decls is
       end case;
    end Create_Var_Wire;
 
+   procedure Synth_Subtype_Indication_If_Anonymous
+     (Syn_Inst : Synth_Instance_Acc; Atype : Node) is
+   begin
+      if Get_Type_Declarator (Atype) = Null_Node then
+         Synth_Subtype_Indication (Syn_Inst, Atype);
+      end if;
+   end Synth_Subtype_Indication_If_Anonymous;
+
+   procedure Synth_Array_Type_Definition
+     (Syn_Inst : Synth_Instance_Acc; Def : Node)
+   is
+      El_Type : constant Node := Get_Element_Subtype (Def);
+      Typ : Type_Acc;
+   begin
+      Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type);
+      Typ := Create_Unbounded_Array
+        (Get_Value_Type (Syn_Inst, El_Type));
+      Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ));
+   end Synth_Array_Type_Definition;
+
    procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
    is
       Typ : Type_Acc;
@@ -93,7 +113,7 @@ package body Synth.Decls is
             end if;
             Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ));
          when Iir_Kind_Array_Type_Definition =>
-            null;
+            Synth_Array_Type_Definition (Syn_Inst, Def);
          when Iir_Kind_Access_Type_Definition
            | Iir_Kind_File_Type_Definition =>
             null;
@@ -174,14 +194,6 @@ package body Synth.Decls is
       end case;
    end Synth_Float_Range_Constraint;
 
-   procedure Synth_Subtype_Indication_If_Anonymous
-     (Syn_Inst : Synth_Instance_Acc; Atype : Node) is
-   begin
-      if Get_Type_Declarator (Atype) = Null_Node then
-         Synth_Subtype_Indication (Syn_Inst, Atype);
-      end if;
-   end Synth_Subtype_Indication_If_Anonymous;
-
    function Synth_Array_Subtype_Indication
      (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc
    is
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 1e39efb13..21511e615 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -1168,14 +1168,17 @@ package body Synth.Expr is
       Pfx : constant Node := Get_Prefix (Name);
       Pfx_Val : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx);
       Indexes : constant Iir_Flist := Get_Index_List (Name);
-      Idx_Val : constant Value_Acc :=
-        Synth_Expression (Syn_Inst, Get_Nth_Element (Indexes, 0));
+      Idx_Expr : constant Node := Get_Nth_Element (Indexes, 0);
+      Idx_Val : Value_Acc;
    begin
       if Get_Nbr_Elements (Indexes) /= 1 then
          Error_Msg_Synth (+Name, "multi-dim arrays not supported");
          return null;
       end if;
 
+      Idx_Val := Synth_Expression_With_Type
+        (Syn_Inst, Idx_Expr, Get_Base_Type (Get_Type (Idx_Expr)));
+
       if Idx_Val.Kind = Value_Discrete then
          declare
             Off : Uns32;
@@ -1661,16 +1664,16 @@ package body Synth.Expr is
                              return Value_Acc
    is
       Len : constant Iir_Index32 := Iir_Index32 (Sz);
+      El_Type : constant Type_Acc := Get_Array_Element (Res_Type);
       Arr : Value_Array_Acc;
       Bnd : Type_Acc;
    begin
       Arr := Create_Value_Array (Len);
       for I in 1 .. Len loop
          Arr.V (Len - I + 1) := Create_Value_Discrete
-           (Std_Logic_0_Pos + (Arg / 2 ** Natural (I - 1)) mod 2,
-            Res_Type.Vec_El);
+           (Std_Logic_0_Pos + (Arg / 2 ** Natural (I - 1)) mod 2, El_Type);
       end loop;
-      Bnd := Create_Vec_Type_By_Length (Width (Len), Res_Type.Vec_El);
+      Bnd := Create_Vec_Type_By_Length (Width (Len), El_Type);
       return Create_Value_Array (Bnd, Arr);
    end Eval_To_Unsigned;
 
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 01e460c77..c10afaf73 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -38,8 +38,14 @@ package body Synth.Values is
       if L.Kind /= R.Kind then
          return False;
       end if;
-      --  TODO.
-      raise Internal_Error;
+
+      case L.Kind is
+         when Value_Discrete =>
+            return L.Scal = R.Scal;
+         when others =>
+            --  TODO.
+            raise Internal_Error;
+      end case;
    end Is_Equal;
 
    function Create_Bit_Type return Type_Acc
@@ -128,6 +134,29 @@ package body Synth.Values is
                                                 Arr_El => El_Type)));
    end Create_Array_Type;
 
+   function Create_Unbounded_Array (El_Type : Type_Acc) return Type_Acc
+   is
+      subtype Unbounded_Type_Type is Type_Type (Type_Unbounded_Array);
+      function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type);
+   begin
+      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array,
+                                                Uarr_El => El_Type)));
+   end Create_Unbounded_Array;
+
+   function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc is
+   begin
+      case Arr_Type.Kind is
+         when Type_Vector =>
+            return Arr_Type.Vec_El;
+         when Type_Array =>
+            return Arr_Type.Arr_El;
+         when Type_Unbounded_Array =>
+            return Arr_Type.Uarr_El;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Array_Element;
+
    function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc
    is
       subtype Value_Type_Wire is Value_Type (Values.Value_Wire);
@@ -154,7 +183,7 @@ package body Synth.Values is
    is
       subtype Value_Type_Mux2 is Value_Type (Value_Mux2);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Mux2);
-      pragma Assert (T.Typ = F.Typ);
+      pragma Assert (F = null or else T.Typ = F.Typ);
    begin
       return To_Value_Acc
         (Alloc (Current_Pool,
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 9f93ab0b9..1a7e5df48 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -67,6 +67,7 @@ package Synth.Values is
       Type_Float,
       Type_Vector,
       Type_Array,
+      Type_Unbounded_Array,
       Type_Record
      );
 
@@ -95,6 +96,8 @@ package Synth.Values is
          when Type_Array =>
             Abounds : Bound_Array_Acc;
             Arr_El : Type_Acc;
+         when Type_Unbounded_Array =>
+            Uarr_El : Type_Acc;
          when Type_Record =>
             Rec : Type_Acc_Array_Acc;
       end case;
@@ -193,6 +196,10 @@ package Synth.Values is
    function Create_Bound_Array (Ndims : Iir_Index32) return Bound_Array_Acc;
    function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc)
                               return Type_Acc;
+   function Create_Unbounded_Array (El_Type : Type_Acc) return Type_Acc;
+
+   --  Return the element of a vector/array/unbounded_array.
+   function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc;
 
    function Is_Equal (L, R : Value_Acc) return Boolean;
 
diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb
index 75382cc5f..d61117bb4 100644
--- a/src/vhdl/vhdl-annotations.adb
+++ b/src/vhdl/vhdl-annotations.adb
@@ -378,6 +378,9 @@ package body Vhdl.Annotations is
          when Iir_Kind_Array_Type_Definition =>
             El := Get_Element_Subtype (Def);
             Annotate_Anonymous_Type_Definition (Block_Info, El);
+            if Flag_Synthesis then
+               Create_Object_Info (Block_Info, Def, Kind_Type);
+            end if;
 
          when Iir_Kind_Array_Subtype_Definition =>
             if Get_Array_Element_Constraint (Def) /= Null_Node then