SA28-035: Don't store source locations in token data

Instead, compute them lazily from offset data.

This creates a slight breakage in the generated slocs for token with
negative spans. Since there is not much you could do with the end sloc
of a token with a negative span range before, this is considered a
minor breakage.

Author: raph-amiard

langkit/support/langkit_support-token_data_handlers.adb

@@ -41,7 +41,9 @@ package body Langkit_Support.Token_Data_Handlers is
       with package Element_Vectors is new Langkit_Support.Vectors (<>);
 
       with function Compare
-         (K : Key_Type; E_Index : Positive; E : Element_Vectors.Element_Type)
+        (K       : Key_Type;
+         E_Index : Positive;
+         E       : Element_Vectors.Element_Type)
           return Relative_Position is <>;
       --  Tell where K is with respect to E (E_Index is the index of E in the
       --  vector).
@@ -117,19 +119,22 @@ package body Langkit_Support.Token_Data_Handlers is
    -- Initialize --
    ----------------
 
-   procedure Initialize (TDH : out Token_Data_Handler; Symbols : Symbol_Table)
-   is
+   procedure Initialize
+     (TDH      : out Token_Data_Handler;
+      Symbols  : Symbol_Table;
+      Tab_Stop : Positive := Default_Tab_Stop) is
    begin
-      TDH := (Source_Buffer     => null,
-              Source_First      => <>,
-              Source_Last       => <>,
-              Filename          => <>,
-              Charset           => <>,
-              Tokens            => <>,
-              Symbols           => Symbols,
-              Tokens_To_Trivias => <>,
-              Trivias           => <>,
-              Lines_Starts       => <>);
+      TDH := (Source_Buffer      => null,
+              Source_First       => <>,
+              Source_Last        => <>,
+              Filename           => <>,
+              Charset            => <>,
+              Tokens             => <>,
+              Symbols            => Symbols,
+              Tokens_To_Trivias  => <>,
+              Trivias            => <>,
+              Lines_Starts       => <>,
+              Tab_Stop           => Tab_Stop);
    end Initialize;
 
    -----------
@@ -217,7 +222,8 @@ package body Langkit_Support.Token_Data_Handlers is
                  Symbols           => No_Symbol_Table,
                  Tokens_To_Trivias => <>,
                  Trivias           => <>,
-                 Lines_Starts      => <>);
+                 Lines_Starts      => <>,
+                 Tab_Stop          => <>);
    end Move;
 
    --------------------------
@@ -537,11 +543,12 @@ package body Langkit_Support.Token_Data_Handlers is
             declare
                Triv_Index     : constant Natural := Natural (Key_Trivia);
                Tok_Index      : constant Natural := Element_Index - 1;
-               Key_Start_Sloc : constant Source_Location := Start_Sloc
-                 (TDH.Trivias.Get (Triv_Index).T.Sloc_Range);
+               Key_Start_Sloc : constant Source_Location := Sloc_Start
+                 (TDH, TDH.Trivias.Get (Triv_Index).T);
             begin
                return Compare
-                 (TDH.Tokens.Get (Tok_Index).Sloc_Range, Key_Start_Sloc);
+                 (Sloc_Range (TDH, TDH.Tokens.Get (Tok_Index)),
+                  Key_Start_Sloc);
             end;
          end if;
 
@@ -582,13 +589,13 @@ package body Langkit_Support.Token_Data_Handlers is
         (Sloc        : Source_Location;
          Dummy_Index : Positive;
          Token       : Stored_Token_Data) return Relative_Position
-      is (Compare (Token.Sloc_Range, Sloc));
+      is (Compare (Sloc_Range (TDH, Token), Sloc));
 
       function Compare
         (Sloc        : Source_Location;
          Dummy_Index : Positive;
          Trivia      : Trivia_Node) return Relative_Position
