Preliminary work to refine overload disambiguation.

7 files changed, 152 insertions, 97 deletions

diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 0540242e3..12ec15c3a 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -354,7 +354,7 @@ package body Sem is
      (Inter_Parent : Iir; Assoc_Parent : Iir) return Boolean
    is
       El : Iir;
-      Match : Boolean;
+      Match : Compatibility_Level;
       Assoc_Chain : Iir;
       Inter_Chain : Iir;
       Miss : Missing_Type;
@@ -418,7 +418,7 @@ package body Sem is
       Sem_Association_Chain
         (Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match);
       Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
-      if not Match then
+      if Match = Not_Compatible then
          return False;
       end if;
 
@@ -461,7 +461,7 @@ package body Sem is
       Actual : Iir;
       Prefix : Iir;
       Object : Iir;
-      Match : Boolean;
+      Match : Compatibility_Level;
       Assoc_Chain : Iir;
       Miss : Missing_Type;
       Inter : Iir;
@@ -506,7 +506,7 @@ package body Sem is
       Sem_Association_Chain (Get_Port_Chain (Inter_Parent), Assoc_Chain,
                              True, Miss, Assoc_Parent, Match);
       Set_Port_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
-      if not Match then
+      if Match = Not_Compatible then
          return;
       end if;
 
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 492e79a55..f75a1fb41 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -21,7 +21,6 @@ with Flags; use Flags;
 with Types; use Types;
 with Iirs_Utils; use Iirs_Utils;
 with Sem_Names; use Sem_Names;
-with Sem_Expr; use Sem_Expr;
 with Iir_Chains; use Iir_Chains;
 with Xrefs;
 
@@ -1277,7 +1276,7 @@ package body Sem_Assocs is
      (Assoc : Iir;
       Inter : Iir;
       Finish : Boolean;
-      Match : out Boolean)
+      Match : out Compatibility_Level)
    is
       Formal : Iir;
       Assoc_Kind : Param_Assoc_Type;
@@ -1287,7 +1286,7 @@ package body Sem_Assocs is
       if Formal /= Null_Iir then
          Assoc_Kind := Sem_Formal (Formal, Inter);
          if Assoc_Kind = None then
-            Match := False;
+            Match := Not_Compatible;
             return;
          end if;
          Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole);
@@ -1298,7 +1297,7 @@ package body Sem_Assocs is
             if Get_Kind (Formal) in Iir_Kinds_Denoting_Name
               and then Is_Error (Get_Named_Entity (Formal))
             then
-               Match := False;
+               Match := Not_Compatible;
                return;
             end if;
 
@@ -1313,28 +1312,32 @@ package body Sem_Assocs is
       else
          Set_Whole_Association_Flag (Assoc, True);
       end if;
-      Match := True;
+      Match := Fully_Compatible;
    end Sem_Association_Open;
 
    procedure Sem_Association_Package
      (Assoc : Iir;
       Inter : Iir;
       Finish : Boolean;
-      Match : out Boolean)
+      Match : out Compatibility_Level)
    is
       Formal : constant Iir := Get_Formal (Assoc);
       Actual : Iir;
       Package_Inter : Iir;
    begin
       if not Finish then
-         Match := Get_Associated_Interface (Assoc) = Inter;
+         if Get_Associated_Interface (Assoc) = Inter then
+            Match := Fully_Compatible;
+         else
+            Match := Not_Compatible;
+         end if;
          return;
       end if;
 
       --  Always match (as this is a generic association, there is no
       --  need to resolve overload).
       pragma Assert (Get_Associated_Interface (Assoc) = Inter);
-      Match := True;
+      Match := Fully_Compatible;
 
       if Formal /= Null_Iir then
          pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name);
@@ -1398,7 +1401,7 @@ package body Sem_Assocs is
      (Assoc : Iir;
       Inter : Iir;
       Finish : Boolean;
-      Match : out Boolean)
+      Match : out Compatibility_Level)
    is
       Formal : Iir;
       Formal_Type : Iir;
@@ -1414,7 +1417,7 @@ package body Sem_Assocs is
       if Formal /= Null_Iir then
          Assoc_Kind := Sem_Formal (Formal, Inter);
          if Assoc_Kind = None then
-            Match := False;
+            Match := Not_Compatible;
             return;
          end if;
          Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole);
