sem_type_conversion: rewrite.

3 files changed, 92 insertions, 77 deletions

diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index bce547087..e49cfcf8f 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -5081,34 +5081,33 @@ package body Sem_Expr is
       end if;
    end Sem_Composite_Expression;
 
-   function Sem_Expression_Universal (Expr : Iir) return Iir
+   --  EXPR must be an expression with type is an overload list.
+   --  Extract and finish the analysis of the expression that is of universal
+   --  type, if there is one and if all types are either integer types or
+   --  floating point types.
+   --  This is used to get rid of implicit conversions.
+   function Sem_Favour_Universal_Type (Expr : Iir) return Iir
    is
-      Expr1 : Iir;
-      Expr_Type : Iir;
-      El : Iir;
+      Expr_Type : constant Iir := Get_Type (Expr);
+      Type_List : constant Iir_List := Get_Overload_List (Expr_Type);
+      --  Extract kind (from the first element).
+      First_El : constant Iir := Get_First_Element (Type_List);
+      Kind : constant Iir_Kind := Get_Kind (Get_Base_Type (First_El));
       Res : Iir;
-      List : Iir_List;
+      El : Iir;
+
       It : List_Iterator;
    begin
-      Expr1 := Sem_Expression_Ov (Expr, Null_Iir);
-      if Expr1 = Null_Iir then
-         return Null_Iir;
-      end if;
-      Expr_Type := Get_Type (Expr1);
-      if Expr_Type = Null_Iir then
-         --  FIXME: improve message
-         Error_Msg_Sem (+Expr, "bad expression for a scalar");
-         return Null_Iir;
-      end if;
-      if not Is_Overload_List (Expr_Type) then
-         return Expr1;
-      end if;
-
-      List := Get_Overload_List (Expr_Type);
       Res := Null_Iir;
-      It := List_Iterate (List);
+
+      It := List_Iterate (Type_List);
       while Is_Valid (It) loop
          El := Get_Element (It);
+         if Get_Kind (Get_Base_Type (El)) /= Kind then
+            --  Must be of the same kind.
+            Res := Null_Iir;
+            exit;
+         end if;
          if El = Universal_Integer_Type_Definition
            or El = Convertible_Integer_Type_Definition
            or El = Universal_Real_Type_Definition
@@ -5117,19 +5116,37 @@ package body Sem_Expr is
             if Res = Null_Iir then
                Res := El;
             else
-               Error_Overload (Expr1);
-               Disp_Overload_List (List, Expr1);
-               return Null_Iir;
+               Res := Null_Iir;
+               exit;
             end if;
          end if;
          Next (It);
       end loop;
+
       if Res = Null_Iir then
-         Error_Overload (Expr1);
-         Disp_Overload_List (List, Expr1);
+         Error_Overload (Expr);
+         Disp_Overload_List (Type_List, Expr);
          return Null_Iir;
       end if;
-      return Sem_Expression_Ov (Expr1, Res);
+
+      return Sem_Expression_Ov (Expr, Res);
+   end Sem_Favour_Universal_Type;
+
+   function Sem_Expression_Universal (Expr : Iir) return Iir
+   is
+      Expr1 : Iir;
+      Expr_Type : Iir;
+   begin
+      Expr1 := Sem_Expression_Wildcard (Expr, Wildcard_Any_Type);
+      Expr_Type := Get_Type (Expr1);
+      if Is_Error (Expr_Type) then
+         return Null_Iir;
+      end if;
+      if not Is_Overload_List (Expr_Type) then
+         return Expr1;
+      else
+         return Sem_Favour_Universal_Type (Expr1);
+      end if;
    end Sem_Expression_Universal;
 
    function Sem_Case_Expression (Expr : Iir) return Iir
diff --git a/src/vhdl/sem_expr.ads b/src/vhdl/sem_expr.ads
index ab9718d65..696217c7b 100644
--- a/src/vhdl/sem_expr.ads
+++ b/src/vhdl/sem_expr.ads
@@ -47,7 +47,7 @@ package Sem_Expr is
    --  expression, and set its type, which is not necessary a base type.
    --  A_TYPE1 must be a base type.
    --
-   --  In case of error, it displays a message and return null.
+   --  In case of error, it displays a message and return null_iir.
    --  In case of success, it returns the analyzed expression, which can
    --  be different from EXPR (eg, a character literal is transformed into an
    --  enumeration literal).
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index b6470914d..da8637f82 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -1319,13 +1319,14 @@ package body Sem_Names is
          return Conv;
       end if;
 
