synth: add value_const_array.

4 files changed, 68 insertions, 18 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index 2d274e051..0024c3bb9 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -385,7 +385,7 @@ package body Synth.Context is
             else
                raise Internal_Error;
             end if;
-         when Value_Array
+         when Value_Const_Array
            | Value_Record =>
             declare
                W : constant Width := Get_Type_Width (Val.Typ);
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index bfaef8f17..7b0553d38 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -59,6 +59,8 @@ package body Synth.Expr is
            | Value_Wire
            | Value_Mux2 =>
             return False;
+         when Value_Const_Array =>
+            return True;
          when others =>
             --  TODO.
             raise Internal_Error;
@@ -279,17 +281,19 @@ package body Synth.Expr is
 
    procedure Fill_Array_Aggregate (Syn_Inst : Synth_Instance_Acc;
                                    Aggr : Node;
-                                   Res : Value_Acc;
-                                   Dim : Natural)
+                                   Res : Value_Array_Acc;
+                                   Typ : Type_Acc;
+                                   Dim : Natural;
+                                   Const_P : out Boolean)
    is
-      Bound : constant Bound_Type := Res.Typ.Abounds.D (1);
+      Bound : Bound_Type renames Typ.Abounds.D (1);
       Aggr_Type : constant Node := Get_Type (Aggr);
       El_Type : constant Node := Get_Element_Subtype (Aggr_Type);
       Nbr_Dims : constant Natural := Get_Nbr_Dimensions (Aggr_Type);
       Idx_Type : constant Node := Get_Index_Type (Aggr_Type, Dim);
       type Boolean_Array is array (Uns32 range <>) of Boolean;
       pragma Pack (Boolean_Array);
-      --  FIXME: test Res.Arr.V (I) instead.
+      --  FIXME: test Res.V (I) instead.
       Is_Set : Boolean_Array (0 .. Bound.Len - 1);
       Value : Node;
       Assoc : Node;
@@ -301,9 +305,12 @@ package body Synth.Expr is
       begin
          if Dim = Nbr_Dims - 1 then
             Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type);
-            Res.Arr.V (Iir_Index32 (Pos + 1)) := Val;
+            Res.V (Iir_Index32 (Pos + 1)) := Val;
             pragma Assert (not Is_Set (Pos));
             Is_Set (Pos) := True;
+            if Const_P and then not Is_Const (Val) then
+               Const_P := False;
+            end if;
          else
             Error_Msg_Synth (+Assoc, "multi-dim aggregate not handled");
          end if;
@@ -312,6 +319,7 @@ package body Synth.Expr is
       Assoc := Get_Association_Choices_Chain (Aggr);
       Pos := 0;
       Is_Set := (others => False);
+      Const_P := True;
       while Is_Valid (Assoc) loop
          Value := Get_Associated_Expr (Assoc);
          loop
@@ -706,7 +714,9 @@ package body Synth.Expr is
       El_Type : constant Node := Get_Element_Subtype (Aggr_Type);
       Bnds : Bound_Array_Acc;
       Res_Type : Type_Acc;
+      Arr : Value_Array_Acc;
       Res : Value_Acc;
+      Const_P : Boolean;
    begin
       --  Allocate the result.
       Bnds := Create_Bound_Array (Iir_Index32 (Ndims));
@@ -716,9 +726,16 @@ package body Synth.Expr is
       end loop;
       Res_Type := Create_Array_Type
         (Bnds, Get_Value (Syn_Inst, El_Type).Typ);
-      Res := Create_Value_Array (Res_Type);
+      Arr := Create_Value_Array
+        (Iir_Index32 (Get_Array_Flat_Length (Res_Type)));
 
-      Fill_Array_Aggregate (Syn_Inst, Aggr, Res, 0);
+      Fill_Array_Aggregate (Syn_Inst, Aggr, Arr, Res_Type, 0, Const_P);
+
+      if Const_P then
+         Res := Create_Value_Const_Array (Res_Type, Arr);
+      else
+         Res := Create_Value_Array (Res_Type, Arr);
+      end if;
 
       if False and Is_Vector_Type (Aggr_Type) then
          Res := Vectorize_Array (Res, Get_Element_Subtype (Aggr_Type));
@@ -2056,19 +2073,21 @@ package body Synth.Expr is
       Bounds : Bound_Type;
       Res_Type : Type_Acc;
       Res : Value_Acc;