@@ -1457,20 +1460,18 @@ package body Sem_Assocs is
       if Out_Conv = Null_Iir and then In_Conv = Null_Iir then
          Match := Is_Expr_Compatible (Formal_Type, Actual);
       else
-         Match := True;
+         Match := Fully_Compatible;
          if In_Conv /= Null_Iir then
-            if not Is_Expr_Compatible (Formal_Type, In_Conv) then
-               Match := False;
-            end if;
+            Match := Compatibility_Level'Min
+              (Match, Is_Expr_Compatible (Formal_Type, In_Conv));
          end if;
          if Out_Conv /= Null_Iir then
-            if not Is_Expr_Compatible (Get_Type (Out_Conv), Actual) then
-               Match := False;
-            end if;
+            Match := Compatibility_Level'Min
+              (Match, Is_Expr_Compatible (Get_Type (Out_Conv), Actual));
          end if;
       end if;
 
-      if not Match then
+      if Match = Not_Compatible then
          if Finish then
             Error_Msg_Sem
               ("can't associate " & Disp_Node (Actual) & " with "
@@ -1512,7 +1513,7 @@ package body Sem_Assocs is
 
       if Res_Type = Null_Iir then
          --  In case of error, do not go farther.
-         Match := False;
+         Match := Not_Compatible;
          return;
       end if;
 
@@ -1586,8 +1587,10 @@ package body Sem_Assocs is
 
    --  Associate ASSOC with interface INTERFACE
    --  This sets MATCH.
-   procedure Sem_Association
-     (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Boolean) is
+   procedure Sem_Association (Assoc : Iir;
+                              Inter : Iir;
+                              Finish : Boolean;
+                              Match : out Compatibility_Level) is
    begin
       case Get_Kind (Assoc) is
          when Iir_Kind_Association_Element_Open =>
@@ -1610,14 +1613,14 @@ package body Sem_Assocs is
       Finish: Boolean;
       Missing : Missing_Type;
       Loc : Iir;
-      Match : out Boolean)
+      Match : out Compatibility_Level)
    is
       --  Set POS and INTERFACE to *the* matching interface if any of ASSOC.
       procedure Search_Interface (Assoc : Iir;
                                   Inter : out Iir;
                                   Pos : out Integer)
       is
-         I_Match : Boolean;
+         I_Match : Compatibility_Level;
       begin
          Inter := Interface_Chain;
          Pos := 0;
@@ -1626,7 +1629,7 @@ package body Sem_Assocs is
             -- be a conversion function, or even an indexed or
             -- selected name.
             Sem_Association (Assoc, Inter, False, I_Match);
-            if I_Match then
+            if I_Match /= Not_Compatible then
                return;
             end if;
             Inter := Get_Chain (Inter);
@@ -1650,7 +1653,7 @@ package body Sem_Assocs is
       Pos_1 : Integer;
       Assoc_1 : Iir;
    begin
-      Match := True;
+      Match := Fully_Compatible;
       Has_Individual := False;
 
       -- Loop on every assoc element, try to match it.
@@ -1668,7 +1671,7 @@ package body Sem_Assocs is
                --  Sem_Actual_Of_Association_Chain (because it is called only
                --  once, while sem_association_chain may be called several
                --  times).
-               Match := False;
+               Match := Not_Compatible;
                return;
             end if;
             -- Try to match actual of ASSOC with the interface.
@@ -1677,11 +1680,11 @@ package body Sem_Assocs is
                   Error_Msg_Sem
                     ("too many actuals for " & Disp_Node (Loc), Assoc);
                end if;
-               Match := False;
+               Match := Not_Compatible;
                return;
             end if;
             Sem_Association (Assoc, Inter, Finish, Match);
-            if not Match then
+            if Match = Not_Compatible then
                return;
             end if;
             if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
@@ -1752,7 +1755,7 @@ package body Sem_Assocs is
                         Error_Msg_Sem
                           (Disp_Node (Inter) & " already associated", Assoc);
                      end if;
-                     Match := False;
+                     Match := Not_Compatible;
                      return;
                   end if;
                else
@@ -1766,7 +1769,7 @@ package body Sem_Assocs is
                         Error_Msg_Sem
                           ("non consecutive individual association for "
                            & Disp_Node (Inter), Assoc);
