WIP: unbounded records (set record subtype staticness)

8 files changed, 151 insertions, 60 deletions

diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb
index b0da9362d..b21ad3ad2 100644
--- a/src/vhdl/sem_types.adb
+++ b/src/vhdl/sem_types.adb
@@ -75,25 +75,31 @@ package body Sem_Types is
          Set_Type_Has_Signal (Orig);
       end if;
 
-      --  Mark resolution function, and for composite types, also mark type
-      --  of elements.
+      --  For subtype, mark resolution function and base type.
+      case Get_Kind (Atype) is
+         when Iir_Kinds_Scalar_Subtype_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            Set_Type_Has_Signal (Get_Base_Type (Atype));
+            Mark_Resolution_Function (Atype);
+         when others =>
+            null;
+      end case;
+
+      --  For composite types, also mark type of elements.
       case Get_Kind (Atype) is
          when Iir_Kind_Integer_Type_Definition
            | Iir_Kind_Enumeration_Type_Definition
            | Iir_Kind_Physical_Type_Definition
            | Iir_Kind_Floating_Type_Definition =>
             null;
-         when Iir_Kinds_Scalar_Subtype_Definition
-           | Iir_Kind_Record_Subtype_Definition =>
-            Set_Type_Has_Signal (Get_Base_Type (Atype));
-            Mark_Resolution_Function (Atype);
-         when Iir_Kind_Array_Subtype_Definition =>
-            Set_Type_Has_Signal (Get_Base_Type (Atype));
-            Mark_Resolution_Function (Atype);
-            Set_Type_Has_Signal (Get_Element_Subtype (Atype));
-         when Iir_Kind_Array_Type_Definition =>
+         when Iir_Kinds_Scalar_Subtype_Definition =>
+            null;
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition =>
             Set_Type_Has_Signal (Get_Element_Subtype (Atype));
-         when Iir_Kind_Record_Type_Definition =>
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
             declare
                El_List : constant Iir_List :=
                  Get_Elements_Declaration_List (Atype);
@@ -1827,7 +1833,6 @@ package body Sem_Types is
       Res := Create_Iir (Iir_Kind_Record_Subtype_Definition);
       Location_Copy (Res, Def);
       Set_Base_Type (Res, Get_Base_Type (Type_Mark));
-      Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
       if Get_Kind (Type_Mark) = Iir_Kind_Record_Subtype_Definition then
          Set_Resolution_Indication
            (Res, Get_Resolution_Indication (Type_Mark));
@@ -1888,6 +1893,7 @@ package body Sem_Types is
             Res_Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir);
             Pos : Natural;
             Constraint : Iir_Constraint;
+            Staticness : Iir_Staticness;
          begin
             --  Fill ELS with record constraints.
             if El_List /= Null_Iir_List then
@@ -1967,6 +1973,7 @@ package body Sem_Types is
             El_List := Create_Iir_List;
             Set_Elements_Declaration_List (Res, El_List);
             Constraint := Fully_Constrained;
+            Staticness := Locally;
             for I in Els'Range loop
                Tm_El := Get_Nth_Element (Tm_El_List, I);
                if Els (I) = Null_Iir and Res_Els (I) = Null_Iir then
@@ -1995,12 +2002,15 @@ package body Sem_Types is
                end if;
                Append_Element (El_List, El);
                Constraint := Update_Record_Constraint (Constraint, El_Type);
+               Staticness := Min (Staticness, Get_Type_Staticness (El_Type));
             end loop;
             Set_Constraint_State (Res, Constraint);
+            Set_Type_Staticness (Res, Staticness);
          end;
       else
          Copy_Record_Elements_Declaration_List (Res, Type_Mark);
          Set_Constraint_State (Res, Get_Constraint_State (Type_Mark));
+         Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
       end if;
 
       Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 1306dfc10..f013b33c8 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1119,6 +1119,7 @@ package body Trans.Chap3 is
       end loop;
 
       --  Then create the record type.
+      Info.S := Ortho_Info_Subtype_Record_Init;
       Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
       for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
          Start_Record_Type (El_List);
