ortho: add unbounded records, rework array subtypes.

3 files changed, 310 insertions, 134 deletions

diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb
index a7bbbe907..fd18f1260 100644
--- a/src/ortho/debug/ortho_debug-disp.adb
+++ b/src/ortho/debug/ortho_debug-disp.adb
@@ -572,6 +572,11 @@ package body Ortho_Debug.Disp is
             Put ("'sizeof (");
             Disp_Tnode_Name (C.S_Type);
             Put (")");
+         when OC_Record_Sizeof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'record_sizeof (");
+            Disp_Tnode_Name (C.S_Type);
+            Put (")");
          when OC_Alignof_Lit =>
             Disp_Tnode_Name (C.Ctype);
             Put ("'alignof (");
@@ -590,14 +595,7 @@ package body Ortho_Debug.Disp is
                El_Type : O_Tnode;
             begin
                El := C.Arr_Els;
-               case C.Ctype.Kind is
-                  when ON_Array_Sub_Type =>
-                     El_Type := C.Ctype.Base_Type.El_Type;
-                  when ON_Array_Type =>
-                     El_Type := C.Ctype.El_Type;
-                  when others =>
-                     raise Program_Error;
-               end case;
+               El_Type := Get_Array_El_Type (C.Ctype);
                Put ('[');
                Put_Trim (Unsigned_32'Image (C.Arr_Len));
                Put (']');
@@ -622,7 +620,7 @@ package body Ortho_Debug.Disp is
                Put ('{');
                El := C.Rec_Els;
                pragma Assert (C.Ctype.Kind = ON_Record_Type);
-               Field := C.Ctype.Elements;
+               Field := C.Ctype.Rec_Elements;
                if El /= null then
                   loop
                      Set_Mark;
@@ -898,24 +896,41 @@ package body Ortho_Debug.Disp is
          when ON_Record_Type =>
             Put_Keyword ("record");
             New_Line;
-            Disp_Fnodes (Atype.Elements);
+            Disp_Fnodes (Atype.Rec_Elements);
             Put_Keyword ("end");
             Put (" ");
             Put_Keyword ("record");
+         when ON_Record_Subtype =>
+            Put_Keyword ("subrecord");
+            Put (" ");
+            Disp_Tnode_Name (Atype.Subrec_Base);
+            Put ("(");
+            Disp_Fnodes (Atype.Subrec_Elements);
+            Put (")");
          when ON_Union_Type =>
             Put_Keyword ("union");
             New_Line;
-            Disp_Fnodes (Atype.Elements);
+            Disp_Fnodes (Atype.Rec_Elements);
             Put_Keyword ("end");
             Put (" ");
             Put_Keyword ("union");
-         when ON_Array_Sub_Type =>
-            Put_Keyword ("subarray");
-            Put (" ");
-            Disp_Tnode_Name (Atype.Base_Type);
-            Put ("[");
-            Disp_Cnode (Atype.Length, Atype.Base_Type.Index_Type);
-            Put ("]");
+         when ON_Array_Subtype =>
+            declare
+               Base : constant O_Tnode := Atype.Arr_Base;
+            begin
+               Put_Keyword ("subarray");
+               Put (" ");
+               Disp_Tnode_Name (Base);
+               Put ("[");
+               Disp_Cnode (Atype.Length, Base.Index_Type);
+               Put ("]");
+               if Atype.Arr_El_Type /= Base.El_Type then
+                  Put (" ");
+                  Put_Keyword ("of");
+                  Put (" ");
+                  Disp_Tnode (Atype.Arr_El_Type, False);
+               end if;
+            end;
       end case;
    end Disp_Tnode;
 
@@ -1222,8 +1237,10 @@ package body Ortho_Debug.Disp is
 
    procedure Disp_Tnode_Decl (N : O_Tnode) is
    begin
-      Disp_Ident (N.Decl.Name);
-      Put (" : ");
+      if N.Decl /= O_Dnode_Null then
+         Disp_Ident (N.Decl.Name);
+         Put (" : ");
+      end if;
       Disp_Tnode (N, True);
    end Disp_Tnode_Decl;
 
diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb
index bf28022da..3617ebbc8 100644
--- a/src/ortho/debug/ortho_debug.adb
+++ b/src/ortho/debug/ortho_debug.adb
@@ -262,8 +262,11 @@ package body Ortho_Debug is
       if T1 = T2 then
          return;
       end if;
-      if T1.Kind = ON_Array_Sub_Type and then T2.Kind = ON_Array_Sub_Type
-        and then T1.Base_Type = T2.Base_Type
+      --  TODO: Two different subtypes with the same constraints are allowed.
+      --  Is it needed ?
+      if T1.Kind = ON_Array_Subtype and then T2.Kind = ON_Array_Subtype
+        and then T1.Arr_Base = T2.Arr_Base
+        and then T1.Arr_El_Type = T2.Arr_El_Type
         and then T1.Length.all = T2.Length.all
       then
          return;
@@ -307,6 +310,16 @@ package body Ortho_Debug is
       end if;
    end Check_Complete_Type;
 
+   procedure Check_Constrained_Type (T : O_Tnode) is
+   begin
+      if not T.Constrained then
+         --  Unconstrained type cannot be used here (since its size is
+         --  required, for example).
+         null;
+         raise Syntax_Error;
+      end if;
+   end Check_Constrained_Type;
+
    function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
      return O_Enode
    is
@@ -426,9 +439,7 @@ package body Ortho_Debug is
                                            Ref => False);
    end New_Default_Value;
 
