Rework literal typing (and initial work for condition operator).

14 files changed, 371 insertions, 515 deletions

diff --git a/flags.ads b/flags.ads
index c79936d54..03e9fe959 100644
--- a/flags.ads
+++ b/flags.ads
@@ -134,6 +134,12 @@ package Flags is
    --  If set, all the design units are analyzed in whole to do the simulation.
    Flag_Whole_Analyze : Boolean := False;
 
+   --  If true, relax some rules:
+   --  * the scope of an object declaration names start after the declaration,
+   --    so that it is possible to use the old name in the default expression:
+   --    constant x : xtype := x;
+   Flag_Relaxed_Rules : Boolean := False;
+
    -- --warn-undriven
    --Warn_Undriven : Boolean := False;
 
diff --git a/iirs.adb b/iirs.adb
index 20997da67..332746b67 100644
--- a/iirs.adb
+++ b/iirs.adb
@@ -5078,6 +5078,29 @@ package body Iirs is
       Set_Field5 (Target, Expr);
    end Set_Expression;
 
+   procedure Check_Kind_For_Allocator_Designated_Type (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype =>
+            null;
+         when others =>
+            Failed ("Allocator_Designated_Type", Target);
+      end case;
+   end Check_Kind_For_Allocator_Designated_Type;
+
+   function Get_Allocator_Designated_Type (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Allocator_Designated_Type (Target);
+      return Get_Field2 (Target);
+   end Get_Allocator_Designated_Type;
+
+   procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir) is
+   begin
+      Check_Kind_For_Allocator_Designated_Type (Target);
+      Set_Field2 (Target, A_Type);
+   end Set_Allocator_Designated_Type;
+
    procedure Check_Kind_For_Selected_Waveform_Chain (Target : Iir) is
    begin
       case Get_Kind (Target) is
diff --git a/iirs.ads b/iirs.ads
index 202ad84d9..14d41b586 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -2430,6 +2430,10 @@ package Iirs is
    --
    --   Get/Set_Type (Field1)
    --
+   -- To ease analysis: set to the designated type (either the type of the
+   -- expression or the subtype)
+   --   Get/Set_Allocator_Designated_Type (Field2)
+   --
    -- Contains the expression for a by expression allocator or the
    -- subtype indication for a by subtype allocator.
    --   Get/Set_Expression (Field5)
@@ -5028,6 +5032,12 @@ package Iirs is
    function Get_Expression (Target : Iir) return Iir;
    procedure Set_Expression (Target : Iir; Expr : Iir);
 
+   --  Set to the designated type (either the type of the expression or the
+   --  subtype) when the expression is analyzed.
+   --  Field: Field2
+   function Get_Allocator_Designated_Type (Target : Iir) return Iir;
+   procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir);
+
    --  Field: Field7
    function Get_Selected_Waveform_Chain (Target : Iir) return Iir;
    procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir);
diff --git a/options.adb b/options.adb
index a62b76da1..cd70f319a 100644
--- a/options.adb
+++ b/options.adb
@@ -114,6 +114,8 @@ package body Options is
          Bootstrap := True;
       elsif Opt = "-fexplicit" then
          Flag_Explicit := True;
+      elsif Opt = "-frelaxed-rules" then
+         Flag_Relaxed_Rules := True;
       elsif Opt = "--syn-binding" then
          Flag_Syn_Binding := True;
       elsif Opt = "--no-vital-checks" then
@@ -215,6 +217,7 @@ package body Options is
 --    P ("           failure or none");
       P ("Extensions:");
       P ("  -fexplicit         give priority to explicitly declared operator");
+      P ("  -frelaxed-rules    relax some LRM rules");
       P ("  -C  --mb-comments  allow multi-bytes chars in a comment");
       P ("  --bootstrap        allow --work=std");
       P ("  --syn-binding      use synthesis default binding rule");
diff --git a/scan.adb b/scan.adb
index 67379c9fd..6b191025b 100644
--- a/scan.adb
+++ b/scan.adb
@@ -1425,6 +1425,9 @@ package body Scan is
                      Current_Token := Tok_Match_Greater;
                      Pos := Pos + 2;
                   end if;
+               elsif Source (Pos + 1) = '?' then
+                  Current_Token := Tok_Condition;
+                  Pos := Pos + 2;
                elsif Source (Pos + 1) = '=' then
                   Current_Token := Tok_Match_Equal;
                   Pos := Pos + 2;
diff --git a/sem_assocs.adb b/sem_assocs.adb
index c4a9bce74..178bf6d2c 100644
--- a/sem_assocs.adb
+++ b/sem_assocs.adb
@@ -1204,7 +1204,6 @@ package body Sem_Assocs is
       Formal : Iir;
       Formal_Type : Iir;
       Actual: Iir;
-      Actual_Types : Iir;
       Out_Conv, In_Conv : Iir;
       Expr : Iir;
       Res_Type : Iir;
@@ -1267,12 +1266,7 @@ package body Sem_Assocs is
 
       --  Extract conversion from actual.
       Actual := Get_Actual (Assoc);
-      Actual_Types := Get_Type (Actual);
       In_Conv := Null_Iir;
-      if Actual_Types = Null_Iir then
-         Match := False;
-         return;
-      end if;
       if Get_Kind (Inter) /= Iir_Kind_Constant_Interface_Declaration then
          case Get_Kind (Actual) is
             when Iir_Kind_Function_Call =>
@@ -1289,7 +1283,6 @@ package body Sem_Assocs is
             when others =>
                null;
          end case;
-         Actual_Types := Get_Type (Actual);
       end if;
 
       --  4 cases: F:out_conv, G:in_conv.
@@ -1298,16 +1291,16 @@ package body Sem_Assocs is
       --    A  => G(B)  type of A = type of G
       --  F(A) => G(B)  type of B = type of F, type of A = type of G
       if Out_Conv = Null_Iir and then In_Conv = Null_Iir then
-         Match := Compatibility_Types (Formal_Type, Actual_Types);
+         Match := Is_Expr_Compatible (Formal_Type, Actual);
       else
          Match := True;
          if In_Conv /= Null_Iir then
-            if not Compatibility_Types (Formal_Type, Get_Type (In_Conv)) then
+            if not Is_Expr_Compatible (Formal_Type, In_Conv) then
                Match := False;
             end if;
          end if;
          if Out_Conv /= Null_Iir then
-            if not Compatibility_Types (Get_Type (Out_Conv), Actual_Types) then
+            if not Is_Expr_Compatible (Get_Type (Out_Conv), Actual) then
                Match := False;
             end if;
          end if;
@@ -1337,9 +1330,9 @@ package body Sem_Assocs is
       else
          if Out_Conv /= Null_Iir then
             Res_Type := Search_Compatible_Type (Get_Type (Out_Conv),
-                                                Actual_Types);
+                                                Get_Type (Actual));
          else
-            Res_Type := Actual_Types;
+            Res_Type := Get_Type (Actual);
          end if;
 
          if In_Conv /= Null_Iir then
diff --git a/sem_decls.adb b/sem_decls.adb
index 83d2448f2..ffe80d566 100644
--- a/sem_decls.adb
+++ b/sem_decls.adb
@@ -1129,8 +1129,6 @@ package body Sem_Decls is
 
                   Sem_Scopes.Name_Visible (St_Decl);
 
-                  Sem_Scopes.Add_Visible_Type (Decl);
-
                   --  The implicit subprogram will be added in the
                   -- scope just after.
                   Create_Implicit_Operations (Decl, False);
@@ -1144,7 +1142,6 @@ package body Sem_Decls is
                   Set_Type_Declarator (Def, Decl);
 
                   Sem_Scopes.Name_Visible (Decl);
-                  Sem_Scopes.Add_Visible_Type (Decl);
 
                   --  The implicit subprogram will be added in the
                   -- scope just after.
@@ -1152,7 +1149,6 @@ package body Sem_Decls is
 
                when Iir_Kind_Protected_Type_Declaration =>
                   Set_Type_Declarator (Def, Decl);
-                  Sem_Scopes.Add_Visible_Type (Decl);
                   St_Decl := Null_Iir;
                   --  No implicit subprograms.
 
@@ -1280,7 +1276,9 @@ package body Sem_Decls is
       end if;
 
       if Deferred_Const = Null_Iir then
-         Sem_Scopes.Add_Name (Decl);
+         if not Flag_Relaxed_Rules then
+            Sem_Scopes.Add_Name (Decl);
+         end if;
          Xref_Decl (Decl);
       else
          Xref_Ref (Decl, Deferred_Const);
@@ -1306,6 +1304,11 @@ package body Sem_Decls is
             Check_Read (Default_Value);
          end if;
       end if;
+
+      if Deferred_Const = Null_Iir and Flag_Relaxed_Rules then
+         Sem_Scopes.Add_Name (Decl);
+      end if;
+
       Set_Type (Decl, Atype);
       Default_Value := Eval_Expr_Check_If_Static (Default_Value, Atype);
       Set_Default_Value (Decl, Default_Value);
diff --git a/sem_expr.adb b/sem_expr.adb
index 47c29f87b..ebe7679b1 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -88,10 +88,12 @@ package body Sem_Expr is
       Set_Type (Target, A_Type);
    end Replace_Type;
 
-   -- Return true if ID is overloaded, ie has several meanings.
-   function Is_Overloaded (Id: Iir) return Boolean is
+   --  Return true if EXPR is overloaded, ie has several meanings.
+   function Is_Overloaded (Expr : Iir) return Boolean
+   is
+      Expr_Type : constant Iir := Get_Type (Expr);
    begin
-      return Is_Overload_List (Get_Type (Id));
+      return Expr_Type = Null_Iir or else Is_Overload_List (Expr_Type);
    end Is_Overloaded;
 
    -- Return the common type of base types LEFT and RIGHT.
@@ -148,6 +150,163 @@ package body Sem_Expr is
       return Are_Types_Compatible (Get_Type (Left), Get_Type (Right));
    end Are_Nodes_Compatible;
 
+   --  Return TRUE iif LEFT_TYPE and RIGHT_TYPES are compatible. RIGHT_TYPES
+   --  may be an overload list.
+   function Compatibility_Types1 (Left_Type : Iir; Right_Types : Iir)
+                                 return Boolean
+   is
+      El : Iir;
+      Right_List : Iir_List;
+   begin
+      pragma Assert (not Is_Overload_List (Left_Type));
+
+      if Is_Overload_List (Right_Types) then
+         Right_List := Get_Overload_List (Right_Types);
+         for I in Natural loop
+            El := Get_Nth_Element (Right_List, I);
+            exit when El = Null_Iir;
+            if Are_Types_Compatible (Left_Type, El) then
+               return True;
+            end if;
+         end loop;
+         return False;
+      else
+         return Are_Types_Compatible (Left_Type, Right_Types);
+      end if;
+   end Compatibility_Types1;
+
+   --  Return compatibility for nodes LEFT and RIGHT.
+   --  LEFT is expected to be an interface of a function definition.
+   --  Type of RIGHT can be an overload_list
+   --  RIGHT might be implicitly converted to LEFT.
+   function Compatibility_Nodes (Left : Iir; Right : Iir)
+     return Boolean
+   is
+      Left_Type, Right_Type : Iir;
+   begin
+      Left_Type := Get_Base_Type (Get_Type (Left));
+      Right_Type := Get_Type (Right);
+
+      --  Check.
+      case Get_Kind (Left_Type) is
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            null;
+         when others =>
+            Error_Kind ("are_node_compatible_ov", Left_Type);
+      end case;
+
+      return Compatibility_Types1 (Left_Type, Right_Type);
+   end Compatibility_Nodes;
+
+   --  Return TRUE iff A_TYPE can be the type of string or bit string literal
+   --  EXPR.  EXPR is needed to distinguish between string and bit string
+   --  for VHDL87 rule about the type of a bit string.
+   function Is_String_Literal_Type (A_Type : Iir; Expr : Iir) return Boolean
+   is
+      Base_Type : constant Iir := Get_Base_Type (A_Type);
+      El_Bt : Iir;
+   begin
+      --  LRM 7.3.1
+      --  [...] the type of the literal must be a one-dimensional array ...
+      if not Is_Unidim_Array_Type (Base_Type) then
+         return False;
+      end if;
+      --  LRM 7.3.1
+      --  ... of a character type ...
+      El_Bt := Get_Base_Type (Get_Element_Subtype (Base_Type));
+      if Get_Kind (El_Bt) /= Iir_Kind_Enumeration_Type_Definition then
+         return False;
+      end if;
+      --  LRM87 7.3.1
+      --  ... (for string literals) or of type BIT (for bit string literals).
+      if Flags.Vhdl_Std = Vhdl_87
+        and then Get_Kind (Expr) = Iir_Kind_Bit_String_Literal
+        and then El_Bt /= Bit_Type_Definition
+      then
+         return False;
+      end if;
+      return True;
+   end Is_String_Literal_Type;
+
+   --  Return TRUE iff A_TYPE can be the type of an aggregate.
+   function Is_Aggregate_Type (A_Type : Iir) return Boolean is
+   begin
+      --  LRM 7.3.2 Aggregates
+      --  [...]  the type of the aggregate must be a composite type.
+      case Get_Kind (Get_Base_Type (A_Type)) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Record_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Aggregate_Type;
+
+   --  Return TRUE iff A_TYPE can be the type of a null literal.
+   function Is_Null_Literal_Type (A_Type : Iir) return Boolean is
+   begin
+      --  LRM 7.3.1 Literals
+      --  The literal NULL represents the null access value for any access
+      --  type.
+      return
+        Get_Kind (Get_Base_Type (A_Type)) = Iir_Kind_Access_Type_Definition;
+   end Is_Null_Literal_Type;
+
+   --  Return TRUE iff A_TYPE can be the type of allocator EXPR.  Note that
+   --  the allocator must have been analyzed.
+   function Is_Allocator_Type (A_Type : Iir; Expr : Iir) return Boolean
+   is
+      Base_Type : constant Iir := Get_Base_Type (A_Type);
+      Designated_Type : Iir;
+   begin
+      --  LRM 7.3.6 Allocators
+      --  [...] the value returned is of an access type having the named
+      --  designated type.
+
+      if Get_Kind (Base_Type) /= Iir_Kind_Access_Type_Definition then
+         return False;
+      end if;
+      Designated_Type := Get_Allocator_Designated_Type (Expr);
+      pragma Assert (Designated_Type /= Null_Iir);
+      --  Cheat: there is no allocators on universal types.
+      return Get_Base_Type (Get_Designated_Type (Base_Type))
+        = Get_Base_Type (Designated_Type);
+   end Is_Allocator_Type;
+
+   --  Return TRUE iff the type of EXPR is compatible with A_TYPE
+   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir) return Boolean
+   is
+      Expr_Type : constant Iir := Get_Type (Expr);
+   begin
+      if Expr_Type /= Null_Iir then
+         return Compatibility_Types1 (A_Type, Expr_Type);
+      end if;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Aggregate =>
+            return Is_Aggregate_Type (A_Type);
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            return Is_String_Literal_Type (A_Type, Expr);
+         when Iir_Kind_Null_Literal =>
+            return Is_Null_Literal_Type (A_Type);
+         when Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype =>
+            return Is_Allocator_Type (A_Type, Expr);
+         when others =>
+            --  Error while EXPR was typed.  FIXME: should create an ERROR
+            --  node?
+            return False;
+      end case;
+   end Is_Expr_Compatible;
+
    function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir
    is
    begin
@@ -335,103 +494,6 @@ package body Sem_Expr is
       end if;
    end Search_Compatible_Type;
 
-   --  Return compatibility for type nodes LEFT and RIGHT.
-   function Compatibility (Left_Type, Right_Type : Iir)
-     return Boolean
-   is
-      Right_Base_Type : Iir;
-      Left_Base_Type : Iir;
-   begin
-      Right_Base_Type := Get_Base_Type (Right_Type);
-      Left_Base_Type := Get_Base_Type (Left_Type);
-      if Right_Base_Type = Left_Base_Type then
-         return True;
-      end if;
-      if Get_Kind (Left_Base_Type) = Iir_Kind_Integer_Type_Definition
-        and then Right_Base_Type = Convertible_Integer_Type_Definition
-      then
-         return True;
-      end if;
-      if Get_Kind (Left_Base_Type) = Iir_Kind_Floating_Type_Definition
-        and then Right_Base_Type = Convertible_Real_Type_Definition
-      then
-         return True;
-      end if;
-      return False;
-   end Compatibility;
-
-   function Compatibility_Types1 (Left_Type : Iir; Right_Types : Iir)
-                                 return Boolean
-   is
-      El : Iir;
-      Right_List : Iir_List;
-   begin
-      if Is_Overload_List (Right_Types) then
-         Right_List := Get_Overload_List (Right_Types);
-         for I in Natural loop
-            El := Get_Nth_Element (Right_List, I);
-            exit when El = Null_Iir;
-            if Compatibility (Left_Type, El) then
-               return True;
-            end if;
-         end loop;
-         return False;
-      else
-         return Compatibility (Left_Type, Right_Types);
-      end if;
-   end Compatibility_Types1;
-
-   --  Return compatibility for nodes LEFT and RIGHT.
-   --  LEFT is expected to be an interface of a function definition.
-   --  Type of RIGHT can be an overload_list
-   --  RIGHT might be implicitly converted to LEFT.
-   function Compatibility_Nodes (Left : Iir; Right : Iir)
-     return Boolean
-   is
-      Left_Type, Right_Type : Iir;
-   begin
-      Left_Type := Get_Base_Type (Get_Type (Left));
-      Right_Type := Get_Type (Right);
-
-      --  Check.
-      case Get_Kind (Left_Type) is
-         when Iir_Kind_Floating_Type_Definition
-           | Iir_Kind_Enumeration_Type_Definition
-           | Iir_Kind_Integer_Type_Definition
-           | Iir_Kind_Record_Type_Definition
-           | Iir_Kind_File_Type_Definition
-           | Iir_Kind_Physical_Type_Definition
-           | Iir_Kind_Access_Type_Definition
-           | Iir_Kind_Array_Type_Definition =>
-            null;
-         when others =>
-            Error_Kind ("are_node_compatible_ov", Left_Type);
-      end case;
-
-      return Compatibility_Types1 (Left_Type, Right_Type);
-   end Compatibility_Nodes;
-
-   function Compatibility_Types (Left_Types : Iir; Right_Types : Iir)
-                                return Boolean
-   is
-      El : Iir;
-      Left_List : Iir_List;
-   begin
-      if Is_Overload_List (Left_Types) then
-         Left_List := Get_Overload_List (Left_Types);
-         for I in Natural loop
-            El := Get_Nth_Element (Left_List, I);
-            exit when El = Null_Iir;
-            if Compatibility_Types1 (El, Right_Types) then
-               return True;
-            end if;
-         end loop;
-         return False;
-      else
-         return Compatibility_Types1 (Left_Types, Right_Types);
-      end if;
-   end Compatibility_Types;
-
    -- Semantize the range expression EXPR.
    -- If A_TYPE is not null_iir, EXPR is expected to be of type A_TYPE.
    -- LRM93 3.2.1.1
@@ -1528,7 +1590,7 @@ package body Sem_Expr is
          Set_Type (Expr, Get_Return_Type (Decl));
          Interface_Chain := Get_Interface_Declaration_Chain (Decl);
          Err := False;
-         if Is_Overload_List (Get_Type (Left)) then
+         if Is_Overloaded (Left) then
             Left := Sem_Expression_Ov
               (Left, Get_Base_Type (Get_Type (Interface_Chain)));
             if Left = Null_Iir then
@@ -1543,7 +1605,7 @@ package body Sem_Expr is
          end if;
          Check_Read (Left);
          if Arity = 2 then
-            if Is_Overload_List (Get_Type (Right)) then
+            if Is_Overloaded (Right) then
                Right := Sem_Expression_Ov
                  (Right,
                   Get_Base_Type (Get_Type (Get_Chain (Interface_Chain))));
