Allow operator symbol as formal name.

For #205

5 files changed, 33 insertions, 16 deletions

diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index ba72e4673..c00565515 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -2335,7 +2335,18 @@ package body Disp_Vhdl is
             end if;
             Formal := Get_Formal (El);
             if Formal /= Null_Iir then
-               Disp_Expression (Formal);
+               case Get_Kind (El) is
+                  when Iir_Kind_Association_Element_Package
+                    | Iir_Kind_Association_Element_Type
+                    | Iir_Kind_Association_Element_Subprogram =>
+                     Disp_Name (Formal);
+                  when Iir_Kind_Association_Element_By_Expression
+                    | Iir_Kind_Association_Element_By_Individual
+                    | Iir_Kind_Association_Element_Open =>
+                     Disp_Expression (Formal);
+                  when others =>
+                     raise Internal_Error;
+               end case;
                if Conv /= Null_Iir then
                   Put (")");
                end if;
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 5495e6057..99ce824e9 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -376,7 +376,8 @@ package body Iirs_Utils is
       El := Formal;
       loop
          case Get_Kind (El) is
-            when Iir_Kind_Simple_Name =>
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Operator_Symbol =>
                return Get_Named_Entity (El);
             when Iir_Kinds_Interface_Declaration =>
                return El;
@@ -425,7 +426,8 @@ package body Iirs_Utils is
       if Formal /= Null_Iir then
          --  Strip denoting name
          case Get_Kind (Formal) is
-            when Iir_Kind_Simple_Name =>
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Operator_Symbol =>
                return Get_Named_Entity (Formal);
             when Iir_Kinds_Interface_Declaration =>
                --  Shouldn't happen.
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 52bd5a34d..31af2556d 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -6642,23 +6642,27 @@ package body Parse is
       return Res;
    end Parse_Process_Statement;
 
-   procedure Check_Formal_Form (Formal : Iir) is
+   function Check_Formal_Form (Formal : Iir) return Iir is
    begin
       if Formal = Null_Iir then
-         return;
+         return Formal;
       end if;
 
       case Get_Kind (Formal) is
          when Iir_Kind_Simple_Name
            | Iir_Kind_Slice_Name
            | Iir_Kind_Selected_Name =>
-            null;
+            return Formal;
          when Iir_Kind_Parenthesis_Name =>
             --  Could be an indexed name, so nothing to check within the
             --  parenthesis.
-            null;
+            return Formal;
+         when Iir_Kind_String_Literal8 =>
+            --  Operator designator
+            return String_To_Operator_Symbol (Formal);
          when others =>
-            Error_Msg_Parse (+Formal, "incorrect formal name");
+            Error_Msg_Parse (+Formal, "incorrect formal name ignored");
+            return Null_Iir;
       end case;
    end Check_Formal_Form;
 
@@ -6736,10 +6740,8 @@ package body Parse is
                   end if;
 
                when Tok_Double_Arrow =>
-                  Formal := Actual;
-
                   --  Check that FORMAL is a name and not an expression.
-                  Check_Formal_Form (Formal);
+                  Formal := Check_Formal_Form (Actual);
 
                   --  Skip '=>'
                   Scan;
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 968ad8a28..b85050ff3 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -141,7 +141,8 @@ package body Sem_Assocs is
                Assoc := Rewrite_Non_Object_Association (Assoc, Inter);
             end if;
          else
-            if Get_Kind (Formal) = Iir_Kind_Simple_Name then
+            if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol)
+            then
                --  A candidate.  Search the corresponding interface.
                Inter := Find_Name_In_Chain
                  (Inter_Chain, Get_Identifier (Formal));
@@ -1335,7 +1336,8 @@ package body Sem_Assocs is
       Formal_Type : Iir;
    begin
       case Get_Kind (Formal) is
-         when Iir_Kind_Simple_Name =>
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Operator_Symbol =>
             --  Certainly the most common case: FORMAL_NAME => VAL.
             --  It is also the easiest.  So, handle it completly now.
             if Get_Identifier (Formal) = Get_Identifier (Inter) then
@@ -1569,7 +1571,7 @@ package body Sem_Assocs is
          --  Can be associated only once
          Match := Fully_Compatible;
       else
-         if Get_Kind (Formal) = Iir_Kind_Simple_Name
+         if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol)
            and then Get_Identifier (Formal) = Get_Identifier (Inter)
          then
             Match := Fully_Compatible;
@@ -1584,7 +1586,6 @@ package body Sem_Assocs is
       Formal : constant Iir := Get_Formal (Assoc);
    begin
       if Formal /= Null_Iir then
-         pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name);
          pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter));
          Set_Named_Entity (Formal, Inter);
          Set_Base_Name (Formal, Inter);
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index c60c6f231..bbe5ad4d7 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -741,7 +741,8 @@ package body Sem_Inst is
             if Is_Valid (Formal) then
                loop
                   case Get_Kind (Formal) is
-                     when Iir_Kind_Simple_Name =>
+                     when Iir_Kind_Simple_Name
+                       | Iir_Kind_Operator_Symbol =>
                         Set_Named_Entity
                           (Formal, Get_Instance (Get_Named_Entity (Formal)));
                         exit;