-                        Match := False;
+                        Match := Not_Compatible;
                         return;
                      end if;
                      Last_Individual := Inter;
@@ -1775,14 +1778,14 @@ package body Sem_Assocs is
                      if Finish then
                         Error_Msg_Sem
                           (Disp_Node (Inter) & " already associated", Assoc);
-                        Match := False;
+                        Match := Not_Compatible;
                         return;
                      end if;
                   end if;
                end if;
                if Finish then
                   Sem_Association (Assoc, Inter, True, Match);
-                  --  MATCH can be false du to errors.
+                  --  MATCH can be Not_Compatible due to errors.
                end if;
             else
                -- Not found.
@@ -1793,7 +1796,7 @@ package body Sem_Assocs is
                     ("no interface for " & Disp_Node (Get_Formal (Assoc))
                      & " in association", Assoc);
                end if;
-               Match := False;
+               Match := Not_Compatible;
                return;
             end if;
          end if;
@@ -1849,7 +1852,7 @@ package body Sem_Assocs is
                               Error_Msg_Sem
                                 ("no actual for " & Disp_Node (Inter), Loc);
                            end if;
-                           Match := False;
+                           Match := Not_Compatible;
                            return;
                         when Missing_Port =>
                            case Get_Mode (Inter) is
@@ -1860,7 +1863,7 @@ package body Sem_Assocs is
                                  Error_Msg_Sem
                                    (Disp_Node (Inter)
                                       & " of mode IN must be connected", Loc);
-                                 Match := False;
+                                 Match := Not_Compatible;
                                  return;
                               when Iir_Out_Mode
                                 | Iir_Linkage_Mode
@@ -1875,7 +1878,7 @@ package body Sem_Assocs is
                                     Error_Msg_Sem
                                       ("unconstrained " & Disp_Node (Inter)
                                          & " must be connected", Loc);
-                                    Match := False;
+                                    Match := Not_Compatible;
                                     return;
                                  end if;
                               when Iir_Unknown_Mode =>
@@ -1888,7 +1891,7 @@ package body Sem_Assocs is
                when Iir_Kind_Interface_Package_Declaration =>
                   Error_Msg_Sem
                     (Disp_Node (Inter) & " must be associated", Loc);
-                  Match := False;
+                  Match := Not_Compatible;
                when others =>
                   Error_Kind ("sem_association_chain", Inter);
             end case;
diff --git a/src/vhdl/sem_assocs.ads b/src/vhdl/sem_assocs.ads
index ec460e0e3..b1f978c73 100644
--- a/src/vhdl/sem_assocs.ads
+++ b/src/vhdl/sem_assocs.ads
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with Iirs; use Iirs;
+with Sem_Expr; use Sem_Expr;
 
 package Sem_Assocs is
    --  Change the kind of association corresponding to non-object interfaces.
@@ -44,7 +45,7 @@ package Sem_Assocs is
       Finish: Boolean;
       Missing : Missing_Type;
       Loc : Iir;
-      Match : out Boolean);
+      Match : out Compatibility_Level);
 
    --  Do port Sem_Association_Chain checks for subprograms.
    procedure Check_Subprogram_Associations
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index dc24d597c..cb7b9cf76 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -127,19 +127,43 @@ package body Sem_Expr is
 
    -- LEFT are RIGHT must be really a type (not a subtype).
    function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
-     return Boolean is
+     return Compatibility_Level is
    begin
-      return Get_Common_Basetype (Left, Right) /= Null_Iir;
+      if Left = Right then
+         return Fully_Compatible;
+      end if;
+      case Get_Kind (Left) is
+         when Iir_Kind_Integer_Type_Definition =>
+            if Right = Convertible_Integer_Type_Definition then
+               return Via_Conversion;
+            elsif Left = Convertible_Integer_Type_Definition
+              and then Get_Kind (Right) = Iir_Kind_Integer_Type_Definition
+            then
+               return Via_Conversion;
+            end if;
+         when Iir_Kind_Floating_Type_Definition =>
+            if Right = Convertible_Real_Type_Definition then
+               return Via_Conversion;
+            elsif Left = Convertible_Real_Type_Definition
+              and then Get_Kind (Right) = Iir_Kind_Floating_Type_Definition
+            then
+               return Via_Conversion;
+            end if;
+         when others =>
+            null;
+      end case;
+      return Not_Compatible;
    end Are_Basetypes_Compatible;
 