-   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
-   is
-      subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit);
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
    begin
       if Rtype.Kind /= ON_Unsigned_Type
         and then Rtype.Kind /= ON_Access_Type
@@ -436,14 +447,30 @@ package body Ortho_Debug is
          raise Type_Error;
       end if;
       Check_Complete_Type (Atype);
-      if Atype.Kind = ON_Array_Type then
+      Check_Constrained_Type (Atype);
+      return new O_Cnode_Type'(Kind => OC_Sizeof_Lit,
+                               Ctype => Rtype,
+                               Ref => False,
+                               S_Type => Atype);
+   end New_Sizeof;
+
+   function New_Record_Sizeof
+     (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type
+        and then Rtype.Kind /= ON_Access_Type
+      then
          raise Type_Error;
       end if;
-      return new O_Cnode_Sizeof_Type'(Kind => OC_Sizeof_Lit,
-                                      Ctype => Rtype,
-                                      Ref => False,
-                                      S_Type => Atype);
-   end New_Sizeof;
+      Check_Complete_Type (Atype);
+      if Atype.Kind /= ON_Record_Type then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Type'(Kind => OC_Record_Sizeof_Lit,
+                               Ctype => Rtype,
+                               Ref => False,
+                               S_Type => Atype);
+   end New_Record_Sizeof;
 
    function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
    is
@@ -496,23 +523,17 @@ package body Ortho_Debug is
       return Res;
    end New_Alloca;
 
-   procedure Check_Constrained_Type (Atype : O_Tnode) is
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode is
    begin
       case Atype.Kind is
-         when ON_Array_Type =>
-            raise Type_Error;
-         when ON_Unsigned_Type
-           | ON_Signed_Type
-           | ON_Boolean_Type
-           | ON_Record_Type
-           | ON_Union_Type
-           | ON_Access_Type
-           | ON_Float_Type
-           | ON_Array_Sub_Type
-           | ON_Enum_Type =>
-            null;
+         when ON_Array_Subtype =>
+            return Atype.Arr_Base;
+         when ON_Record_Subtype =>
+            return Atype.Subrec_Base;
+         when others =>
+            return Atype;
       end case;
