elocations: add arrow location for element associations.

6 files changed, 72 insertions, 17 deletions

diff --git a/src/dyn_tables.ads b/src/dyn_tables.ads
index f1cffac84..8f6f96513 100644
--- a/src/dyn_tables.ads
+++ b/src/dyn_tables.ads
@@ -63,7 +63,7 @@ package Dyn_Tables is
       Priv : Instance_Private;
    end record;
 
-   --  Initialize the table.  This is done automatically at elaboration.
+   --  Initialize the table.  This must be done by users.
    procedure Init (T : in out Instance);
 
    --  Logical bounds of the array.
diff --git a/src/vhdl/elocations.adb b/src/vhdl/elocations.adb
index c63a35c59..6ee8d0c2f 100644
--- a/src/vhdl/elocations.adb
+++ b/src/vhdl/elocations.adb
@@ -175,12 +175,6 @@ package body Elocations is
            | Iir_Kind_Waveform_Element
            | Iir_Kind_Conditional_Waveform
            | Iir_Kind_Conditional_Expression
-           | Iir_Kind_Association_Element_By_Expression
-           | Iir_Kind_Association_Element_By_Individual
-           | Iir_Kind_Association_Element_Open
-           | Iir_Kind_Association_Element_Package
-           | Iir_Kind_Association_Element_Type
-           | Iir_Kind_Association_Element_Subprogram
            | Iir_Kind_Choice_By_Range
            | Iir_Kind_Choice_By_Expression
            | Iir_Kind_Choice_By_Others
@@ -374,6 +368,12 @@ package body Elocations is
            | Iir_Kind_Attribute_Name =>
             return Format_None;
          when Iir_Kind_Library_Clause
+           | Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package
+           | Iir_Kind_Association_Element_Type
+           | Iir_Kind_Association_Element_Subprogram
            | Iir_Kind_Attribute_Specification
            | Iir_Kind_Anonymous_Type_Declaration
            | Iir_Kind_Attribute_Declaration
@@ -626,4 +626,20 @@ package body Elocations is
       Set_Field2 (N, Loc);
    end Set_Port_Map_Location;
 
+   function Get_Arrow_Location (N : Iir) return Location_Type is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_Arrow_Location (Get_Kind (N)),
+                     "no field Arrow_Location");
+      return Get_Field1 (N);
+   end Get_Arrow_Location;
+
+   procedure Set_Arrow_Location (N : Iir; Loc : Location_Type) is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_Arrow_Location (Get_Kind (N)),
+                     "no field Arrow_Location");
+      Set_Field1 (N, Loc);
+   end Set_Arrow_Location;
+
 end Elocations;
diff --git a/src/vhdl/elocations.ads b/src/vhdl/elocations.ads
index 4a83820e3..b71944b5b 100644
--- a/src/vhdl/elocations.ads
+++ b/src/vhdl/elocations.ads
@@ -52,12 +52,14 @@ package Elocations is
    --  Tuples --
    -------------
 
-   -- Iir_Kind_Association_Element_By_Expression (None)
-   -- Iir_Kind_Association_Element_Open (None)
-   -- Iir_Kind_Association_Element_By_Individual (None)
-   -- Iir_Kind_Association_Element_Package (None)
-   -- Iir_Kind_Association_Element_Type (None)
-   -- Iir_Kind_Association_Element_Subprogram (None)
+   -- Iir_Kind_Association_Element_By_Expression (L1)
+   -- Iir_Kind_Association_Element_Open (L1)
+   -- Iir_Kind_Association_Element_By_Individual (L1)
+   -- Iir_Kind_Association_Element_Package (L1)
+   -- Iir_Kind_Association_Element_Type (L1)
+   -- Iir_Kind_Association_Element_Subprogram (L1)
+   --
+   --   Get/Set_Arrow_Location (Field1)
 
    -- Iir_Kind_Waveform_Element (None)
 
@@ -311,8 +313,6 @@ package Elocations is
 
    -- Iir_Kind_Record_Type_Definition (L2)
    --
-   --   Get/Set_Start_Location (Field1)
-   --
    --   Get/Set_End_Location (Field2)
 
    -- Iir_Kind_Access_Type_Definition (None)
@@ -666,4 +666,8 @@ package Elocations is
    --  Field: Field2
    function Get_Port_Map_Location (N : Iir) return Location_Type;
    procedure Set_Port_Map_Location (N : Iir; Loc : Location_Type);
+
+   --  Field: Field1
+   function Get_Arrow_Location (N : Iir) return Location_Type;
+   procedure Set_Arrow_Location (N : Iir; Loc : Location_Type);
 end Elocations;