@@ -1626,7 +1688,8 @@ package body Sem_Expr is
 
             --  Check return type.
             if Res_Type /= Null_Iir
-              and then not Compatibility (Res_Type, Get_Return_Type (Decl))
+              and then
+              not Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
             then
                goto Next;
             end if;
@@ -1634,16 +1697,26 @@ package body Sem_Expr is
             Interface_Chain := Get_Interface_Declaration_Chain (Decl);
 
             --  Check arity.
+
+            --  LRM93 2.5.2 Operator overloading
+            --  The subprogram specification of a unary operator must have
+            --  a single parameter [...]
+            --  The subprogram specification of a binary operator must have
+            --  two parameters [...]
+            --
+            --  GHDL: So even in presence of default expression in a parameter,
+            --  a unary operation has to match with a binary operator.
             if Iir_Chains.Get_Chain_Length (Interface_Chain) /= Arity then
                goto Next;
             end if;
 
             -- Check operands.
-            if not Compatibility_Nodes (Interface_Chain, Left) then
+            if not Is_Expr_Compatible (Get_Type (Interface_Chain), Left) then
                goto Next;
             end if;
             if Arity = 2 then
-               if not Compatibility_Nodes (Get_Chain (Interface_Chain), Right)
+               if not Is_Expr_Compatible
+                 (Get_Type (Get_Chain (Interface_Chain)), Right)
                then
                   goto Next;
                end if;
@@ -1740,7 +1813,7 @@ package body Sem_Expr is
             Decl := Get_Nth_Element (Overload_List, I);
             exit when Decl = Null_Iir;
             --  FIXME: wrong: compatibilty with return type and args.
-            if Compatibility (Get_Return_Type (Decl), Res_Type) then
+            if Are_Types_Compatible (Get_Return_Type (Decl), Res_Type) then
                if Full_Compat /= Null_Iir then
                   Error_Operator_Overload (Overload_List);
                   return Null_Iir;
@@ -1754,37 +1827,6 @@ package body Sem_Expr is
       end if;
    end Sem_Operator;
 
-   -- Create a subtype for a string literal.
-   -- The literal must have been typed, with a type or a subtype.
-   -- FIXME: not general at all!
-   function Check_Type_For_String_Literal (A_Type : Iir; Expr : Iir)
-                                          return Boolean
-   is
-      Base_Type : constant Iir := Get_Base_Type (A_Type);
-      El_Bt : Iir;
-   begin
-      --  LRM 7.3.1
-      --  [...] the type of the literal must be a one-dimensional array ...
-      if not Is_Unidim_Array_Type (Base_Type) then
-         return False;
-      end if;
-      --  LRM 7.3.1
-      --  ... of a character type ...
-      El_Bt := Get_Base_Type (Get_Element_Subtype (Base_Type));
-      if Get_Kind (El_Bt) /= Iir_Kind_Enumeration_Type_Definition then
-         return False;
-      end if;
-      --  LRM87 7.3.1
-      --  ... (for string literals) or of type BIT (for bit string literals).
-      if Flags.Vhdl_Std = Vhdl_87
-        and then Get_Kind (Expr) = Iir_Kind_Bit_String_Literal
-        and then El_Bt /= Bit_Type_Definition
-      then
-         return False;
-      end if;
-      return True;
-   end Check_Type_For_String_Literal;
-
    --  Semantize LIT whose elements must be of type EL_TYPE, and return
    --  the length.
    --  FIXME: the errors are reported, but there is no mark of that.
@@ -2135,7 +2177,7 @@ package body Sem_Expr is
       end if;
    end Sem_String_Choices_Range;
 
-   function Is_Name (Name : Iir) return Boolean
+   function Is_Choice_Name (Name : Iir) return Boolean
    is
    begin
       case Get_Kind (Name) is
@@ -2147,7 +2189,7 @@ package body Sem_Expr is
          when others =>
             return False;
       end case;
