package MlFront_Thunk

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file ThunkRanges.ml

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
type mapped_uchar_lexer = {
  outer_range : Fmlib_parse.Position.range;
      (** The range of the full token, including any surrounding quotes or
          escape characters. This is the range that would be used for reparsing.
      *)
  inner_range : Fmlib_parse.Position.range;
      (** The range of the raw characters that are or need to be fed to the
          {!character_parser}. Typically this is the range of raw characters
          that are inside any surrounding quotes. *)
}
(** Character lexer for quoted or escaped tokens within the restricted domain of
    characters in the index {!inner_range}. *)

type t =
  | Raw_range of Fmlib_parse.Position.range
  | Mapped_range of mapped_uchar_lexer
      (** A range that is either the conventional "raw" range of a token, where
          the raw characters that make up the token are equivalent to the
          characters that make up the token value (that is, the token does not
          need to be unescaped, unquoted or normalized) -or- that is a range of
          a token that needs character mapping (unescaping, unquoting,
          normalization) to convert the raw stream of characters to a token
          value. *)

let raw_range range = Raw_range range

open struct
  let range_of_string s =
    let len = String.length s in
    let end_ = ref Fmlib_parse.Position.start in
    for i = 0 to len - 1 do
      end_ := Fmlib_parse.Position.next s.[i] !end_
    done;
    (Fmlib_parse.Position.start, !end_)
end

let raw_range_of_string s = Raw_range (range_of_string s)

(** [mapped_range_of_quoted_term range] takes a [range] that includes quotes and
    creates a mapped range where the {!display_range} will be the content inside
    the quotes. *)
let mapped_range_of_quoted_term : Fmlib_parse.Position.range -> t = function
  | start_, end_ ->
      Mapped_range
        {
          outer_range = (start_, end_);
          inner_range =
            ( Fmlib_parse.Position.advance 1 1 start_,
              Fmlib_parse.Position.advance (-1) (-1) end_ );
        }

let quote_and_range ~quote s =
  let len = String.length s in
  let quoted = quote s in
  let qlen = String.length quoted in
  if len = qlen then (s, raw_range_of_string s)
  else
    let inner_range = range_of_string quoted in
    (quoted, mapped_range_of_quoted_term inner_range)

let start = function
  | Raw_range (start_pos, _) -> start_pos
  | Mapped_range { inner_range = start_pos, _; _ } -> start_pos

open struct
  let byte_width (start_pos, end_pos) =
    Fmlib_parse.Position.byte_offset end_pos
    - Fmlib_parse.Position.byte_offset start_pos
end

let outer_byte_width = function
  | Raw_range (start_pos, end_pos) -> byte_width (start_pos, end_pos)
  | Mapped_range { outer_range = start_pos, end_pos; inner_range = _ } ->
      byte_width (start_pos, end_pos)

let inner_byte_width = function
  | Raw_range (start_pos, end_pos) -> byte_width (start_pos, end_pos)
  | Mapped_range { inner_range = start_pos, end_pos; outer_range = _ } ->
      byte_width (start_pos, end_pos)

(** [outer_range range] is the range of raw characters including any surrounding
    quotes. This is typically used for reparsing like for
    {!Assumptions.location_of_value_token_word_includes_surrounding_quotes} or
    when merging two ranges (like a command line option and its value). *)
let outer_range = function
  | Raw_range range -> range
  | Mapped_range { outer_range; _ } -> outer_range

(** [inner_range range] is the range of raw characters without any surrounding
    quotes. This is typically used for displaying errors to a user or for
    feeding to an autofix function. *)
let inner_range = function
  | Raw_range range -> range
  | Mapped_range { inner_range; _ } -> inner_range

(** [lossy_merge_or_right left right] merges two ranges [left] and [right],
    preferring the Mapped_range if either is a Mapped_range, and preferring
    [right] if both are Mapped_range. *)
let lossy_merge_or_right left right =
  match (left, right) with
  | Raw_range r1, Raw_range r2 -> Raw_range (Fmlib_parse.Position.merge r1 r2)
  | _, Mapped_range r_arg -> Mapped_range r_arg
  | Mapped_range r_into, _ -> Mapped_range r_into