diff --git a/src/vhdl/elocations_meta.adb b/src/vhdl/elocations_meta.adb
index 1dcbdeb53..bcac6d39e 100644
--- a/src/vhdl/elocations_meta.adb
+++ b/src/vhdl/elocations_meta.adb
@@ -46,6 +46,8 @@ package body Elocations_Meta is
             return "generic_map_location";
          when Field_Port_Map_Location =>
             return "port_map_location";
+         when Field_Arrow_Location =>
+            return "arrow_location";
       end case;
    end Get_Field_Image;
 
@@ -89,6 +91,8 @@ package body Elocations_Meta is
             return Get_Generic_Map_Location (N);
          when Field_Port_Map_Location =>
             return Get_Port_Map_Location (N);
+         when Field_Arrow_Location =>
+            return Get_Arrow_Location (N);
          when others =>
             raise Internal_Error;
       end case;
@@ -123,6 +127,8 @@ package body Elocations_Meta is
             Set_Generic_Map_Location (N, V);
          when Field_Port_Map_Location =>
             Set_Port_Map_Location (N, V);
+         when Field_Arrow_Location =>
+            Set_Arrow_Location (N, V);
          when others =>
             raise Internal_Error;
       end case;
@@ -134,7 +140,6 @@ package body Elocations_Meta is
          when Iir_Kind_Library_Clause
            | Iir_Kind_Attribute_Specification
            | Iir_Kind_Protected_Type_Declaration
-           | Iir_Kind_Record_Type_Definition
            | Iir_Kind_Protected_Type_Body
            | Iir_Kind_Type_Declaration
            | Iir_Kind_Anonymous_Type_Declaration
@@ -335,6 +340,21 @@ package body Elocations_Meta is
       end case;
    end Has_Port_Map_Location;
 
+   function Has_Arrow_Location (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package
+           | Iir_Kind_Association_Element_Type
+           | Iir_Kind_Association_Element_Subprogram =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Arrow_Location;
+
 
    pragma Warnings (On, """others"" choice is redundant");
 end Elocations_Meta;
diff --git a/src/vhdl/elocations_meta.ads b/src/vhdl/elocations_meta.ads
index ed1f2cdf1..c2e968248 100644
--- a/src/vhdl/elocations_meta.ads
+++ b/src/vhdl/elocations_meta.ads
@@ -34,7 +34,8 @@ package Elocations_Meta is
       Field_Generic_Location,
       Field_Port_Location,
       Field_Generic_Map_Location,
-      Field_Port_Map_Location
+      Field_Port_Map_Location,
+      Field_Arrow_Location
      );
    pragma Discard_Names (Fields_Enum);
 
@@ -60,4 +61,5 @@ package Elocations_Meta is
    function Has_Port_Location (K : Iir_Kind) return Boolean;
    function Has_Generic_Map_Location (K : Iir_Kind) return Boolean;
    function Has_Port_Map_Location (K : Iir_Kind) return Boolean;
+   function Has_Arrow_Location (K : Iir_Kind) return Boolean;
 end Elocations_Meta;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index b0c8f1287..24e62e0d3 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -2202,6 +2202,11 @@ package body Parse is
 
       Set_Elements_Declaration_List (Res, List_To_Flist (El_List));
 
+      if Flag_Elocations then
+         Create_Elocations (Res);
+         Set_End_Location (Res, Get_Token_Location);
+      end if;
+
       --  Skip 'end'
       Scan_Expect (Tok_Record);
       Set_End_Has_Reserved_Id (Res, True);
@@ -7114,6 +7119,7 @@ package body Parse is
       Actual: Iir;
       Nbr_Assocs : Natural;
       Loc : Location_Type;
+      Arrow_Loc : Location_Type;
       Comma_Loc : Location_Type;
    begin
       Sub_Chain_Init (Res, Last);
@@ -7127,6 +7133,7 @@ package body Parse is
       loop
          --  Parse formal and actual.
          Loc := Get_Token_Location;
+         Arrow_Loc := No_Location;
          Formal := Null_Iir;
 
          if Current_Token /= Tok_Open then
@@ -7150,6 +7157,7 @@ package body Parse is
                when Tok_Double_Arrow =>
                   --  Check that FORMAL is a name and not an expression.
                   Formal := Check_Formal_Form (Actual);
+                  Arrow_Loc := Get_Token_Location;
 
                   --  Skip '=>'
                   Scan;
@@ -7177,6 +7185,11 @@ package body Parse is
          end if;
          Set_Formal (El, Formal);
 
+         if Flag_Elocations then
+            Create_Elocations (El);
+            Set_Arrow_Location (El, Arrow_Loc);
+         end if;
+
          Sub_Chain_Append (Res, Last, El);
          exit when Current_Token = Tok_Right_Paren;