synth: improve support of vhdl2008 aggregate targets. Fix #1178

3 files changed, 72 insertions, 53 deletions

diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 77236a069..1a735cc82 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -223,26 +223,6 @@ package body Synth.Expr is
       end case;
    end Value2logvec;
 
-   function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node)
-                        return Value_Acc
-   is
-      N : Net;
-   begin
-      case Val.Kind is
-         when Value_Array
-           | Value_Const_Array =>
-            pragma Assert (Val.Typ.Vbound.Len >= Off);
-            return Val.Arr.V (Iir_Index32 (Val.Typ.Vbound.Len - Off));
-         when Value_Net
-           | Value_Wire =>
-            N := Build_Extract_Bit (Build_Context, Get_Net (Val), Off);
-            Set_Location (N, Loc);
-            return Create_Value_Net (N, Val.Typ.Vec_El);
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Bit_Extract;
-
    --  Resize for a discrete value.
    function Synth_Resize (Val : Value_Acc; W : Width; Loc : Node) return Net
    is
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 4ceeafc4b..66c1104c2 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -65,9 +65,6 @@ package Synth.Expr is
    function Synth_Clock_Edge
      (Syn_Inst : Synth_Instance_Acc; Left, Right : Node) return Net;
 
-   function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node)
-                        return Value_Acc;
-
    function Concat_Array (Arr : Net_Array_Acc) return Net;
 
    function Synth_Expression_With_Type
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 67911c531..36b5deeba 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -103,36 +103,6 @@ package body Synth.Stmts is
                   Offset);
    end Synth_Assign;
 
-   procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc;
-                                         Target : Node;
-                                         Target_Type : Type_Acc;
-                                         Val : Value_Acc;
-                                         Loc : Node)
-   is
-      Choice : Node;
-      Assoc : Node;
-      Pos : Uns32;
-   begin
-      if Target_Type.Kind = Type_Vector then
-         Choice := Get_Association_Choices_Chain (Target);
-         Pos := Target_Type.W;
-         while Is_Valid (Choice) loop
-            Assoc := Get_Associated_Expr (Choice);
-            case Get_Kind (Choice) is
-               when Iir_Kind_Choice_By_None =>
-                  Pos := Pos - 1;
-                  Synth_Assignment
-                    (Syn_Inst, Assoc, Bit_Extract (Val, Pos, Target), Loc);
-               when others =>
-                  Error_Kind ("synth_assignment_aggregate", Choice);
-            end case;
-            Choice := Get_Chain (Choice);
-         end loop;
-      else
-         raise Internal_Error;
-      end if;
-   end Synth_Assignment_Aggregate;
-
    procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
                                       Pfx : Node;
                                       Dest_Obj : out Value_Acc;
@@ -454,6 +424,78 @@ package body Synth.Stmts is
    procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
                                Target : Target_Info;
                                Val : Value_Acc;
+                               Loc : Node);
+
+   --  Extract a part of VAL from a target aggregate at offset OFF (offset
+   --  in the array).
+   function Aggregate_Extract
+     (Val : Value_Acc; Off : Uns32; Typ : Type_Acc; Loc : Node)
+     return Value_Acc
+   is
+      El_Typ : constant Type_Acc := Get_Array_Element (Val.Typ);
+   begin
+      case Val.Kind is
+         when Value_Array
+           | Value_Const_Array =>
+            if Typ /= El_Typ then
+               --  Sub-array (vhdl 2008) not yet supported.
+               raise Internal_Error;
+            end if;
+            pragma Assert (Val.Typ.Vbound.Len >= Off);
+            return Val.Arr.V (Iir_Index32 (Val.Typ.Vbound.Len - Off));
+         when Value_Net
+           | Value_Wire =>
+            declare
+               N : Net;
+            begin
+               N := Build2_Extract
+                 (Build_Context, Get_Net (Val), Off * El_Typ.W, Typ.W);
+               Set_Location (N, Loc);
+               return Create_Value_Net (N, Typ);
+            end;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Aggregate_Extract;
+
+   procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc;
+                                         Target : Node;
+                                         Target_Typ : Type_Acc;
+                                         Val : Value_Acc;
+                                         Loc : Node)
+   is
+      Targ_Bnd : constant Bound_Type := Get_Array_Bound (Target_Typ, 1);
+      Choice : Node;
+      Assoc : Node;
+      Pos : Uns32;
+      Targ_Info : Target_Info;
+   begin
+      Choice := Get_Association_Choices_Chain (Target);
+      Pos := Targ_Bnd.Len;
+      while Is_Valid (Choice) loop
+         Assoc := Get_Associated_Expr (Choice);
+         case Get_Kind (Choice) is
+            when Iir_Kind_Choice_By_None =>
+               Targ_Info := Synth_Target (Syn_Inst, Assoc);
+               if Get_Element_Type_Flag (Choice) then
+                  Pos := Pos - 1;
+               else
+                  Pos := Pos - Get_Array_Bound (Targ_Info.Targ_Type, 1).Len;
+               end if;
+               Synth_Assignment
+                 (Syn_Inst, Targ_Info,
+                  Aggregate_Extract (Val, Pos, Targ_Info.Targ_Type, Assoc),
+                  Loc);
+            when others =>
+               Error_Kind ("synth_assignment_aggregate", Choice);
+         end case;
+         Choice := Get_Chain (Choice);
+      end loop;
+   end Synth_Assignment_Aggregate;
+
+   procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
+                               Target : Target_Info;
+                               Val : Value_Acc;
                                Loc : Node) is
    begin
       case Target.Kind is