@@ -1185,8 +1186,6 @@ package body Trans.Chap3 is
       El_Tnode   : O_Tnode;
 
       Mark : Id_Mark_Type;
-
-      Base_Field : O_Fnode;
    begin
       --  Translate the newly constrained elements.
       Has_New_Constraints := False;
@@ -1221,17 +1220,24 @@ package body Trans.Chap3 is
 
       --  Then create the record type.
       if Get_Type_Staticness (Def) = Locally then
+         Info.Type_Mode := Type_Mode_Record;
          Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
          for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
             Start_Record_Type (Rec);
-            New_Record_Field (Rec, Base_Field, Wki_Base,
+            New_Record_Field (Rec, Info.S.Box_Field (Kind), Wki_Base,
                               Info.B.Base_Type (Kind));
             for I in Natural loop
                B_El := Get_Nth_Element (El_Blist, I);
                exit when B_El = Null_Iir;
 
                if Is_Unbounded_Type (Get_Info (Get_Type (B_El))) then
-                  Field_Info := Add_Info (El, Kind_Field);
+                  El := Get_Nth_Element (El_List, I);
+                  if Kind = Mode_Value then
+                     Field_Info := Add_Info (El, Kind_Field);
+                  else
+                     Field_Info := Get_Info (El);
+                  end if;
+                  El := Get_Nth_Element (El_List, I);
                   El_Tinfo := Get_Info (Get_Type (El));
                   El_Tnode := El_Tinfo.Ortho_Type (Kind);
                   New_Record_Field (Rec, Field_Info.Field_Node (Kind),
@@ -2455,7 +2461,7 @@ package body Trans.Chap3 is
         (New_Selected_Element (M2Lv (B),
                                Get_Info (Base_El).Field_Bound),
          El_Tinfo, Mode_Value,
-         El_Tinfo.B.Range_Type, El_Tinfo.B.Range_Ptr_Type);
+         El_Tinfo.B.Bounds_Type, El_Tinfo.B.Bounds_Ptr_Type);
    end Bounds_To_Element_Bounds;
 
    function Type_To_Range (Atype : Iir) return Mnode
@@ -2514,7 +2520,8 @@ package body Trans.Chap3 is
       case Info.Type_Mode is
          when Type_Mode_Fat_Array =>
             raise Internal_Error;
-         when Type_Mode_Array =>
+         when Type_Mode_Array
+           | Type_Mode_Record =>
             return Varv2M (Info.S.Composite_Bounds,
                            Info, Mode_Value,
                            Info.B.Bounds_Type,
@@ -2547,7 +2554,8 @@ package body Trans.Chap3 is
                   Info.B.Bounds_Type,
                   Info.B.Bounds_Ptr_Type);
             end;
-         when Type_Mode_Array =>
+         when Type_Mode_Array
+           | Type_Mode_Record =>
             return Get_Array_Type_Bounds (Info);
          when Type_Mode_Bounds_Acc =>
             return Lp2M (M2Lv (Arr), Info, Mode_Value);
@@ -2619,21 +2627,16 @@ package body Trans.Chap3 is
    function Get_Composite_Base (Arr : Mnode) return Mnode
    is
       Info : constant Type_Info_Acc := Get_Type_Info (Arr);
+      Kind : constant Object_Kind_Type := Get_Object_Kind (Arr);
    begin
       case Info.Type_Mode is
          when Type_Mode_Unbounded_Array
            | Type_Mode_Unbounded_Record =>
-            declare
-               Kind : constant Object_Kind_Type := Get_Object_Kind (Arr);
-            begin
-               return Lp2M
-                 (New_Selected_Element (M2Lv (Arr),
-                                        Info.B.Base_Field (Kind)),
-                  Info,
-                  Kind,
-                  Info.B.Base_Type (Kind),
-                  Info.B.Base_Ptr_Type (Kind));
-            end;
+            return Lp2M
+              (New_Selected_Element (M2Lv (Arr),
+                                     Info.B.Base_Field (Kind)),
+               Info, Kind,
+               Info.B.Base_Type (Kind), Info.B.Base_Ptr_Type (Kind));
          when Type_Mode_Array
            | Type_Mode_Record =>
             return Arr;
@@ -2774,15 +2777,13 @@ package body Trans.Chap3 is
            | Type_Mode_File =>
             --  Scalar or thin pointer.
             New_Assign_Stmt (M2Lv (Dest), Src);
-         when Type_Mode_Unbounded_Array =>
+         when Type_Mode_Unbounded_Array
+           | Type_Mode_Unbounded_Record =>
             --  a fat array.
             D := Stabilize (Dest);
             Gen_Memcpy (M2Addr (Get_Composite_Base (D)),
                         M2Addr (Get_Composite_Base (E2M (Src, Info, Kind))),
                         Get_Object_Size (D, Obj_Type));
-         when Type_Mode_Unbounded_Record =>
-            --  TODO
-            raise Internal_Error;
          when Type_Mode_Array
             | Type_Mode_Record =>
             D := Stabilize (Dest);
@@ -2830,8 +2831,11 @@ package body Trans.Chap3 is
                El_Type : Iir;
                El_Type_Info : Type_Info_Acc;
                El_Bounds : Mnode;
+               Stable_Bounds : Mnode;
                Res : O_Enode;
             begin
+               Stable_Bounds := Stabilize (Bounds);
+
                --  Size of base type
                Res := New_Lit (New_Sizeof (Type_Info.B.Base_Type (Kind),
                                            Ghdl_Index_Type));
@@ -2843,7 +2847,7 @@ package body Trans.Chap3 is
                   if El_Type_Info.Type_Mode in Type_Mode_Unbounded then
                      --  Recurse
                      Res := Realign (Res, El_Type);
-                     El_Bounds := Bounds_To_Element_Bounds (Bounds, El);
+                     El_Bounds := Bounds_To_Element_Bounds (Stable_Bounds, El);
                      Res := New_Dyadic_Op
                        (ON_Add_Ov,
                         Res, Get_Subtype_Size (El_Type, El_Bounds, Kind));
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 32dc21136..c4e956e67 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2802,9 +2802,8 @@ package body Trans.Chap4 is
                E := New_Function_Call (Constr);
             end if;
             Res := E2M
-              (Chap7.Translate_Implicit_Conv
-                 (E, Get_Return_Type (Func),
-                  Out_Type, Mode_Value, Imp),
+              (Chap7.Translate_Implicit_Conv (E, Get_Return_Type (Func),
+                                              Out_Type, Mode_Value, Imp),
                Get_Info (Out_Type), Mode_Value);
 
          when Iir_Kind_Type_Conversion =>
diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index 6d0ec5eea..5d6c87993 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -816,12 +816,14 @@ package body Trans.Chap6 is
    function Translate_Selected_Element
      (Prefix : Mnode; El : Iir_Element_Declaration) return Mnode
    is
-      Base_El : constant Iir := Get_Base_Element_Declaration (El);
-      El_Info       : constant Field_Info_Acc := Get_Info (Base_El);
-      El_Type       : constant Iir := Get_Type (Base_El);
+      El_Type       : constant Iir := Get_Type (El);
       El_Tinfo      : constant Type_Info_Acc := Get_Info (El_Type);
       Kind          : constant Object_Kind_Type := Get_Object_Kind (Prefix);
+      El_Info       : Field_Info_Acc;
+      Base_Tinfo    : Type_Info_Acc;
       Stable_Prefix, Base, Res, Fat_Res : Mnode;
+      Box_Field : O_Fnode;
+      B : O_Lnode;
    begin
       --  There are 3 cases:
       --  a) the record is bounded (and so is the element).
@@ -830,6 +832,13 @@ package body Trans.Chap6 is
       --  If the record is unbounded, PREFIX is a fat pointer.
       --  On top of that, the element may be complex.
 
+      --  For record subtypes, there is no info for elements that have not
+      --  changed.
+      El_Info := Get_Info (El);
+      if El_Info = null then
+         El_Info := Get_Info (Get_Base_Element_Declaration (El));
+      end if;
+
       if Is_Unbounded_Type (El_Tinfo) then
          Stable_Prefix := Stabilize (Prefix);
 
@@ -848,8 +857,12 @@ package body Trans.Chap6 is
       end if;
 
       Base := Chap3.Get_Composite_Base (Stable_Prefix);
+      Base_Tinfo := Get_Type_Info (Base);
+      Box_Field := Base_Tinfo.S.Box_Field (Kind);
 
-      if Is_Complex_Type (El_Tinfo) or Is_Unbounded_Type (El_Tinfo) then
+      if Box_Field = O_Fnode_Null
+        and then (Is_Complex_Type (El_Tinfo) or Is_Unbounded_Type (El_Tinfo))
+      then
          --  The element is complex: it's an offset.
          Stabilize (Base);
          Res := E2M
@@ -865,8 +878,16 @@ package body Trans.Chap6 is
             El_Tinfo, Kind);
       else
          --  Normal element.