-   end Is_Name;
+   end Is_Choice_Name;
 
    procedure Sem_Choices_Range
      (Choice_Chain : in out Iir;
@@ -2193,7 +2235,7 @@ package body Sem_Expr is
          Expr := Get_Expression (El);
          if Get_Kind (El) = Iir_Kind_Choice_By_Range then
             Expr := Sem_Discrete_Range_Expression (Expr, Sub_Type, True);
-         elsif Is_Name (Expr) then
+         elsif Is_Choice_Name (Expr) then
             declare
                Name : Iir;
                N_Choice : Iir;
@@ -3388,96 +3430,74 @@ package body Sem_Expr is
    begin
       Arg := Get_Expression (Expr);
       Set_Expr_Staticness (Expr, None);
-      if Get_Type (Expr) = Null_Iir then
-         if Get_Kind (Expr) = Iir_Kind_Allocator_By_Expression then
-            if Get_Kind (Arg) /= Iir_Kind_Qualified_Expression then
-               raise Internal_Error;
-            end if;
-            Arg := Sem_Expression (Arg, Null_Iir);
-            if Arg = Null_Iir then
-               return Null_Iir;
-            end if;
-            Check_Read (Arg);
-            Arg_Type := Get_Type (Arg);
-         else
-            Arg := Sem_Types.Sem_Subtype_Indication (Arg);
-            if Arg = Null_Iir then
-               return Null_Iir;
-            end if;
-            --  LRM93 §7.3.6
-            --  If an allocator includes a subtype indication and if the
-            --  type of the object created is an array type, then the
-            --  subtype indication must either denote a constrained
-            --  subtype or include an explicit index constraint.
-            if not Is_Fully_Constrained_Type (Arg) then
-               Error_Msg_Sem ("allocator of unconstrained " &
-                              Disp_Node (Arg) & " is not allowed", Expr);
-            end if;
-            --  LRM93 7.3.6
-            --  A subtype indication that is part of an allocator must
-            --  not include a resolution function.
-            if Is_Anonymous_Type_Definition (Arg)
-              and then Get_Resolution_Function (Arg) /= Null_Iir
-            then
-               Error_Msg_Sem ("subtype indication must not include"
-                              & " a resolution function", Expr);
-            end if;
-            Arg_Type := Arg;
-         end if;
+
+      Arg_Type := Get_Allocator_Designated_Type (Expr);
+
+      if Arg_Type = Null_Iir then
+         --  Expression was not analyzed.
+         case Iir_Kinds_Allocator (Get_Kind (Expr)) is
+            when Iir_Kind_Allocator_By_Expression =>
+               if Get_Kind (Arg) /= Iir_Kind_Qualified_Expression then
+                  raise Internal_Error;
+               end if;
+               Arg := Sem_Expression (Arg, Null_Iir);
+               if Arg = Null_Iir then
+                  return Null_Iir;
+               end if;
+               Check_Read (Arg);
+               Arg_Type := Get_Type (Arg);
+            when Iir_Kind_Allocator_By_Subtype =>
+               Arg := Sem_Types.Sem_Subtype_Indication (Arg);
+               if Arg = Null_Iir then
+                  return Null_Iir;
+               end if;
+               --  LRM93 §7.3.6
+               --  If an allocator includes a subtype indication and if the
+               --  type of the object created is an array type, then the
+               --  subtype indication must either denote a constrained
+               --  subtype or include an explicit index constraint.
+               if not Is_Fully_Constrained_Type (Arg) then
+                  Error_Msg_Sem
+                    ("allocator of unconstrained " &
+                       Disp_Node (Arg) & " is not allowed", Expr);
+               end if;
+               --  LRM93 7.3.6
+               --  A subtype indication that is part of an allocator must
+               --  not include a resolution function.
+               if Is_Anonymous_Type_Definition (Arg)
+                 and then Get_Resolution_Function (Arg) /= Null_Iir
+               then
+                  Error_Msg_Sem ("subtype indication must not include"
+                                   & " a resolution function", Expr);
+               end if;
+               Arg_Type := Arg;
+         end case;
          Set_Expression (Expr, Arg);
-      else
-         if Get_Kind (Expr) = Iir_Kind_Allocator_By_Expression then
-            Arg_Type := Get_Type (Arg);
-         else
-            Arg_Type := Arg;
-         end if;
+         Set_Allocator_Designated_Type (Expr, Arg_Type);
       end if;
 
+      --  LRM 7.3.6 Allocators
+      --  The type of the access value returned by an allocator must be
+      --  determinable solely from the context, but using the fact that the
+      --  value returned is of an access type having the named designated
+      --  type.
       if A_Type = Null_Iir then
-         --  Pass 1.
-         --  LRM 7.3.6 Allocators
-         --  The type of the access value returned by an allocator must be
-         --  determinable solely from the context, but using the fact that the
-         --  value returned is of an access type having the named designated
-         --  type.
-         declare
-            Index : Visible_Type_Index_Type;
-            Vtype : Iir;
-            Btype : Iir;
-            Dtype : Iir;
-            List : Iir_List;
-         begin
-            List := Create_Iir_List;
-            Index := Get_First_Visible_Type;
-            while Index /= No_Visible_Type_Index loop
-               Vtype := Get_Visible_Type_Decl (Index);
-               Btype := Get_Base_Type (Get_Type (Vtype));
-               if Get_Kind (Btype) = Iir_Kind_Access_Type_Definition then
-                  Dtype := Get_Base_Type (Get_Designated_Type (Btype));
-                  if Dtype = Get_Base_Type (Arg_Type) then
-                     Add_Element (List, Dtype);
-                  end if;
-               end if;
-               Index := Get_Next_Visible_Type (Index);
-            end loop;
-            Set_Type (Expr, Simplify_Overload_List (List));
-         end;
+         --  Type of the context is not yet known.
+         return Expr;
       else
-         if Get_Kind (A_Type) /= Iir_Kind_Access_Type_Definition then
-            if Get_Kind (A_Type) /= Iir_Kind_Error then
-               Error_Msg_Sem ("expected type is not an access type", Expr);
+         if not Is_Allocator_Type (A_Type, Expr) then
+            if Get_Kind (A_Type) /= Iir_Kind_Access_Type_Definition then
+               if Get_Kind (A_Type) /= Iir_Kind_Error then
+                  Error_Msg_Sem ("expected type is not an access type", Expr);
+               end if;
+            else
+               Not_Match (Expr, A_Type);
             end if;
             return Null_Iir;
          end if;
-         if not Are_Types_Compatible (Arg_Type, Get_Designated_Type (A_Type))
-         then
-            Not_Match (Expr, A_Type);
-            return Null_Iir;
-         end if;
-         Free_Old_Iir (Get_Type (Expr));
          Set_Type (Expr, A_Type);
+         return Expr;
       end if;
-      return Expr;
    end Sem_Allocator;
 
    procedure Check_Read_Aggregate (Aggr : Iir)
@@ -3810,87 +3830,31 @@ package body Sem_Expr is
 
          when Iir_Kind_String_Literal
            | Iir_Kind_Bit_String_Literal =>
-            if A_Type /= Null_Iir then
-               if not Check_Type_For_String_Literal (A_Type, Expr) then
-                  Not_Match (Expr, A_Type);
-                  return Null_Iir;
-               end if;
-               -- It is enough ?
-               -- FIXME: check against LRM.
+            --  LRM93 7.3.1 Literals
+            --  The type of a string or bit string literal must be
+            --  determinable solely from the context in whcih the literal
+            --  appears, excluding the literal itself [...]
+            if A_Type = Null_Iir then
+               return Expr;
+            end if;
+
+            if not Is_String_Literal_Type (A_Type, Expr) then
+               Not_Match (Expr, A_Type);
+               return Null_Iir;
+            else
                Replace_Type (Expr, A_Type);
                Sem_String_Literal (Expr);
                return Expr;
             end if;
 
-            -- Look on every visible declaration of unidimensional array.
-            declare
-               Vt: Visible_Type_Index_Type;
-               Vt_Type : Iir;
-               Decl: Iir;
-               List: Iir_List;
-            begin
-               Vt := Get_First_Visible_Type;
-               List := Create_Iir_List;
-               while Vt /= No_Visible_Type_Index loop
-                  Vt_Type := Get_Type (Get_Visible_Type_Decl (Vt));
-                  Decl := Get_Base_Type (Vt_Type);
-                  if Check_Type_For_String_Literal (Decl, Expr) then
-                     Append_Element (List, Decl);
-                  end if;
-                  Vt := Get_Next_Visible_Type (Vt);
-               end loop;
-               case Get_Nbr_Elements (List) is
-                  when 0 =>
-                     Destroy_Iir_List (List);
-                     Error_Msg_Sem
-                       ("no character type for string literal", Expr);
-                     return Null_Iir;
-                  when 1 =>
-                     Set_Type (Expr, Get_First_Element (List));
-                     Destroy_Iir_List (List);
-                     Sem_String_Literal (Expr);
-                     return Expr;
-                  when others =>
-                     Set_Type (Expr, Create_Overload_List (List));
-                     return Expr;
-               end case;
-            end;
-
          when Iir_Kind_Null_Literal =>
             Set_Expr_Staticness (Expr, Locally);
+            --  GHDL: the LRM doesn't explain how the type of NULL is
+            --  determined.  Use the same rule as string or aggregates.
             if A_Type = Null_Iir then
-               declare
-                  Vt: Visible_Type_Index_Type;
-                  Vt_Type : Iir;
-                  Decl: Iir;
-                  List: Iir_List;
-               begin
-                  Vt := Get_First_Visible_Type;
-                  List := Create_Iir_List;
-                  while Vt /= No_Visible_Type_Index loop
-                     Vt_Type := Get_Type (Get_Visible_Type_Decl (Vt));
-                     Decl := Get_Base_Type (Vt_Type);
-                     if Get_Kind (Decl) = Iir_Kind_Access_Type_Definition then
-                        Append_Element (List, Decl);
-                     end if;
-                     Vt := Get_Next_Visible_Type (Vt);
-                  end loop;
-                  case Get_Nbr_Elements (List) is
-                     when 0 =>
-                        Error_Msg_Sem
-                          ("no visible access type for null literal", Expr);
-                        Destroy_Iir_List (List);
-                        return Null_Iir;
-                     when 1 =>
-                        Set_Type (Expr, Get_First_Element (List));
-                        Destroy_Iir_List (List);
-                        return Expr;
-                     when others =>
-                        Set_Type (Expr, Create_Overload_List (List));
-                        return Expr;
-                  end case;
-               end;
-            elsif Get_Kind (A_Type) /= Iir_Kind_Access_Type_Definition then
+               return Expr;
+            end if;
+            if not Is_Null_Literal_Type (A_Type) then
                Error_Msg_Sem ("null literal can only be access type", Expr);
                return Null_Iir;
             else
@@ -3898,6 +3862,17 @@ package body Sem_Expr is
                return Expr;
             end if;
 
+         when Iir_Kind_Aggregate =>
+            --  LRM93 7.3.2 Aggregates
+            --  The type of an aggregate must be determinable solely from the
+            --  context in which the aggregate appears, excluding the aggregate
+            --  itself but [...]
+            if A_Type = Null_Iir then
+               return Expr;
+            else
+               return Sem_Aggregate (Expr, A_Type);
+            end if;
+
          when Iir_Kind_Qualified_Expression =>
             declare
                N_Type: Iir;
@@ -3931,48 +3906,6 @@ package body Sem_Expr is
            | Iir_Kind_Allocator_By_Subtype =>
             return Sem_Allocator (Expr, A_Type);
 
-         when Iir_Kind_Aggregate =>
-            if A_Type = Null_Iir then
-               declare
-                  Vt: Visible_Type_Index_Type;
-                  Vt_Type : Iir;
-                  Decl: Iir;
-                  List: Iir_List;
-                  Res : Iir;
-               begin
-                  Vt := Get_First_Visible_Type;
-                  List := Create_Iir_List;
-                  while Vt /= No_Visible_Type_Index loop
-                     Vt_Type := Get_Type (Get_Visible_Type_Decl (Vt));
-                     Decl := Get_Base_Type (Vt_Type);
-                     case Get_Kind (Decl) is
-                        when Iir_Kind_Array_Type_Definition
-                          | Iir_Kind_Record_Type_Definition =>
-                           Append_Element (List, Decl);
-                        when others =>
-                           null;
-                     end case;
-                     Vt := Get_Next_Visible_Type (Vt);
-                  end loop;
-                  case Get_Nbr_Elements (List) is
-                     when 0 =>
-                        Destroy_Iir_List (List);
-                        Error_Msg_Sem
-                          ("no visible composite type for aggregate", Expr);
-                        return Null_Iir;
-                     when 1 =>
-                        Res := Sem_Aggregate (Expr, Get_First_Element (List));
-                        Destroy_Iir_List (List);
-                        return Res;
-                     when others =>
-                        Set_Type (Expr, Create_Overload_List (List));
-                        return Expr;
-                  end case;
-               end;
-            else
-               return Sem_Aggregate (Expr, A_Type);
-            end if;
-
          when Iir_Kinds_Procedure_Declaration =>
             Error_Msg_Sem
               (Disp_Node (Expr) & " cannot be used as an expression", Expr);
@@ -4027,7 +3960,7 @@ package body Sem_Expr is
             if A_Type = Null_Iir then
                Res := Sem_Expression_Ov (Expr, Null_Iir);
             else
-               if not Check_Type_For_String_Literal (A_Type, Expr) then
+               if not Is_String_Literal_Type (A_Type, Expr) then
                   Not_Match (Expr, A_Type);
                   return Null_Iir;
                end if;
@@ -4040,8 +3973,12 @@ package body Sem_Expr is
       end case;
 
       if Res /= Null_Iir and then Is_Overloaded (Res) then
+         --  FIXME: clarify between overload and not determinable from the
+         --  context.
          Error_Overload (Expr);
-         Disp_Overload_List (Get_Overload_List (Get_Type (Res)), Expr);
+         if Get_Type (Res) /= Null_Iir then
+            Disp_Overload_List (Get_Overload_List (Get_Type (Res)), Expr);
+         end if;
          return Null_Iir;
       end if;
       return Res;
@@ -4104,6 +4041,17 @@ package body Sem_Expr is
          return Null_Iir;
       end if;
       Expr_Type := Get_Type (Expr1);
+      if Expr_Type = Null_Iir then
+         --  Possible only if the type cannot be determined without the
+         --  context (aggregate or string literal).
+         Error_Msg_Sem
+           ("cannot determine the type of choice expression", Expr);
+         if Get_Kind (Expr1) = Iir_Kind_Aggregate then
+            Error_Msg_Sem
+              ("(use a qualified expression of the form T'(xxx).)", Expr);
+         end if;
+         return Null_Iir;
+      end if;
       if not Is_Overload_List (Expr_Type) then
          return Expr1;
       end if;
diff --git a/sem_expr.ads b/sem_expr.ads
index 5b56cae40..3304923c7 100644
--- a/sem_expr.ads
+++ b/sem_expr.ads
@@ -92,14 +92,6 @@ package Sem_Expr is
    --  If EXPR is NULL_IIR, NULL_IIR is silently returned.
    function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir;
 
-   -- LEFT are RIGHT must be really a type (not a subtype).
-   function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
-     return Boolean;
-
-   --  Return TRUE iif types of LEFT and RIGHT are compatible.
-   function Are_Nodes_Compatible (Left: Iir; Right: Iir)
-     return Boolean;
-
    --  Semantize a procedure_call or a concurrent_procedure_call_statement.
    procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir);
 