-   function Are_Types_Compatible (Left: Iir; Right: Iir) return Boolean is
+   function Are_Types_Compatible (Left: Iir; Right: Iir)
+                                 return Compatibility_Level is
    begin
-      return Get_Common_Basetype (Get_Base_Type (Left),
-                                  Get_Base_Type (Right)) /= Null_Iir;
+      return Are_Basetypes_Compatible (Get_Base_Type (Left),
+                                       Get_Base_Type (Right));
    end Are_Types_Compatible;
 
    function Are_Nodes_Compatible (Left: Iir; Right: Iir)
-     return Boolean is
+                                 return Compatibility_Level is
    begin
       return Are_Types_Compatible (Get_Type (Left), Get_Type (Right));
    end Are_Nodes_Compatible;
@@ -147,23 +171,27 @@ package body Sem_Expr is
    --  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
+                                 return Compatibility_Level
    is
       El : Iir;
       Right_List : Iir_List;
+      Level : Compatibility_Level;
    begin
       pragma Assert (not Is_Overload_List (Left_Type));
 
       if Is_Overload_List (Right_Types) then
          Right_List := Get_Overload_List (Right_Types);
+         Level := Not_Compatible;
          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;
+            Level := Compatibility_Level'Max
+              (Level, Are_Types_Compatible (Left_Type, El));
+            if Level = Fully_Compatible then
+               return Fully_Compatible;
             end if;
          end loop;
-         return False;
+         return Level;
       else
          return Are_Types_Compatible (Left_Type, Right_Types);
       end if;
@@ -174,7 +202,7 @@ package body Sem_Expr is
    --  Type of RIGHT can be an overload_list
    --  RIGHT might be implicitly converted to LEFT.
    function Compatibility_Nodes (Left : Iir; Right : Iir)
-     return Boolean
+     return Compatibility_Level
    is
       Left_Type, Right_Type : Iir;
    begin
@@ -275,9 +303,11 @@ package body Sem_Expr is
    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
+   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir)
+                               return Compatibility_Level
    is
       Expr_Type : constant Iir := Get_Type (Expr);
+      Is_Compatible : Boolean;
    begin
       if Expr_Type /= Null_Iir then
          return Compatibility_Types1 (A_Type, Expr_Type);
@@ -285,21 +315,26 @@ package body Sem_Expr is
 
       case Get_Kind (Expr) is
          when Iir_Kind_Aggregate =>
-            return Is_Aggregate_Type (A_Type);
+            Is_Compatible := Is_Aggregate_Type (A_Type);
          when Iir_Kind_String_Literal8 =>
-            return Is_String_Literal_Type (A_Type, Expr);
+            Is_Compatible := Is_String_Literal_Type (A_Type, Expr);
          when Iir_Kind_Null_Literal =>
-            return Is_Null_Literal_Type (A_Type);
+            Is_Compatible := Is_Null_Literal_Type (A_Type);
          when Iir_Kind_Allocator_By_Expression
            | Iir_Kind_Allocator_By_Subtype =>
-            return Is_Allocator_Type (A_Type, Expr);
+            Is_Compatible := Is_Allocator_Type (A_Type, Expr);
          when Iir_Kind_Parenthesis_Expression =>
             return Is_Expr_Compatible (A_Type, Get_Expression (Expr));
          when others =>
             --  Error while EXPR was typed.  FIXME: should create an ERROR
             --  node?
-            return False;
+            Is_Compatible := False;
       end case;
+      if Is_Compatible then
+         return Fully_Compatible;
+      else
+         return Not_Compatible;
+      end if;
    end Is_Expr_Compatible;
 
    function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir
@@ -556,17 +591,17 @@ package body Sem_Expr is
             Expr_Type := Search_Compatible_Type (Left_Type, Right_Type);
             if Expr_Type = Null_Iir then
                if Compatibility_Types1 (Universal_Integer_Type_Definition,
-                                        Left_Type)
+                                        Left_Type) /= Not_Compatible
                  and then
                  Compatibility_Types1 (Universal_Integer_Type_Definition,
-                                       Right_Type)
+                                       Right_Type) /= Not_Compatible
                then
                   Expr_Type := Universal_Integer_Type_Definition;
                elsif Compatibility_Types1 (Universal_Real_Type_Definition,
-                                           Left_Type)
+                                           Left_Type) /= Not_Compatible
                  and then
                  Compatibility_Types1 (Universal_Real_Type_Definition,
-                                       Right_Type)
+                                       Right_Type) /= Not_Compatible
                then
                   Expr_Type := Universal_Real_Type_Definition;
                else