-      is (Compare (Trivia.T.Sloc_Range, Sloc));
+      is (Compare (Sloc_Range (TDH, Trivia.T), Sloc));
 
       function Token_Floor is new Floor
         (Key_Type        => Source_Location,
@@ -617,7 +624,7 @@ package body Langkit_Support.Token_Data_Handlers is
 
       declare
          function SS (Token : Stored_Token_Data) return Source_Location is
-           (Start_Sloc (Token.Sloc_Range));
+           (Sloc_Start (TDH, Token));
 
          Tok_Sloc  : constant Source_Location := SS (TDH.Tokens.Get (Token));
          Triv_Sloc : constant Source_Location :=
@@ -681,16 +688,121 @@ package body Langkit_Support.Token_Data_Handlers is
    begin
       --  Return slice from...
       return
-        TDH.Source_Buffer (
-         --  The first character in the requested line
-         TDH.Lines_Starts.Get (Line_Number)
+        TDH.Source_Buffer
+          (
+           --  The first character in the requested line
+           TDH.Lines_Starts.Get (Line_Number)
+
+           ..
 
-         ..
+           --  The character before the LF that precedes the first character of
+           --  the next line.
+             TDH.Lines_Starts.Get (Line_Number + 1) - 2
+          );
 
-         --  The character before the LF that precedes the first character of
-         --  the next line.
-           TDH.Lines_Starts.Get (Line_Number + 1) - 2
-        );
    end Get_Line;
 
+   --------------
+   -- Get_Sloc --
+   --------------
+
+   function Get_Sloc
+     (TDH : Token_Data_Handler; Index : Natural) return Source_Location
+   is
+      function Compare
+        (Sought      : Positive;
+         Dummy_Index : Positive;
+         Line_Start  : Positive) return Relative_Position
+      is
+        (if Sought > Line_Start then After
+         elsif Sought = Line_Start then Inside
+         else Before);
+
+      function Get_Line_Index is new Floor (Positive, Index_Vectors);
+      --  Return the index of the first character of Line `N` in a given
+      --  `TDH.Line_Starts` vector.
+
+      Column : Natural := 0;
+      --  0 based column number
+
+      Tab_Stop : Positive renames TDH.Tab_Stop;
+   begin
+      --  Allow 0 as an offset because it's a common value when the text buffer
+      --  is empty: in that case just return a null source location.
+      if Index = 0 then
+         return No_Source_Location;
+      end if;
+
+      declare
+         Line_Index  : constant Positive :=
+           Get_Line_Index (Index, TDH.Lines_Starts);
+         Line_Offset : constant Positive := TDH.Lines_Starts.Get (Line_Index);
+      begin
+         --  Allow a sloc pointing at the EOL char (hence the + 1)
+         if Index > TDH.Source_Buffer'Last + 1 then
+            raise Constraint_Error with "out of bound access";
+         end if;
+
+         --  Make horizontal tabulations move by stride of Tab_Stop columns, as
+         --  usually implemented in code editors.
+         for I in Line_Offset .. Natural'Min (Index, TDH.Source_Last) - 1 loop
+            if TDH.Source_Buffer (I) = Chars.HT then
+               Column := (Column + Tab_Stop) / Tab_Stop * Tab_Stop;
+            else
+               Column := Column + 1;
+            end if;
+         end loop;
+
+         return Source_Location'
+           (Line   => Line_Number (Line_Index),
+            Column =>
+              Column_Number
+                (Natural'Max (Column + 1, Index - Line_Offset + 1)));
+      end;
+   end Get_Sloc;
+
+   ----------------
+   -- Sloc_Start --
+   ----------------
+
+   function Sloc_Start
+     (TDH   : Token_Data_Handler;
+      Token : Stored_Token_Data) return Source_Location is
+   begin
+      return Get_Sloc (TDH, Token.Source_First);
+   end Sloc_Start;
+
+   --------------
+   -- Sloc_End --
+   --------------
+
+   function Sloc_End
+     (TDH   : Token_Data_Handler;
+      Token : Stored_Token_Data) return Source_Location is
+   begin
+      return Get_Sloc
+        (TDH,
+         (if Token.Source_Last < Token.Source_First
+          --  This is a special case for when the range is negative: in that
+          --  case we want to propagate that behavior to the sloc itself,
+          --  because negative ranges are used for tokens that have no
+          --  "width", and shouldn't be lookup-able, like the termination
+          --  token.
+          then Token.Source_Last
+          --  For regular cases, we want the sloc_end to be one column after
+          --  the end of the token.
+          else Token.Source_Last + 1));
+   end Sloc_End;
+
+   ----------------
+   -- Sloc_Range --
+   ----------------
+
+   function Sloc_Range
+     (TDH   : Token_Data_Handler;
+      Token : Stored_Token_Data) return Source_Location_Range is
+   begin
+      return Make_Range (Sloc_Start (TDH, Token), Sloc_End (TDH, Token));
+   end Sloc_Range;
+
 end Langkit_Support.Token_Data_Handlers;

langkit/support/langkit_support-token_data_handlers.ads

@@ -47,10 +47,6 @@ package Langkit_Support.Token_Data_Handlers is
       --  this is either null or the symbolization of the token text.
       --
       --  For instance: null for keywords but actual text for identifiers.
-
-      Sloc_Range : Source_Location_Range;
-      --  Source location range for this token. Note that the end bound is
-      --  exclusive.
    end record;
    --  Holder for per-token data to be stored in the token data handler
 
@@ -161,9 +157,16 @@ package Langkit_Support.Token_Data_Handlers is
       --  multiple Token_Data_Handlers.
 
       Lines_Starts : Index_Vectors.Vector;
-      --  Table keeping count of line starts and line endings
+      --  Table keeping count of line starts and line endings. The index of the
+      --  starting character for line N is at the Nth position in the vector.
+
+      Tab_Stop : Positive;
    end record;
 
+   Default_Tab_Stop : constant Positive := 8;
+   --  Value that will be used for the default tab stop if none is passed
+   --  during the initialization of a ``Token_Data_Handler``.
+
    type Token_Data_Handler_Access is access all Token_Data_Handler;
 
    function Initialized (TDH : Token_Data_Handler) return Boolean;
@@ -173,10 +176,15 @@ package Langkit_Support.Token_Data_Handlers is
       with Pre => Initialized (TDH);
    --  Return whether TDH was used to lex some input source
 
-   procedure Initialize (TDH : out Token_Data_Handler; Symbols : Symbol_Table)
+   procedure Initialize
+     (TDH      : out Token_Data_Handler;
+      Symbols  : Symbol_Table;
+      Tab_Stop : Positive := Default_Tab_Stop)
       with Pre  => Symbols /= No_Symbol_Table,
            Post => Initialized (TDH) and then not Has_Source_Buffer (TDH);
-   --  Create a token data handler that is associated with Symbols
+   --  Create a token data handler that is associated with the ``Symbols``
+   --  symbol table, and takes its value for the tabulation in the ``Tab_Stop``
+   --  access.
 
    procedure Reset
      (TDH           : in out Token_Data_Handler;
@@ -285,4 +293,32 @@ package Langkit_Support.Token_Data_Handlers is
      (TDH : Token_Data_Handler; Line_Number : Positive) return Text_Type;
    --  Get the source text of line at index ``Line_Number``
 
+   function Get_Sloc
+     (TDH : Token_Data_Handler; Index : Natural) return Source_Location;
+   --  Return the sloc for given ``Index`` in ``TDH``. If:
+   --
+   --  - ``Index`` is ``0``, return ``No_Source_Location``.
+   --
+   --  - ``Index`` is in range ``1 .. TDH.Source_Buffer'Last + 1``, return a
+   --    corresponding sloc (``TDH.Source_Buffer'Last + 1`` being the EOF
+   --    sloc).
+   --
+   --  - ``Index`` is bigger than ``TDH.Source_Buffer'Last + 1``: raise a
+   --    ``Constraint_Error``.
+
+   function Sloc_Start
+     (TDH   : Token_Data_Handler;
+      Token : Stored_Token_Data) return Source_Location;
+   --  Get the starting sloc for given ``Token`` in ``TDH``
+
+   function Sloc_End
+     (TDH   : Token_Data_Handler;
+      Token : Stored_Token_Data) return Source_Location;
+   --  Get the end sloc for given ``Token`` in ``TDH``
+
+   function Sloc_Range
+     (TDH   : Token_Data_Handler;
+      Token : Stored_Token_Data) return Source_Location_Range;
+   --  Get the sloc range for given ``Token`` in ``TDH``
+
 end Langkit_Support.Token_Data_Handlers;

langkit/templates/parsers/opt_code_ada.mako

@@ -51,7 +51,8 @@ if ${subparser.pos_var} = No_Token_Index then
         ## Emit a diagnostic informing the user that the sub parser has not
         ## succeeded.
         Append (Parser.Diagnostics,
-                Get_Token (Parser.TDH.all, ${parser.start_pos}).Sloc_Range,
+                Sloc_Range (Parser.TDH.all,
+                            Get_Token (Parser.TDH.all, ${parser.start_pos})),
                 To_Text ("Missing '${subparser.error_repr}'"));
     % endif
 

langkit/templates/parsers/pkg_main_body_ada.mako

@@ -174,13 +174,13 @@ package body ${ada_lib_name}.Parsers is
          Get_Token (Parser.TDH.all, Parser.Last_Fail.Pos);
       D : constant Diagnostic :=
         (if Parser.Last_Fail.Kind = Token_Fail then
-          Create (Last_Token.Sloc_Range, To_Text
+          Create (Sloc_Range (Parser.TDH.all, Last_Token), To_Text
             ("Expected "
              & Token_Error_Image (Parser.Last_Fail.Expected_Token_Id)
              & ", got "
              & Token_Error_Image (Parser.Last_Fail.Found_Token_Id)))
          else
-           Create (Last_Token.Sloc_Range,
+           Create (Sloc_Range (Parser.TDH.all, Last_Token),
                    To_Text (Parser.Last_Fail.Custom_Message.all)));
    begin
       Parser.Diagnostics.Append (D);
@@ -210,7 +210,7 @@ package body ${ada_lib_name}.Parsers is
             begin
                Append
                  (Parser.Diagnostics,
-                  First_Garbage_Token.Sloc_Range,
+                  Sloc_Range (Parser.TDH.all, First_Garbage_Token),
                   To_Text
                     ("End of input expected, got """
                      & Token_Kind_Name

langkit/templates/parsers/skip_code_ada.mako

@@ -21,7 +21,8 @@ ${parser.dest_node_parser.generate_code()}
 ${parser.dest_node_parser.res_var}.Token_End_Index := ${parser.start_pos};
 
 Append (Parser.Diagnostics,
-        Get_Token (Parser.TDH.all, ${parser.start_pos}).Sloc_Range,
+        Sloc_Range (Parser.TDH.all,
+                    Get_Token (Parser.TDH.all, ${parser.start_pos})),
         To_Text ("Skipped token ")
         & Common.Text
             (Wrap_Token_Reference

langkit/templates/parsers/transform_code_ada.mako

@@ -64,7 +64,8 @@ if ${parser.pos_var} /= No_Token_Index then
          ${parser.parser.progress_var if is_row(parser.parser) else 1};
 
       Append (Parser.Diagnostics,
-              Get_Token (Parser.TDH.all, ${parser.start_pos}).Sloc_Range,
+              Sloc_Range (Parser.TDH.all,
+                          Get_Token (Parser.TDH.all, ${parser.start_pos})),
               To_Text ("Cannot parse <${parser.name}>"));
 
       Add_Last_Fail_Diagnostic (Parser);

langkit/templates/pkg_common_body_ada.mako

@@ -376,7 +376,7 @@ package body ${ada_lib_name}.Common is
               Source_Buffer => Text_Cst_Access (TDH.Source_Buffer),
               Source_First  => Raw_Data.Source_First,
               Source_Last   => Raw_Data.Source_Last,
-              Sloc_Range    => Raw_Data.Sloc_Range);
+              Sloc_Range    => Sloc_Range (TDH, Raw_Data));
    end Convert;
 
    --------------------------

langkit/templates/pkg_debug_body_ada.mako

@@ -54,7 +54,7 @@ package body ${ada_lib_name}.Debug is
             Put (" " & Image (Langkit_Support
                               .Token_Data_Handlers.Text (TDH.all, D),
                               With_Quotes => True));
-            Put_Line (" [" & Image (D.Sloc_Range) & "]");
+            Put_Line (" [" & Image (Sloc_Range (TDH.all, D)) & "]");
          end;
       end if;
    end PTok;

langkit/templates/pkg_debug_spec_ada.mako

@@ -11,7 +11,6 @@ use Langkit_Support.Token_Data_Handlers;
 
 with Langkit_Support.Symbols; use Langkit_Support.Symbols;
 
-with ${ada_lib_name}.Common;
 with ${ada_lib_name}.Implementation;
 use ${ada_lib_name}.Implementation;