@@ -163,9 +155,17 @@ package Sem_Expr is
    --  one-dimensional character array type.
    procedure Sem_String_Choices_Range (Choice_Chain : Iir; Sel : Iir);
 
-   function Compatibility_Types (Left_Types : Iir; Right_Types : Iir)
+   -- LEFT are RIGHT must be really a type (not a subtype).
+   function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
      return Boolean;
 
+   --  Return TRUE iif types of LEFT and RIGHT are compatible.
+   function Are_Nodes_Compatible (Left: Iir; Right: Iir)
+     return Boolean;
+
+   --  Return TRUE iff the type of EXPR is compatible with A_TYPE
+   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir) return Boolean;
+
    --  LIST1, LIST2 are either a type node or an overload list of types.
    --  Return THE type which is compatible with LIST1 are LIST2.
    --  Return null_iir if there is no such type or if there are several types.
diff --git a/sem_names.adb b/sem_names.adb
index f56dabcb6..31de9a8d5 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -1998,6 +1998,13 @@ package body Sem_Names is
             when Iir_Kinds_Function_Declaration =>
                Sem_Parenthesis_Function (Prefix);
                if Res = Null_Iir then
+                  declare
+                     Match : Boolean;
+                  begin
+                     Sem_Association_Chain
+                       (Get_Interface_Declaration_Chain (Prefix),
+                        Assoc_Chain, True, Missing_Parameter, Name, Match);
+                  end;
                   Error_Msg_Sem
                     ("prefix is neither a function name "
                      & "nor can it be sliced or indexed", Name);
