vhdl: linearize analyze and evaluation of concat operators.

5 files changed, 647 insertions, 360 deletions

diff --git a/src/vhdl/vhdl-evaluation.adb b/src/vhdl/vhdl-evaluation.adb
index 52b489816..1b5232767 100644
--- a/src/vhdl/vhdl-evaluation.adb
+++ b/src/vhdl/vhdl-evaluation.adb
@@ -997,126 +997,157 @@ package body Vhdl.Evaluation is
       return Build_Simple_Aggregate (Res_List, Origin, Get_Type (Left));
    end Eval_Shift_Operator;
 
-   --  Note: operands must be locally static.
-   function Eval_Concatenation
-     (Left, Right : Iir; Orig : Iir; Func : Iir_Predefined_Concat_Functions)
-     return Iir
+   --  Concatenate all the elements of OPERANDS.
+   --  The first element of OPERANDS is the rightest one, the last the
+   --  leftest one.  All the elements are concatenation operators.
+   --  All the elements are static.
+   function Eval_Concatenation (Operands : Iir_Array) return Iir
    is
+      pragma Assert (Operands'First = 1);
+      Orig : constant Iir := Operands (1);
+      Origin_Type : constant Iir := Get_Type (Orig);
+
+      Ops_Val : Iir_Array (Operands'Range);
+      Str_Lits : Iir_Array (Operands'Range);
+      Left_Op : Iir;
+      Left_Val : Iir;
+      Left_Lit : Iir;
       Res_List : Iir_Flist;
       Res_Len : Natural;
       Res_Type : Iir;
-      Origin_Type : Iir;
-      Left_Aggr, Right_Aggr : Iir;
-      Left_List, Right_List : Iir_Flist;
-      Left_Len, Right_Len : Natural;
+      Def, Left_Def : Iir_Predefined_Functions;
+      Op : Iir;
+      El : Iir;
+      El_List : Iir_Flist;
+      El_Len : Natural;
+      Err_Orig : Iir;
+
+      --  To compute the index range of the result for vhdl87.
+      Leftest_Non_Null : Iir;
+      Bounds_From_Subtype : Boolean;
    begin
-      --  Compute length of the result.
-      --  Left:
-      case Func is
-         when Iir_Predefined_Element_Array_Concat
-           | Iir_Predefined_Element_Element_Concat =>
-            Left_Len := 1;
-         when Iir_Predefined_Array_Element_Concat
-           | Iir_Predefined_Array_Array_Concat =>
-            Left_Aggr := Eval_String_Literal (Left);
-            Left_List := Get_Simple_Aggregate_List (Left_Aggr);
-            Left_Len := Get_Nbr_Elements (Left_List);
-      end case;
-      --  Right:
-      case Func is
-         when Iir_Predefined_Array_Element_Concat
-           | Iir_Predefined_Element_Element_Concat =>
-            Right_Len := 1;
-         when Iir_Predefined_Element_Array_Concat
-           | Iir_Predefined_Array_Array_Concat =>
-            Right_Aggr := Eval_String_Literal (Right);
-            Right_List := Get_Simple_Aggregate_List (Right_Aggr);
-            Right_Len := Get_Nbr_Elements (Right_List);
-      end case;
+      --  Eval operands, compute length of the result.
+      Err_Orig := Null_Iir;
+      Res_Len := 0;
+      for I in Operands'Range loop
+         Op := Operands (I);
+         Def := Get_Implicit_Definition (Get_Implementation (Op));
+         if Get_Kind (Op) = Iir_Kind_Function_Call then
+            El := Get_Actual
+              (Get_Chain (Get_Parameter_Association_Chain (Op)));
+         else
+            El := Get_Right (Op);
+         end if;
+         Ops_Val (I) := Eval_Static_Expr (El);
+         if Get_Kind (Ops_Val (I)) = Iir_Kind_Overflow_Literal then
+            Err_Orig := El;
+         else
+            case Iir_Predefined_Concat_Functions (Def) is
+               when Iir_Predefined_Array_Element_Concat
+                 | Iir_Predefined_Element_Element_Concat =>
+                  Res_Len := Res_Len + 1;
+               when Iir_Predefined_Element_Array_Concat
+                 | Iir_Predefined_Array_Array_Concat =>
+                  Str_Lits (I) := Eval_String_Literal (Ops_Val (I));
+                  El_List := Get_Simple_Aggregate_List (Str_Lits (I));
+                  Res_Len := Res_Len + Get_Nbr_Elements (El_List);
+            end case;
+         end if;
+      end loop;
+
+      Op := Operands (Operands'Last);
+      if Get_Kind (Op) = Iir_Kind_Function_Call then
+         Left_Op := Get_Actual (Get_Parameter_Association_Chain (Op));
+      else
+         Left_Op := Get_Left (Op);
+      end if;
+      Left_Val := Eval_Static_Expr (Left_Op);
+      if Get_Kind (Left_Val) = Iir_Kind_Overflow_Literal then
+         Err_Orig := Left_Op;
+      else
+         Left_Def := Def;
+         case Iir_Predefined_Concat_Functions (Left_Def) is
+            when Iir_Predefined_Element_Array_Concat
+              | Iir_Predefined_Element_Element_Concat =>
+               Res_Len := Res_Len + 1;
+            when Iir_Predefined_Array_Element_Concat
+              | Iir_Predefined_Array_Array_Concat =>
+               Left_Lit := Eval_String_Literal (Left_Val);
+               El_List := Get_Simple_Aggregate_List (Left_Lit);
+               Res_Len := Res_Len + Get_Nbr_Elements (El_List);
+         end case;
+      end if;
+
+      --  Handle overflow.
+      if Err_Orig /= Null_Iir then
+         --  Free all.
+         for I in Ops_Val'Range loop
+            Free_Eval_Static_Expr (Ops_Val (I), Operands (I));
+         end loop;
+         Free_Eval_Static_Expr (Left_Val, Left_Op);
+
+         return Build_Overflow (Err_Orig);
+      end if;
 
-      Res_Len := Left_Len + Right_Len;
       Res_List := Create_Iir_Flist (Res_Len);
+
       --  Do the concatenation.
       --  Left:
-      case Func is
+      Leftest_Non_Null := Null_Iir;
+      case Iir_Predefined_Concat_Functions (Left_Def) is
          when Iir_Predefined_Element_Array_Concat
            | Iir_Predefined_Element_Element_Concat =>
-            Set_Nth_Element (Res_List, 0, Left);
+            Set_Nth_Element (Res_List, 0, Left_Val);
+            Bounds_From_Subtype := True;
+            Res_Len := 1;
          when Iir_Predefined_Array_Element_Concat
            | Iir_Predefined_Array_Array_Concat =>
-            for I in 0 .. Left_Len - 1 loop
-               Set_Nth_Element (Res_List, I, Get_Nth_Element (Left_List, I));
+            El_List := Get_Simple_Aggregate_List (Left_Lit);
+            Res_Len := Get_Nbr_Elements (El_List);
+            for I in 0 .. Res_Len - 1 loop
+               Set_Nth_Element (Res_List, I, Get_Nth_Element (El_List, I));
             end loop;
-            Free_Eval_String_Literal (Left_Aggr, Left);
+            Bounds_From_Subtype := Def = Iir_Predefined_Array_Element_Concat;
+            if Res_Len > 0 then
+               Leftest_Non_Null := Get_Type (Left_Lit);
+            end if;
+            Free_Eval_String_Literal (Left_Lit, Left_Val);
       end case;
+
       --  Right:
-      case Func is
-         when Iir_Predefined_Array_Element_Concat
-           | Iir_Predefined_Element_Element_Concat =>
-            Set_Nth_Element (Res_List, Left_Len, Right);
-         when Iir_Predefined_Element_Array_Concat
-           | Iir_Predefined_Array_Array_Concat =>
-            for I in 0 .. Right_Len - 1 loop
-               Set_Nth_Element
-                 (Res_List, Left_Len + I, Get_Nth_Element (Right_List, I));
-            end loop;
-            Free_Eval_String_Literal (Right_Aggr, Right);
-      end case;
+      for I in reverse Operands'Range loop
+         Def := Get_Implicit_Definition (Get_Implementation (Operands (I)));
+         case Iir_Predefined_Concat_Functions (Def) is
+            when Iir_Predefined_Array_Element_Concat
+              | Iir_Predefined_Element_Element_Concat =>
+               Set_Nth_Element (Res_List, Res_Len, Ops_Val (I));
+               Bounds_From_Subtype := True;
+               Res_Len := Res_Len + 1;
+            when Iir_Predefined_Element_Array_Concat
+              | Iir_Predefined_Array_Array_Concat =>
+               El_List := Get_Simple_Aggregate_List (Str_Lits (I));
+               El_Len := Get_Nbr_Elements (El_List);
+               for I in 0 .. El_Len - 1 loop
+                  Set_Nth_Element
+                    (Res_List, Res_Len + I, Get_Nth_Element (El_List, I));
+               end loop;
+               Bounds_From_Subtype := Bounds_From_Subtype
+                 or Def = Iir_Predefined_Element_Array_Concat;
+               if Leftest_Non_Null = Null_Iir and then El_Len /= 0 then
+                  Leftest_Non_Null := Get_Type (Ops_Val (I));
+               end if;
+               Free_Eval_String_Literal (Str_Lits (I), Ops_Val (I));
+               Res_Len := Res_Len + El_Len;
+         end case;
+      end loop;
 
       --  Compute subtype...
-      Origin_Type := Get_Type (Orig);
-      Res_Type := Null_Iir;
-      if Func = Iir_Predefined_Array_Array_Concat
-        and then Left_Len = 0
-      then
-         if Flags.Vhdl_Std = Vhdl_87 then
-            --  LRM87 7.2.3
-            --  [...], unless the left operand is a null array, in which case
-            --  the result of the concatenation is the right operand.
-            Res_Type := Get_Type (Right);
-         else
-            --  LRM93 7.2.4
-            --  If both operands are null arrays, then the result of the
-            --  concatenation is the right operand.
-            if Get_Nbr_Elements (Right_List) = 0 then
-               Res_Type := Get_Type (Right);
-            end if;
-         end if;
-      end if;
-      if Res_Type = Null_Iir then
-         if Flags.Vhdl_Std = Vhdl_87
-           and then (Func = Iir_Predefined_Array_Array_Concat
-                     or Func = Iir_Predefined_Array_Element_Concat)
-         then
-            --  LRM87 7.2.3
-            --  The left bound of the result is the left operand, [...]
-            --
-            --  LRM87 7.2.3
-            --  The direction of the result is the direction of the left
-            --  operand, [...]
-            declare
-               Left_Index : constant Iir :=
-                 Get_Index_Type (Get_Type (Left), 0);
-               Left_Range : constant Iir :=
-                 Get_Range_Constraint (Left_Index);
-               Ret_Type : constant Iir :=
-                 Get_Return_Type (Get_Implementation (Orig));
-               A_Range : Iir;
-               Index_Type : Iir;
-            begin
-               A_Range := Create_Iir (Iir_Kind_Range_Expression);
-               Set_Type (A_Range, Get_Index_Type (Ret_Type, 0));
-               Set_Expr_Staticness (A_Range, Locally);
-               Set_Left_Limit (A_Range, Get_Left_Limit (Left_Range));
-               Set_Direction (A_Range, Get_Direction (Left_Range));
-               Location_Copy (A_Range, Orig);
-               Set_Right_Limit_By_Length (A_Range, Int64 (Res_Len));
-               Index_Type := Create_Range_Subtype_From_Type
-                 (Left_Index, Get_Location (Orig));
-               Set_Range_Constraint (Index_Type, A_Range);
-               Res_Type := Create_Unidim_Array_From_Index
-                 (Origin_Type, Index_Type, Orig);
-            end;
+      if Flags.Vhdl_Std > Vhdl_87 then
+         --  LRM93 7.2.4
+         --  If both operands are null arrays, then the result of the
+         --  concatenation is the right operand.
+         if Res_Len = 0 then
+            Res_Type := Get_Type (Get_Right (Operands (1)));
          else
             --  LRM93 7.2.4
             --  Otherwise, the direction and bounds of the result are
@@ -1127,7 +1158,63 @@ package body Vhdl.Evaluation is
             Res_Type := Create_Unidim_Array_By_Length
               (Origin_Type, Int64 (Res_Len), Orig);
          end if;
+      else
+         --  LRM87 7.2.3
+         --  The left bound of the result is the left operand, [...]
+         --
+         --  LRM87 7.2.3
+         --  The direction of the result is the direction of the left
+         --  operand, [...]
+         --
+         --  LRM87 7.2.3
+         --  [...], unless the left operand is a null array, in which case
+         --  the result of the concatenation is the right operand.
+
+         --  Look for the first operand that is either an element or
+         --  a non-null array.  If it is an element, create the bounds
+         --  by length.  If it is an array, create the bounds from it.  If
+         --  there is no such operand, use the leftest operands for the
+         --  bounds.
+         if Bounds_From_Subtype then
+            --  There is at least one concatenation with an element.
+            Res_Type := Create_Unidim_Array_By_Length
+              (Origin_Type, Int64 (Res_Len), Orig);
+         else
+            if Res_Len = 0 then
+               Res_Type := Get_Type (Get_Right (Operands (1)));
+            else
+               declare
+                  Left_Index : constant Iir :=
+                    Get_Index_Type (Leftest_Non_Null, 0);
+                  Left_Range : constant Iir :=
+                    Get_Range_Constraint (Left_Index);
+                  Ret_Type : constant Iir :=
+                    Get_Return_Type (Get_Implementation (Orig));
+                  A_Range : Iir;
+                  Index_Type : Iir;
+               begin
+                  A_Range := Create_Iir (Iir_Kind_Range_Expression);
+                  Set_Type (A_Range, Get_Index_Type (Ret_Type, 0));
+                  Set_Expr_Staticness (A_Range, Locally);
+                  Set_Left_Limit (A_Range, Get_Left_Limit (Left_Range));
+                  Set_Direction (A_Range, Get_Direction (Left_Range));
+                  Location_Copy (A_Range, Orig);
+                  Set_Right_Limit_By_Length (A_Range, Int64 (Res_Len));
+                  Index_Type := Create_Range_Subtype_From_Type
+                    (Left_Index, Get_Location (Orig));
+                  Set_Range_Constraint (Index_Type, A_Range);
+                  Res_Type := Create_Unidim_Array_From_Index
+                    (Origin_Type, Index_Type, Orig);
+               end;
+            end if;
+         end if;
       end if;
+
+      for I in Ops_Val'Range loop
+         Free_Eval_Static_Expr (Ops_Val (I), Operands (I));
+      end loop;
+      Free_Eval_Static_Expr (Left_Val, Left_Op);
+
       --  FIXME: this is not necessarily a string, it may be an aggregate if
       --  element type is not a character type.
       return Build_Simple_Aggregate (Res_List, Orig, Res_Type, Res_Type);
@@ -1284,7 +1371,7 @@ package body Vhdl.Evaluation is
 
    --  ORIG is either a dyadic operator or a function call.
    function Eval_Dyadic_Operator (Orig : Iir; Imp : Iir; Left, Right : Iir)
-     return Iir
+                                 return Iir
    is
       pragma Unsuppress (Overflow_Check);
       Func : constant Iir_Predefined_Functions :=
@@ -1496,7 +1583,7 @@ package body Vhdl.Evaluation is
            | Iir_Predefined_Array_Element_Concat
            | Iir_Predefined_Array_Array_Concat
            | Iir_Predefined_Element_Element_Concat =>
-            return Eval_Concatenation (Left, Right, Orig, Func);
+            raise Internal_Error;
 
          when Iir_Predefined_Enum_Equality
            | Iir_Predefined_Bit_Match_Equality =>
@@ -2631,21 +2718,27 @@ package body Vhdl.Evaluation is
             end;
          when Iir_Kinds_Dyadic_Operator =>
             declare
+               Imp : constant Iir := Get_Implementation (Expr);
                Left : constant Iir := Get_Left (Expr);
                Right : constant Iir := Get_Right (Expr);
                Left_Val, Right_Val : Iir;
                Res : Iir;
             begin
-               Left_Val := Eval_Static_Expr (Left);
-               Right_Val := Eval_Static_Expr (Right);
+               if (Get_Implicit_Definition (Imp)
+                     in Iir_Predefined_Concat_Functions)
+               then
+                  return Eval_Concatenation ((1 => Expr));
+               else
+                  Left_Val := Eval_Static_Expr (Left);
+                  Right_Val := Eval_Static_Expr (Right);
 
-               Res := Eval_Dyadic_Operator
-                 (Expr, Get_Implementation (Expr), Left_Val, Right_Val);
+                  Res := Eval_Dyadic_Operator (Expr, Imp, Left_Val, Right_Val);
 
-               Free_Eval_Static_Expr (Left_Val, Left);
-               Free_Eval_Static_Expr (Right_Val, Right);
+                  Free_Eval_Static_Expr (Left_Val, Left);
+                  Free_Eval_Static_Expr (Right_Val, Right);
 
-               return Res;
+                  return Res;
+               end if;
             end;
 
          when Iir_Kind_Attribute_Name =>
@@ -2874,16 +2967,22 @@ package body Vhdl.Evaluation is
                Imp : constant Iir := Get_Implementation (Expr);
                Left, Right : Iir;
             begin
-               --  Note: there can't be association by name.
-               Left := Get_Parameter_Association_Chain (Expr);
-               Right := Get_Chain (Left);
-
-               Left := Eval_Static_Expr (Get_Actual (Left));
-               if Right = Null_Iir then
-                  return Eval_Monadic_Operator (Expr, Left);
+               if (Get_Implicit_Definition (Imp)
+                     in Iir_Predefined_Concat_Functions)
+               then
+                  return Eval_Concatenation ((1 => Expr));
                else
-                  Right := Eval_Static_Expr (Get_Actual (Right));
-                  return Eval_Dyadic_Operator (Expr, Imp, Left, Right);
+                  --  Note: there can't be association by name.
+                  Left := Get_Parameter_Association_Chain (Expr);
+                  Right := Get_Chain (Left);
+
+                  Left := Eval_Static_Expr (Get_Actual (Left));
+                  if Right = Null_Iir then
+                     return Eval_Monadic_Operator (Expr, Left);
+                  else
+                     Right := Eval_Static_Expr (Get_Actual (Right));
+                     return Eval_Dyadic_Operator (Expr, Imp, Left, Right);
+                  end if;
                end if;
             end;
 
@@ -2982,7 +3081,7 @@ package body Vhdl.Evaluation is
    end Can_Eval_Value;
 
    --  For composite values.
-   --  Evluating a composite value is a trade-off: it can simplify the
+   --  Evaluating a composite value is a trade-off: it can simplify the
    --  generated code if the value is small enough, or it can be a bad idea if
    --  the value is very large.  It is very easy to create large static
    --  composite values (like: bit_vector'(1 to 10**4 => '0'))
diff --git a/src/vhdl/vhdl-evaluation.ads b/src/vhdl/vhdl-evaluation.ads
index 48a36a886..bf63abb49 100644
--- a/src/vhdl/vhdl-evaluation.ads
+++ b/src/vhdl/vhdl-evaluation.ads
@@ -66,6 +66,12 @@ package Vhdl.Evaluation is
    --  is locally static.
    function Eval_Expr_If_Static (Expr : Iir) return Iir;
 
+   --  Concatenate all the elements of OPERANDS.
+   --  The first element of OPERANDS is the rightest one, the last the
+   --  leftest one.  All the elements are concatenation operators.
+   --  All the elements are static.
+   function Eval_Concatenation (Operands : Iir_Array) return Iir;
+
    --  Evaluate a physical literal and return a normalized literal (using
    --  the primary unit as unit).
    function Eval_Physical_Literal (Expr : Iir) return Iir;
diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads
index 57c6bb73c..f44f6c4e0 100644
--- a/src/vhdl/vhdl-nodes.ads
+++ b/src/vhdl/vhdl-nodes.ads
@@ -3540,6 +3540,7 @@ package Vhdl.Nodes is
    --   Get/Set_Type (Field1)
    --
    --   Get/Set_Operand (Field2)
+   --   Get/Set_Left (Alias Field2)
    --
    --  Function declaration corresponding to the function to call.
    --   Get/Set_Implementation (Field3)
diff --git a/src/vhdl/vhdl-nodes_meta.adb b/src/vhdl/vhdl-nodes_meta.adb
index 48c5129bc..2e3512028 100644
--- a/src/vhdl/vhdl-nodes_meta.adb
+++ b/src/vhdl/vhdl-nodes_meta.adb
@@ -9692,7 +9692,19 @@ package body Vhdl.Nodes_Meta is
    function Has_Left (K : Iir_Kind) return Boolean is
    begin
       case K is
-         when Iir_Kind_And_Operator
+         when Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator
+           | Iir_Kind_Implicit_Condition_Operator
+           | Iir_Kind_Condition_Operator
+           | Iir_Kind_Reduction_And_Operator
+           | Iir_Kind_Reduction_Or_Operator
+           | Iir_Kind_Reduction_Nand_Operator
+           | Iir_Kind_Reduction_Nor_Operator
+           | Iir_Kind_Reduction_Xor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator
+           | Iir_Kind_And_Operator
            | Iir_Kind_Or_Operator
            | Iir_Kind_Nand_Operator
            | Iir_Kind_Nor_Operator
diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 59159feff..06c689848 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -1703,282 +1703,319 @@ package body Vhdl.Sem_Expr is
    --  Set when the -fexplicit option was adviced.
    Explicit_Advice_Given : Boolean := False;
 
-   function Sem_Operator (Expr : Iir; Res_Type : Iir; Arity : Positive)
-      return Iir
+   -- LEFT and RIGHT must be set.
+   function Set_Operator_Unique_Interpretation
+     (Expr : Iir; Decl : Iir) return Iir
    is
-      Operator : Name_Id;
-      Left, Right: Iir;
-      Interpretation : Name_Interpretation_Type;
-      Decl : Iir;
-      Overload_List : Iir_List;
-      Overload : Iir;
-      Res_Type_List : Iir;
-      Full_Compat : Iir;
-      It : List_Iterator;
-
-      -- LEFT and RIGHT must be set.
-      function Set_Uniq_Interpretation (Decl : Iir) return Iir
-      is
-         Interface_Chain : Iir;
-         Err : Boolean;
-      begin
-         Set_Type (Expr, Get_Return_Type (Decl));
-         Interface_Chain := Get_Interface_Declaration_Chain (Decl);
-         Err := False;
-         if Is_Overloaded (Left) then
-            Left := Sem_Expression_Ov
-              (Left, Get_Base_Type (Get_Type (Interface_Chain)));
-            if Left = Null_Iir then
+      Is_Dyadic : constant Boolean :=
+        Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator;
+      Interface_Chain : Iir;
+      Err : Boolean;
+      Left : Iir;
+      Right : Iir;
+   begin
+      Set_Type (Expr, Get_Return_Type (Decl));
+      Interface_Chain := Get_Interface_Declaration_Chain (Decl);
+      Err := False;
+      Left := Get_Left (Expr);
+      if Is_Overloaded (Left) then
+         Left := Sem_Expression_Ov
+           (Left, Get_Base_Type (Get_Type (Interface_Chain)));
+         if Left = Null_Iir then
+            Err := True;
+         else
+            Set_Left (Expr, Left);
+         end if;
+      end if;
+      Check_Read (Left);
+      if Is_Dyadic then
+         Right := Get_Right (Expr);
+         if Is_Overloaded (Right) then
+            Right := Sem_Expression_Ov
+              (Right, Get_Base_Type (Get_Type (Get_Chain (Interface_Chain))));
+            if Right = Null_Iir then
                Err := True;
             else
-               if Arity = 1 then
-                  Set_Operand (Expr, Left);
-               else
-                  Set_Left (Expr, Left);
-               end if;
-            end if;
-         end if;
-         Check_Read (Left);
-         if Arity = 2 then
-            if Is_Overloaded (Right) then
-               Right := Sem_Expression_Ov
-                 (Right,
-                  Get_Base_Type (Get_Type (Get_Chain (Interface_Chain))));
-               if Right = Null_Iir then
-                  Err := True;
-               else
-                  Set_Right (Expr, Right);
-               end if;
+               Set_Right (Expr, Right);
             end if;
-            Check_Read (Right);
          end if;
-         Destroy_Iir_List (Overload_List);
-         if not Err then
-            Set_Implementation (Expr, Decl);
-            Sem_Subprogram_Call_Finish (Expr, Decl);
-            return Eval_Expr_If_Static (Expr);
-         else
-            return Expr;
-         end if;
-      end Set_Uniq_Interpretation;
-
-      --  Note: operator and implementation node of expr must be set.
-      procedure Error_Operator_Overload (List : Iir_List) is
-      begin
-         Report_Start_Group;
-         Error_Msg_Sem (+Expr, "operator ""%i"" is overloaded", +Operator);
-         Disp_Overload_List (List, Expr);
-         Report_End_Group;
-      end Error_Operator_Overload;
-
-      Interface_Chain : Iir;
-   begin
-      if Arity = 1 then
-         Left := Get_Operand (Expr);
-         Right := Null_Iir;
+         Check_Read (Right);
+      end if;
+      if not Err then
+         Set_Implementation (Expr, Decl);
+         Sem_Subprogram_Call_Finish (Expr, Decl);
+         return Eval_Expr_If_Static (Expr);
       else
-         Left := Get_Left (Expr);
-         Right := Get_Right (Expr);
+         return Expr;
       end if;
-      Operator := Utils.Get_Operator_Name (Expr);
+   end Set_Operator_Unique_Interpretation;
 
-      if Get_Type (Expr) = Null_Iir then
-         --  First pass.
-         --  Analyze operands.
-         --  FIXME: should try to analyze right operand even if analyze
-         --  of left operand has failed ??
-         if Get_Type (Left) = Null_Iir then
-            Left := Sem_Expression_Ov (Left, Null_Iir);
-            if Left = Null_Iir then
-               return Null_Iir;
-            end if;
-            if Arity = 1 then
-               Set_Operand (Expr, Left);
-            else
-               Set_Left (Expr, Left);
-            end if;
+   --  Display an error message for sem_operator.
+   procedure Error_Operator_Overload (Expr : Iir; List : Iir_List)
+   is
+      Operator : Name_Id;
+   begin
+      Operator := Utils.Get_Operator_Name (Expr);
+      Report_Start_Group;
+      Error_Msg_Sem (+Expr, "operator ""%i"" is overloaded", +Operator);
+      Disp_Overload_List (List, Expr);
+      Report_End_Group;
+   end Error_Operator_Overload;
+
+   --  Return False in case of error.
+   function Sem_Operator_Operands (Expr : Iir) return Boolean
+   is
+      Is_Dyadic : constant Boolean :=
+        Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator;
+      Left, Right: Iir;
+   begin
+      --  First pass.
+      --  Analyze operands.
+      --  FIXME: should try to analyze right operand even if analyze
+      --  of left operand has failed ??
+      Left := Get_Left (Expr);
+      if Get_Type (Left) = Null_Iir then
+         Left := Sem_Expression_Ov (Left, Null_Iir);
+         if Left = Null_Iir then
+            return False;
          end if;
-         if Arity = 2 and then Get_Type (Right) = Null_Iir then
+         Set_Left (Expr, Left);
+      end if;
+      if Is_Dyadic then
+         Right := Get_Right (Expr);
+         if Get_Type (Right) = Null_Iir then
             Right := Sem_Expression_Ov (Right, Null_Iir);
             if Right = Null_Iir then
-               return Null_Iir;
+               return False;
             end if;
             Set_Right (Expr, Right);
          end if;
+      end if;
+      return True;
+   end Sem_Operator_Operands;
 
-         Overload_List := Create_Iir_List;
+   function Sem_Operator_Pass1 (Expr : Iir; Res_Type : Iir) return Iir
+   is
+      Is_Dyadic : constant Boolean :=
+        Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator;
+      Operator : constant Name_Id := Utils.Get_Operator_Name (Expr);
+      Interpretation : Name_Interpretation_Type;
+      Decl : Iir;
+      Overload_List : Iir_List;
+      Res_Type_List : Iir;
+      It : List_Iterator;
 
-         --  Try to find an implementation among user defined function
-         Interpretation := Get_Interpretation (Operator);
-         while Valid_Interpretation (Interpretation) loop
-            Decl := Get_Non_Alias_Declaration (Interpretation);
+      Interfaces : Iir;
+   begin
+      --  First pass.
+      --  Analyze operands.
+      --  FIXME: should try to analyze right operand even if analyze
+      --  of left operand has failed ??
+      if not Sem_Operator_Operands (Expr) then
+         return Null_Iir;
+      end if;
 
-            --  It is compatible with operand types ?
-            pragma Assert (Is_Function_Declaration (Decl));
+      Overload_List := Create_Iir_List;
 
-            --  LRM08 12.3 Visibility
-            --  [...] or all visible declarations denote the same named entity.
-            --
-            --  GHDL: If DECL has already been seen, then skip it.
-            if Get_Seen_Flag (Decl) then
-               goto Continue;
-            end if;
+      --  Try to find an implementation among user defined function
+      Interpretation := Get_Interpretation (Operator);
+      while Valid_Interpretation (Interpretation) loop
+         Decl := Get_Non_Alias_Declaration (Interpretation);
 
-            --  Check return type.
-            if Res_Type /= Null_Iir
-              and then (Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
-                          = Not_Compatible)
-            then
-               goto Continue;
-            end if;
+         --  It is compatible with operand types ?
+         pragma Assert (Is_Function_Declaration (Decl));
 
-            Interface_Chain := Get_Interface_Declaration_Chain (Decl);
+         --  LRM08 12.3 Visibility
+         --  [...] or all visible declarations denote the same named entity.
+         --
+         --  GHDL: If DECL has already been seen, then skip it.
+         if Get_Seen_Flag (Decl) then
+            goto Continue;
+         end if;
 
-            --  Check arity.
+         --  Check return type.
+         if Res_Type /= Null_Iir
+           and then (Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
+                       = Not_Compatible)
+         then
+            goto Continue;
+         end if;
 
-            --  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 Get_Chain_Length (Interface_Chain) /= Arity then
-               goto Continue;
-            end if;
+         Interfaces := Get_Interface_Declaration_Chain (Decl);
 
-            -- Check operands.
-            if Is_Expr_Compatible (Get_Type (Interface_Chain), Left)
-              = Not_Compatible
-            then
-               goto Continue;
-            end if;
-            if Arity = 2 then
-               if Is_Expr_Compatible (Get_Type (Get_Chain (Interface_Chain)),
-                                      Right)
-                 = Not_Compatible
-               then
-                  goto Continue;
-               end if;
-            end if;
+         --  Check arity.
 
-            --  Match.
-            Set_Seen_Flag (Decl, True);
-            Append_Element (Overload_List, Decl);
+         --  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 Get_Chain_Length (Interfaces) /= 1 + Boolean'Pos (Is_Dyadic) then
+            goto Continue;
+         end if;
 
-            << Continue >> null;
-            Interpretation := Get_Next_Interpretation (Interpretation);
-         end loop;
+         -- Check operands.
+         if Is_Expr_Compatible (Get_Type (Interfaces), Get_Left (Expr))
+           = Not_Compatible
+         then
+            goto Continue;
+         end if;
+         if Is_Dyadic
+           and then (Is_Expr_Compatible (Get_Type (Get_Chain (Interfaces)),
+                                         Get_Right (Expr))
+                       = Not_Compatible)
+         then
+            goto Continue;
+         end if;
 
-         --  Clear seen_flags.
-         It := List_Iterate (Overload_List);
-         while Is_Valid (It) loop
-            Set_Seen_Flag (Get_Element (It), False);
-            Next (It);
-         end loop;
+         --  Match.
+         Set_Seen_Flag (Decl, True);
+         Append_Element (Overload_List, Decl);
 
-         --  The list of possible implementations was computed.
-         case Get_Nbr_Elements (Overload_List) is
-            when 0 =>
-               if Get_Kind (Expr) = Iir_Kind_Implicit_Condition_Operator then
-                  --  TODO: display expression type.
-                  Error_Msg_Sem (+Expr, "cannot convert expression to boolean "
-                                   & "(no ""??"" found)");
-               else
-                  Error_Msg_Sem (+Expr,
-                                 "no function declarations for %n", +Expr);
-               end if;
-               Destroy_Iir_List (Overload_List);
-               return Null_Iir;
+         << Continue >> null;
+         Interpretation := Get_Next_Interpretation (Interpretation);
+      end loop;
 
-            when 1 =>
-               Decl := Get_First_Element (Overload_List);
-               return Set_Uniq_Interpretation (Decl);
+      --  Clear seen_flags.
+      It := List_Iterate (Overload_List);
+      while Is_Valid (It) loop
+         Set_Seen_Flag (Get_Element (It), False);
+         Next (It);
+      end loop;
 
-            when others =>
-               --  Preference for universal operator.
-               --  This roughly corresponds to:
-               --
-               --  LRM 7.3.5
-               --  An implicit conversion of a convertible universal operand
-               --  is applied if and only if the innermost complete context
-               --  determines a unique (numeric) target type for the implicit
-               --  conversion, and there is no legal interpretation of this
-               --  context without this conversion.
-               if Arity = 2 then
-                  Decl := Get_Non_Implicit_Subprogram (Overload_List);
-                  if Decl /= Null_Iir then
-                     return Set_Uniq_Interpretation (Decl);
-                  end if;
+      --  The list of possible implementations was computed.
+      case Get_Nbr_Elements (Overload_List) is
+         when 0 =>
+            if Get_Kind (Expr) = Iir_Kind_Implicit_Condition_Operator then
+               --  TODO: display expression type.
+               Error_Msg_Sem (+Expr, "cannot convert expression to boolean "
+                                & "(no ""??"" found)");
+            else
+               Error_Msg_Sem (+Expr,
+                              "no function declarations for %n", +Expr);
+            end if;
+            Destroy_Iir_List (Overload_List);
+            return Null_Iir;
+
+         when 1 =>
+            Decl := Get_First_Element (Overload_List);
+            Destroy_Iir_List (Overload_List);
+            return Set_Operator_Unique_Interpretation (Expr, Decl);
+
+         when others =>
+            --  Preference for universal operator.
+            --  This roughly corresponds to:
+            --
+            --  LRM 7.3.5
+            --  An implicit conversion of a convertible universal operand
+            --  is applied if and only if the innermost complete context
+            --  determines a unique (numeric) target type for the implicit
+            --  conversion, and there is no legal interpretation of this
+            --  context without this conversion.
+            if Is_Dyadic then
+               Decl := Get_Non_Implicit_Subprogram (Overload_List);
+               if Decl /= Null_Iir then
+                  Destroy_Iir_List (Overload_List);
+                  return Set_Operator_Unique_Interpretation (Expr, Decl);
                end if;
+            end if;
 
-               Set_Implementation (Expr, Create_Overload_List (Overload_List));
-
-               --  Create the list of possible return types, if it is not yet
-               --  determined.
-               if Res_Type = Null_Iir then
-                  Res_Type_List := Create_List_Of_Types (Overload_List);
-                  if Is_Overload_List (Res_Type_List) then
-                     --  There are many possible return types.
-                     --  Try again.
-                     Set_Type (Expr, Res_Type_List);
-                     return Expr;
-                  end if;
+            Set_Implementation (Expr, Create_Overload_List (Overload_List));
+
+            --  Create the list of possible return types, if it is not yet
+            --  determined.
+            if Res_Type = Null_Iir then
+               Res_Type_List := Create_List_Of_Types (Overload_List);
+               if Is_Overload_List (Res_Type_List) then
+                  --  There are many possible return types.
+                  --  Try again.
+                  Set_Type (Expr, Res_Type_List);
+                  return Expr;
                end if;
+            end if;
 
-               --  The return type is known.
-               --  Search for explicit subprogram.
+            --  The return type is known.
+            --  Search for explicit subprogram.
 
-               --  It was impossible to find one solution.
-               Error_Operator_Overload (Overload_List);
+            --  It was impossible to find one solution.
+            Error_Operator_Overload (Expr, Overload_List);
 
-               --  Give an advice.
-               if not Flags.Flag_Explicit
-                 and then not Explicit_Advice_Given
-                 and then Flags.Vhdl_Std < Vhdl_08
-               then
-                  Decl := Get_Explicit_Subprogram (Overload_List);
-                  if Decl /= Null_Iir then
-                     Error_Msg_Sem
-                       (+Expr, "(you may want to use the -fexplicit option)");
-                     Explicit_Advice_Given := True;
-                  end if;
+            --  Give an advice.
+            if not Flags.Flag_Explicit
+              and then not Explicit_Advice_Given
+              and then Flags.Vhdl_Std < Vhdl_08
+            then
+               Decl := Get_Explicit_Subprogram (Overload_List);
+               if Decl /= Null_Iir then
+                  Error_Msg_Sem
+                    (+Expr, "(you may want to use the -fexplicit option)");
+                  Explicit_Advice_Given := True;
                end if;
+            end if;
+
+            return Null_Iir;
+      end case;
+   end Sem_Operator_Pass1;
 
+   function Sem_Operator_Pass2_Interpretation
+     (Expr : Iir; Res_Type : Iir) return Iir
+   is
+      Decl : Iir;
+      Overload : Iir;
+      Overload_List : Iir_List;
+      Full_Compat : Iir;
+      It : List_Iterator;
+   begin
+      --  Second pass
+      --  Find the uniq implementation for this call.
+      Overload := Get_Implementation (Expr);
+      Overload_List := Get_Overload_List (Overload);
+      Full_Compat := Null_Iir;
+      It := List_Iterate (Overload_List);
+      while Is_Valid (It) loop
+         Decl := Get_Element (It);
+         --  FIXME: wrong: compatibilty with return type and args.
+         if Are_Types_Compatible (Get_Return_Type (Decl), Res_Type)
+           /= Not_Compatible
+         then
+            if Full_Compat /= Null_Iir then
+               Error_Operator_Overload (Expr, Overload_List);
                return Null_Iir;
-         end case;
-      else
-         --  Second pass
-         --  Find the uniq implementation for this call.
-         Overload := Get_Implementation (Expr);
-         Overload_List := Get_Overload_List (Overload);
-         Full_Compat := Null_Iir;
-         It := List_Iterate (Overload_List);
-         while Is_Valid (It) loop
-            Decl := Get_Element (It);
-            --  FIXME: wrong: compatibilty with return type and args.
-            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;
-               else
-                  Full_Compat := Decl;
-               end if;
+            else
+               Full_Compat := Decl;
             end if;
-            Next (It);
-         end loop;
-         Free_Iir (Overload);
-         Overload := Get_Type (Expr);
-         Free_Overload_List (Overload);
-         if Full_Compat = Null_Iir then
-            Error_Msg_Sem (+Expr,
-                           "no matching function declarations for %n", +Expr);
+         end if;
+         Next (It);
+      end loop;
+      Free_Iir (Overload);
+      Overload := Get_Type (Expr);
+      Free_Overload_List (Overload);
+      Destroy_Iir_List (Overload_List);
+      if Full_Compat = Null_Iir then
+         Error_Msg_Sem (+Expr,
+                        "no matching function declarations for %n", +Expr);
+         return Null_Iir;
+      else
+         Destroy_Iir_List (Overload_List);
+         return Full_Compat;
+      end if;
+   end Sem_Operator_Pass2_Interpretation;
+
+   function Sem_Operator (Expr : Iir; Res_Type : Iir) return Iir
+   is
+      Interpretation : Iir;
+   begin
+      if Get_Type (Expr) = Null_Iir then
+         return Sem_Operator_Pass1 (Expr, Res_Type);
+      else
+         Interpretation := Sem_Operator_Pass2_Interpretation (Expr, Res_Type);
+         if Interpretation = Null_Iir then
             return Null_Iir;
          else
-            return Set_Uniq_Interpretation (Full_Compat);
+            return Set_Operator_Unique_Interpretation (Expr, Interpretation);
          end if;
       end if;
    end Sem_Operator;
@@ -4372,6 +4409,138 @@ package body Vhdl.Sem_Expr is
       end if;
    end Check_Constant_Restriction;
 
+   function Sem_Dyadic_Operator (Expr : Iir; Atype : Iir) return Iir
+   is
+      Arr : Iir_Array (1 .. 128);
+      Len : Natural;
+   begin
+      --  Try to linearize the tree in order to reduce recursion depth
+      --  and also improve speed of evaluation.
+      --  This is particularly useful for repeated concatenations.
+      declare
+         Left : Iir;
+      begin
+         Len := 0;
+         Left := Expr;
+         while Len < Arr'Last
+           and then Get_Kind (Left) in Iir_Kinds_Dyadic_Operator
+         loop
+            Len := Len + 1;
+            Arr (Len) := Left;
+            Left := Get_Left (Left);
+         end loop;
+      end;
+
+      --  No possibility to linearize...
+      if Len = 1 then
+         return Sem_Operator (Expr, Atype);
+      end if;
+
+      if Get_Type (Expr) = Null_Iir then
+         --  First pass.
+         Arr (Len) := Sem_Operator_Pass1 (Arr (Len), Null_Iir);
+         if Arr (Len) = Null_Iir then
+            return Null_Iir;
+         end if;
+         for I in reverse 2 .. Len - 1 loop
+            Set_Left (Arr (I), Arr (I + 1));
+            Arr (I) := Sem_Operator_Pass1 (Arr (I), Null_Iir);
+            if Arr (I) = Null_Iir then
+               return Null_Iir;
+            end if;
+         end loop;
+         Set_Left (Arr (1), Arr (2));
+         Arr (1) := Sem_Operator_Pass1 (Arr (1), Atype);
+         return Arr (1);
+      else
+         --  Second pass.
+         declare
+            Op_Type : Iir;
+            Decl : Iir;
+            Interfaces : Iir;
+            Left, Right : Iir;
+            Is_All_Concat : Boolean;
+            Imp : Iir;
+            Err : Boolean;
+         begin
+            Op_Type := Atype;
+            Err := False;
+            for I in 1 .. Len loop
+               if not Is_Overloaded (Arr (I)) then
+                  pragma Assert (I > 1);
+                  exit;
+               end if;
+               Decl := Sem_Operator_Pass2_Interpretation
+                 (Arr (I), Op_Type);
+               if Decl = Null_Iir then
+                  --  Stop in case of error.
+                  return Null_Iir;
+               end if;
+               Set_Type (Arr (I), Get_Return_Type (Decl));
+               Set_Implementation (Arr (I), Decl);
+               Interfaces := Get_Interface_Declaration_Chain (Decl);
+               Op_Type := Get_Base_Type (Get_Type (Interfaces));
+
+               --  Right operand.
+               Right := Get_Right (Arr (I));
+               if Is_Overloaded (Right) then
+                  Right := Get_Right (Arr (I));
+                  Right := Sem_Expression_Ov
+                    (Right,
+                     Get_Base_Type (Get_Type (Get_Chain (Interfaces))));
+                  if Right = Null_Iir then
+                     Err := True;
+                  else
+                     Set_Right (Arr (I), Right);
+                  end if;
+               end if;
+               Check_Read (Right);
+            end loop;
+
+            Left := Get_Left (Arr (Len));
+            if Is_Overloaded (Left) then
+               Left := Sem_Expression_Ov
+                 (Left, Get_Base_Type (Get_Type (Interfaces)));
+               if Left = Null_Iir then
+                  Err := True;
+               else
+                  Set_Left (Arr (Len), Left);
+               end if;
+            end if;
+
+            --  Finish
+
+            if not Err then
+               Is_All_Concat := True;
+               for I in reverse 1 .. Len loop
+                  Imp := Get_Implementation (Arr (I));
+                  Sem_Subprogram_Call_Finish (Arr (I), Imp);
+                  Is_All_Concat := Is_All_Concat
+                    and then (Get_Implicit_Definition (Imp)
+                                in Iir_Predefined_Concat_Functions);
+               end loop;
+               if Get_Expr_Staticness (Arr (1)) = Locally then
+                  if Is_All_Concat
+                  then
+                     Arr (1) := Eval_Concatenation (Arr (1 .. Len));
+                  else
+                     Arr (1) := Eval_Expr_If_Static (Arr (1));
+                  end if;
+               else
+                  for I in reverse 1 .. Len loop
+                     exit when Get_Expr_Staticness (Arr (I)) /= Locally;
+                     Arr (I) := Eval_Expr_If_Static (Arr (I));
+                     if I > 1 then
+                        Set_Left (Arr (I - 1), Arr (I));
+                     end if;
+                  end loop;
+               end if;
+            end if;
+            return Arr (1);
+         end;
+      end if;
+   end Sem_Dyadic_Operator;
+
    -- Set semantic to EXPR.
    --  Replace simple_name with the referenced node,
    --  Set type to nodes,
@@ -4438,10 +4607,10 @@ package body Vhdl.Sem_Expr is
             return Expr;
 
          when Iir_Kinds_Monadic_Operator =>
-            return Sem_Operator (Expr, A_Type, 1);
+            return Sem_Operator (Expr, A_Type);
 
          when Iir_Kinds_Dyadic_Operator =>
-            return Sem_Operator (Expr, A_Type, 2);
+            return Sem_Dyadic_Operator (Expr, A_Type);
 
          when Iir_Kind_Enumeration_Literal
            | Iir_Kinds_Object_Declaration =>
@@ -5185,7 +5354,7 @@ package body Vhdl.Sem_Expr is
       Location_Copy (Op, Cond);
       Set_Operand (Op, Cond);
 
-      Res := Sem_Operator (Op, Boolean_Type_Definition, 1);
+      Res := Sem_Operator (Op, Boolean_Type_Definition);
       Check_Read (Res);
       return Res;
    end Insert_Condition_Operator;