-   end Check_Constrained_Type;
+   end Get_Base_Type;
 
    procedure New_Completed_Type_Decl (Atype : O_Tnode)
    is
@@ -528,15 +549,14 @@ package body Ortho_Debug is
       Add_Decl (N, False);
    end New_Completed_Type_Decl;
 
-   procedure New_Uncomplete_Record_Type (Res : out O_Tnode)
-   is
-      subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type);
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
    begin
-      Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type,
-                                      Decl => O_Dnode_Null,
-                                      Uncomplete => True,
-                                      Complete => False,
-                                      Elements => O_Fnode_Null);
+      Res := new O_Tnode_Type'(Kind => ON_Record_Type,
+                               Decl => O_Dnode_Null,
+                               Uncomplete => True,
+                               Complete => False,
+                               Constrained => True,
+                               Rec_Elements => O_Fnode_Null);
    end New_Uncomplete_Record_Type;
 
    procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
@@ -546,7 +566,7 @@ package body Ortho_Debug is
          --  RES record type is not an uncomplete record type.
          raise Syntax_Error;
       end if;
-      if Res.Elements /= O_Fnode_Null then
+      if Res.Rec_Elements /= O_Fnode_Null then
          --  RES record type already has elements...
          raise Syntax_Error;
       end if;
@@ -556,14 +576,16 @@ package body Ortho_Debug is
 
    procedure Start_Record_Type (Elements : out O_Element_List)
    is
-      subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type);
+      Res : O_Tnode;
    begin
-      Elements.Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type,
-                                               Decl => O_Dnode_Null,
-                                               Uncomplete => False,
-                                               Complete => False,
-                                               Elements => O_Fnode_Null);
-      Elements.Last := null;
+      Res := new O_Tnode_Type'(Kind => ON_Record_Type,
+                               Decl => O_Dnode_Null,
+                               Uncomplete => False,
+                               Complete => False,
+                               Constrained => True,
+                               Rec_Elements => O_Fnode_Null);
+      Elements := (Res => Res,
+                   Last => null);
    end Start_Record_Type;
 
    procedure New_Record_Field
@@ -573,15 +595,16 @@ package body Ortho_Debug is
    is
    begin
       Check_Complete_Type (Etype);
-      Check_Constrained_Type (Etype);
+      if not Etype.Constrained then
+         Elements.Res.Constrained := False;
+      end if;
       El := new O_Fnode_Type'(Parent => Elements.Res,
                               Next => null,
                               Ident => Ident,
-                              Ftype => Etype,
-                              Offset => 0);
+                              Ftype => Etype);
       --  Append EL.
       if Elements.Last = null then
-         Elements.Res.Elements := El;
+         Elements.Res.Rec_Elements := El;
       else
          Elements.Last.Next := El;
       end if;
@@ -599,15 +622,82 @@ package body Ortho_Debug is
       Res.Complete := True;
    end Finish_Record_Type;
 
-   procedure Start_Union_Type (Elements : out O_Element_List)
+   procedure Start_Record_Subtype
+     (Rtype : O_Tnode; Elements : out O_Element_Sublist)
+   is
+      Res : O_Tnode;
+   begin
+      if Rtype.Kind /= ON_Record_Type then
+         raise Syntax_Error;
+      end if;
+
+      Res := new O_Tnode_Type'(Kind => ON_Record_Subtype,
+                               Decl => O_Dnode_Null,
+                               Uncomplete => False,
+                               Complete => False,
+                               Constrained => True,
+                               Subrec_Elements => O_Fnode_Null,
+                               Subrec_Base => Rtype);
+      Elements := (Res => Res,
+                   Last => null,
+                   Base_Field => Rtype.Rec_Elements);
+   end Start_Record_Subtype;
+
+   procedure New_Subrecord_Field
+     (Elements : in out O_Element_Sublist; El : out O_Fnode; Etype : O_Tnode)
    is
