1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133 | --
-- Copyright (C) 2014-2022, AdaCore
-- SPDX-License-Identifier: Apache-2.0
--
with Ada.Strings.Wide_Wide_Fixed; use Ada.Strings.Wide_Wide_Fixed;
package body Langkit_Support.Slocs is
-------------
-- Compare --
-------------
function Compare
(Reference, Compared : Source_Location) return Relative_Position
is
begin
-- First compare line numbers...
if Compared.Line < Reference.Line then
return Before;
elsif Reference.Line < Compared.Line then
return After;
-- Past this point, we know that both are on the same line, so now
-- compare column numbers.
elsif Compared.Column < Reference.Column then
return Before;
elsif Reference.Column < Compared.Column then
return After;
else
return Inside;
end if;
end Compare;
-------------
-- Compare --
-------------
function Compare
(Sloc_Range : Source_Location_Range;
Sloc : Source_Location) return Relative_Position
is
Inclusive_End_Sloc : Source_Location := End_Sloc (Sloc_Range);
begin
-- End_Sloc returns an exclusive end sloc. Switch to an inclusive
-- representation for computation.
Inclusive_End_Sloc.Column := Inclusive_End_Sloc.Column - 1;
return (case Compare (Start_Sloc (Sloc_Range), Sloc) is
when Before => Before,
when Inside | After =>
(if Compare (Inclusive_End_Sloc, Sloc) = After
then After
else Inside));
end Compare;
-----------
-- Value --
-----------
function Value (T : Text_Type) return Source_Location is
Colon_Index : constant Natural := Index (T, ":");
Line_Slice : Text_Type renames T (T'First .. Colon_Index - 1);
Column_Slice : Text_Type renames T (Colon_Index + 1 .. T'Last);
Line : Line_Number;
Column : Column_Number;
begin
if Colon_Index = 0 then
raise Constraint_Error with "invalid source location";
end if;
begin
Line := Line_Number'Wide_Wide_Value (Line_Slice);
exception
when Constraint_Error =>
raise Constraint_Error with
"invalid line number: "
& Image (Line_Slice, With_Quotes => True);
end;
begin
Column := Column_Number'Wide_Wide_Value (Column_Slice);
exception
when Constraint_Error =>
raise Constraint_Error with
"invalid column number: "
& Image (Column_Slice, With_Quotes => True);
end;
return (Line, Column);
end Value;
-----------
-- Value --
-----------
function Value (T : Text_Type) return Source_Location_Range is
Dash_Index : constant Natural := Index (T, "-");
Start_Slice : Text_Type renames T (T'First .. Dash_Index - 1);
End_Slice : Text_Type renames T (Dash_Index + 1 .. T'Last);
begin
return Make_Range (Value (Start_Slice), Value (End_Slice));
end Value;
------------------
-- Column_Count --
------------------
function Column_Count
(Line : Text_Type;
Tab_Stop : Positive := Default_Tab_Stop) return Column_Number
is
TS : constant Column_Number := Column_Number (Tab_Stop);
Result : Column_Number := 0;
begin
-- Make horizontal tabulations move by stride of Tab_Stop columns, as
-- usually implemented in code editors.
for C of Line loop
if C = Chars.HT then
Result := (Result + TS) / TS * TS;
else
Result := Result + 1;
end if;
end loop;
return Result;
end Column_Count;
end Langkit_Support.Slocs;
|