diff --git a/sem_scopes.adb b/sem_scopes.adb
index ab7dbef17..c5483e49e 100644
--- a/sem_scopes.adb
+++ b/sem_scopes.adb
@@ -32,9 +32,6 @@ package body Sem_Scopes is
    procedure Disp_Scopes;
    pragma Unreferenced (Disp_Scopes);
 
-   procedure Disp_Visible_Types;
-   pragma Unreferenced (Disp_Visible_Types);
-
    procedure Disp_Detailed_Interpretations (Ident : Name_Id);
    pragma Unreferenced (Disp_Detailed_Interpretations);
 
@@ -90,18 +87,6 @@ package body Sem_Scopes is
       Id: Name_Id;
    end record;
 
-   type Visible_Type_Cell is record
-      Id: Name_Id;
-      Decl: Iir;
-   end record;
-
-   package Visible_Types is new GNAT.Table
-     (Table_Component_Type => Visible_Type_Cell,
-      Table_Index_Type => Visible_Type_Index_Type,
-      Table_Low_Bound => No_Visible_Type_Index + 1,
-      Table_Initial => 32,
-      Table_Increment => 10);
-
    package Interpretations is new GNAT.Table
      (Table_Component_Type => Interpretation_Cell,
       Table_Index_Type => Name_Interpretation_Type,
@@ -119,8 +104,6 @@ package body Sem_Scopes is
    -- Index into Interpretations marking the last interpretation of
    -- the previous (immediate) declarative region.
    Current_Scope_Start: Name_Interpretation_Type := No_Name_Interpretation;
-   Current_Composite_Types_Start : Visible_Type_Index_Type :=
-     No_Visible_Type_Index;
 
    function Valid_Interpretation (Inter : Name_Interpretation_Type)
                                  return Boolean is
@@ -206,7 +189,7 @@ package body Sem_Scopes is
       Scopes.Increment_Last;
       Scopes.Table (Scopes.Last) := (Kind => Region_Start,
                                      Inter => Current_Scope_Start,
-                                     Id => Name_Id (Visible_Types.Last));
+                                     Id => Null_Identifier);
       Current_Scope_Start := Interpretations.Last;
    end Open_Declarative_Region;
 
@@ -221,8 +204,6 @@ package body Sem_Scopes is
                Interpretations.Set_Last (Current_Scope_Start);
                --  Restore Current_Scope_Start.
                Current_Scope_Start := Scopes.Table (Scopes.Last).Inter;
-               Visible_Types.Set_Last
-                 (Visible_Type_Index_Type (Scopes.Table (Scopes.Last).Id));
                Scopes.Decrement_Last;
                return;
             when Save_Cell =>
@@ -315,14 +296,13 @@ package body Sem_Scopes is
       Scopes.Table (Scopes.Last) :=
         (Kind => Barrier_End,
          Inter => Interpretations.Last,
-         Id => Name_Id (Current_Composite_Types_Start));
+         Id => Null_Identifier);
 
       -- Start a completly new scope.
       Current_Scope_Start := Interpretations.Last + 1;
 
       -- Keep the last barrier.
       Current_Barrier := Scopes.Last + 1;
-      Current_Composite_Types_Start := Visible_Types.Last;
 
       pragma Debug (Name_Table.Assert_No_Infos);
    end Push_Interpretations;
@@ -344,8 +324,6 @@ package body Sem_Scopes is
 
       -- Restore the stack pointer of interpretations.
       Interpretations.Set_Last (Scopes.Table (Scopes.Last).Inter);
-      Current_Composite_Types_Start :=
-        Visible_Type_Index_Type (Scopes.Table (Scopes.Last).Id);
       Scopes.Decrement_Last;
 
       -- Restore all name interpretations.
@@ -397,78 +375,6 @@ package body Sem_Scopes is
       end case;
    end Is_Overloadable;
 
-   -- Return true if DECL declare a type that is visible.
-   --  This is used to build the list of visible types, ie types that must
-   --  be considered for certains expression: access for NULL literals,
-   --  arrays and records for aggregates, arrays for string literals.
---    function Is_Visible_Type (Decl: Iir) return Boolean
---    is
---       Def: Iir;
---    begin
---       case Get_Kind (Decl) is
---          when Iir_Kind_Array_Type_Definition
---            | Iir_Kind_Array_Subtype_Definition =>
---             raise Internal_Error;
---          when Iir_Kind_Type_Declaration =>
---             Def := Get_Type (Decl);
---          when others =>
---             return False;
---       end case;
---       case Get_Kind (Def) is
---          when Iir_Kind_Array_Type_Definition
---            | Iir_Kind_Array_Subtype_Definition =>
---             return True;
---          when Iir_Kind_Record_Type_Definition =>
---             return True;
---          when Iir_Kind_Access_Type_Definition
---            | Iir_Kind_Access_Subtype_Definition =>
---             return True;
---          when others =>
---             return False;
---       end case;
---    end Is_Visible_Type;
-
-   function Get_Visible_Type (Vt: Visible_Type_Index_Type)
-     return Visible_Type_Index_Type
-   is
-      Pt: Visible_Type_Index_Type := Vt;
-   begin
-      if True then
-         return Pt;
-      else
-         while Pt > Current_Composite_Types_Start loop
-            if Get_Declaration
-              (Get_Interpretation (Visible_Types.Table (Pt).Id))
-              = Visible_Types.Table (Pt).Decl
-            then
-               return Pt;
-            end if;
-            Pt := Pt - 1;
-         end loop;
-         return No_Visible_Type_Index;
-      end if;
-   end Get_Visible_Type;
-
-   -- Get the first visible declaration of unidim array.
-   function Get_First_Visible_Type return Visible_Type_Index_Type is
-   begin
-      return Get_Visible_Type (Visible_Types.Last);
-   end Get_First_Visible_Type;
-
-   -- Get the next visible declaration of unidim array in the list.
-   function Get_Next_Visible_Type (Index: Visible_Type_Index_Type)
-     return Visible_Type_Index_Type is
-   begin
-      return Get_Visible_Type (Index - 1);
-   end Get_Next_Visible_Type;
-
-   -- Get the declaration corresponding to an uni_array_visible_type.
-   function Get_Visible_Type_Decl (Index : Visible_Type_Index_Type)
-     return Iir is
-   begin
-      return Visible_Types.Table (Index).Decl;
-   end Get_Visible_Type_Decl;
-
    -- Return TRUE if INTER was made direclty visible in the current
    -- declarative region.
    function Is_In_Current_Declarative_Region (Inter: Name_Interpretation_Type)
