-- 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>.
with Grt.Algos;
with Simple_IO; use Simple_IO;
with Utils_IO; use Utils_IO;
package body File_Comments is
Flag_Trace : constant Boolean := False;
Ctxt : Comment_Context;
procedure Comment_Init_Scan (File : Source_File_Entry) is
begin
Ctxt := (File => File,
State => State_Before,
Next => No_Comment_Index + 1,
Last_Node => 0,
Last_Newline => No_Comment_Index,
Line_Start => Source_Ptr_Bad);
-- Create entry for FILE if not already created.
if Comments_Table.Last < Ctxt.File then
while Comments_Table.Last < Ctxt.File loop
Comments_Table.Append (File_Comments_Table'(Table => null,
Priv => <>));
end loop;
end if;
-- Always reset the table.
File_Comments_Tables.Init (Comments_Table.Table (Ctxt.File), 16);
end Comment_Init_Scan;
procedure Comment_Close_Scan is
begin
Ctxt.File := No_Source_File_Entry;
end Comment_Close_Scan;
-- Gather last comments to the current node.
-- Called at the end of a block.
procedure Comment_Gather_Existing
is
Fc : File_Comments_Table renames
Comments_Table.Table (Ctxt.File);
Last : constant Comment_Index := File_Comments_Tables.Last (Fc);
begin
if Flag_Trace then
Put ("Comment_Gather_Existing: ");
Put_Uns32 (Uns32 (Ctxt.Next));
Put ("..");
Put_Uns32 (Uns32 (Last));
Put (" -> ");
Put_Uns32 (Ctxt.Last_Node);
New_Line;
end if;
for I in Ctxt.Next .. Last loop
pragma Assert (Fc.Table (I).N = 0);
Fc.Table (I).N := Ctxt.Last_Node;
end loop;
Ctxt.Next := Last + 1;
end Comment_Gather_Existing;
function Is_Empty_Line (Line_Start : Source_Ptr) return Boolean
is
Fc : File_Comments_Table renames
Comments_Table.Table (Ctxt.File);
Last : constant Comment_Index := File_Comments_Tables.Last (Fc);
begin
-- The start of the line is after the last comment, so the line is
-- empty.
return Line_Start > Fc.Table (Last).Last;
end Is_Empty_Line;
-- Very important: this procedure is called only after a comment has
-- been scanned and added.
-- So this is either the newline after a comment (in that case
-- LINE_START is less than the last comment),
-- or an empty line (in that case LINE_START is greater than the last
-- comment).
procedure Comment_Newline (Line_Start : Source_Ptr) is
begin
case Ctxt.State is
when State_Before =>
-- In before mode, we simply gather all the comments.
if Is_Empty_Line (Line_Start) then
-- Keep a marker to the comments up to the last newline.
Ctxt.Last_Newline :=
File_Comments_Tables.Last (Comments_Table.Table (Ctxt.File));
end if;
when State_Block =>
-- Detect empty line.
-- This can happen only after a comments has been added.
if Is_Empty_Line (Line_Start) then
-- Attach existing comments.
Comment_Gather_Existing;
end if;
when State_Line =>
-- If a comment appear before the newline, the state would be
-- changed to State_Line_Cont; so here no comment on the same
-- line.
--
-- The following comments will be attached to the next node.
Ctxt.State := State_Before;
when State_Line_Cont =>
-- If the line is empty, change to State_Block.
-- Otherwise, continue to associate with the last node.
if Is_Empty_Line (Line_Start) then
Ctxt.State := State_Block;
end if;
end case;
end Comment_Newline;
procedure Add_Comment (Start, Last : Source_Ptr;
Line_Start : Source_Ptr)
is
pragma Assert (Ctxt.File /= No_Source_File_Entry);
T : File_Comments_Table renames Comments_Table.Table (Ctxt.File);
N : Uns32;
begin
if Flag_Trace then
Put ("Add_Comment, file=");
Put_Uns32 (Uns32 (Ctxt.File));
Put (", start=");
Put_Uns32 (Uns32 (Start));
Put ("..");
Put_Uns32 (Uns32 (Last));
Put (" => ");
Put_Uns32 (Uns32 (File_Comments_Tables.Last (T) + 1));
Put (", state=");
end if;
case Ctxt.State is
when State_Before =>
-- Will be attached later.
N := 0;
if Flag_Trace then
Put ("before");
end if;
when State_Block =>
-- Will be attached on the next empty line.
N := 0;
if Flag_Trace then
Put ("block");
end if;
when State_Line =>
if Flag_Trace then
Put ("line");
Put (" (start=");
Put_Uns32 (Uns32 (Ctxt.Line_Start));
Put (", cmt=");
Put_Uns32 (Uns32 (Line_Start));
Put (")");
end if;
-- Is it on the same line ?
if Line_Start = Ctxt.Line_Start then
-- Yes, associate with the last node.
N := Ctxt.Last_Node;
Ctxt.Next := File_Comments_Tables.Last (T) + 2;
-- And continue to associate.
Ctxt.State := State_Line_Cont;
else
-- Not the same line, for the next node.
N := 0;
Ctxt.State := State_Before;
end if;
when State_Line_Cont =>
-- Continue to associate with the last node.
if Flag_Trace then
Put ("line_cont");
end if;
N := Ctxt.Last_Node;
Ctxt.Next := File_Comments_Tables.Last (T) + 2;
end case;
if Flag_Trace then
Put (", node=");
Put_Uns32 (N);
New_Line;
end if;
-- Append a comment entry.
File_Comments_Tables.Append
(T, Comment_Record'(Start => Start, Last => Last, N => N));
end Add_Comment;
procedure Save_Comments (Rng : out Comments_Range)
is
use File_Comments_Tables;
pragma Assert (Ctxt.File /= No_Source_File_Entry);
Fc : File_Comments_Table renames Comments_Table.Table (Ctxt.File);
begin
Rng := (First => Ctxt.Next, Last => Last (Fc));
Ctxt.Next := Rng.Last + 1;
Ctxt.State := State_Before;
Ctxt.Last_Newline := Rng.Last;
end Save_Comments;
procedure Gather_Comments_Before (Rng : Comments_Range; N : Uns32)
is
pragma Assert (Ctxt.File /= No_Source_File_Entry);
begin
if Rng.Last /= No_Comment_Index then
if Flag_Trace then
Put ("Gather_Comments_Before, file=");
Put_Uns32 (Uns32 (Ctxt.File));
Put (", rng=");
Put_Uns32 (Uns32 (Rng.First));
Put ("..");
Put_Uns32 (Uns32 (Rng.Last));
Put (", node=");
Put_Uns32 (N);
New_Line;
end if;
declare
Fc : File_Comments_Table renames Comments_Table.Table (Ctxt.File);
begin
for I in Rng.First .. Rng.Last loop
Fc.Table (I).N := N;
end loop;
Ctxt.Next := Rng.Last + 1;
end;
end if;
end Gather_Comments_Before;
procedure Gather_Comments_Block (Rng : Comments_Range; N : Uns32) is
begin
Gather_Comments_Before (Rng, N);
if Ctxt.Last_Newline /= No_Comment_Index then
-- Comments after RNG and until last_newline are also gathered.
Gather_Comments_Before ((First => Rng.Last + 1,
Last => Ctxt.Last_Newline), N);
end if;
Ctxt.State := State_Block;
Ctxt.Last_Node := N;
end Gather_Comments_Block;
procedure Gather_Comments_Line (Pos : Source_Ptr;
N : Uns32)
is
Rng : Comments_Range;
begin
-- Previous unassociated comments are associated to the node N.
Save_Comments (Rng);
Gather_Comments_Before (Rng, N);
-- Start Line mode.
Ctxt.State := State_Line;
Ctxt.Last_Node := N;
Ctxt.Line_Start := Pos;
end Gather_Comments_Line;
procedure Gather_Comments_End is
begin
case Ctxt.State is
when State_Before =>
-- Discard unattached comments.
declare
Fc : File_Comments_Table renames
Comments_Table.Table (Ctxt.File);
Last : Comment_Index;
begin
loop
Last := File_Comments_Tables.Last (Fc);
exit when Last = No_Comment_Index;
exit when Fc.Table (Last).N /= 0;
File_Comments_Tables.Decrement_Last (Fc);
end loop;
end;
when State_Block =>
Comment_Gather_Existing;
when State_Line
| State_Line_Cont =>
-- All comments are attached.
null;
end case;
Ctxt.State := State_Before;
end Gather_Comments_End;
procedure Gather_Comments (N : Uns32)
is
Rng : Comments_Range;
begin
Save_Comments (Rng);
Gather_Comments_Block (Rng, N);
end Gather_Comments;
procedure Sort_Comments_By_Node
is
pragma Assert (Ctxt.File /= No_Source_File_Entry);
Fc : File_Comments_Table renames Comments_Table.Table (Ctxt.File);
function Lt (L, R : Positive) return Boolean
is
Lc : Comment_Record renames Fc.Table (Comment_Index (L));
Rc : Comment_Record renames Fc.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.Table (Comment_Index (P1));
R : Comment_Record renames Fc.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)));
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_Comments_Table renames Comments_Table.Table (File);
Nd : Uns32;
F, L, M : Comment_Index;
begin
F := File_Comments_Tables.First;
L := File_Comments_Tables.Last (Fc);
while F <= L loop
M := F + (L - F) / 2;
Nd := Fc.Table (M).N;
if Nd = N then
-- Found, but must return the first comment.
while M > No_Comment_Index + 1
and then Fc.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_Comments_Table renames Comments_Table.Table (File);
begin
Start := Fc.Table (Idx).Start;
Last := Fc.Table (Idx).Last;
end Get_Comment;
function Get_Comment_Start (File : Source_File_Entry;
Idx : Comment_Index) return Source_Ptr
is
Start, Last : Source_Ptr;
begin
Get_Comment (File, Idx, Start, Last);
return Start;
end Get_Comment_Start;
function Get_Comment_Last (File : Source_File_Entry;
Idx : Comment_Index) return Source_Ptr
is
Start, Last : Source_Ptr;
begin
Get_Comment (File, Idx, Start, Last);
return Last;
end Get_Comment_Last;
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_Comments_Table renames Comments_Table.Table (File);
begin
if Idx < Last (Fc)
and then Fc.Table (Idx + 1).N = Fc.Table (Idx).N
then
return Idx + 1;
else
return No_Comment_Index;
end if;
end Get_Next_Comment;
procedure Finalize is
begin
for I in Comments_Table.First .. Comments_Table.Last loop
File_Comments_Tables.Free (Comments_Table.Table (I));
end loop;
Comments_Table.Free;
end Finalize;
procedure Initialize is
begin
Comments_Table.Init;
end Initialize;
end File_Comments;