-      subtype O_Tnode_Union_Type is O_Tnode_Type (ON_Union_Type);
+      Base_Field : O_Fnode;
+   begin
+      Check_Complete_Type (Etype);
+      Check_Constrained_Type (Etype);
+
+      Base_Field := Elements.Base_Field;
+      if Base_Field = O_Fnode_Null then
+         raise Syntax_Error;
+      end if;
+      if Base_Field.Ftype.Constrained then
+         --  For constrained field of the base type, the type must be the
+         --  same.
+         if Base_Field.Ftype /= Etype then
+            raise Syntax_Error;
+         end if;
+      else
+         --  Otherwise, must be a subtype.
+         if Get_Base_Type (Etype) /= Base_Field.Ftype then
+            raise Syntax_Error;
+         end if;
+      end if;
+      El := new O_Fnode_Type'(Parent => Elements.Res,
+                              Next => null,
+                              Ident => Base_Field.Ident,
+                              Ftype => Etype);
+
+      --  Append EL.
+      if Elements.Last = null then
+         Elements.Res.Subrec_Elements := El;
+      else
+         Elements.Last.Next := El;
+      end if;
+      Elements.Last := El;
+
+      Elements.Base_Field := Base_Field.Next;
+   end New_Subrecord_Field;
+
+   procedure Finish_Record_Subtype
+     (Elements : in out O_Element_Sublist; Res : out O_Tnode) is
    begin
-      Elements.Res := new O_Tnode_Union_Type'(Kind => ON_Union_Type,
-                                              Decl => O_Dnode_Null,
-                                              Uncomplete => False,
-                                              Complete => False,
-                                              Elements => O_Fnode_Null);
+      Res := Elements.Res;
+      Res.Complete := True;
+   end Finish_Record_Subtype;
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Elements.Res := new O_Tnode_Type'(Kind => ON_Union_Type,
+                                        Decl => O_Dnode_Null,
+                                        Uncomplete => False,
+                                        Complete => False,
+                                        Constrained => True,
+                                        Rec_Elements => O_Fnode_Null);
       Elements.Last := null;
    end Start_Union_Type;
 
@@ -627,29 +717,34 @@ package body Ortho_Debug is
       Res.Complete := True;
    end Finish_Union_Type;
 
+   function Is_Subtype (T : O_Tnode) return Boolean is
+   begin
+      case T.Kind is
+         when ON_Array_Subtype
+            | ON_Record_Subtype =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Subtype;
+
    function New_Access_Type (Dtype : O_Tnode) return O_Tnode
    is
       subtype O_Tnode_Access is O_Tnode_Type (ON_Access_Type);
       Res : O_Tnode;
    begin
-      if Dtype /= O_Tnode_Null
-        and then Dtype.Kind = ON_Array_Sub_Type
-      then
-         --  Access to sub array are not allowed, use access to array.
-         raise Type_Error;
-      end if;
       Res := new O_Tnode_Access'(Kind => ON_Access_Type,
                                  Decl => O_Dnode_Null,
                                  Uncomplete => Dtype = O_Tnode_Null,
                                  Complete => True,
+                                 Constrained => True,
                                  D_Type => Dtype);
       return Res;
    end New_Access_Type;
 
-   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode)
-   is
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
    begin
-      if Dtype.Kind = ON_Array_Sub_Type then
+      if Is_Subtype (Dtype) then
          --  Access to sub array are not allowed, use access to array.
          raise Type_Error;
       end if;
@@ -668,31 +763,47 @@ package body Ortho_Debug is
    is
       subtype O_Tnode_Array is O_Tnode_Type (ON_Array_Type);
    begin
-      Check_Constrained_Type (El_Type);
       Check_Complete_Type (El_Type);
       return new O_Tnode_Array'(Kind => ON_Array_Type,
                                 Decl => O_Dnode_Null,
                                 Uncomplete => False,
                                 Complete => True,