@@ -603,7 +638,7 @@ package body Sem_Expr is
             --  FIXME: resolve overload
             raise Internal_Error;
          else
-            if not Are_Types_Compatible (Expr_Type, A_Type) then
+            if Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible then
                Error_Msg_Sem
                  ("type of range doesn't match expected type", Expr);
                return Null_Iir;
@@ -621,7 +656,7 @@ package body Sem_Expr is
                                       Get_Expr_Staticness (Right)));
 
       if A_Type /= Null_Iir
-        and then not Are_Types_Compatible (Expr_Type, A_Type)
+        and then Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible
       then
          Error_Msg_Sem ("type of range doesn't match expected type", Expr);
          return Null_Iir;
@@ -735,8 +770,9 @@ package body Sem_Expr is
 
          Res_Type := Res;
          if A_Type /= Null_Iir
-           and then (not Are_Types_Compatible
-                       (A_Type, Get_Type_Of_Subtype_Indication (Res)))
+           and then (Are_Types_Compatible
+                       (A_Type, Get_Type_Of_Subtype_Indication (Res))
+                       = Not_Compatible)
          then
             --  A_TYPE is known when analyzing an index_constraint within
             --  a subtype indication.
@@ -1186,7 +1222,7 @@ package body Sem_Expr is
       Inter_Chain : Iir;
       Res_Type: Iir_List;
       Inter: Iir;
-      Match : Boolean;
+      Match : Compatibility_Level;
    begin
       --  Sem_Name has gathered all the possible names for the prefix of this
       --  call.  Reduce this list to only names that match the types.
@@ -1217,12 +1253,13 @@ package body Sem_Expr is
 
          --  Keep this interpretation only if compatible.
          if A_Type = Null_Iir
-           or else Compatibility_Nodes (A_Type, Get_Return_Type (A_Func))
+           or else (Compatibility_Nodes (A_Type, Get_Return_Type (A_Func))
+                      /= Not_Compatible)
          then
             Sem_Association_Chain
               (Get_Interface_Declaration_Chain (A_Func),
                Assoc_Chain, False, Missing_Parameter, Expr, Match);
-            if Match then
+            if Match /= Not_Compatible then
                Replace_Nth_Element (Imp_List, Nbr_Inter, A_Func);
                Nbr_Inter := Nbr_Inter + 1;
             end if;
@@ -1255,9 +1292,7 @@ package body Sem_Expr is
               (Inter_Chain, Assoc_Chain,
                True, Missing_Parameter, Expr, Match);
             Set_Parameter_Association_Chain (Expr, Assoc_Chain);
-            if not Match then
-               raise Internal_Error;
-            end if;
+            pragma Assert (Match /= Not_Compatible);
             Check_Subprogram_Associations (Inter_Chain, Assoc_Chain);
             Sem_Subprogram_Call_Finish (Expr, Inter);
             return Expr;
@@ -1308,7 +1343,7 @@ package body Sem_Expr is
       Param_Chain : Iir;
       Inter: Iir;
       Assoc_Chain : Iir;
-      Match : Boolean;
+      Match : Compatibility_Level;
    begin
       if Is_Func then
          Res_Type := Get_Type (Expr);
@@ -1349,7 +1384,7 @@ package body Sem_Expr is
               (Param_Chain, Assoc_Chain,
                True, Missing_Parameter, Expr, Match);
             Set_Parameter_Association_Chain (Expr, Assoc_Chain);
-            if not Match then
+            if Match = Not_Compatible then
                --  No need to disp an error message, this is done by
                --  sem_subprogram_arguments.
                return Null_Iir;
@@ -1384,6 +1419,7 @@ package body Sem_Expr is
             exit when Inter = Null_Iir;
             if Are_Basetypes_Compatible
               (A_Type, Get_Base_Type (Get_Return_Type (Inter)))
+              /= Not_Compatible
             then
                if Res /= Null_Iir then
                   Error_Overload (Expr);
