First import from sources

1 files changed, 1479 insertions, 0 deletions

diff --git a/sem_types.adb b/sem_types.adb
new file mode 100644
index 000000000..a465b0fde
--- /dev/null
+++ b/sem_types.adb
@@ -0,0 +1,1479 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Errorout; use Errorout;
+with Evaluation; use Evaluation;
+with Sem;
+with Sem_Expr; use Sem_Expr;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Decls;
+with Libraries;
+with Flags;
+with Types; use Types;
+with Std_Names;
+with Iirs_Utils; use Iirs_Utils;
+with Std_Package; use Std_Package;
+with Sem_Names; use Sem_Names;
+with Xrefs; use Xrefs;
+
+package body Sem_Types is
+   --  Sem a range expression.
+   --  Both left and right bounds must be of the same type kind, ie
+   --  integer types, or if INT_ONLY is false, real types.
+   --  However, the two bounds need not have the same type.
+   function Sem_Range_Expression (Expr : Iir; Int_Only : Boolean) return Iir
+   is
+      Left, Right: Iir;
+      Bt_L_Kind, Bt_R_Kind : Iir_Kind;
+   begin
+      Left := Sem_Expression_Universal (Get_Left_Limit (Expr));
+      Right := Sem_Expression_Universal (Get_Right_Limit (Expr));
+      if Left = Null_Iir or Right = Null_Iir then
+         return Null_Iir;
+      end if;
+      Set_Left_Limit (Expr, Left);
+      Set_Right_Limit (Expr, Right);
+
+      Set_Expr_Staticness (Expr, Min (Get_Expr_Staticness (Left),
+                                      Get_Expr_Staticness (Right)));
+
+      Bt_L_Kind := Get_Kind (Get_Base_Type (Get_Type (Left)));
+      Bt_R_Kind := Get_Kind (Get_Base_Type (Get_Type (Right)));
+
+      if Int_Only then
+         if Bt_L_Kind /= Iir_Kind_Integer_Type_Definition
+           and then Bt_R_Kind = Iir_Kind_Integer_Type_Definition
+         then
+            Error_Msg_Sem ("left bound must be an integer expression", Left);
+            return Null_Iir;
+         end if;
+         if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition
+           and then Bt_L_Kind = Iir_Kind_Integer_Type_Definition
+         then
+            Error_Msg_Sem ("right bound must be an integer expression", Left);
+            return Null_Iir;
+         end if;
+         if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition
+           and then Bt_L_Kind /= Iir_Kind_Integer_Type_Definition
+         then
+            Error_Msg_Sem ("each bound must be an integer expression", Expr);
+            return Null_Iir;
+         end if;
+      else
+         if Bt_L_Kind /= Bt_R_Kind then
+            Error_Msg_Sem ("left and right bounds must be of the same type",
+                           Expr);
+            return Null_Iir;
+         end if;
+         case Bt_L_Kind is
+            when Iir_Kind_Integer_Type_Definition
+              | Iir_Kind_Floating_Type_Definition =>
+               null;
+         when others =>
+            --  Enumeration range are not allowed to define a new type.
+            Error_Msg_Sem
+              ("bad range type, only integer or float is allowed", Expr);
+            return Null_Iir;
+         end case;
+      end if;
+
+      return Expr;
+   end Sem_Range_Expression;
+
+   function Create_Integer_Type (Loc : Iir; Constraint : Iir; Decl : Iir)
+     return Iir
+   is
+      Ntype: Iir_Integer_Subtype_Definition;
+      Ndef: Iir_Integer_Type_Definition;
+   begin
+      Ntype := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+      Location_Copy (Ntype, Loc);
+      Ndef := Create_Iir (Iir_Kind_Integer_Type_Definition);
+      Location_Copy (Ndef, Loc);
+      Set_Base_Type (Ndef, Ndef);
+      Set_Type_Declarator (Ndef, Decl);
+      Set_Type_Staticness (Ndef, Locally);
+      Set_Signal_Type_Flag (Ndef, True);
+      Set_Base_Type (Ntype, Ndef);
+      Set_Type_Declarator (Ntype, Decl);
+      Set_Range_Constraint (Ntype, Constraint);
+      Set_Type_Staticness (Ntype, Get_Expr_Staticness (Constraint));
+      Set_Resolved_Flag (Ntype, False);
+      Set_Signal_Type_Flag (Ntype, True);
+      if Get_Type_Staticness (Ntype) /= Locally then
+         Error_Msg_Sem ("range constraint of type must be locally static",
+                        Decl);
+      end if;
+      return Ntype;
+   end Create_Integer_Type;
+
+   function Range_Expr_To_Type_Definition (Expr : Iir; Decl: Iir)
+     return Iir
+   is
+      Left, Right : Iir;
+   begin
+      if Sem_Range_Expression (Expr, False) = Null_Iir then
+         return Null_Iir;
+      end if;
+      Left := Get_Left_Limit (Expr);
+      Right := Get_Right_Limit (Expr);
+      if Get_Expr_Staticness (Expr) = Locally then
+         Left := Eval_Expr (Left);
+         Set_Left_Limit (Expr, Left);
+         Right := Eval_Expr (Right);
+         Set_Right_Limit (Expr, Right);
+      end if;
+
+      case Get_Kind (Get_Base_Type (Get_Type (Left))) is
+         when Iir_Kind_Integer_Type_Definition =>
+            return Create_Integer_Type (Expr, Expr, Decl);
+         when Iir_Kind_Floating_Type_Definition =>
+            declare
+               Ntype: Iir_Floating_Subtype_Definition;
+               Ndef: Iir_Floating_Type_Definition;
+            begin
+               Ntype := Create_Iir (Iir_Kind_Floating_Subtype_Definition);
+               Location_Copy (Ntype, Expr);
+               Ndef := Create_Iir (Iir_Kind_Floating_Type_Definition);
+               Location_Copy (Ndef, Expr);
+               Set_Base_Type (Ndef, Ndef);
+               Set_Type_Declarator (Ndef, Decl);
+               Set_Type_Staticness (Ndef, Get_Expr_Staticness (Expr));
+               Set_Signal_Type_Flag (Ndef, True);
+               Set_Base_Type (Ntype, Ndef);
+               Set_Type_Declarator (Ntype, Decl);
+               Set_Range_Constraint (Ntype, Expr);
+               Set_Resolved_Flag (Ntype, False);
+               Set_Type_Staticness (Ntype, Get_Expr_Staticness (Expr));
+               Set_Signal_Type_Flag (Ntype, True);
+               return Ntype;
+            end;
+         when others =>
+            --  sem_range_expression should catch such errors.
+            raise Internal_Error;
+      end case;
+   end Range_Expr_To_Type_Definition;
+
+   function Create_Physical_Literal (Val : Iir_Int64; Unit : Iir) return Iir
+   is
+      Lit : Iir;
+   begin
+      Lit := Create_Iir (Iir_Kind_Physical_Int_Literal);
+      Set_Value (Lit, Val);
+      Set_Unit_Name (Lit, Unit);
+      Set_Expr_Staticness (Lit, Locally);
+      Set_Type (Lit, Get_Type (Unit));
+      Location_Copy (Lit, Unit);
+      return Lit;
+   end Create_Physical_Literal;
+
+   -- Sem a physical type definition.  Create a subtype.
+   function Sem_Physical_Type_Definition (Range_Expr: Iir; Decl : Iir)
+      return Iir_Physical_Subtype_Definition
+   is
+      Unit: Iir_Unit_Declaration;
+      Def : Iir_Physical_Type_Definition;
+      Sub_Type: Iir_Physical_Subtype_Definition;
+      Range_Expr1: Iir;
+      Val : Iir;
+      Lit : Iir_Physical_Int_Literal;
+   begin
+      Def := Get_Type (Range_Expr);
+
+      --  LRM93 §4.1
+      --  The simple name declared by a type declaration denotes the
+      --  declared type, unless the type declaration declares both a base
+      --  type and a subtype of the base type, in which case the simple name
+      --  denotes the subtype, and the base type is anonymous.
+      Set_Type_Declarator (Def, Decl);
+      Set_Base_Type (Def, Def);
+      Set_Resolved_Flag (Def, False);
+      Set_Type_Staticness (Def, Locally);
+      Set_Signal_Type_Flag (Def, True);
+
+      --  LRM93 §3.1.3
+      --  Each bound of a range constraint that is used in a physical type
+      --  definition must be a locally static expression of some integer type
+      --  but the two bounds need not have the same integer type.
+      case Get_Kind (Range_Expr) is
+         when Iir_Kind_Range_Expression =>
+            Range_Expr1 := Sem_Range_Expression (Range_Expr, True);
+         when others =>
+            Error_Kind ("sem_physical_type_definition", Range_Expr);
+      end case;
+      if Range_Expr1 /= Null_Iir then
+         if Get_Expr_Staticness (Range_Expr1) /= Locally then
+            Error_Msg_Sem
+              ("range constraint for a physical type must be static",
+               Range_Expr1);
+            Range_Expr1 := Null_Iir;
+         else
+            Range_Expr1 := Eval_Expr (Range_Expr1);
+         end if;
+      end if;
+
+      --  Create the subtype.
+      Sub_Type := Create_Iir (Iir_Kind_Physical_Subtype_Definition);
+      Location_Copy (Sub_Type, Range_Expr);
+      Set_Base_Type (Sub_Type, Def);
+      Set_Signal_Type_Flag (Sub_Type, True);
+
+      --  Sem primary units.
+      Unit := Get_Unit_Chain (Def);
+
+      Lit := Create_Physical_Literal (1, Unit);
+      Set_Physical_Unit_Value (Unit, Lit);
+
+      Add_Name (Unit);
+      Set_Type (Unit, Def);
+      Set_Expr_Staticness (Unit, Locally);
+      Set_Visible_Flag (Unit, True);
+      Xref_Decl (Unit);
+
+      --  Sem secondary units.
+      Unit := Get_Chain (Unit);
+      while Unit /= Null_Iir loop
+         --  Val := Sem_Physical_Literal (Get_Multiplier (Unit));
+         Val := Sem_Expression (Get_Physical_Literal (Unit), Def);
+         if Val /= Null_Iir then
+            Val := Eval_Expr (Val);
+            Set_Physical_Literal (Unit, Val);
+            if Get_Kind (Val) = Iir_Kind_Unit_Declaration then
+               Val := Create_Physical_Literal (1, Val);
+            end if;
+            Set_Physical_Unit_Value (Unit, Val);
+
+            --  LRM93 §3.1
+            --  The position number of unit names need not lie within the range
+            --  specified by the range constraint.
+            --  GHDL: this was not true in VHDL87.
+            --  GHDL: This is not so simple if 1 is not included in the range.
+            if False and then Flags.Vhdl_Std = Vhdl_87
+              and then Range_Expr1 /= Null_Iir
+            then
+               if not Eval_Int_In_Range (Get_Value (Unit), Range_Expr1) then
+                  Error_Msg_Sem
+                    ("physical literal does not lie within the range", Unit);
+               end if;
+            end if;
+         else
+            --  Avoid errors storm.
+            Set_Physical_Literal (Unit, Get_Primary_Unit (Def));
+            Set_Physical_Unit_Value (Unit, Lit);
+         end if;
+
+         Sem_Scopes.Add_Name (Unit);
+         Set_Type (Unit, Def);
+         Set_Expr_Staticness (Unit, Locally);
+         Sem_Scopes.Name_Visible (Unit);
+         Xref_Decl (Unit);
+         Unit := Get_Chain (Unit);
+      end loop;
+
+      if Range_Expr1 /= Null_Iir then
+         declare
+            --  Convert an integer literal to a physical literal.
+            --  This is used to convert bounds.
+            function Lit_To_Phys_Lit (Lim : Iir_Integer_Literal)
+              return Iir_Physical_Int_Literal
+            is
+               Res : Iir_Physical_Int_Literal;
+            begin
+               Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+               Location_Copy (Res, Lim);
+               Set_Type (Res, Def);
+               Set_Value (Res, Get_Value (Lim));
+               Set_Unit_Name (Res, Get_Primary_Unit (Def));
+               Set_Expr_Staticness (Res, Locally);
+               Set_Literal_Origin (Res, Lim);
+               return Res;
+            end Lit_To_Phys_Lit;
+
+            Phys_Range : Iir_Range_Expression;
+         begin
+            --  Create the physical range.
+            Phys_Range := Create_Iir (Iir_Kind_Range_Expression);
+            Location_Copy (Phys_Range, Range_Expr1);
+            Set_Type (Phys_Range, Def);
+            Set_Direction (Phys_Range, Get_Direction (Range_Expr1));
+            Set_Left_Limit
+              (Phys_Range, Lit_To_Phys_Lit (Get_Left_Limit (Range_Expr1)));
+            Set_Right_Limit
+              (Phys_Range, Lit_To_Phys_Lit (Get_Right_Limit (Range_Expr1)));
+            Set_Expr_Staticness
+              (Phys_Range, Get_Expr_Staticness (Range_Expr1));
+
+            Set_Range_Constraint (Sub_Type, Phys_Range);
+            --  This must be locally...
+            Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (Range_Expr1));
+         end;
+      end if;
+      Set_Resolved_Flag (Sub_Type, False);
+
+      return Sub_Type;
+   end Sem_Physical_Type_Definition;
+
+   --  Return true iff decl is std.textio.text
+   function Is_Text_Type_Declaration (Decl : Iir_Type_Declaration)
+     return Boolean
+   is
+      use Std_Names;
+      P : Iir;
+   begin
+      if Get_Identifier (Decl) /= Name_Text then
+         return False;
+      end if;
+      P := Get_Parent (Decl);
+      if Get_Kind (P) /= Iir_Kind_Package_Declaration
+        or else Get_Identifier (P) /= Name_Textio
+      then
+         return False;
+      end if;
+      --  design_unit, design_file, library_declaration.
+      P := Get_Library (Get_Design_File (Get_Design_Unit (P)));
+      if P /= Libraries.Std_Library then
+         return False;
+      end if;
+      return True;
+   end Is_Text_Type_Declaration;
+
+   procedure Check_No_File_Type (El_Type : Iir; Loc : Iir) is
+   begin
+      case Get_Kind (El_Type) is
+         when Iir_Kind_File_Type_Definition =>
+            Error_Msg_Sem
+              ("element of file type is not allowed in a composite type", Loc);
+         when others =>
+            null;
+      end case;
+   end Check_No_File_Type;
+
+   --  Semantize the array_element type of DEF.
+   --  Set type_staticness and resolved_flag of DEF.
+   --  type_staticness of DEF (before calling this function) must be the
+   --  staticness of the array indexes.
+   procedure Sem_Array_Element (Def : Iir)
+   is
+      El_Type : Iir;
+   begin
+      El_Type := Get_Element_Subtype (Def);
+      El_Type := Sem_Subtype_Indication (El_Type);
+      if El_Type = Null_Iir then
+         Set_Type_Staticness (Def, None);
+         Set_Resolved_Flag (Def, False);
+         Set_Element_Subtype (Def, Error_Type);
+         return;
+      end if;
+      Set_Element_Subtype (Def, El_Type);
+      Check_No_File_Type (El_Type, Def);
+      Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (El_Type));
+
+      --  LRM93 §3.2.1.1
+      --  The same requirement exists [must define a constrained
+      --  array subtype] [...] for the element subtype indication
+      --  of an array type definition, if the type of the array
+      --  element is itself an array type.
+      if not Sem_Is_Constrained (El_Type) then
+         Error_Msg_Sem ("array element of unconstrained "
+                        & Disp_Node (El_Type) & " is not allowed", Def);
+      end if;
+      Set_Type_Staticness (Def, Min (Get_Type_Staticness (El_Type),
+                                     Get_Type_Staticness (Def)));
+      Set_Resolved_Flag (Def, Get_Resolved_Flag (El_Type));
+   end Sem_Array_Element;
+
+   procedure Sem_Protected_Type_Declaration (Type_Decl : Iir_Type_Declaration)
+   is
+      Decl : Iir_Protected_Type_Declaration;
+      El : Iir;
+   begin
+      Decl := Get_Type (Type_Decl);
+      Set_Base_Type (Decl, Decl);
+      Set_Resolved_Flag (Decl, False);
+      Set_Signal_Type_Flag (Decl, False);
+      Set_Type_Staticness (Decl, None);
+
+      --  LRM 10.3 Visibility
+      --  [...] except in the declaration of a design_unit or a protected type
+      --  declaration, in which case it starts immediatly after the reserved
+      --  word is occuring after the identifier of the design unit or
+      --  protected type declaration.
+      Set_Visible_Flag (Type_Decl, True);
+
+      --  LRM 10.1
+      --  n) A protected type declaration, together with the corresponding
+      --     body.
+      Open_Declarative_Region;
+
+      Sem_Decls.Sem_Declaration_Chain (Decl);
+      El := Get_Declaration_Chain (Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Use_Clause
+              | Iir_Kind_Attribute_Specification =>
+               null;
+            when Iir_Kind_Procedure_Declaration
+              | Iir_Kind_Function_Declaration =>
+               declare
+                  Inter : Iir;
+                  Inter_Type : Iir;
+               begin
+                  Inter := Get_Interface_Declaration_Chain (El);
+                  while Inter /= Null_Iir loop
+                     Inter_Type := Get_Type (Inter);
+                     if Inter_Type /= Null_Iir
+                       and then Get_Signal_Type_Flag (Inter_Type) = False
+                       and then Get_Kind (Inter_Type)
+                       /= Iir_Kind_Protected_Type_Declaration
+                     then
+                        Error_Msg_Sem
+                          ("formal parameter method must not be "
+                           & "access or file type", Inter);
+                     end if;
+                     Inter := Get_Chain (Inter);
+                  end loop;
+                  if Get_Kind (El) = Iir_Kind_Function_Declaration then
+                     Inter_Type := Get_Return_Type (El);
+                     if Inter_Type /= Null_Iir
+                       and then Get_Signal_Type_Flag (Inter_Type) = False
+                     then
+                        Error_Msg_Sem
+                          ("method return type must not be access of file",
+                           El);
+                     end if;
+                  end if;
+               end;
+            when others =>
+               Error_Msg_Sem
+                 (Disp_Node (El)
+                  & " are not allowed in protected type declaration", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      Close_Declarative_Region;
+   end Sem_Protected_Type_Declaration;
+
+   procedure Sem_Protected_Type_Body (Bod : Iir)
+   is
+      Inter : Name_Interpretation_Type;
+      Type_Decl : Iir;
+      Decl : Iir;
+      El : Iir;
+   begin
+      --  LRM 3.5 Protected types.
+      --  Each protected type declaration appearing immediatly within a given
+      --  declaration region must have exactly one corresponding protected type
+      --  body appearing immediatly within the same declarative region and
+      --  textually subsequent to the protected type declaration.
+      --
+      --  Similarly, each protected type body appearing immediatly within a
+      --  given declarative region must have exactly one corresponding
+      --  protected type declaration appearing immediatly within the same
+      --  declarative region and textually prior to the protected type body.
+      Inter := Get_Interpretation (Get_Identifier (Bod));
+      if Valid_Interpretation (Inter)
+        and then Is_In_Current_Declarative_Region (Inter)
+      then
+         Type_Decl := Get_Declaration (Inter);
+         if Get_Kind (Type_Decl) = Iir_Kind_Type_Declaration then
+            Decl := Get_Type (Type_Decl);
+         else
+            Decl := Null_Iir;
+         end if;
+      else
+         Decl := Null_Iir;
+      end if;
+
+      if Decl /= Null_Iir
+        and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Declaration
+      then
+         Set_Protected_Type_Declaration (Bod, Decl);
+         if Get_Protected_Type_Body (Decl) /= Null_Iir then
+            Error_Msg_Sem
+              ("protected type body already declared for "
+               & Disp_Node (Decl), Bod);
+            Error_Msg_Sem
+              ("(previous body)", Get_Protected_Type_Body (Decl));
+            Decl := Null_Iir;
+         elsif not Get_Visible_Flag (Type_Decl) then
+            --  Can this happen ?
+            Error_Msg_Sem
+              ("protected type declaration not yet visible", Bod);
+            Error_Msg_Sem
+              ("(location of protected type declaration)", Decl);
+            Decl := Null_Iir;
+         else
+            Set_Protected_Type_Body (Decl, Bod);
+         end if;
+      else
+         Error_Msg_Sem
+           ("no protected type declaration for this body", Bod);
+         if Decl /= Null_Iir then
+            Error_Msg_Sem
+              ("(found " & Disp_Node (Decl) & " declared here)", Decl);
+            Decl := Null_Iir;
+         end if;
+      end if;
+
+      --  LRM 10.1
+      --  n) A protected type declaration, together with the corresponding
+      --     body.
+      Open_Declarative_Region;
+
+      if Decl /= Null_Iir then
+         Xref_Body (Bod, Decl);
+         Add_Protected_Type_Declarations (Decl);
+      end if;
+
+      Sem_Decls.Sem_Declaration_Chain (Bod);
+
+      El := Get_Declaration_Chain (Bod);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Procedure_Declaration
+              | Iir_Kind_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration
+              | Iir_Kind_Implicit_Function_Declaration =>
+               null;
+            when Iir_Kind_Procedure_Body
+              | Iir_Kind_Function_Body =>
+               null;
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Anonymous_Type_Declaration =>
+               null;
+            when Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Constant_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_File_Declaration =>
+               null;
+            when Iir_Kind_Object_Alias_Declaration
+              | Iir_Kind_Non_Object_Alias_Declaration =>
+               null;
+            when Iir_Kind_Attribute_Declaration
+              | Iir_Kind_Attribute_Specification
+              | Iir_Kind_Use_Clause
+              | Iir_Kind_Group_Template_Declaration
+              | Iir_Kind_Group_Declaration =>
+               null;
+            when others =>
+               Error_Msg_Sem
+                 (Disp_Node (El) & " not allowed in a protected type body",
+                  El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      Sem_Decls.Check_Full_Declaration (Bod, Bod);
+
+      --  LRM 3.5.2 Protected type bodies
+      --  Each subprogram declaration appearing in a given protected type
+      --  declaration shall have a corresponding subprogram body appearing in
+      --  the corresponding protected type body.
+      if Decl /= Null_Iir then
+         Sem_Decls.Check_Full_Declaration (Decl, Bod);
+      end if;
+
+      Close_Declarative_Region;
+   end Sem_Protected_Type_Body;
+
+   function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir
+   is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Set_Base_Type (Def, Def);
+            Set_Type_Staticness (Def, Locally);
+            Set_Signal_Type_Flag (Def, True);
+
+            Create_Range_Constraint_For_Enumeration_Type (Def);
+
+            --  Makes all literal visible.
+            declare
+               El: Iir;
+               Literal_List: Iir_List;
+            begin
+               Literal_List := Get_Enumeration_Literal_List (Def);
+               for I in Natural loop
+                  El := Get_Nth_Element (Literal_List, I);
+                  exit when El = Null_Iir;
+                  Set_Expr_Staticness (El, Locally);
+                  Set_Name_Staticness (El, Locally);
+                  Set_Base_Name (El, El);
+                  Set_Type (El, Def);
+                  Set_Enumeration_Decl (El, El);
+                  Sem.Compute_Subprogram_Hash (El);
+                  Sem_Scopes.Add_Name (El);
+                  Name_Visible (El);
+                  Xref_Decl (El);
+               end loop;
+            end;
+            Set_Resolved_Flag (Def, False);
+            return Def;
+
+         when Iir_Kind_Range_Expression =>
+            if Get_Type (Def) /= Null_Iir then
+               return Sem_Physical_Type_Definition (Def, Decl);
+            else
+               return Range_Expr_To_Type_Definition (Def, Decl);
+            end if;
+
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Parenthesis_Name =>
+            if Get_Type (Def) /= Null_Iir then
+               return Sem_Physical_Type_Definition (Def, Decl);
+            end if;
+            --  Nb: the attribute is expected to be a 'range or
+            --  a 'reverse_range attribute.
+            declare
+               Res : Iir;
+            begin
+               Res := Sem_Discrete_Range_Expression (Def, Null_Iir);
+               if Res = Null_Iir then
+                  return Null_Iir;
+               end if;
+               --  This cannot be a floating range.
+               return Create_Integer_Type (Def, Res, Decl);
+            end;
+
+         when Iir_Kind_Array_Subtype_Definition =>
+            declare
+               Index_Type : Iir;
+               Index_List : Iir_List;
+               Base_Index_List : Iir_List;
+               Staticness : Iir_Staticness;
+
+               -- array_type_definition, which is the same as the subtype,
+               -- but without any constraint in the indexes.
+               Base_Type: Iir;
+            begin
+               -- FIXME: all indexes must be either constrained or
+               -- unconstrained.
+               -- If all indexes are unconstrained, this is really a type
+               -- otherwise, this is a subtype.
+
+               -- Create a definition for the base type of subtype DEF.
+               Base_Type := Create_Iir (Iir_Kind_Array_Type_Definition);
+               Location_Copy (Base_Type, Def);
+               Set_Base_Type (Base_Type, Base_Type);
+               Set_Type_Declarator (Base_Type, Decl);
+               Base_Index_List := Create_Iir_List;
+               Set_Index_Subtype_List (Base_Type, Base_Index_List);
+
+               Staticness := Locally;
+               Index_List := Get_Index_Subtype_List (Def);
+               for I in Natural loop
+                  Index_Type := Get_Nth_Element (Index_List, I);
+                  exit when Index_Type = Null_Iir;
+
+                  Index_Type := Sem_Discrete_Range_Integer (Index_Type);
+                  if Index_Type /= Null_Iir then
+                     Index_Type := Range_To_Subtype_Definition (Index_Type);
+                  else
+                     --  Avoid errors.
+                     Index_Type := Natural_Subtype_Definition;
+                  end if;
+
+                  Replace_Nth_Element (Index_List, I, Index_Type);
+                  Staticness := Min (Staticness,
+                                     Get_Type_Staticness (Index_Type));
+
+                  -- Set the index type in the array type.
+                  -- must "unconstraint" the subtype.
+                  Append_Element (Base_Index_List, Index_Type);
+               end loop;
+               Set_Type_Staticness (Def, Staticness);
+
+               -- Element type.
+               Sem_Array_Element (Def);
+
+               Set_Element_Subtype (Base_Type, Get_Element_Subtype (Def));
+               Set_Signal_Type_Flag (Base_Type, Get_Signal_Type_Flag (Def));
+               --  According to LRM93 §7.4.1, an unconstrained array type
+               --  is not static.
+               Set_Type_Staticness (Base_Type, None);
+               Set_Type_Declarator (Base_Type, Decl);
+               Set_Resolved_Flag (Base_Type, Get_Resolved_Flag (Def));
+
+               Set_Base_Type (Def, Base_Type);
+               Set_Type_Mark (Def, Base_Type);
+               return Def;
+            end;
+
+         when Iir_Kind_Array_Type_Definition =>
+            declare
+               Index_Type : Iir;
+               Index_List : Iir_List;
+            begin
+               Set_Base_Type (Def, Def);
+               Index_List := Get_Index_Subtype_List (Def);
+
+               for I in Natural loop
+                  Index_Type := Get_Nth_Element (Index_List, I);
+                  exit when Index_Type = Null_Iir;
+
+                  Index_Type := Sem_Subtype_Indication (Index_Type);
+                  if Index_Type /= Null_Iir then
+                     if Get_Kind (Index_Type) not in
+                       Iir_Kinds_Discrete_Type_Definition
+                     then
+                        Error_Msg_Sem
+                          ("index type of an array must be discrete",
+                           Index_Type);
+                     end if;
+                  else
+                     --  Avoid errors.
+                     Index_Type := Natural_Subtype_Definition;
+                  end if;
+
+                  Replace_Nth_Element (Index_List, I, Index_Type);
+               end loop;
+
+               --  According to LRM93 §7.4.1, an unconstrained array type
+               --  is not static.
+               Set_Type_Staticness (Def, None);
+
+               Sem_Array_Element (Def);
+               return Def;
+            end;
+
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               --  Non semantized type of previous element.
+               Last_El_Type : Iir;
+               --  Semantized type of previous element
+               Last_Type : Iir;
+
+               El: Iir;
+               El_Type : Iir;
+               Resolved_Flag : Boolean;
+               Staticness : Iir_Staticness;
+            begin
+               --  LRM 10.1
+               --  5. A record type declaration,
+               Open_Declarative_Region;
+
+               Resolved_Flag := True;
+               Last_El_Type := Null_Iir;
+               Last_Type := Null_Iir;
+               Staticness := Locally;
+               Set_Signal_Type_Flag (Def, True);
+               El := Get_Element_Declaration_Chain (Def);
+               while El /= Null_Iir loop
+                  El_Type := Get_Type (El);
+                  if El_Type /= Last_El_Type then
+                     --  Be careful for a declaration list (r,g,b: integer).
+                     Last_El_Type := El_Type;
+                     El_Type := Sem_Subtype_Indication (El_Type);
+                     Last_Type := El_Type;
+                  else
+                     El_Type := Last_Type;
+                  end if;
+                  if El_Type /= Null_Iir then
+                     Set_Type (El, El_Type);
+                     Check_No_File_Type (El_Type, El);
+                     if not Get_Signal_Type_Flag (El_Type) then
+                        Set_Signal_Type_Flag (Def, False);
+                     end if;
+
+                     --  LRM93 §3.2.1.1
+                     --  The same requirement [must define a constrained array
+                     --  subtype] exits for the subtype indication of an
+                     --  element declaration, if the type of the record
+                     --  element is an array type.
+                     if not Sem_Is_Constrained (El_Type) then
+                        Error_Msg_Sem
+                          ("element declaration of unconstrained "
+                           & Disp_Node (El_Type) & " is not allowed", El);
+                     end if;
+                     Resolved_Flag :=
+                       Resolved_Flag and Get_Resolved_Flag (El_Type);
+                     Staticness := Min (Staticness,
+                                        Get_Type_Staticness (El_Type));
+                  else
+                     Staticness := None;
+                  end if;
+                  Sem_Scopes.Add_Name (El);
+                  Name_Visible (El);
+                  Xref_Decl (El);
+                  El := Get_Chain (El);
+               end loop;
+               Close_Declarative_Region;
+               Set_Base_Type (Def, Def);
+               Set_Resolved_Flag (Def, Resolved_Flag);
+               Set_Type_Staticness (Def, Staticness);
+               return Def;
+            end;
+
+         when Iir_Kind_Access_Type_Definition =>
+            declare
+               D_Type : Iir;
+            begin
+               D_Type := Sem_Subtype_Indication (Get_Designated_Type (Def),
+                                                 True);
+               if D_Type /= Null_Iir then
+                  case Get_Kind (D_Type) is
+                     when Iir_Kind_Incomplete_Type_Definition =>
+                        Append_Element
+                          (Get_Incomplete_Type_List (D_Type), Def);
+                     when Iir_Kind_File_Type_Definition =>
+                        --  LRM 3.3
+                        --  The designated type must not be a file type.
+                        Error_Msg_Sem
+                          ("designated type must not be a file type", Def);
+                     when others =>
+                        null;
+                  end case;
+                  Set_Designated_Type (Def, D_Type);
+               end if;
+               Set_Base_Type (Def, Def);
+               Set_Type_Staticness (Def, None);
+               Set_Resolved_Flag (Def, False);
+               Set_Signal_Type_Flag (Def, False);
+               return Def;
+            end;
+
+         when Iir_Kind_File_Type_Definition =>
+            declare
+               Type_Mark : Iir;
+            begin
+               Type_Mark := Sem_Subtype_Indication (Get_Type_Mark (Def));
+               Set_Type_Mark (Def, Type_Mark);
+               if Type_Mark /= Null_Iir then
+                  if Get_Signal_Type_Flag (Type_Mark) = False then
+                     --  LRM 3.4
+                     --  The base type of this subtype must not be a file type
+                     --  or an access type.
+                     --  If the base type is a composite type, it must not
+                     --  contain a subelement of an access type.
+                     Error_Msg_Sem
+                       (Disp_Node (Type_Mark) & " cannot be a file type", Def);
+                  elsif Get_Kind (Type_Mark) in Iir_Kinds_Array_Type_Definition
+                  then
+                     --  LRM 3.4
+                     --  If the base type is an array type, it must be a one
+                     --  dimensional array type.
+                     if not Is_Unidim_Array_Type (Type_Mark) then
+                        Error_Msg_Sem
+                          ("multi-dimensional " & Disp_Node (Type_Mark)
+                           & " cannot be a file type", Def);
+                     end if;
+                  end if;
+               end if;
+               Set_Base_Type (Def, Def);
+               Set_Resolved_Flag (Def, False);
+               Set_Text_File_Flag (Def, Is_Text_Type_Declaration (Decl));
+               Set_Signal_Type_Flag (Def, False);
+               Set_Type_Staticness (Def, None);
+               return Def;
+            end;
+
+         when Iir_Kind_Protected_Type_Declaration =>
+            Sem_Protected_Type_Declaration (Decl);
+            return Def;
+
+         when others =>
+            Error_Kind ("sem_type_definition", Def);
+            return Def;
+      end case;
+   end Sem_Type_Definition;
+
+   --  Convert a range expression to a subtype definition whose constraint is
+   --  A_RANGE.
+   --  This function extract the type of the range expression.
+   function Range_To_Subtype_Definition (A_Range: Iir) return Iir
+   is
+      Sub_Type: Iir;
+      Range_Type : Iir;
+   begin
+      case Get_Kind (A_Range) is
+         when Iir_Kind_Range_Expression
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            --  Create a sub type.
+            Range_Type := Get_Type (A_Range);
+         when Iir_Kinds_Discrete_Type_Definition =>
+            --  A_RANGE is already a subtype definition.
+            return A_Range;
+         when others =>
+            Error_Kind ("range_to_subtype_definition", A_Range);
+            return Null_Iir;
+      end case;
+
+      case Get_Kind (Range_Type) is
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            Sub_Type := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            Sub_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Location_Copy (Sub_Type, A_Range);
+      Set_Range_Constraint (Sub_Type, A_Range);
+      Set_Base_Type (Sub_Type, Get_Base_Type (Range_Type));
+      Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (A_Range));
+      Set_Signal_Type_Flag (Sub_Type, True);
+      return Sub_Type;
+   end Range_To_Subtype_Definition;
+
+   -- Return TRUE iff FUNC is a resolution function for ATYPE.
+   function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean
+   is
+      Decl: Iir;
+      Decl_Type : Iir;
+   begin
+      -- LRM93 2.4
+      --  A resolution function must be a [pure] function;
+      if Get_Kind (Func) not in Iir_Kinds_Function_Declaration then
+         return False;
+      end if;
+      Decl := Get_Interface_Declaration_Chain (Func);
+      -- LRM93 2.4
+      --  moreover, it must have a single input parameter of class constant
+      if Decl = Null_Iir or else Get_Chain (Decl) /= Null_Iir then
+         return False;
+      end if;
+      if Get_Kind (Decl) /= Iir_Kind_Constant_Interface_Declaration then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  that is a one-dimensional, unconstrained array
+      Decl_Type := Get_Type (Decl);
+      if Get_Kind (Decl_Type) /= Iir_Kind_Array_Type_Definition then
+         return False;
+      end if;
+      if Get_Nbr_Elements (Get_Index_Subtype_List (Decl_Type)) /= 1 then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  whose element type is that of the resolved signal.
+      if Get_Base_Type (Get_Element_Subtype (Decl_Type))
+        /= Get_Base_Type (Atype)
+      then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  The type of the return value of the function must also be that of
+      --  the signal.
+      if Get_Base_Type (Get_Return_Type (Func)) /= Get_Base_Type (Atype) then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  A resolution function must be a [pure] function;
+      if Flags.Vhdl_Std >= Vhdl_93 and then Get_Pure_Flag (Func) = False then
+         Error_Msg_Sem
+           ("resolution " & Disp_Node (Func) & " must be pure", Atype);
+         return False;
+      end if;
+      return True;
+   end Is_A_Resolution_Function;
+
+   procedure Sem_Resolution_Function (Decl: Iir)
+   is
+      Func: Iir;
+      Name : Iir;
+      Res: Iir;
+      El : Iir;
+      List : Iir_List;
+   begin
+      Name := Get_Resolution_Function (Decl);
+      if Name = Null_Iir then
+         -- This is not a resolved type.
+         return;
+      end if;
+
+      -- FIXME: add this check (maybe based on resolved_flag ?)
+      --if Get_Kind (Name) in Iir_Kinds_Function_Declaration then
+      --   --  The resolution function was already semantized.
+      --   --  This can happen if comes from an unconstrained array subtype.
+      --   return;
+      --end if;
+
+      Sem_Name (Name, False);
+      Func := Get_Named_Entity (Name);
+      if Func = Error_Mark then
+         return;
+      end if;
+
+      Res := Null_Iir;
+
+      if Is_Overload_List (Func) then
+         List := Get_Overload_List (Func);
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if Is_A_Resolution_Function (El, Decl) then
+               if Func /= Null_Iir then
+                  Error_Msg_Sem
+                    ("can't resolve overload for resolution function", Decl);
+                  return;
+               else
+                  Func := El;
+               end if;
+            end if;
+         end loop;
+      else
+         if Is_A_Resolution_Function (Func, Decl) then
+            Res := Func;
+         end if;
+      end if;
+
+      if Res = Null_Iir then
+         Error_Msg_Sem ("no matching resolution function for "
+                        & Disp_Node (Name), Decl);
+      else
+         Set_Named_Entity (Name, Res);
+         Set_Use_Flag (Res, True);
+         Set_Resolved_Flag (Decl, True);
+         Xref_Name (Name);
+      end if;
+   end Sem_Resolution_Function;
+
+   --  Semantize array_subtype_definition DEF using BASE_TYPE as the base type
+   --  of DEF.
+   --  DEF must have an index list and may have a resolution function.
+   --  Return DEF.
+   function Sem_Array_Subtype_Indication (Type_Mark : Iir; Def : Iir)
+     return Iir
+   is
+      Type_Index, Subtype_Index: Iir;
+      Base_Type : Iir;
+      El_Type : Iir;
+      Staticness : Iir_Staticness;
+      Error_Seen : Boolean;
+      Type_Index_List : Iir_List;
+      Subtype_Index_List : Iir_List;
+   begin
+      case Get_Kind (Type_Mark) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            null;
+         when others =>
+            Error_Msg_Sem
+              (Disp_Node (Type_Mark) & " cannot be constrained", Def);
+            --  Continue as if BASE_TYPE is really a base type, it is safe.
+      end case;
+
+      Base_Type := Get_Base_Type (Type_Mark);
+      Set_Base_Type (Def, Base_Type);
+      El_Type := Get_Element_Subtype (Base_Type);
+      Staticness := Get_Type_Staticness (El_Type);
+      Error_Seen := False;
+      Type_Index_List := Get_Index_Subtype_List (Base_Type);
+      Subtype_Index_List := Get_Index_Subtype_List (Def);
+      for I in Natural loop
+         Type_Index := Get_Nth_Element (Type_Index_List, I);
+         Subtype_Index := Get_Nth_Element (Subtype_Index_List, I);
+         exit when Type_Index = Null_Iir and Subtype_Index = Null_Iir;
+
+         if Type_Index = Null_Iir then
+            Error_Msg_Sem ("subtype has more indexes than "
+                           & Disp_Node (Type_Mark)
+                           & " defined at " & Disp_Location (Type_Mark),
+                           Subtype_Index);
+            --  Forget extra indexes.
+            Set_Nbr_Elements (Subtype_Index_List, I);
+            exit;
+         end if;
+         if Subtype_Index = Null_Iir then
+            if not Error_Seen then
+               Error_Msg_Sem ("subtype has less indexes than "
+                              & Disp_Node (Type_Mark)
+                              & " defined at " & Disp_Location (Type_Mark),
+                              Def);
+               Error_Seen := True;
+            end if;
+            --  Use type_index as a fake subtype
+            --  FIXME: it is too fake.
+            Append_Element (Subtype_Index_List, Type_Index);
+            Staticness := None;
+         else
+            Subtype_Index := Sem_Discrete_Range_Expression
+              (Subtype_Index, Type_Index);
+            if Subtype_Index /= Null_Iir then
+               Subtype_Index := Range_To_Subtype_Definition (Subtype_Index);
+               Staticness := Min (Staticness,
+                                  Get_Type_Staticness (Subtype_Index));
+            end if;
+            if Subtype_Index = Null_Iir then
+               --  Create a fake subtype from type_index.
+               --  FIXME: It is too fake.
+               Subtype_Index := Type_Index;
+               Staticness := None;
+            end if;
+            Replace_Nth_Element (Subtype_Index_List, I, Subtype_Index);
+         end if;
+      end loop;
+      Set_Type_Staticness (Def, Staticness);
+      Set_Element_Subtype (Def, El_Type);
+      Sem_Resolution_Function (Def);
+      if Get_Resolution_Function (Def) /= Null_Iir
+        or else Get_Resolved_Flag (El_Type)
+      then
+         Set_Resolved_Flag (Def, True);
+      else
+         Set_Resolved_Flag (Def, False);
+      end if;
+      Set_Type_Mark (Def, Type_Mark);
+      Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark));
+      return Def;
+   end Sem_Array_Subtype_Indication;
+
+   --  Semantize a subtype indication.
+   --  DEF can be either a name or an iir_subtype_definition.
+   --  Return a new (an anonymous) subtype definition (with the correct kind),
+   --  or an already defined type definition (if DEF is a name).
+   function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False)
+     return Iir
+   is
+      Type_Mark: Iir;
+      Res: Iir;
+      Decl_Kind : Decl_Kind_Type;
+   begin
+      if Incomplete then
+         Decl_Kind := Decl_Incomplete_Type;
+      else
+         Decl_Kind := Decl_Type;
+      end if;
+
+      -- Simple case that correspond to no indication except a subtype
+      -- identifier
+      if Get_Kind (Def) in Iir_Kinds_Name then
+         Type_Mark := Find_Declaration (Def, Decl_Kind);
+         if Type_Mark = Null_Iir then
+            return Create_Error_Type (Def);
+         else
+            return Type_Mark;
+         end if;
+      end if;
+
+      --  Semantize the type mark.
+      Type_Mark := Find_Declaration (Get_Type_Mark (Def), Decl_Kind);
+      if Type_Mark = Null_Iir then
+         --  FIXME: handle inversion such as "subtype BASETYPE RESOLV", which
+         --  should emit "resolution function must precede type name".
+         return Create_Error_Type (Get_Type_Mark (Def));
+      end if;
+      Set_Type_Mark (Def, Type_Mark);
+
+      --  Check constraint.
+      case Get_Kind (Def) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            case Get_Kind (Type_Mark) is
+               when Iir_Kind_Unconstrained_Array_Subtype_Definition
+                 | Iir_Kind_Array_Type_Definition
+                 | Iir_Kind_Access_Type_Definition =>
+                  null;
+               when others =>
+                  --  LRM 3.2.1.1  Index Constraints and Discrete Ranges
+                  --  If an index constraint appears after a type mark [...]
+                  --  The type mark must denote either an unconstrained array
+                  --  type, or an access type whose designated type is such
+                  --  an array type.
+                  Error_Msg_Sem
+                    ("only unconstrained array type may be contrained "
+                     &"by index", Def);
+                  Error_Msg_Sem
+                    (" (type mark is " & Disp_Node (Type_Mark) & ")",
+                     Type_Mark);
+                  return Type_Mark;
+            end case;
+         when Iir_Kind_Subtype_Definition =>
+            case Get_Kind (Type_Mark) is
+               when Iir_Kind_Integer_Subtype_Definition
+                 | Iir_Kind_Floating_Subtype_Definition
+                 | Iir_Kind_Enumeration_Subtype_Definition
+                 | Iir_Kind_Physical_Subtype_Definition =>
+                  null;
+               when Iir_Kind_Enumeration_Type_Definition =>
+                  null;
+               when others =>
+                  --  FIXME: find the correct sentence from LRM
+                  --  GHDL: subtype_definition may also be used just to add
+                  --    a resolution function.
+                  if Get_Range_Constraint (Def) /= Null_Iir then
+                     Error_Msg_Sem
+                       ("only scalar types may be constrained by range", Def);
+                     Error_Msg_Sem
+                       (" (type mark is " & Disp_Node (Type_Mark) & ")",
+                        Type_Mark);
+                     return Type_Mark;
+                  end if;
+            end case;
+         when others =>
+            Error_Kind ("sem_subtype_indication", Def);
+      end case;
+
+      case Get_Kind (Type_Mark) is
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+--             --  If the base type is an unconstrained array subtype, then get
+--            --  the *real* base type, and copy the resolution function (since
+--             --  a base type has no resolution function).
+--             if Get_Kind (Type_Mark) =
+--               Iir_Kind_Unconstrained_Array_Subtype_Definition
+--               and then Get_Kind (Def) = Iir_Kind_Subtype_Definition
+--             then
+--                if Get_Resolution_Function (Def) = Null_Iir then
+--                   if Get_Range_Constraint (Def) = Null_Iir then
+--                      --  In this case, DEF must simply be a name.  There is
+--                      --  a parser internal error.
+--                      raise Internal_Error;
+--                   end if;
+--                   Set_Resolution_Function
+--                     (Def, Get_Resolution_Function (Type_Mark));
+--                end if;
+--             end if;
+
+            if Get_Kind (Def) = Iir_Kind_Subtype_Definition then
+               -- This is the case of "subtype new_array is [func] old_array".
+               -- def must be a constrained array.
+               if Get_Range_Constraint (Def) /= Null_Iir then
+                  Error_Msg_Sem
+                    ("cannot use a range constraint for an array", Def);
+                  return Type_Mark;
+               end if;
+               if Get_Resolution_Function (Def) = Null_Iir then
+                  --  In this case, DEF must simply be a name.  There is
+                  --  a parser internal error.
+                  raise Internal_Error;
+               end if;
+               case Get_Kind (Type_Mark) is
+                  when Iir_Kind_Array_Type_Definition =>
+                     Res := Create_Iir
+                       (Iir_Kind_Unconstrained_Array_Subtype_Definition);
+                  when Iir_Kind_Array_Subtype_Definition =>
+                     Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+                     Set_Element_Subtype
+                       (Res, Get_Element_Subtype (Type_Mark));
+                     Set_Index_Subtype_List
+                       (Res, Get_Index_Subtype_List (Type_Mark));
+                  when others =>
+                     Error_Kind ("sem_subtype_indication(array)", Type_Mark);
+               end case;
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Get_Base_Type (Type_Mark));
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
+               Sem_Resolution_Function (Res);
+               Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+               if Get_Resolution_Function (Res) /= Null_Iir
+                 or else Get_Resolved_Flag (Get_Element_Subtype (Type_Mark))
+               then
+                  Set_Resolved_Flag (Res, True);
+               else
+                  Set_Resolved_Flag (Res, False);
+               end if;
+               Set_Type_Mark (Res, Type_Mark);
+               Free_Name (Def);
+               return Res;
+            elsif Get_Kind (Def) = Iir_Kind_Array_Subtype_Definition then
+               -- Case of a constraint for an array.
+               -- Check each index constraint against array type.
+               return Sem_Array_Subtype_Indication (Type_Mark, Def);
+            else
+               Error_Kind ("sem_subtype_indication(1)", Def);
+               return Type_Mark;
+            end if;
+
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            if Get_Range_Constraint (Def) = Null_Iir
+              and then Get_Resolution_Function (Def) = Null_Iir
+            then
+               --  This defines an alias, and must have been handled just
+               --  before the case statment.
+               raise Internal_Error;
+            end if;
+            declare
+               A_Range : Iir;
+            begin
+               -- There are limits.  Create a new subtype.
+               Res := Create_Iir (Get_Kind (Type_Mark));
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Get_Base_Type (Type_Mark));
+               Set_Type_Mark (Res, Type_Mark);
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               A_Range := Get_Range_Constraint (Def);
+               if A_Range = Null_Iir then
+                  A_Range := Get_Range_Constraint (Type_Mark);
+               else
+                  A_Range := Sem_Discrete_Range_Expression
+                    (A_Range, Type_Mark);
+                  if A_Range = Null_Iir then
+                     --  Avoid error propagation.
+                     A_Range := Get_Range_Constraint (Type_Mark);
+                  end if;
+               end if;
+               Set_Range_Constraint (Res, A_Range);
+               Set_Type_Staticness (Res, Get_Expr_Staticness (A_Range));
+               Free_Name (Def);
+               Sem_Resolution_Function (Res);
+               Set_Resolved_Flag
+                 (Res, Get_Resolution_Function (Res) /= Null_Iir);
+               Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+               return Res;
+            end;
+
+         when Iir_Kind_Enumeration_Type_Definition =>
+            if Get_Range_Constraint (Def) = Null_Iir and then
+              Get_Resolution_Function (Def) = Null_Iir
+            then
+               raise Internal_Error;
+            end if;
+
+            declare
+               Constraint : Iir_Range_Expression;
+            begin
+               -- There are limits.  Create a new subtype.
+               Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Type_Mark);
+               Set_Type_Mark (Res, Type_Mark);
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               Constraint := Get_Range_Constraint (Def);
+               if Constraint = Null_Iir then
+                  Constraint := Get_Range_Constraint (Type_Mark);
+               else
+                  Constraint := Sem_Discrete_Range_Expression
+                    (Constraint, Type_Mark);
+                  -- FIXME: check bounds, check static
+               end if;
+               Set_Range_Constraint (Res, Constraint);
+               Set_Type_Staticness (Res, Get_Expr_Staticness (Constraint));
+            end;
+            Free_Name (Def);
+            Sem_Resolution_Function (Res);
+            Set_Resolved_Flag
+              (Res, Get_Resolution_Function (Res) /= Null_Iir);
+            Set_Signal_Type_Flag (Res, True);
+            return Res;
+
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               Func: Iir;
+            begin
+               if Get_Kind (Def) /= Iir_Kind_Subtype_Definition then
+                  Error_Kind ("sem_subtype_indication1", Def);
+                  return Null_Iir;
+               end if;
+               Func := Get_Resolution_Function (Def);
+               if Func = Null_Iir then
+                  --  This is an alias.
+                  raise Internal_Error;
+               end if;
+               Res := Create_Iir (Iir_Kind_Record_Subtype_Definition);
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Type_Mark);
+               Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
+               Set_Type_Mark (Res, Type_Mark);
+               Set_Resolution_Function (Res, Func);
+               Sem_Resolution_Function (Res);
+               Set_Resolved_Flag (Res, Func /= Null_Iir);
+               Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+               Free_Name (Def);
+               return Res;
+            end;
+
+         when Iir_Kind_Access_Type_Definition =>
+            --  LRM93 4.2
+            --  A subtype indication denoting an access type [or a file type]
+            --  may not contain a resolution function.
+            if Get_Resolution_Function (Def) /= Null_Iir then
+               Error_Msg_Sem
+                 ("resolution function not allowed for an access type", Def);
+            end if;
+
+            case Get_Kind (Def) is
+               when Iir_Kind_Subtype_Definition =>
+                  Free_Name (Def);
+                  return Type_Mark;
+               when Iir_Kind_Array_Subtype_Definition =>
+                  --  LRM93 §3.3
+                  --  The only form of constraint that is allowed after a name
+                  --  of an access type in a subtype indication is an index
+                  --  constraint.
+                  declare
+                     Sub_Type : Iir;
+                     Base_Type : Iir;
+                  begin
+                     Base_Type := Get_Designated_Type (Type_Mark);
+                     Sub_Type := Sem_Array_Subtype_Indication (Base_Type, Def);
+                     Res := Create_Iir (Iir_Kind_Access_Subtype_Definition);
+                     Location_Copy (Res, Def);
+                     Set_Base_Type (Res, Type_Mark);
+                     Set_Signal_Type_Flag (Res, False);
+                     Free_Old_Iir (Def);
+                     return Res;
+                  end;
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Kind_File_Type_Definition =>
+            if Get_Kind (Def) = Iir_Kind_Subtype_Definition then
+               Free_Name (Def);
+               return Type_Mark;
+            else
+               raise Internal_Error;
+            end if;
+
+         when others =>
+            Error_Kind ("sem_subtype_indication", Type_Mark);
+            return Def;
+      end case;
+   end Sem_Subtype_Indication;
+
+   function Sem_Is_Constrained (A_Type: Iir) return Boolean is
+   begin
+      case Get_Kind (A_Type) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            return True;
+         when Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_File_Type_Definition =>
+            --| Iir_Kind_File_Subtype_Definition =>
+            return True;
+         when Iir_Kind_Protected_Type_Declaration =>
+            return True;
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            return False;
+         when Iir_Kind_Incomplete_Type_Definition =>
+            return False;
+         when Iir_Kind_Error =>
+            return True;
+         when others =>
+            Error_Kind ("sem_is_constrained", A_Type);
+      end case;
+   end Sem_Is_Constrained;
+
+end Sem_Types;