diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/file_comments.adb | 184 | ||||
| -rw-r--r-- | src/file_comments.ads | 102 | ||||
| -rw-r--r-- | src/flags.ads | 4 | ||||
| -rw-r--r-- | src/vhdl/vhdl-comments.adb | 33 | ||||
| -rw-r--r-- | src/vhdl/vhdl-comments.ads | 28 | ||||
| -rw-r--r-- | src/vhdl/vhdl-parse.adb | 26 | ||||
| -rw-r--r-- | src/vhdl/vhdl-scanner.adb | 7 |
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; |