synth-expr: handle any object for array attributes.

5 files changed, 95 insertions, 60 deletions

diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 98ee96a9e..459a7d071 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -703,13 +703,79 @@ package body Synth.Expr is
       return ((Get_Direction (Rng), L.Fp, R.Fp));
    end Synth_Float_Range_Expression;
 
+   --  Return the type of EXPR without evaluating it.
+   function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
+                                 return Type_Acc is
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kinds_Object_Declaration =>
+            declare
+               Val : constant Value_Acc := Get_Value (Syn_Inst, Expr);
+            begin
+               return Val.Typ;
+            end;
+         when Iir_Kind_Simple_Name =>
+            return Synth_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr));
+         when Iir_Kind_Slice_Name =>
+            declare
+               Pfx_Typ : Type_Acc;
+               Pfx_Bnd : Bound_Type;
+               El_Typ : Type_Acc;
+               Res_Bnd : Bound_Type;
+               Sl_Voff : Net;
+               Sl_Off : Uns32;
+               Wd : Uns32;
+            begin
+               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
+               Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ);
+               Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ.W,
+                                   Res_Bnd, Sl_Voff, Sl_Off, Wd);
+
+               if Sl_Voff /= No_Net then
+                  raise Internal_Error;
+               end if;
+               return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd);
+            end;
+         when Iir_Kind_Indexed_Name =>
+            declare
+               Pfx_Typ : Type_Acc;
+            begin
+               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
+               return Get_Array_Element (Pfx_Typ);
+            end;
+         when Iir_Kind_Selected_Element =>
+            declare
+               Idx : constant Iir_Index32 :=
+                 Get_Element_Position (Get_Named_Entity (Expr));
+               Pfx_Typ : Type_Acc;
+            begin
+               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
+               return Pfx_Typ.Rec.E (Idx + 1).Typ;
+            end;
+
+         when Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Dereference =>
+            declare
+               Val : Value_Acc;
+            begin
+               --  Maybe do not dereference it if its type is known ?
+               Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr));
+               Val := Heap.Synth_Dereference (Val.Acc);
+               return Val.Typ;
+            end;
+
+         when others =>
+            Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr);
+      end case;
+      return null;
+   end Synth_Type_Of_Object;
+
    function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
                                   return Bound_Type
    is
       Prefix : constant Iir := Strip_Denoting_Name (Get_Prefix (Attr));
       Dim : constant Natural :=
         Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr);
-      Obj : Value_Acc;
       Typ : Type_Acc;
    begin
       --  Prefix is an array object or an array subtype.
@@ -717,18 +783,10 @@ package body Synth.Expr is
          --  TODO: does this cover all the cases ?
          Typ := Get_Value_Type (Syn_Inst, Get_Subtype_Indication (Prefix));
       else
-         Obj := Synth_Name (Syn_Inst, Prefix);
-         Typ := Obj.Typ;
+         Typ := Synth_Type_Of_Object (Syn_Inst, Prefix);
       end if;
 
-      if Typ.Kind = Type_Vector then
-         if Dim /= 1 then
-            raise Internal_Error;
-         end if;
-         return Typ.Vbound;
-      else
-         return Typ.Abounds.D (Iir_Index32 (Dim));
-      end if;
+      return Get_Array_Bound (Typ, Dim_Type (Dim));
    end Synth_Array_Attribute;
 
    procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index c5969b483..eee5f1d4d 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -118,6 +118,11 @@ package Synth.Expr is
                                  Off : out Uns32;
                                  W : out Width);
 
+   --  Return the type of EXPR (an object) without evaluating it (except when
+   --  needed, like bounds of a slice).
+   function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
+                                 return Type_Acc;
+
    --  Conversion to logic vector.
 
    type Logic_32 is record
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 797033bb8..8acf79e24 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -751,55 +751,6 @@ package body Synth.Insts is
       end loop;
    end Synth_Instantiate_Module;
 
-   --  Return the type of EXPR without evaluating it.
-   --  FIXME: how dubious is it ?
-   function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
-                                 return Type_Acc is
-   begin
-      case Get_Kind (Expr) is
-         when Iir_Kind_Signal_Declaration
-           | Iir_Kind_Interface_Signal_Declaration =>
-            declare
-               Val : constant Value_Acc := Get_Value (Syn_Inst, Expr);
-            begin
-               return Val.Typ;
-            end;
-         when Iir_Kind_Simple_Name =>
-            return Synth_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr));
-         when Iir_Kind_Slice_Name =>
-            declare
-               Pfx_Typ : Type_Acc;
-               Pfx_Bnd : Bound_Type;
-               El_Typ : Type_Acc;
-               Res_Bnd : Bound_Type;
-               Sl_Voff : Net;
-               Sl_Off : Uns32;
-               Wd : Uns32;
-            begin
-               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
-               Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ);
-               Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ.W,
-                                   Res_Bnd, Sl_Voff, Sl_Off, Wd);
-
-               if Sl_Voff /= No_Net then
-                  raise Internal_Error;
-               end if;
-               return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd);
-            end;
-         when Iir_Kind_Indexed_Name =>
-            declare
-               Pfx_Typ : Type_Acc;
-            begin
-               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
-               return Get_Array_Element (Pfx_Typ);
-            end;
-
-         when others =>
-            Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr);
-      end case;
-      return null;
-   end Synth_Type_Of_Object;
-
    function Synth_Port_Association_Type (Sub_Inst : Synth_Instance_Acc;
                                          Syn_Inst : Synth_Instance_Acc;
                                          Inter : Node;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 0d10a94da..f9fd187cb 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -428,6 +428,22 @@ package body Synth.Values is
       end case;
    end Get_Array_Element;
 
+   function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type)
+                            return Bound_Type is
+   begin
+      case Typ.Kind is
+         when Type_Vector =>
+            if Dim /= 1 then
+               raise Internal_Error;
+            end if;
+            return Typ.Vbound;
+         when Type_Array =>
+            return Typ.Abounds.D (Iir_Index32 (Dim));
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Array_Bound;
+
    function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc
    is
       use System;
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 2bbf70810..2bc2e9940 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -272,6 +272,11 @@ package Synth.Values is
 
    function Create_File_Type (File_Type : Type_Acc) return Type_Acc;
 
+   --  Return the bounds of dimension DIM of a vector/array.  For a vector,
+   --  DIM must be 1.
+   function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type)
+                            return Bound_Type;
+
    --  Return the element of a vector/array/unbounded_array.
    function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc;