From 5ef6fa41c3681dfbcbf8b7a0fb1fc9a6a7d98ce3 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 22 Feb 2023 20:42:51 +0100 Subject: synth-vhdl_expr: improve subtype conversion --- src/synth/synth-vhdl_expr.adb | 229 +++++++++++++++++++++++++++++------------- 1 file changed, 160 insertions(+), 69 deletions(-) (limited to 'src') diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index a3fce6be4..e5ffd933f 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -553,6 +553,147 @@ package body Synth.Vhdl_Expr is end if; end Convert_Array_Indexes; + pragma Unreferenced (Convert_Array_Indexes); + + -- Convert OBJ to T, assuming matching indexes. + function Convert_Indexes (T : Type_Acc; Obj : Type_Acc) return Type_Acc is + begin + if Obj = T then + return Obj; + end if; + case T.Kind is + when Type_Scalars + | Type_Access + | Type_File + | Type_Protected + | Type_Slice => + raise Internal_Error; + when Type_Unbounded_Vector => + return Obj; + when Type_Vector => + return T; + when Type_Array => + return T; + when Type_Array_Unbounded => + -- Element is unbounded. + declare + El : Type_Acc; + begin + El := Convert_Indexes (T.Arr_El, Obj.Arr_El); + return Create_Array_Type (T.Abound, T.Is_Bnd_Static, + T.Alast, El); + end; + when Type_Unbounded_Array => + declare + El : Type_Acc; + begin + El := Convert_Indexes (T.Uarr_El, Obj.Arr_El); + return Create_Array_Type (Obj.Abound, Obj.Is_Bnd_Static, + T.Ulast, El); + end; + when Type_Record => + return T; + when Type_Unbounded_Record => + declare + Els : Rec_El_Array_Acc; + begin + Els := Create_Rec_El_Array (T.Rec.Len); + for I in Els.E'Range loop + Els.E (I).Typ := Convert_Indexes + (T.Rec.E (I).Typ, Obj.Rec.E (I).Typ); + -- Offsets don't change, only bounds do. + Els.E (I).Offs := Obj.Rec.E (I).Offs; + end loop; + return Create_Record_Type (T.Rec_Base, Els); + end; + end case; + end Convert_Indexes; + + -- Return True iff bounds of T and OBJ matches. + -- Return False and emit an error message if not. + function Check_Matching_Bounds (Syn_Inst : Synth_Instance_Acc; + T : Type_Acc; + Obj : Type_Acc; + Loc : Node) return Boolean + is + begin + if T = Obj then + return True; + end if; + case T.Kind is + when Type_Scalars + | Type_Access + | Type_File + | Type_Protected => + return True; + when Type_Unbounded_Vector => + pragma Assert (Obj.Kind = Type_Vector + or else Obj.Kind = Type_Slice); + return True; + when Type_Vector => + pragma Assert (Obj.Kind = Type_Vector + or Obj.Kind = Type_Slice); + if T.W /= Obj.W then + Error_Msg_Synth (Syn_Inst, Loc, + "mismatching vector length; got %v, expect %v", + (+Obj.W, +T.W)); + return False; + end if; + when Type_Array + | Type_Array_Unbounded => + pragma Assert (Obj.Kind = Type_Array); + -- Check bounds. + declare + Src_Typ, Dst_Typ : Type_Acc; + begin + Src_Typ := T; + Dst_Typ := Obj; + loop + pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); + if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then + Error_Msg_Synth + (Syn_Inst, Loc, "mismatching array bounds"); + return False; + end if; + exit when Src_Typ.Alast; + Src_Typ := Src_Typ.Arr_El; + Dst_Typ := Dst_Typ.Arr_El; + end loop; + return Check_Matching_Bounds + (Syn_Inst, Src_Typ.Arr_El, Dst_Typ.Arr_El, Loc); + end; + when Type_Unbounded_Array => + pragma Assert (Obj.Kind = Type_Array); + declare + T1, O1 : Type_Acc; + begin + T1 := T; + O1 := Obj; + loop + pragma Assert (T1.Ulast = O1.Alast); + exit when T1.Ulast; + T1 := T1.Uarr_El; + O1 := O1.Arr_El; + end loop; + return Check_Matching_Bounds + (Syn_Inst, T1.Uarr_El, O1.Arr_El, Loc); + end; + when Type_Record + | Type_Unbounded_Record => + pragma Assert (Obj.Kind = Type_Record); + for I in T.Rec.E'Range loop + if not Check_Matching_Bounds + (Syn_Inst, T.Rec.E (I).Typ, Obj.Rec.E (I).Typ, Loc) + then + return False; + end if; + end loop; + when Type_Slice => + raise Internal_Error; + end case; + return True; + end Check_Matching_Bounds; + function Synth_Subtype_Conversion (Syn_Inst : Synth_Instance_Acc; Vt : Valtyp; Dtype : Type_Acc; @@ -640,94 +781,44 @@ package body Synth.Vhdl_Expr is -- Is it possible ? Only const ? return Vt; end if; - when Type_Vector => + when Type_Vector + | Type_Unbounded_Vector => pragma Assert (Vtype.Kind = Type_Vector or Vtype.Kind = Type_Slice); - if Dtype.W /= Vtype.W then - Error_Msg_Synth (Syn_Inst, Loc, - "mismatching vector length; got %v, expect %v", - (+Vtype.W, +Dtype.W)); + if not Check_Matching_Bounds(Syn_Inst, Dtype, Vtype, Loc) then return No_Valtyp; end if; if Bounds then - return Reshape_Value (Vt, Dtype); + return Reshape_Value (Vt, Convert_Indexes (Dtype, Vtype)); else return Vt; end if; when Type_Slice => -- TODO: check width return Vt; - when Type_Array => - pragma Assert (Vtype.Kind = Type_Array); - -- Check bounds. - declare - Src_Typ, Dst_Typ : Type_Acc; - begin - Src_Typ := Vtype; - Dst_Typ := Dtype; - loop - pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); - if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then - Error_Msg_Synth - (Syn_Inst, Loc, "mismatching array bounds"); - return No_Valtyp; - end if; - exit when Src_Typ.Alast; - Src_Typ := Src_Typ.Arr_El; - Dst_Typ := Dst_Typ.Arr_El; - end loop; - -- TODO: check element. - if Bounds then - return Reshape_Value (Vt, Dtype); - else - return Vt; - end if; - end; - when Type_Array_Unbounded => - pragma Assert (Vtype.Kind = Type_Array); - -- TODO: check element. - return Vt; - when Type_Unbounded_Array => + when Type_Array + | Type_Array_Unbounded + | Type_Unbounded_Array => pragma Assert (Vtype.Kind = Type_Array); - 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); - if Vtype.Kind = Type_Slice then - -- Cannot be converted. + if not Check_Matching_Bounds(Syn_Inst, Dtype, Vtype, Loc) then + return No_Valtyp; + end if; + if Bounds then + return Reshape_Value (Vt, Convert_Indexes (Dtype, Vtype)); + else 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 => + when Type_Record + | Type_Unbounded_Record => pragma Assert (Vtype.Kind = Type_Record); - -- TODO: check elements. + if not Check_Matching_Bounds(Syn_Inst, Dtype, Vtype, Loc) then + return No_Valtyp; + end if; if Bounds then - return Reshape_Value (Vt, Dtype); + return Reshape_Value (Vt, Convert_Indexes (Dtype, Vtype)); else return Vt; end if; - when Type_Unbounded_Record => - pragma Assert (Vtype.Kind = Type_Record); - -- TODO: check elements - return Vt; when Type_Access => return Vt; when Type_File -- cgit v1.2.3