-      -- LRM93 7.3.5
-      -- Furthermore, the operand of a type conversion is not allowed to be
-      -- the literal null, an allocator, an aggregate, or a string literal.
+      --  LRM93 7.3.5
+      --  Furthermore, the operand of a type conversion is not allowed to be
+      --  the literal null, an allocator, an aggregate, or a string literal.
       case Get_Kind (Actual) is
          when Iir_Kind_Null_Literal
            | Iir_Kind_Aggregate
-           | Iir_Kind_String_Literal8 =>
+           | Iir_Kind_String_Literal8
+           | Iir_Kinds_Allocator =>
             Error_Msg_Sem
               (+Actual, "%n cannot be a type conversion operand", +Actual);
             return Conv;
@@ -1334,61 +1335,58 @@ package body Sem_Names is
             Error_Msg_Sem
               (+Actual, "subtype indication not allowed in an expression");
             return Conv;
+         when Iir_Kind_Error =>
+            return Conv;
          when others =>
-            -- LRM93 7.3.5
-            -- The type of the operand of a type conversion must be
-            -- determinable independent of the context (in particular,
-            -- independent of the target type).
-            Expr := Sem_Expression_Universal (Actual);
-            if Expr = Null_Iir then
-               return Conv;
-            end if;
-            if Get_Kind (Expr) in Iir_Kinds_Allocator then
-               Error_Msg_Sem
-                 (+Expr, "%n cannot be a type conversion operand", +Expr);
-            end if;
-            Set_Expression (Conv, Expr);
+            null;
       end case;
 
+      --  LRM93 7.3.5
+      --  The type of the operand of a type conversion must be
+      --  determinable independent of the context (in particular,
+      --  independent of the target type).
+      Expr := Sem_Expression_Universal (Actual);
+      if Expr = Null_Iir then
+         return Conv;
+      end if;
+      Set_Expression (Conv, Expr);
+
       --  LRM93 7.4.1 Locally Static Primaries.
       --  9. a type conversion whose expression is a locally static expression.
       --  LRM93 7.4.2 Globally Static Primaries.
       --  14. a type conversion whose expression is a globally static
       --      expression.
-      if Expr /= Null_Iir then
-         Staticness := Get_Expr_Staticness (Expr);
-
-         --  If the type mark is not locally static, the expression cannot
-         --  be locally static.  This was clarified in VHDL 08, but a type
-         --  mark that denotes an unconstrained array type, does not prevent
-         --  the expression from being static.
-         if Get_Kind (Conv_Type) not in Iir_Kinds_Array_Type_Definition
-           or else Get_Constraint_State (Conv_Type) = Fully_Constrained
-         then
-            Staticness := Min (Staticness, Get_Type_Staticness (Conv_Type));
-         end if;
+      Staticness := Get_Expr_Staticness (Expr);
+
+      --  If the type mark is not locally static, the expression cannot
+      --  be locally static.  This was clarified in VHDL 08, but a type
+      --  mark that denotes an unconstrained array type, does not prevent
+      --  the expression from being static.
+      if Get_Kind (Conv_Type) not in Iir_Kinds_Array_Type_Definition
+        or else Get_Constraint_State (Conv_Type) = Fully_Constrained
+      then
+         Staticness := Min (Staticness, Get_Type_Staticness (Conv_Type));
+      end if;
 
-         --  LRM87 7.4 Static Expressions
-         --  A type conversion is not a locally static expression.
-         if Flags.Vhdl_Std = Vhdl_87 then
-            Staticness := Min (Globally, Staticness);
-         end if;
-         Set_Expr_Staticness (Conv, Staticness);
+      --  LRM87 7.4 Static Expressions
+      --  A type conversion is not a locally static expression.
+      if Flags.Vhdl_Std = Vhdl_87 then
+         Staticness := Min (Globally, Staticness);
+      end if;
+      Set_Expr_Staticness (Conv, Staticness);
 
-         if not Are_Types_Closely_Related (Conv_Type, Get_Type (Expr))
-         then
-            --  FIXME: should explain why the types are not closely related.
-            Error_Msg_Sem
-              (+Conv,
-               "conversion not allowed between not closely related types");
-            --  Avoid error storm in evaluation.
-            Set_Expr_Staticness (Conv, None);
-         else
-            --  Unless the type conversion appears in the formal part of an
-            --  association, the expression must be readable.
-            if not In_Formal then
-               Check_Read (Expr);
-            end if;
+      if not Are_Types_Closely_Related (Conv_Type, Get_Type (Expr)) then
+         --  FIXME: should explain why the types are not closely related.
+         Error_Msg_Sem
+           (+Conv,
+            "conversion not allowed between not closely related types");
+         --  Avoid error storm in evaluation.
+         Set_Expr_Staticness (Conv, None);
+      else
+         --  Unless the type conversion appears in the formal part of an
+         --  association, the expression must be readable.
+         if not In_Formal then
+            Check_Read (Expr);
          end if;
       end if;
       return Conv;