+      Arr : Value_Array_Acc;
       Pos : Nat8;
    begin
       Bounds := Synth_Array_Bounds (Syn_Inst, Str_Type, 0);
       El_Type := Get_Value_Type (Syn_Inst, Get_Element_Subtype (Str_Type));
       Res_Type := Create_Vector_Type (Bounds, El_Type);
+      Arr := Create_Value_Array (Iir_Index32 (Bounds.Len));
 
-      Res := Create_Value_Array (Res_Type);
-      for I in Res.Arr.V'Range loop
+      for I in Arr.V'Range loop
          -- FIXME: use literal from type ??
          Pos := Str_Table.Element_String8 (Id, Pos32 (I));
-         Res.Arr.V (I) := Create_Value_Discrete (Int64 (Pos), El_Type);
+         Arr.V (I) := Create_Value_Discrete (Int64 (Pos), El_Type);
       end loop;
 
+      Res := Create_Value_Const_Array (Res_Type, Arr);
       return Res;
    end Synth_String_Literal;
 
@@ -2086,7 +2105,7 @@ package body Synth.Expr is
            (Std_Logic_0_Pos + (Arg / 2 ** Natural (I - 1)) mod 2, El_Type);
       end loop;
       Bnd := Create_Vec_Type_By_Length (Width (Len), El_Type);
-      return Create_Value_Array (Bnd, Arr);
+      return Create_Value_Const_Array (Bnd, Arr);
    end Eval_To_Unsigned;
 
    function Synth_User_Function_Call
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 750b0c5e1..4ca48933a 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -305,16 +305,40 @@ package body Synth.Values is
       return Res;
    end Create_Value_Array;
 
-   procedure Create_Array_Data (Arr : Value_Acc)
+   function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc)
+                               return Value_Acc
+   is
+      subtype Value_Type_Const_Array is Value_Type (Value_Const_Array);
+      function Alloc is
+         new Areapools.Alloc_On_Pool_Addr (Value_Type_Const_Array);
+
+      Res : Value_Acc;
+   begin
+      pragma Assert (Bounds /= null);
+      Res := To_Value_Acc (Alloc (Current_Pool,
+                                  (Kind => Value_Const_Array,
+                                   Arr => Arr, Typ => Bounds)));
+      return Res;
+   end Create_Value_Const_Array;
+
+   function Get_Array_Flat_Length (Typ : Type_Acc) return Width
    is
       Len : Width;
    begin
       Len := 1;
+      for I in Typ.Abounds.D'Range loop
+         Len := Len * Typ.Abounds.D (I).Len;
+      end loop;
+      return Len;
+   end Get_Array_Flat_Length;
+
+   procedure Create_Array_Data (Arr : Value_Acc)
+   is
+      Len : Width;
+   begin
       case Arr.Typ.Kind is
          when Type_Array =>
-            for I in Arr.Typ.Abounds.D'Range loop
-               Len := Len * Arr.Typ.Abounds.D (I).Len;
-            end loop;
+            Len := Get_Array_Flat_Length (Arr.Typ);
          when Type_Vector =>
             Len := Arr.Typ.Vbound.Len;
          when others =>
@@ -324,7 +348,6 @@ package body Synth.Values is
       Arr.Arr := Create_Value_Array (Iir_Index32 (Len));
    end Create_Array_Data;
 
-
    function Create_Value_Array (Bounds : Type_Acc) return Value_Acc
    is
       Res : Value_Acc;
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 09718bd80..744791a29 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -138,6 +138,7 @@ package Synth.Values is
 
       --  An array.
       Value_Array,
+      Value_Const_Array,
 
       --  A record.
       Value_Record,
@@ -181,7 +182,8 @@ package Synth.Values is
             Fp : Fp64;
          when Value_Subtype =>
             null;
-         when Value_Array =>
+         when Value_Array
+           | Value_Const_Array =>
             Arr : Value_Array_Acc;
          when Value_Record =>
             Rec : Value_Array_Acc;
@@ -242,6 +244,8 @@ package Synth.Values is
    --  Create a Value_Array.
    function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc)
                                return Value_Acc;
+   function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc)
+                                     return Value_Acc;
 
    --  Like the previous one but automatically build the array.
    function Create_Value_Array (Bounds : Type_Acc) return Value_Acc;
@@ -256,6 +260,10 @@ package Synth.Values is
    function Unshare (Src : Value_Acc; Pool : Areapool_Acc)
                     return Value_Acc;
 
+   --  Get the number of indexes in array type TYP without counting
+   --  sub-elements.
+   function Get_Array_Flat_Length (Typ : Type_Acc) return Width;
+
    function Get_Type_Width (Atype : Type_Acc) return Width;
 
    procedure Init;