@@ -1397,6 +1433,7 @@ package body Sem_Expr is
       else
          if Are_Basetypes_Compatible
            (A_Type, Get_Base_Type (Get_Return_Type (Inter_List)))
+           /= Not_Compatible
          then
             Res := Inter_List;
          end if;
@@ -1429,7 +1466,7 @@ package body Sem_Expr is
       Sem_Association_Chain
         (Param_Chain, Assoc_Chain, True, Missing_Parameter, Expr, Match);
       Set_Parameter_Association_Chain (Expr, Assoc_Chain);
-      if not Match then
+      if Match = Not_Compatible then
          return Null_Iir;
       end if;
       Check_Subprogram_Associations (Param_Chain, Assoc_Chain);
@@ -1738,8 +1775,8 @@ package body Sem_Expr is
 
             --  Check return type.
             if Res_Type /= Null_Iir
-              and then
-              not Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
+              and then (Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
+                          = Not_Compatible)
             then
                goto Next;
             end if;
@@ -1761,12 +1798,15 @@ package body Sem_Expr is
             end if;
 
             -- Check operands.
-            if not Is_Expr_Compatible (Get_Type (Interface_Chain), Left) then
+            if Is_Expr_Compatible (Get_Type (Interface_Chain), Left)
+              = Not_Compatible
+            then
                goto Next;
             end if;
             if Arity = 2 then
-               if not Is_Expr_Compatible
-                 (Get_Type (Get_Chain (Interface_Chain)), Right)
+               if Is_Expr_Compatible (Get_Type (Get_Chain (Interface_Chain)),
+                                      Right)
+                 = Not_Compatible
                then
                   goto Next;
                end if;
@@ -1861,7 +1901,9 @@ 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 Are_Types_Compatible (Get_Return_Type (Decl), Res_Type) then
+            if Are_Types_Compatible (Get_Return_Type (Decl), Res_Type)
+              /= Not_Compatible
+            then
                if Full_Compat /= Null_Iir then
                   Error_Operator_Overload (Overload_List);
                   return Null_Iir;
@@ -2285,7 +2327,7 @@ package body Sem_Expr is
          N_Choice : Iir;
          Name1 : Iir;
       begin
-         if not Are_Types_Compatible (Range_Type, Sub_Type) then
+         if Are_Types_Compatible (Range_Type, Sub_Type) = Not_Compatible then
             Not_Match (Name, Sub_Type);
             return False;
          end if;
@@ -2825,7 +2867,7 @@ package body Sem_Expr is
          Ass_Type := Get_Type (Rec_El);
          if El_Type = Null_Iir then
             El_Type := Ass_Type;
-         elsif not Are_Types_Compatible (El_Type, Ass_Type) then
+         elsif Are_Types_Compatible (El_Type, Ass_Type) = Not_Compatible then
             Error_Msg_Sem ("elements are not of the same type", El);
             Ok := False;
          end if;
@@ -3625,7 +3667,7 @@ package body Sem_Expr is
       N_Type := Get_Type (N_Type);
       Set_Type (Expr, N_Type);
       if A_Type /= Null_Iir
-        and then not Are_Types_Compatible (A_Type, N_Type)
+        and then Are_Types_Compatible (A_Type, N_Type) = Not_Compatible
       then
          Not_Match (Expr, A_Type);
          return Null_Iir;
@@ -3903,8 +3945,8 @@ package body Sem_Expr is
                return Null_Iir;
             end if;
             if A_Type /= Null_Iir
-              and then not Are_Basetypes_Compatible
-              (A_Type, Get_Base_Type (Get_Type (Expr)))
+              and then Are_Basetypes_Compatible
+              (A_Type, Get_Base_Type (Get_Type (Expr))) = Not_Compatible
             then
                Not_Match (Expr, A_Type);
                return Null_Iir;
@@ -4051,7 +4093,7 @@ package body Sem_Expr is
          --  with A_TYPE set to NULL_IIR and results in setting the type of
          --  EXPR.
          if A_Type /= Null_Iir
-           and then not Are_Types_Compatible (Expr_Type, A_Type)
+           and then Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible
          then
             Not_Match (Expr, A_Type);
             return Null_Iir;
