synth: handle indexes in arrays conversion

5 files changed, 85 insertions, 17 deletions

diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index a2a8b3cfb..cf9b1036e 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -904,7 +904,7 @@ package body Simul.Vhdl_Simul is
             Sub_Inst := Synth_Subprogram_Call_Instance (Inst, Imp, Imp);
 
             Synth_Subprogram_Associations
-              (Sub_Inst, Inst, Inter_Chain, Assoc_Chain);
+              (Sub_Inst, Inst, Inter_Chain, Assoc_Chain, Call);
 
             Synth.Vhdl_Static_Proc.Synth_Static_Procedure
               (Sub_Inst, Imp, Call);
@@ -937,7 +937,7 @@ package body Simul.Vhdl_Simul is
             --  one!
             Set_Uninstantiated_Scope (Sub_Inst, Imp);
             Synth_Subprogram_Associations
-              (Sub_Inst, Inst, Inter_Chain, Assoc_Chain);
+              (Sub_Inst, Inst, Inter_Chain, Assoc_Chain, Call);
 
             Process.Instance := Sub_Inst;
             Synth.Vhdl_Decls.Synth_Declarations
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index 0004816d5..f2c2aae82 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -516,12 +516,46 @@ package body Synth.Vhdl_Expr is
       end case;
    end Reshape_Value;
 
+   function Convert_Array_Indexes (Syn_Inst : Synth_Instance_Acc;
+                                   Utype : Type_Acc;
+                                   Stype : Type_Acc;
+                                   Loc : Node) return Type_Acc
+   is
+      Res_El : Type_Acc;
+   begin
+      if not Stype.Alast then
+         Res_El := Convert_Array_Indexes
+           (Syn_Inst, Utype.Uarr_El, Stype.Arr_El, Loc);
+      else
+         Res_El := Stype.Arr_El;
+      end if;
+
+      --  FIXME: we assume the index types are closely related...
+      if Stype.Abound.Len = 0
+        or else
+        (In_Range (Utype.Uarr_Idx.Drange, Int64 (Stype.Abound.Left))
+           and then
+           In_Range (Utype.Uarr_Idx.Drange, Int64 (Stype.Abound.Right)))
+      then
+         case Utype.Kind is
+            when Type_Unbounded_Array =>
+               return Create_Array_Type (Stype.Abound, Utype.Ulast, Res_El);
+            when Type_Unbounded_Vector =>
+               return Create_Vector_Type (Stype.Abound, Res_El);
+            when others =>
+               raise Internal_Error;
+         end case;
+      else
+         Error_Msg_Synth (Syn_Inst, Loc, "indexes out of range");
+         return Stype;
+      end if;
+   end Convert_Array_Indexes;
+
    function Synth_Subtype_Conversion (Syn_Inst : Synth_Instance_Acc;
                                       Vt : Valtyp;
                                       Dtype : Type_Acc;
                                       Bounds : Boolean;
-                                      Loc : Source.Syn_Src)
-                                     return Valtyp
+                                      Loc : Source.Syn_Src) return Valtyp
    is
       Vtype : constant Type_Acc := Vt.Typ;
    begin
@@ -637,20 +671,44 @@ package body Synth.Vhdl_Expr is
             end;
          when Type_Array_Unbounded =>
             pragma Assert (Vtype.Kind = Type_Array);
+            --  TODO: check element.
             return Vt;
          when Type_Unbounded_Array =>
             pragma Assert (Vtype.Kind = Type_Array);
-            return Vt;
+            declare
+               Rtype : Type_Acc;
+            begin
+               Rtype := Convert_Array_Indexes (Syn_Inst, Dtype, Vtype, Loc);
+               if Bounds then
+                  return Reshape_Value (Vt, Rtype);
+               else
+                  return Vt;
+               end if;
+            end;
          when Type_Unbounded_Vector =>
             pragma Assert (Vtype.Kind = Type_Vector
                              or else Vtype.Kind = Type_Slice);
-            return Vt;
+            if Vtype.Kind = Type_Slice then
+               --  Cannot be converted.
+               return Vt;
+            end if;
+            declare
+               Rtype : Type_Acc;
+            begin
+               Rtype := Convert_Array_Indexes (Syn_Inst, Dtype, Vtype, Loc);
+               if Bounds then
+                  return Reshape_Value (Vt, Rtype);
+               else
+                  return Vt;
+               end if;
+            end;
          when Type_Record =>
             pragma Assert (Vtype.Kind = Type_Record);
-            --  TODO: handle elements.
+            --  TODO: check elements.
             return Vt;
          when Type_Unbounded_Record =>
             pragma Assert (Vtype.Kind = Type_Record);
+            --  TODO: check elements
             return Vt;
          when Type_Access =>
             return Vt;
diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb
index 5d5d9cb5c..22ef709aa 100644
--- a/src/synth/synth-vhdl_oper.adb
+++ b/src/synth/synth-vhdl_oper.adb
@@ -2209,7 +2209,7 @@ package body Synth.Vhdl_Oper is
       Subprg_Inst := Make_Instance (Syn_Inst, Imp);
 
       Synth_Subprogram_Associations
-        (Subprg_Inst, Syn_Inst, Inter_Chain, Assoc_Chain);
+        (Subprg_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Expr);
 
       if Is_Error (Subprg_Inst) then
          Res := No_Valtyp;
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index 4a902b408..1f2d308a4 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -1867,7 +1867,8 @@ package body Synth.Vhdl_Stmts is
    function Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
                                           Caller_Inst : Synth_Instance_Acc;
                                           Inter : Node;
-                                          Assoc : Node) return Valtyp
+                                          Assoc : Node;
+                                          Loc : Node) return Valtyp
    is
       Inter_Type : constant Node := Get_Type (Inter);
       Inter_Typ : Type_Acc;
@@ -1919,7 +1920,7 @@ package body Synth.Vhdl_Stmts is
             return Val;
          end if;
          Val := Synth_Subtype_Conversion
-           (Subprg_Inst, Val, Inter_Typ, True, Assoc);
+           (Subprg_Inst, Val, Inter_Typ, True, Loc);
          if Val = No_Valtyp then
             return Val;
          end if;
@@ -2182,13 +2183,15 @@ package body Synth.Vhdl_Stmts is
 
    procedure Synth_Subprogram_Associations (Subprg_Inst : Synth_Instance_Acc;
                                             Caller_Inst : Synth_Instance_Acc;
-                                            Init : Association_Iterator_Init)
+                                            Init : Association_Iterator_Init;
+                                            Call_Loc : Node)
    is
       Inter : Node;
       Assoc : Node;
       Iterator : Association_Iterator;
       Marker : Mark_Type;
       Val : Valtyp;
+      Loc : Node;
    begin
       Set_Instance_Const (Subprg_Inst, True);
 
@@ -2207,8 +2210,13 @@ package body Synth.Vhdl_Stmts is
             Val := Synth_Individual_Association
               (Subprg_Inst, Caller_Inst, Inter, Assoc);
          else
+            if Assoc = Null_Node then
+               Loc := Call_Loc;
+            else
+               Loc := Assoc;
+            end if;
             Val := Synth_Subprogram_Association
-              (Subprg_Inst, Caller_Inst, Inter, Assoc);
+              (Subprg_Inst, Caller_Inst, Inter, Assoc, Loc);
             if Val /= No_Valtyp then
                Val := Unshare (Val, Instance_Pool);
             end if;
@@ -2227,12 +2235,13 @@ package body Synth.Vhdl_Stmts is
    procedure Synth_Subprogram_Associations (Subprg_Inst : Synth_Instance_Acc;
                                             Caller_Inst : Synth_Instance_Acc;
                                             Inter_Chain : Node;
-                                            Assoc_Chain : Node)
+                                            Assoc_Chain : Node;
+                                            Call_Loc : Node)
    is
       Init : Association_Iterator_Init;
    begin
       Init := Association_Iterator_Build (Inter_Chain, Assoc_Chain);
-      Synth_Subprogram_Associations (Subprg_Inst, Caller_Inst, Init);
+      Synth_Subprogram_Associations (Subprg_Inst, Caller_Inst, Init, Call_Loc);
    end Synth_Subprogram_Associations;
 
    --  Create wires for out and inout interface variables.
@@ -2642,7 +2651,7 @@ package body Synth.Vhdl_Stmts is
          Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
       end if;
 
-      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init);
+      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init, Call);
 
       if Is_Error (Sub_Inst) then
          Res := No_Valtyp;
@@ -2747,7 +2756,7 @@ package body Synth.Vhdl_Stmts is
          Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
       end if;
 
-      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init);
+      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init, Call);
 
       Synth.Vhdl_Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call);
 
diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads
index e9eda5c25..8b1687795 100644
--- a/src/synth/synth-vhdl_stmts.ads
+++ b/src/synth/synth-vhdl_stmts.ads
@@ -51,7 +51,8 @@ package Synth.Vhdl_Stmts is
    procedure Synth_Subprogram_Associations (Subprg_Inst : Synth_Instance_Acc;
                                             Caller_Inst : Synth_Instance_Acc;
                                             Inter_Chain : Node;
-                                            Assoc_Chain : Node);
+                                            Assoc_Chain : Node;
+                                            Call_Loc : Node);
 
    --  Dynamic index for Synth_Assignment_Prefix.
    --  As dynamic is about dynamic (!) index, the index is a net.