(** [pp_pos_1based_linecol file ppf (line1,col1)] prints the position with
    one-based line and column numbers.

    The format conforms to
    {{:https://github.com/microsoft/vscode/blob/d2bd76b5cad77e4d380853533014bc9f94ef0405/src/vs/workbench/contrib/terminalContrib/links/test/browser/terminalLinkParsing.test.ts#L42}vscode
     terminal link parsing}.*)
let pp_pos_1based_linecol file ppf (line1, col1) =
  match file with
  | None -> Format.fprintf ppf "%d.%d" line1 col1
  | Some file -> Format.fprintf ppf "%s:%d.%d" file line1 col1

(** [pp_pos file].

    The format conforms to
    {{:https://github.com/microsoft/vscode/blob/d2bd76b5cad77e4d380853533014bc9f94ef0405/src/vs/workbench/contrib/terminalContrib/links/test/browser/terminalLinkParsing.test.ts#L42}vscode
     terminal link parsing}.*)
let pp_pos file ppf pos =
  let open Fmlib_parse in
  let line1, col1 = (1 + Position.line pos, 1 + Position.column pos) in
  match file with
  | None -> Format.fprintf ppf "%d.%d" line1 col1
  | Some file -> Format.fprintf ppf "%s:%d.%d" file line1 col1

(** [pp_range file].

    The format conforms to
    {{:https://github.com/microsoft/vscode/blob/d2bd76b5cad77e4d380853533014bc9f94ef0405/src/vs/workbench/contrib/terminalContrib/links/test/browser/terminalLinkParsing.test.ts#L42}vscode
     terminal link parsing}.*)
let pp_range file ppf (start, end_) =
  let open Fmlib_parse in
  let line1, col1 = (1 + Position.line start, 1 + Position.column start) in
  let line2, col2 = (1 + Position.line end_, 1 + Position.column end_) in
  match file with
  | None -> Format.fprintf ppf "%d.%d-%d.%d" line1 col1 line2 col2
  | Some file when line1 = 0 && col1 = 0 && line2 = 0 && col2 = 0 ->
      Format.pp_print_string ppf file
  | Some file -> Format.fprintf ppf "%s:%d.%d-%d.%d" file line1 col1 line2 col2

(** [pp_outer_range file].

    The format conforms to
    {{:https://github.com/microsoft/vscode/blob/d2bd76b5cad77e4d380853533014bc9f94ef0405/src/vs/workbench/contrib/terminalContrib/links/test/browser/terminalLinkParsing.test.ts#L42}vscode
     terminal link parsing}.*)
let pp_outer_range file ppf range = pp_range file ppf (outer_range range)

(** [pp_inner_range file].

    The format conforms to
    {{:https://github.com/microsoft/vscode/blob/d2bd76b5cad77e4d380853533014bc9f94ef0405/src/vs/workbench/contrib/terminalContrib/links/test/browser/terminalLinkParsing.test.ts#L42}vscode
     terminal link parsing}.*)
let pp_inner_range file ppf range = pp_range file ppf (inner_range range)

(** [range_around_linecol_in_string ~line ~col s] returns the range around the
    string [s] at line [line] and column [col], if it exists. Lines and columns
    are one-based.

    If [line] and [col] exceed the bounds of the string [s], the last valid
    position of [s] is returned. *)
let range_around_linecol_in_string ~line ~col s =
  (* inputs are 1-based. search with Fmlib_parse.Position is 0-based. *)
  let line = line - 1 in
  let col = col - 1 in
  (* Loop through all the bytes of the string. *)
  let len = String.length s in
  let last3 = ref Fmlib_parse.Position.start in
  let last2 = ref Fmlib_parse.Position.start in
  let last1 = ref Fmlib_parse.Position.start in
  let cur_ = ref Fmlib_parse.Position.start in
  let i = ref 0 in
  let found = ref false in
  while !i < len && not !found do
    (* keep track of the last three positions at the start of every non-empty line *)
    if Fmlib_parse.Position.column !cur_ = 1 then (
      last3 := !last2;
      last2 := !last1;
      last1 := !cur_);
    (* if we've found the desired line,col, stop*)
    if
      Fmlib_parse.Position.line !cur_ = line
      && Fmlib_parse.Position.column !cur_ = col
    then found := true
    else begin
      (* otherwise update the current position *)
      cur_ := Fmlib_parse.Position.next s.[!i] !cur_;
      i := !i + 1
    end
  done;
  (!last3, !cur_)

(** [range_exact_linecol_in_string ~line ~col s] returns the range from the
    start of the line to the exact line and column in the string [s]. Lines and
    columns are one-based.

    If [line] and [col] exceed the bounds of the string [s], the last valid line
    of [s] is returned. *)
let range_exact_linecol_in_string ~line ~col s =
  (* inputs are 1-based. search with Fmlib_parse.Position is 0-based. *)
  let line = line - 1 in
  let col = col - 1 in
  (* Loop through all the bytes of the string. *)
  let len = String.length s in
  let last1 = ref Fmlib_parse.Position.start in
  let cur_ = ref Fmlib_parse.Position.start in
  let i = ref 0 in
  let found = ref false in
  while !i < len && not !found do
    (* keep track of the last position at the start of every non-empty line *)
    if Fmlib_parse.Position.column !cur_ = 1 then last1 := !cur_;
    (* if we've found the desired line,col, stop*)
    if
      Fmlib_parse.Position.line !cur_ = line
      && Fmlib_parse.Position.column !cur_ = col
    then found := true
    else begin
      (* otherwise update the current position *)
      cur_ := Fmlib_parse.Position.next s.[!i] !cur_;
      i := !i + 1
    end
  done;
  (!last1, !cur_)

(** [luastyle_byte0_line1_col1 pos] is a triplet of the byte offset (0-based),
    line (1-based) and column (1-based) of the position [pos]. *)
let luastyle_byte0_line1_col1 (pos : Fmlib_parse.Position.t) =
  let byte = Fmlib_parse.Position.byte_offset pos in
  let line = 1 + Fmlib_parse.Position.line pos in
  let col = 1 + Fmlib_parse.Position.column pos in
  (byte, line, col)

let from_luastyle_byte0_line1_col1 (byte, line, col) =
  let line0 = line - 1 in
  let col0 = col - 1 in
  let rec advance_to_line pos target_line =
    if Fmlib_parse.Position.line pos >= target_line then pos
    else advance_to_line (Fmlib_parse.Position.newline 0 pos) target_line
  in
  let pos_at_line = advance_to_line Fmlib_parse.Position.start line0 in
  Fmlib_parse.Position.advance byte col0 pos_at_line