From 3f02d97cfe261bb96b7717c4e6199b20f253b361 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Tue, 5 May 2020 04:37:27 +0200
Subject: synth: initial support of unbounded records. Fix #1283
---
src/synth/synth-aggr.adb | 3 ++-
src/synth/synth-decls.adb | 9 +++++----
src/synth/synth-expr.adb | 3 +++
src/synth/synth-objtypes.adb | 21 +++++++++++++++++++--
src/synth/synth-objtypes.ads | 5 ++++-
src/synth/synth-values-debug.adb | 4 ++++
src/synth/synth-values.adb | 6 +++---
7 files changed, 40 insertions(+), 11 deletions(-)
(limited to 'src')
diff --git a/src/synth/synth-aggr.adb b/src/synth/synth-aggr.adb
index 2ec210ca5..f7cd5278d 100644
--- a/src/synth/synth-aggr.adb
+++ b/src/synth/synth-aggr.adb
@@ -488,7 +488,8 @@ package body Synth.Aggr is
when Type_Vector
| Type_Array =>
return Synth_Aggregate_Array (Syn_Inst, Aggr, En, Aggr_Type);
- when Type_Record =>
+ when Type_Record
+ | Type_Unbounded_Record =>
return Synth_Aggregate_Record (Syn_Inst, Aggr, En, Aggr_Type);
when others =>
raise Internal_Error;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index d3a9cc13f..9e0ce30c1 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -121,9 +121,6 @@ package body Synth.Decls is
El : Node;
El_Typ : Type_Acc;
begin
- if not Is_Fully_Constrained_Type (Def) then
- return null;
- end if;
Rec_Els := Create_Rec_El_Array
(Iir_Index32 (Get_Nbr_Elements (El_List)));
@@ -133,7 +130,11 @@ package body Synth.Decls is
Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ;
end loop;
- return Create_Record_Type (Rec_Els);
+ if not Is_Fully_Constrained_Type (Def) then
+ return Create_Unbounded_Record (Rec_Els);
+ else
+ return Create_Record_Type (Rec_Els);
+ end if;
end Synth_Record_Type_Definition;
function Synth_Access_Type_Definition
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index dfe2f47d2..e24a4959d 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -823,6 +823,9 @@ package body Synth.Expr is
when Type_Record =>
-- TODO: handle elements.
return Vt;
+ when Type_Unbounded_Record =>
+ pragma Assert (Vtype.Kind = Type_Record);
+ return Vt;
when Type_Access =>
return Vt;
when Type_File =>
diff --git a/src/synth/synth-objtypes.adb b/src/synth/synth-objtypes.adb
index f7517c927..0876da3cb 100644
--- a/src/synth/synth-objtypes.adb
+++ b/src/synth/synth-objtypes.adb
@@ -55,6 +55,7 @@ package body Synth.Objtypes is
return True;
when Type_Unbounded_Array
| Type_Unbounded_Vector
+ | Type_Unbounded_Record
| Type_Protected =>
return False;
end case;
@@ -99,7 +100,8 @@ package body Synth.Objtypes is
when Type_Unbounded_Array =>
return L.Uarr_Ndim = R.Uarr_Ndim
and then Are_Types_Equal (L.Uarr_El, R.Uarr_El);
- when Type_Record =>
+ when Type_Record
+ | Type_Unbounded_Record =>
if L.Rec.Len /= R.Rec.Len then
return False;
end if;
@@ -457,6 +459,20 @@ package body Synth.Objtypes is
Rec => Els)));
end Create_Record_Type;
+ function Create_Unbounded_Record (Els : Rec_El_Array_Acc) return Type_Acc
+ is
+ subtype Unbounded_Record_Type_Type is Type_Type (Type_Unbounded_Record);
+ function Alloc is
+ new Areapools.Alloc_On_Pool_Addr (Unbounded_Record_Type_Type);
+ begin
+ return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Record,
+ Is_Synth => True,
+ Al => 0,
+ Sz => 0,
+ W => 0,
+ Rec => Els)));
+ end Create_Unbounded_Record;
+
function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc
is
subtype Access_Type_Type is Type_Type (Type_Access);
@@ -566,7 +582,8 @@ package body Synth.Objtypes is
end loop;
return True;
when Type_Unbounded_Array
- | Type_Unbounded_Vector =>
+ | Type_Unbounded_Vector
+ | Type_Unbounded_Record =>
raise Internal_Error;
when Type_Record =>
-- FIXME: handle vhdl-08
diff --git a/src/synth/synth-objtypes.ads b/src/synth/synth-objtypes.ads
index 339197489..c90937b64 100644
--- a/src/synth/synth-objtypes.ads
+++ b/src/synth/synth-objtypes.ads
@@ -77,6 +77,7 @@ package Synth.Objtypes is
Type_Slice,
Type_Array,
Type_Unbounded_Array,
+ Type_Unbounded_Record,
Type_Record,
Type_Access,
@@ -144,7 +145,8 @@ package Synth.Objtypes is
when Type_Unbounded_Array =>
Uarr_Ndim : Dim_Type;
Uarr_El : Type_Acc;
- when Type_Record =>
+ when Type_Record
+ | Type_Unbounded_Record =>
Rec : Rec_El_Array_Acc;
when Type_Access =>
Acc_Acc : Type_Acc;
@@ -210,6 +212,7 @@ package Synth.Objtypes is
function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc;
function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc;
+ function Create_Unbounded_Record (Els : Rec_El_Array_Acc) return Type_Acc;
function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc;
diff --git a/src/synth/synth-values-debug.adb b/src/synth/synth-values-debug.adb
index 2e3e111c1..15e584cb6 100644
--- a/src/synth/synth-values-debug.adb
+++ b/src/synth/synth-values-debug.adb
@@ -72,6 +72,8 @@ package body Synth.Values.Debug is
when Type_Record =>
Put ("rec: (");
Put (")");
+ when Type_Unbounded_Record =>
+ Put ("unbounded record");
when Type_Discrete =>
Put ("discrete: ");
Put_Int64 (T.Drange.Left);
@@ -168,6 +170,8 @@ package body Synth.Values.Debug is
Put ("unbounded vector");
when Type_Unbounded_Array =>
Put ("unbounded array");
+ when Type_Unbounded_Record =>
+ Put ("unbounded record");
when Type_Protected =>
Put ("protected");
end case;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 40a394b4a..e515d6a46 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -425,7 +425,9 @@ package body Synth.Values is
Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ);
end loop;
end;
- when Type_Unbounded_Vector =>
+ when Type_Unbounded_Vector
+ | Type_Unbounded_Array
+ | Type_Unbounded_Record =>
raise Internal_Error;
when Type_Slice =>
raise Internal_Error;
@@ -438,8 +440,6 @@ package body Synth.Values is
Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ);
end loop;
end;
- when Type_Unbounded_Array =>
- raise Internal_Error;
when Type_Record =>
for I in Typ.Rec.E'Range loop
Write_Value_Default (M + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ);
--
cgit v1.2.3