Add an API to gather comments.

7 files changed, 380 insertions, 4 deletions

diff --git a/src/file_comments.adb b/src/file_comments.adb
new file mode 100644
index 000000000..183b17144
--- /dev/null
+++ b/src/file_comments.adb
@@ -0,0 +1,184 @@
+--  Comments table.
+--  Copyright (C) 2022 Tristan Gingold
+--
+--  This program is free software: you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation, either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <gnu.org/licenses>.
+
+--  All the variables declared in this package are set by Parse_Option function
+--  and can by read as soon as the command line is parsed.
+--
+--  Since the names are not prefixed, this package is expected to be with'ed
+--  but not to be use'd.
+
+with Grt.Algos;
+
+package body File_Comments is
+   procedure Add_Comment (File : Source_File_Entry;
+                          Start, Last : Source_Ptr)
+   is
+      pragma Assert (File > No_Source_File_Entry);
+   begin
+      --  Create entry for FILE if not already created.
+      if Comments_Table.Last < File then
+         while Comments_Table.Last < File loop
+            Comments_Table.Append
+              (File_Comment_Record'(Comments => <>,
+                                    Next => File_Comments_Tables.First));
+         end loop;
+         File_Comments_Tables.Init (Comments_Table.Table (File).Comments, 16);
+      end if;
+
+      --  Append a comment entry.
+      File_Comments_Tables.Append
+        (Comments_Table.Table (File).Comments,
+         Comment_Record'(Start => Start, Last => Last, N => 0));
+   end Add_Comment;
+
+   procedure Discard_Comments (File : Source_File_Entry) is
+   begin
+      if Comments_Table.Last < File then
+         --  No comments for FILE.
+         return;
+      end if;
+      raise Internal_Error;
+   end Discard_Comments;
+
+   procedure Gather_Comments (File : Source_File_Entry; N : Uns32)
+   is
+      use File_Comments_Tables;
+   begin
+      if Comments_Table.Last < File then
+         --  No comments for FILE.
+         return;
+      end if;
+      declare
+         Fc : File_Comment_Record renames Comments_Table.Table (File);
+      begin
+         while Fc.Next <= Last (Fc.Comments) loop
+            Fc.Comments.Table (Fc.Next).N := N;
+            Fc.Next := Fc.Next + 1;
+         end loop;
+      end;
+   end Gather_Comments;
+
+   procedure Rename_Comments (File : Source_File_Entry;
+                              Prev : Uns32;
+                              N : Uns32) is
+   begin
+      raise Internal_Error;
+   end Rename_Comments;
+
+   procedure Sort_Comments_By_Node_1 (Fc : File_Comment_Record)
+   is
+      function Lt (L, R : Positive) return Boolean
+      is
+         Lc : Comment_Record renames Fc.Comments.Table (Comment_Index (L));
+         Rc : Comment_Record renames Fc.Comments.Table (Comment_Index (R));
+      begin
+         if Lc.N < Rc.N then
+            return True;
+         elsif Lc.N = Rc.N then
+            return Lc.Start < Rc.Start;
+         end if;
+         return False;
+      end Lt;
+
+      procedure Swap (P1 : Positive; P2 : Positive)
+      is
+         L : Comment_Record renames Fc.Comments.Table (Comment_Index (P1));
+         R : Comment_Record renames Fc.Comments.Table (Comment_Index (P2));
+         T : Comment_Record;
+      begin
+         T := L;
+         L := R;
+         R := T;
+      end Swap;
+
+      procedure Sort is new Grt.Algos.Heap_Sort
+        (Lt => Lt, Swap => Swap);
+   begin
+      Sort (Natural (File_Comments_Tables.Last (Fc.Comments)));
+   end Sort_Comments_By_Node_1;
+
+   procedure Sort_Comments_By_Node (File : Source_File_Entry) is
+   begin
+      if File > Comments_Table.Last then
+         --  No comments gathered, nothing to do.
+         return;
+      end if;
+      Sort_Comments_By_Node_1 (Comments_Table.Table (File));
+   end Sort_Comments_By_Node;
+
+   function Find_First_Comment (File : Source_File_Entry; N : Uns32)
+                               return Comment_Index is
+   begin
+      if Comments_Table.Last < File then
+         --  No comments for FILE.
+         return No_Comment_Index;
+      end if;
+      declare
+         Fc : File_Comment_Record renames Comments_Table.Table (File);
+         Nd : Uns32;
+         F, L, M : Comment_Index;
+      begin
+         F := File_Comments_Tables.First;
+         L := File_Comments_Tables.Last (Fc.Comments);
+         while F <= L loop
+            M := F + (L - F) / 2;
+            Nd := Fc.Comments.Table (M).N;
+            if Nd = N then
+               --  Found, but must return the first comment.
+               while M > No_Comment_Index + 1
+                 and then Fc.Comments.Table (M - 1).N = N
+               loop
+                  M := M - 1;
+               end loop;
+               return M;
+            elsif Nd < N then
+               F := M + 1;
+            else
+               pragma Assert (Nd > N);
+               L := M - 1;
+            end if;
+         end loop;
+         return No_Comment_Index;
+      end;
+   end Find_First_Comment;
+
+   procedure Get_Comment (File : Source_File_Entry;
+                          Idx : Comment_Index;
+                          Start, Last : out Source_Ptr)
+   is
+      pragma Assert (Comments_Table.Last >= File);
+      Fc : File_Comment_Record renames Comments_Table.Table (File);
+   begin
+      Start := Fc.Comments.Table (Idx).Start;
+      Last := Fc.Comments.Table (Idx).Last;
+   end Get_Comment;
+
+   function Get_Next_Comment (File : Source_File_Entry; Idx : Comment_Index)
+                             return Comment_Index
+   is
+      use File_Comments_Tables;
+      pragma Assert (Comments_Table.Last >= File);
+      Fc : File_Comment_Record renames Comments_Table.Table (File);
+   begin
+      if Idx < Last (Fc.Comments)
+        and then Fc.Comments.Table (Idx + 1).N = Fc.Comments.Table (Idx).N
+      then
+         return Idx + 1;
+      else
+         return No_Comment_Index;
+      end if;
+   end Get_Next_Comment;
+end File_Comments;
diff --git a/src/file_comments.ads b/src/file_comments.ads
new file mode 100644
index 000000000..8ed07566d
--- /dev/null
+++ b/src/file_comments.ads
@@ -0,0 +1,102 @@
+--  Comments table.
+--  Copyright (C) 2022 Tristan Gingold
+--
+--  This program is free software: you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation, either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <gnu.org/licenses>.
+
+--  All the variables declared in this package are set by Parse_Option function
+--  and can by read as soon as the command line is parsed.
+--
+--  Since the names are not prefixed, this package is expected to be with'ed
+--  but not to be use'd.
+
+with Types; use Types;
+with Dyn_Tables;
+with Tables;
+
+package File_Comments is
+   --  Add a comment for FILE.
+   --  This procedure is called from a scanner when a comment is scanned.
+   --
+   --  For a line comment, START is the position of the token that starts the
+   --  comment (the '--' in vhdl).  LAST is the position of the last character
+   --  of the comment (before the new line).
+   procedure Add_Comment (File : Source_File_Entry;
+                          Start, Last : Source_Ptr);
+
+   --  Discard unassigned comments ?
+   procedure Discard_Comments (File : Source_File_Entry);
+
+   --  Assign node N to the last comments scanned.
+   --  This procedure is called by the parser when a node that could be
+   --  annotated with a comment is parsed.
+   procedure Gather_Comments (File : Source_File_Entry;
+                              N : Uns32);
+
+   --  Reassign comments to node N.
+   procedure Rename_Comments (File : Source_File_Entry;
+                              Prev : Uns32;
+                              N : Uns32);
+
+   --  Sort comments; to be done once all comments have been gathered and
+   --  before searching comments.
+   --  Discard unassigned comments ?
+   procedure Sort_Comments_By_Node (File : Source_File_Entry);
+
+   type Comment_Index is new Nat32;
+   No_Comment_Index : constant Comment_Index := 0;
+
+   --  Return the first comment index for node N.
+   --  Return No_Comment_Index if not found.
+   function Find_First_Comment (File : Source_File_Entry; N : Uns32)
+                               return Comment_Index;
+
+   --  Return the source bounds of comment IDX.
+   procedure Get_Comment (File : Source_File_Entry;
+                          Idx : Comment_Index;
+                          Start, Last : out Source_Ptr);
+
+   --  Return the next comment after IDX.
+   --  Return No_Comment_Index if no related comment exists.
+   function Get_Next_Comment (File : Source_File_Entry;
+                              Idx : Comment_Index)
+                             return Comment_Index;
+private
+   type Comment_Record is record
+      --  Comment range in the source.
+      Start : Source_Ptr;
+      Last : Source_Ptr;
+
+      --  Associated node.
+      N : Uns32;
+   end record;
+
+   package File_Comments_Tables is new Dyn_Tables
+     (Table_Component_Type => Comment_Record,
+      Table_Index_Type => Comment_Index,
+      Table_Low_Bound => 1);
+
+   type File_Comment_Record is record
+      --  Table of comments for a file.
+      Comments : File_Comments_Tables.Instance;
+      --  Next unassigned comment.
+      Next : Comment_Index;
+   end record;
+
+   --  Table of comments, indexed by files.
+   package Comments_Table is new Tables
+     (Table_Component_Type => File_Comment_Record,
+      Table_Index_Type => Source_File_Entry,
+      Table_Low_Bound => No_Source_File_Entry + 1,
+      Table_Initial => 8);
+end File_Comments;
diff --git a/src/flags.ads b/src/flags.ads
index 326733564..f2054b17c 100644
--- a/src/flags.ads
+++ b/src/flags.ads
@@ -152,6 +152,10 @@ package Flags is
    --  If true, allow to use synopsys packages (std_logic_arith & co).
    Flag_Synopsys : Boolean := False;
 
+   --  If true, comments are gathered during scan.
+   --  See package File_Comments.
+   Flag_Gather_Comments : Boolean := False;
+
    --  If True, disp original source line and a caret indicating the column.
    Flag_Caret_Diagnostics : Boolean := True;
 
diff --git a/src/vhdl/vhdl-comments.adb b/src/vhdl/vhdl-comments.adb
new file mode 100644
index 000000000..bc7a3e2e8
--- /dev/null
+++ b/src/vhdl/vhdl-comments.adb
@@ -0,0 +1,33 @@
+--  Specialisation of File_Comments for vhdl
+--  Copyright (C) 2022 Tristan Gingold
+--
+--  This program is free software: you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation, either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <gnu.org/licenses>.
+
+--  All the variables declared in this package are set by Parse_Option function
+--  and can by read as soon as the command line is parsed.
+--
+--  Since the names are not prefixed, this package is expected to be with'ed
+--  but not to be use'd.
+
+with Types; use Types;
+with File_Comments; use File_Comments;
+
+with Vhdl.Scanner; use Vhdl.Scanner;
+
+package body Vhdl.Comments is
+   procedure Gather_Comments (N : Iir) is
+   begin
+      Gather_Comments (Get_Current_Source_File, Uns32 (N));
+   end Gather_Comments;
+end Vhdl.Comments;
diff --git a/src/vhdl/vhdl-comments.ads b/src/vhdl/vhdl-comments.ads
new file mode 100644
index 000000000..b9b63b667
--- /dev/null
+++ b/src/vhdl/vhdl-comments.ads
@@ -0,0 +1,28 @@
+--  Specialisation of File_Comments for vhdl
+--  Copyright (C) 2022 Tristan Gingold
+--
+--  This program is free software: you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation, either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <gnu.org/licenses>.
+
+--  All the variables declared in this package are set by Parse_Option function
+--  and can by read as soon as the command line is parsed.
+--
+--  Since the names are not prefixed, this package is expected to be with'ed
+--  but not to be use'd.
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+package Vhdl.Comments is
+   --  Attach previously scanned comments to node N.
+   procedure Gather_Comments (N : Iir);
+end Vhdl.Comments;
diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb
index 929f47b61..7e47e05cb 100644
--- a/src/vhdl/vhdl-parse.adb
+++ b/src/vhdl/vhdl-parse.adb
@@ -13,18 +13,23 @@
 --
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
+
+with Std_Names; use Std_Names;
+with Flags; use Flags;
+with Str_Table;
+with Errorout; use Errorout;
+with File_Comments;
+
 with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils;
 with Vhdl.Tokens; use Vhdl.Tokens;
 with Vhdl.Scanner; use Vhdl.Scanner;
 with Vhdl.Utils; use Vhdl.Utils;
-with Errorout; use Errorout;
 with Vhdl.Errors; use Vhdl.Errors;
-with Std_Names; use Std_Names;
-with Flags; use Flags;
 with Vhdl.Parse_Psl;
-with Str_Table;
 with Vhdl.Xrefs;
 with Vhdl.Elocations; use Vhdl.Elocations;
+with Vhdl.Comments; use Vhdl.Comments;
+
 with PSL.Types; use PSL.Types;
 
 --  Recursive descendant parser.
@@ -1709,6 +1714,10 @@ package body Vhdl.Parse is
          Set_Start_Location (First, Get_Token_Location);
       end if;
 
+      if Flag_Gather_Comments then
+         Gather_Comments (First);
+      end if;
+
       if Current_Token = Tok_Identifier then
          Is_Default := True;
          Has_Class := False;
@@ -11701,6 +11710,11 @@ package body Vhdl.Parse is
       Set_Location (Res);
       Set_Date_State (Res, Date_Extern);
 
+      --  Attach comments to the design unit.
+      if Flag_Gather_Comments then
+         Gather_Comments (Res);
+      end if;
+
       Parse_Context_Clause (Res);
 
       if Get_Library_Unit (Res) = Null_Iir then
@@ -11767,6 +11781,10 @@ package body Vhdl.Parse is
          Set_Last_Design_Unit (Res, Last_Design);
       end loop;
 
+      if Flag_Gather_Comments then
+         File_Comments.Sort_Comments_By_Node (Get_Current_Source_File);
+      end if;
+
       if Last_Design = Null_Iir then
          Error_Msg_Parse ("design file is empty (no design unit found)");
       end if;
diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb
index a6c7b64dd..cee853792 100644
--- a/src/vhdl/vhdl-scanner.adb
+++ b/src/vhdl/vhdl-scanner.adb
@@ -20,6 +20,7 @@ with Files_Map; use Files_Map;
 with Std_Names;
 with Str_Table;
 with Flags; use Flags;
+with File_Comments; use File_Comments;
 
 package body Vhdl.Scanner is
 
@@ -2162,6 +2163,12 @@ package body Vhdl.Scanner is
                   end if;
                   Pos := Pos + 1;
                end loop;
+
+               if Flag_Gather_Comments then
+                  Add_Comment (Current_Context.Source_File,
+                               Current_Context.Token_Pos, Pos - 1);
+               end if;
+
                if Flag_Comment then
                   Current_Token := Tok_Line_Comment;
                   return;