+                                Constrained => False, --  By definition
                                 El_Type => El_Type,
                                 Index_Type => Index_Type);
    end New_Array_Type;
 
-   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
-     return O_Tnode
+   function New_Array_Subtype
+     (Atype : O_Tnode; El_Type : O_Tnode; Length : O_Cnode) return O_Tnode
    is
-      subtype O_Tnode_Sub_Array is O_Tnode_Type (ON_Array_Sub_Type);
+      subtype O_Tnode_Sub_Array is O_Tnode_Type (ON_Array_Subtype);
    begin
+      --  Can only constraint an array type.
       if Atype.Kind /= ON_Array_Type then
          raise Type_Error;
       end if;
-      return new O_Tnode_Sub_Array'(Kind => ON_Array_Sub_Type,
+
+      --  The element must either be ATYPE element or a constrained subtype
+      --  of it.
+      if El_Type /= Atype.El_Type then
+         if El_Type.Kind = ON_Array_Subtype then
+            if El_Type.Arr_Base /= Atype.El_Type then
+               raise Type_Error;
+            end if;
+         else
+            raise Type_Error;
+         end if;
+      end if;
+
+      return new O_Tnode_Sub_Array'(Kind => ON_Array_Subtype,
                                     Decl => O_Dnode_Null,
                                     Uncomplete => False,
                                     Complete => True,
-                                    Base_Type => Atype,
+                                    Constrained => True,
+                                    Arr_Base => Atype,
+                                    Arr_El_Type => El_Type,
                                     Length => Length);
-   end New_Constrained_Array_Type;
+   end New_Array_Subtype;
 
    function New_Unsigned_Type (Size : Natural) return O_Tnode
    is
@@ -702,6 +813,7 @@ package body Ortho_Debug is
                                    Decl => O_Dnode_Null,
                                    Uncomplete => False,
                                    Complete => True,
+                                   Constrained => True,
                                    Int_Size => Size);
    end New_Unsigned_Type;
 
@@ -713,6 +825,7 @@ package body Ortho_Debug is
                                  Decl => O_Dnode_Null,
                                  Uncomplete => False,
                                  Complete => True,
+                                 Constrained => True,
                                  Int_Size => Size);
    end New_Signed_Type;
 
@@ -723,7 +836,8 @@ package body Ortho_Debug is
       return new O_Tnode_Float'(Kind => ON_Float_Type,
                                 Decl => O_Dnode_Null,
                                 Uncomplete => False,
-                                Complete => True);
+                                Complete => True,
+                                Constrained => True);
    end New_Float_Type;
 
    procedure New_Boolean_Type (Res : out O_Tnode;
@@ -739,6 +853,7 @@ package body Ortho_Debug is
                                   Decl => O_Dnode_Null,
                                   Uncomplete => False,
                                   Complete => True,
+                                  Constrained => True,
                                   True_N => O_Cnode_Null,
                                   False_N => O_Cnode_Null);
       True_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit,
@@ -765,6 +880,7 @@ package body Ortho_Debug is
                                Decl => O_Dnode_Null,
                                Uncomplete => False,
                                Complete => False,
+                               Constrained => True,
                                Nbr => 0,
                                Literals => O_Cnode_Null);
       List.Res := Res;
@@ -800,16 +916,17 @@ package body Ortho_Debug is
       Res.Complete := True;
    end Finish_Enum_Type;
 
-   function Get_Base_Type (Atype : O_Tnode) return O_Tnode
-   is
+   function Get_Array_El_Type (Atype : O_Tnode) return O_Tnode is
    begin
       case Atype.Kind is
-         when ON_Array_Sub_Type =>
-            return Atype.Base_Type;
+         when ON_Array_Subtype =>
+            return Atype.Arr_El_Type;
+         when ON_Array_Type =>
+            return Atype.El_Type;
          when others =>
-            return Atype;
+               raise Syntax_Error;
       end case;