@@ -510,11 +416,6 @@ package body Sem_Scopes is
 --       end case;
 --    end Redeclaration_Allowed;
 
-   procedure Add_Visible_Type (Decl : Iir) is
-   begin
-      Visible_Types.Append ((Id => Get_Identifier (Decl), Decl => Decl));
-   end Add_Visible_Type;
-
    -- Add interpretation DECL to the identifier of DECL.
    -- POTENTIALLY is true if the identifier comes from a use clause.
    procedure Add_Name (Decl: Iir; Ident: Name_Id; Potentially: Boolean)
@@ -973,11 +874,8 @@ package body Sem_Scopes is
          when Iir_Kind_Library_Clause =>
             Add_Name (Get_Library_Declaration (Decl),
                       Get_Identifier (Decl), Potentially);
-         when Iir_Kind_Type_Declaration =>
-            Add_Name (Decl, Get_Identifier (Decl), Potentially);
-            Add_Visible_Type (Decl);
          when Iir_Kind_Anonymous_Type_Declaration =>
-            Add_Visible_Type (Decl);
+            null;
          when others =>
             Add_Name (Decl, Get_Identifier (Decl), Potentially);
       end case;
@@ -1157,18 +1055,6 @@ package body Sem_Scopes is
    end Extend_Scope_Of_Block_Declarations;
 
    -- Debugging
-   procedure Disp_Visible_Types
-   is
-      use Ada.Text_IO;
-      Index: Visible_Type_Index_Type;
-   begin
-      Index := Get_First_Visible_Type;
-      while Index /= No_Visible_Type_Index loop
-         Put_Line (Disp_Node (Get_Visible_Type_Decl (Index)));
-         Index := Get_Next_Visible_Type (Index);
-      end loop;
-   end Disp_Visible_Types;
-
    procedure Disp_Detailed_Interpretations (Ident : Name_Id)
    is
       use Ada.Text_IO;
diff --git a/sem_scopes.ads b/sem_scopes.ads
index b8f7664de..7126d388c 100644
--- a/sem_scopes.ads
+++ b/sem_scopes.ads
@@ -53,9 +53,6 @@ package Sem_Scopes is
    --  Set the visible_flag of DECL to true.
    procedure Name_Visible (Decl : Iir);
 
-   --  Add DECL is the list of visible types.
-   procedure Add_Visible_Type (Decl : Iir);
-
    --  Replace the interpretation OLD of ID by DECL.
    --  ID must have a uniq interpretation OLD (ie, it must not be overloaded).
    --  The interpretation must have been done in the current scope.
@@ -181,31 +178,6 @@ package Sem_Scopes is
    --  declarations added can be removed with Close_Scope_Extension.
    procedure Extend_Scope_Of_Block_Declarations (Decl : Iir);
 
-   -- It is necessary to keep trace of all visible type definition of
-   -- arrays, record and access.  This is used by string, bit string, aggregate
-   -- and null literal.
-   -- This is for the user a simple linked list.
-
-   -- list element type.
-   type Visible_Type_Index_Type is private;
-
-   -- End of the list element.
-   No_Visible_Type_Index: constant Visible_Type_Index_Type;
-
-   -- Get the first visible type declaration.
-   function Get_First_Visible_Type return Visible_Type_Index_Type;
-   pragma Inline (Get_First_Visible_Type);
-
-   -- Get the visible type declaration after INDEX.
-   function Get_Next_Visible_Type (Index: Visible_Type_Index_Type)
-     return Visible_Type_Index_Type;
-   pragma Inline (Get_Next_Visible_Type);
-
-   -- Get the declaration corresponding to INDEX.
-   function Get_Visible_Type_Decl (Index: Visible_Type_Index_Type)
-     return Iir;
-   pragma Inline (Get_Visible_Type_Decl);
-
    --  Call HANDLE_DECL for each declaration found in DECL.
    --  This will generally call HANDLE_DECL with DECL.
    --  For types, HANDLE_DECL is first called with the type declaration, then
@@ -235,7 +207,4 @@ private
    No_Name_Interpretation : constant Name_Interpretation_Type := 0;
    Conflict_Interpretation : constant Name_Interpretation_Type := 1;
    First_Valid_Interpretation : constant Name_Interpretation_Type := 2;
-
-   type Visible_Type_Index_Type is new Nat32;
-   No_Visible_Type_Index: constant Visible_Type_Index_Type := 0;
 end Sem_Scopes;
diff --git a/tokens.adb b/tokens.adb
index ffbad10be..415486cab 100644
--- a/tokens.adb
+++ b/tokens.adb
@@ -105,11 +105,14 @@ package body Tokens is
             return "+";
          when Tok_Minus =>
             return "-";
-            -- and adding_operator
+         -- and adding_operator
          when Tok_Ampersand =>
             return "&";
 
-            -- multiplying operator
+         when Tok_Condition =>
+            return "??";
+
+         -- multiplying operator
          when Tok_Star =>
             return "*";
          when Tok_Slash =>
@@ -119,7 +122,7 @@ package body Tokens is
          when Tok_Rem =>
             return "rem";
 
-            -- relation token:
+         -- relation token:
          when Tok_And =>
             return "and";
          when Tok_Or =>
@@ -133,7 +136,7 @@ package body Tokens is
          when Tok_Xnor =>
             return "xnor";
 
-            -- Key words.
+         -- Reserved words.
          when Tok_Abs =>
             return "abs";
          when Tok_Access =>
diff --git a/tokens.ads b/tokens.ads
index 41b50f24d..bb431b95a 100644
--- a/tokens.ads
+++ b/tokens.ads
@@ -70,6 +70,8 @@ package Tokens is
    -- and adding_operator
        Tok_Ampersand,           -- &
 
+       Tok_Condition,
+
    --  PSL
        Tok_And_And,             -- &&
        Tok_Bar_Bar,             -- ||