@@ -4278,6 +4320,7 @@ package body Sem_Expr is
             --  Only one result.  Operator "??" is not applied if the result
             --  is of type boolean.
             if Are_Types_Compatible (Get_Type (Res), Boolean_Type_Definition)
+              /= Not_Compatible
             then
                Check_Read (Res);
                return Res;
@@ -4296,7 +4339,9 @@ package body Sem_Expr is
                for I in Natural loop
                   El := Get_Nth_Element (Res_List, I);
                   exit when El = Null_Iir;
-                  if Are_Types_Compatible (El, Boolean_Type_Definition) then
+                  if Are_Types_Compatible (El, Boolean_Type_Definition)
+                    /= Not_Compatible
+                  then
                      Nbr_Booleans := Nbr_Booleans + 1;
                   end if;
                end loop;
diff --git a/src/vhdl/sem_expr.ads b/src/vhdl/sem_expr.ads
index a0422e727..ef0afadcf 100644
--- a/src/vhdl/sem_expr.ads
+++ b/src/vhdl/sem_expr.ads
@@ -160,16 +160,20 @@ package Sem_Expr is
    --  one-dimensional character array type.
    procedure Sem_String_Choices_Range (Choice_Chain : Iir; Sel : Iir);
 
+   type Compatibility_Level is
+     (Not_Compatible, Via_Conversion, Fully_Compatible);
+
    -- LEFT are RIGHT must be really a type (not a subtype).
    function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
-     return Boolean;
+     return Compatibility_Level;
 
    --  Return TRUE iif types of LEFT and RIGHT are compatible.
    function Are_Nodes_Compatible (Left: Iir; Right: Iir)
-     return Boolean;
+     return Compatibility_Level;
 
    --  Return TRUE iff the type of EXPR is compatible with A_TYPE
-   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir) return Boolean;
+   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir)
+                               return Compatibility_Level;
 
    --  LIST1, LIST2 are either a type node or an overload list of types.
    --  Return THE type which is compatible with LIST1 are LIST2.
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 62998263f..a49a7c7e2 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -2212,14 +2212,14 @@ package body Sem_Names is
       procedure Sem_Parenthesis_Function (Sub_Name : Iir) is
          Used : Boolean;
          R : Iir;
-         Match : Boolean;
+         Match : Compatibility_Level;
       begin
          Used := False;
          if Get_Kind (Sub_Name) = Iir_Kind_Function_Declaration then
             Sem_Association_Chain
               (Get_Interface_Declaration_Chain (Sub_Name),
                Assoc_Chain, False, Missing_Parameter, Name, Match);
-            if Match then
+            if Match /= Not_Compatible then
                Add_Result
                  (Res,
                   Sem_As_Function_Call (Prefix_Name, Sub_Name, Assoc_Chain));
@@ -2240,7 +2240,7 @@ package body Sem_Names is
 
       procedure Error_Parenthesis_Function (Spec : Iir)
       is
-         Match : Boolean;
+         Match : Compatibility_Level;
       begin
          Error_Msg_Sem
            ("cannot match " & Disp_Node (Prefix) & " with actuals", Name);
@@ -3518,7 +3518,8 @@ package body Sem_Names is
             if Res_Type = Null_Iir then
                return Null_Iir;
             end if;
-            if not Are_Basetypes_Compatible (Get_Base_Type (Res_Type), A_Type)
+            if Are_Basetypes_Compatible (Get_Base_Type (Res_Type), A_Type)
+              = Not_Compatible
             then
                Error_Not_Match (Res, A_Type, Name);
                return Null_Iir;
@@ -3537,6 +3538,7 @@ package body Sem_Names is
                exit when El = Null_Iir;
                if Are_Basetypes_Compatible (Get_Base_Type (Get_Type (El)),
                                             A_Type)
+                 /= Not_Compatible
                then
                   Add_Result (Res, El);
                end if;
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index 47807a068..6ac2b2e00 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -1590,7 +1590,7 @@ package body Sem_Specs is
             Assoc := Create_Iir (Iir_Kind_Association_Element_Open);
             Location_Copy (Assoc, Parent);
          else
-            if not Are_Nodes_Compatible (Comp_El, Ent_El) then
+            if Are_Nodes_Compatible (Comp_El, Ent_El) = Not_Compatible then
                if not Error then
                   Error_Msg_Sem
                     ("for default port binding of " & Disp_Node (Parent)