-   end Get_Base_Type;
+   end Get_Array_El_Type;
 
    procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode)
    is
@@ -826,7 +943,7 @@ package body Ortho_Debug is
                                     Rec_Els => null);
       List.Res := Res;
       List.Last := null;
-      List.Field := Atype.Elements;
+      List.Field := Atype.Rec_Elements;
    end Start_Record_Aggr;
 
    procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
@@ -872,16 +989,16 @@ package body Ortho_Debug is
       Res : O_Cnode;
    begin
       case Atype.Kind is
-         when ON_Array_Sub_Type =>
+         when ON_Array_Subtype =>
             if Atype.Length.U_Val /= Unsigned_64 (Len) then
                raise Type_Error;
             end if;
-            List.El_Type := Atype.Base_Type.El_Type;
          when ON_Array_Type =>
-            List.El_Type := Atype.El_Type;
+            null;
          when others =>
             raise Type_Error;
       end case;
+      List.El_Type := Get_Array_El_Type (Atype);
       Check_Complete_Type (Atype);
       Res := new O_Cnode_Aggregate'(Kind => OC_Array_Aggregate,
                                     Ctype => Atype,
@@ -982,6 +1099,12 @@ package body Ortho_Debug is
       subtype O_Lnode_Indexed is O_Lnode_Type (OL_Indexed_Element);
       Res : O_Lnode;
    begin
+      if Arr.Rtype.Kind not in ON_Array_Kinds then
+         --  Can only index an array.
+         raise Type_Error;
+      end if;
+      --  The element type of ARR must be constrained.
+      Check_Constrained_Type (Get_Array_El_Type (Arr.Rtype));
       Check_Ref (Arr);
       Res := new O_Lnode_Indexed'(Kind => OL_Indexed_Element,
                                   Rtype => Get_Base_Type (Arr.Rtype).El_Type,
@@ -997,9 +1120,14 @@ package body Ortho_Debug is
       subtype O_Lnode_Slice is O_Lnode_Type (OL_Slice);
       Res : O_Lnode;
    begin
-      if Res_Type.Kind /= ON_Array_Type
-        and then Res_Type.Kind /= ON_Array_Sub_Type
-      then
+      if Arr.Rtype.Kind not in ON_Array_Kinds then
+         --  Can only slice an array.
+         raise Type_Error;
+      end if;
+      --  The element type of ARR must be constrained.
+      Check_Constrained_Type (Get_Array_El_Type (Arr.Rtype));
+      --  The result is an array.
+      if Res_Type.Kind not in ON_Array_Kinds then
          raise Type_Error;
       end if;
       Check_Ref (Arr);
@@ -1018,11 +1146,14 @@ package body Ortho_Debug is
    is
       subtype O_Lnode_Selected_Element is O_Lnode_Type (OL_Selected_Element);
    begin
-      if Rec.Rtype.Kind /= ON_Record_Type
-        and then Rec.Rtype.Kind /= ON_Union_Type
-      then
-         raise Type_Error;
-      end if;
+      case Rec.Rtype.Kind is
+         when ON_Record_Type
+            | ON_Record_Subtype
+            | ON_Union_Type =>
+            null;
+         when others =>
+            raise Type_Error;
+      end case;
       if Rec.Rtype /= El.Parent then
          raise Type_Error;
       end if;
@@ -1076,16 +1207,18 @@ package body Ortho_Debug is
       T : constant Boolean := True;
       F : constant Boolean := False;
       Conv_Allowed : constant Conv_Array :=