-         Res := Lv2M (New_Selected_Element (M2Lv (Base),
-                      El_Info.Field_Node (Kind)),
+         B := M2Lv (Base);
+
+         if Box_Field /= O_Fnode_Null
+           and then Get_Kind (El) = Iir_Kind_Element_Declaration
+         then
+            --  Unbox.
+            B := New_Selected_Element (B, Box_Field);
+         end if;
+
+         Res := Lv2M (New_Selected_Element (B, El_Info.Field_Node (Kind)),
                       El_Tinfo, Kind);
       end if;
 
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index c361f0905..dfc0f221b 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -818,16 +818,15 @@ package body Trans.Chap7 is
       Ainfo := Get_Info (Res_Type);
       Einfo := Get_Info (Expr_Type);
       case Ainfo.Type_Mode is
-         when Type_Mode_Fat_Array =>
+         when Type_Mode_Unbounded_Array =>
             --  X to unconstrained.
             case Einfo.Type_Mode is
-               when Type_Mode_Fat_Array =>
+               when Type_Mode_Unbounded_Array =>
                   --  unconstrained to unconstrained.
                   return Expr;
                when Type_Mode_Array =>
                   --  constrained to unconstrained.
-                  return Convert_Constrained_To_Unconstrained
-                    (Expr, Res_Type);
+                  return Convert_Constrained_To_Unconstrained (Expr, Res_Type);
                when others =>
                   raise Internal_Error;
             end case;
@@ -855,6 +854,51 @@ package body Trans.Chap7 is
       end case;
    end Translate_Implicit_Array_Conversion;
 
+   function Translate_Implicit_Record_Conversion
+     (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode
+   is
+      pragma Unreferenced (Loc);
+      Ainfo : Type_Info_Acc;
+      Einfo : Type_Info_Acc;
+   begin
+      if Res_Type = Expr_Type then
+         return Expr;
+      end if;
+
+      Ainfo := Get_Info (Res_Type);
+      Einfo := Get_Info (Expr_Type);
+      case Ainfo.Type_Mode is
+         when Type_Mode_Unbounded_Record =>
+            --  X to unbounded.
+            case Einfo.Type_Mode is
+               when Type_Mode_Unbounded_Record =>
+                  --  unbounded to unbounded
+                  return Expr;
+               when Type_Mode_Record =>
+                  --  bounded to unconstrained.
+                  return Convert_Constrained_To_Unconstrained (Expr, Res_Type);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Type_Mode_Record =>
+            --  X to bounded
+            case Einfo.Type_Mode is
+               when Type_Mode_Unbounded_Record =>
+                  --  unbounded to bounded.
+                  --  TODO: need to check bounds.
+                  raise Internal_Error;
+               when Type_Mode_Record =>
+                  --  bounded to bounded.
+                  --  TODO: likewise ?
+                  return Expr;
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Translate_Implicit_Record_Conversion;
+
    --  Convert (if necessary) EXPR translated from EXPR_ORIG to type ATYPE.
    function Translate_Implicit_Conv (Expr      : O_Enode;
                                      Expr_Type : Iir;
@@ -872,12 +916,20 @@ package body Trans.Chap7 is
          return New_Convert_Ov (Expr, Get_Ortho_Type (Atype, Mode_Value));
       elsif Expr_Type = Universal_Real_Type_Definition then
          return New_Convert_Ov (Expr, Get_Ortho_Type (Atype, Mode_Value));
-      elsif Get_Kind (Expr_Type) in Iir_Kinds_Array_Type_Definition then
-         return M2E (Translate_Implicit_Array_Conversion
-                     (E2M (Expr, Get_Info (Expr_Type), Is_Sig),
-                        Expr_Type, Atype, Loc));
       else
-         return Expr;
+         case Get_Kind (Expr_Type) is
+            when Iir_Kinds_Array_Type_Definition =>
+               return M2E (Translate_Implicit_Array_Conversion
+                             (E2M (Expr, Get_Info (Expr_Type), Is_Sig),
+                              Expr_Type, Atype, Loc));
+            when Iir_Kind_Record_Type_Definition
+              | Iir_Kind_Record_Subtype_Definition =>
+               return M2E (Translate_Implicit_Record_Conversion
+                             (E2M (Expr, Get_Info (Expr_Type), Is_Sig),
+                              Expr_Type, Atype, Loc));
+            when others =>
+               return Expr;
+         end case;
       end if;
    end Translate_Implicit_Conv;
 
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 080894562..171eb9231 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -2698,7 +2698,7 @@ package body Trans.Chap8 is
                            Alloc := Alloc_Stack;
                         end if;
 
-                        if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                        if Ftype_Info.Type_Mode in Type_Mode_Unbounded then
                            --  Create the constraints and then the object.
                            --  FIXME: do not allocate bounds.
                            Chap3.Create_Array_Subtype (Actual_Type);
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index ebedf7492..053d2335e 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -1302,9 +1302,7 @@ package body Trans is
 
    procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc) is
    begin
-      if Node_Infos.Table (Target) /= null then
-         raise Internal_Error;
-      end if;
+      pragma Assert (Node_Infos.Table (Target) = null);
       Node_Infos.Table (Target) := Info;
    end Set_Info;
 
@@ -1325,6 +1323,7 @@ package body Trans is
    is
       Res : Ortho_Info_Acc;
    begin
+      pragma Assert (Target /= Null_Iir);
       Res := new Ortho_Info_Type (Kind);
       Set_Info (Target, Res);
       return Res;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index a9d02017a..412c37c8e 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -777,6 +777,10 @@ package Trans is
             --  Variable containing the bounds for a constrained type.
             Composite_Bounds : Var_Type;
 
+            --  For a locally constrained record subtype whose base type has
+            --  unbounded elements: the field containing the base record.
+            Box_Field : O_Fnode_Array;
+
          when Kind_Type_File =>
             null;
 
@@ -808,7 +812,8 @@ package Trans is
    Ortho_Info_Subtype_Array_Init : constant Ortho_Info_Subtype_Type :=
      (Kind => Kind_Type_Array,
       Static_Bounds => False,
-      Composite_Bounds => Null_Var);
+      Composite_Bounds => Null_Var,
+      Box_Field => (O_Fnode_Null, O_Fnode_Null));
 
    Ortho_Info_Basetype_Record_Init : constant Ortho_Info_Basetype_Type :=
      (Kind => Kind_Type_Record,
@@ -823,7 +828,8 @@ package Trans is
    Ortho_Info_Subtype_Record_Init : constant Ortho_Info_Subtype_Type :=
      (Kind => Kind_Type_Record,
       Static_Bounds => False,
-      Composite_Bounds => Null_Var);
+      Composite_Bounds => Null_Var,
+      Box_Field => (O_Fnode_Null, O_Fnode_Null));
 
    Ortho_Info_Basetype_File_Init : constant Ortho_Info_Basetype_Type :=
      (Kind => Kind_Type_File,