-        (ON_Boolean_Type =>  (T, F, T, T, F, F, F, F, F, F),
-         ON_Enum_Type =>     (F, F, T, T, F, F, F, F, F, F),
-         ON_Unsigned_Type => (T, T, T, T, F, F, F, F, F, F),
-         ON_Signed_Type =>   (T, T, T, T, T, F, F, F, F, F),
-         ON_Float_Type =>    (F, F, F, T, T, F, F, F, F, F),
-         ON_Array_Type =>    (F, F, F, F, F, F, T, F, F, F),
-         ON_Array_Sub_Type =>(F, F, F, F, F, T, T, F, F, F),
-         ON_Record_Type =>   (F, F, F, F, F, F, F, F, F, F),
-         ON_Union_Type =>    (F, F, F, F, F, F, F, F, F, F),
-         ON_Access_Type =>   (F, F, F, F, F, F, F, F, F, T));
+        --                     B  E  U  S  F  A  a  R  r  U  A
+        (ON_Boolean_Type =>   (T, F, T, T, F, F, F, F, F, F, F),
+         ON_Enum_Type =>      (F, F, T, T, F, F, F, F, F, F, F),
+         ON_Unsigned_Type =>  (T, T, T, T, F, F, F, F, F, F, F),
+         ON_Signed_Type =>    (T, T, T, T, T, F, F, F, F, F, F),
+         ON_Float_Type =>     (F, F, F, T, T, F, F, F, F, F, F),
+         ON_Array_Type =>     (F, F, F, F, F, F, F, F, F, F, F),
+         ON_Array_Subtype =>  (F, F, F, F, F, F, F, F, F, F, F),
+         ON_Record_Type =>    (F, F, F, F, F, F, F, F, F, F, F),
+         ON_Record_Subtype => (F, F, F, F, F, F, F, F, F, F, F),
+         ON_Union_Type =>     (F, F, F, F, F, F, F, F, F, F, F),
+         ON_Access_Type =>    (F, F, F, F, F, F, F, F, F, F, T));
    begin
       if Source = Target then
          return True;
@@ -1149,11 +1282,7 @@ package body Ortho_Debug is
          --  An address is of type access.
          raise Type_Error;
       end if;
-      if Get_Base_Type (Lvalue.Rtype) /= Get_Base_Type (Atype.D_Type) then
-         if not Disable_Checks then
-            raise Type_Error;
-         end if;
-      end if;
+      Check_Type (Get_Base_Type (Lvalue.Rtype), Get_Base_Type (Atype.D_Type));
       return new O_Enode_Address'(Kind => OE_Address,
                                   Rtype => Atype,
                                   Ref => False,
@@ -1225,8 +1354,9 @@ package body Ortho_Debug is
             return;
          when ON_Array_Type
            | ON_Record_Type
+           | ON_Record_Subtype
            | ON_Union_Type
-           | ON_Array_Sub_Type =>
+           | ON_Array_Subtype =>
             raise Type_Error;
       end case;
    end Check_Not_Composite;
@@ -1342,6 +1472,7 @@ package body Ortho_Debug is
       subtype O_Dnode_Const is O_Dnode_Type (ON_Const_Decl);
    begin
       Check_Complete_Type (Atype);
+      Check_Constrained_Type (Atype);
       if Storage = O_Storage_Local then
          --  A constant cannot be local.
          raise Syntax_Error;
@@ -1415,6 +1546,7 @@ package body Ortho_Debug is
       subtype O_Dnode_Var is O_Dnode_Type (ON_Var_Decl);
    begin
       Check_Complete_Type (Atype);
+      Check_Constrained_Type (Atype);
       Check_Object_Storage (Storage);
       Res := new O_Dnode_Var'(Kind => ON_Var_Decl,
                               Name => Ident,
diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads
index 0bf91f106..2419c07b8 100644
--- a/src/ortho/debug/ortho_debug.private.ads
+++ b/src/ortho/debug/ortho_debug.private.ads
@@ -29,6 +29,12 @@ private
    --  This back-end supports nested subprograms.
    Has_Nested_Subprograms : constant Boolean := True;
 
+   --  Return the type of elements of array type/subtype ATYPE.
+   function Get_Array_El_Type (Atype : O_Tnode) return O_Tnode;
+
+   --  Return the base type of T.
+   --  function Get_Base_Type (T : O_Tnode) return O_Tnode;
+
    --  A node for a type.
    type O_Tnode_Type (<>);
    type O_Tnode is access O_Tnode_Type;
@@ -111,8 +117,6 @@ private
       Ident : O_Ident;
       --  Type of the record field.
       Ftype : O_Tnode;
-      --  Offset in the field.
-      Offset : Unsigned_32;
    end record;
 
    type O_Anode_Type;
@@ -132,6 +136,7 @@ private
       OC_Enum_Lit,
       OC_Null_Lit,
       OC_Sizeof_Lit,
+      OC_Record_Sizeof_Lit,
       OC_Alignof_Lit,
       OC_Offsetof_Lit,
       OC_Default_Lit,
@@ -167,7 +172,8 @@ private
          when OC_Default_Lit =>
             null;
          when OC_Sizeof_Lit
-           | OC_Alignof_Lit =>
+            | OC_Record_Sizeof_Lit
+            | OC_Alignof_Lit =>
             S_Type : O_Tnode;
          when OC_Offsetof_Lit =>
             Off_Field : O_Fnode;
@@ -342,14 +348,22 @@ private
    O_Tnode_Null : constant O_Tnode := null;
    type ON_Type_Kind is
      (ON_Boolean_Type, ON_Enum_Type,
-      ON_Unsigned_Type, ON_Signed_Type, ON_Float_Type, ON_Array_Type,
-      ON_Array_Sub_Type, ON_Record_Type, ON_Union_Type, ON_Access_Type);
+      ON_Unsigned_Type, ON_Signed_Type, ON_Float_Type,
+      ON_Array_Type, ON_Array_Subtype,
+      ON_Record_Type, ON_Record_Subtype,
+      ON_Union_Type, ON_Access_Type);
+
+   subtype ON_Array_Kinds is ON_Type_Kind
+     range ON_Array_Type .. ON_Array_Subtype;
+
    type O_Tnode_Type (Kind : ON_Type_Kind) is record
       Decl : O_Dnode;
       --  True if the type was first created as an uncomplete type.
       Uncomplete : Boolean;
       --  True if the type is complete.
       Complete : Boolean;
+      --  True if the type is fully constrained.
+      Constrained : Boolean;
       case Kind is
          when ON_Boolean_Type =>
             True_N : O_Cnode;
@@ -362,17 +376,21 @@ private
          when ON_Enum_Type =>
             Nbr : Natural;
             Literals: O_Cnode;
+         when ON_Access_Type =>
+            D_Type : O_Tnode;
          when ON_Array_Type =>
             El_Type : O_Tnode;
             Index_Type : O_Tnode;
-         when ON_Access_Type =>
-            D_Type : O_Tnode;
+         when ON_Array_Subtype =>
+            Length : O_Cnode;
+            Arr_El_Type : O_Tnode;
+            Arr_Base : O_Tnode;
          when ON_Record_Type
            | ON_Union_Type =>
-            Elements : O_Fnode;
-         when ON_Array_Sub_Type =>
-            Length : O_Cnode;
-            Base_Type : O_Tnode;
+            Rec_Elements : O_Fnode;
+         when ON_Record_Subtype =>
+            Subrec_Elements : O_Fnode;
+            Subrec_Base : O_Tnode;
       end case;
    end record;
 
@@ -455,6 +473,15 @@ private
       Last : O_Fnode;
    end record;
 
+   type O_Element_Sublist is record
+      --  The type definition.
+      Res : O_Tnode;
+      --  The last element added.
+      Last : O_Fnode;
+      --  The correspond field from the base type.
+      Base_Field : O_Fnode;
+   end record;
+
    type O_Record_Aggr_List is record
       Res : O_Cnode;
       Last : O_Cnode;