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
|
(**************************************************************************)
(* *)
(* OCamlFormat *)
(* *)
(* Copyright (c) Facebook, Inc. and its affiliates. *)
(* *)
(* This source code is licensed under the MIT license found in *)
(* the LICENSE file in the root directory of this source tree. *)
(* *)
(**************************************************************************)
module Lexing = struct
include Lexing
let set_position lexbuf position =
lexbuf.lex_curr_p <-
{position with pos_fname= lexbuf.lex_curr_p.pos_fname} ;
lexbuf.lex_abs_pos <- position.pos_cnum
let set_filename lexbuf fname =
lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname= fname}
end
module Position = struct
open Lexing
type t = position
let column {pos_bol; pos_cnum; _} = pos_cnum - pos_bol
let fmt fs {pos_lnum; pos_bol; pos_cnum; pos_fname= _} =
if pos_lnum = -1 then Format.fprintf fs "[%d]" pos_cnum
else Format.fprintf fs "[%d,%d+%d]" pos_lnum pos_bol (pos_cnum - pos_bol)
let to_string x = Format.asprintf "%a" fmt x
let sexp_of_t x = Sexp.Atom (to_string x)
let compare_col p1 p2 = Int.compare (column p1) (column p2)
let compare p1 p2 =
if phys_equal p1 p2 then 0 else Int.compare p1.pos_cnum p2.pos_cnum
include (val Comparator.make ~compare ~sexp_of_t)
let distance p1 p2 = p2.pos_cnum - p1.pos_cnum
end
module Location = struct
include Location
let fmt fs {loc_start; loc_end; loc_ghost} =
Format.fprintf fs "(%a..%a)%s" Position.fmt loc_start Position.fmt
loc_end
(if loc_ghost then " ghost" else "")
let to_string x = Format.asprintf "%a" fmt x
let sexp_of_t x = Sexp.Atom (to_string x)
let compare {loc_start; loc_end; loc_ghost} b =
match Position.compare loc_start b.loc_start with
| 0 -> (
match Position.compare loc_end b.loc_end with
| 0 -> Bool.compare loc_ghost b.loc_ghost
| c -> c )
| c -> c
type location = t
module Location_comparator = Comparator.Make (struct
type t = location
let sexp_of_t = sexp_of_t
let compare = compare
end)
include Location_comparator
let compare_start x y = Position.compare x.loc_start y.loc_start
let compare_start_col x y = Position.compare_col x.loc_start y.loc_start
let compare_end x y = Position.compare x.loc_end y.loc_end
let compare_end_col x y = Position.compare_col x.loc_end y.loc_end
let line_difference fst snd = snd.loc_start.pos_lnum - fst.loc_end.pos_lnum
let contains l1 l2 = compare_start l1 l2 <= 0 && compare_end l1 l2 >= 0
let width x = Position.distance x.loc_start x.loc_end
let descending cmp a b = -cmp a b
let compare_width_decreasing =
Comparable.lexicographic [compare_start; descending compare_end; compare]
let is_single_line x margin =
(* The last character of a line can exceed the margin if it is not
preceded by a break. Adding 1 here is a workaround for this bug. *)
width x <= margin + 1 && x.loc_start.pos_lnum = x.loc_end.pos_lnum
let smallest loc stack =
let min a b = if width a < width b then a else b in
List.reduce_exn (loc :: stack) ~f:min
let of_lexbuf (lexbuf : Lexing.lexbuf) =
{ loc_start= lexbuf.lex_start_p
; loc_end= lexbuf.lex_curr_p
; loc_ghost= false }
let of_lines ~filename:pos_fname lines =
List.folding_mapi ~init:0 lines ~f:(fun i c s ->
let loc =
let pos_lnum = i + 1 in
let loc_start : Lexing.position =
{pos_fname; pos_lnum; pos_bol= c; pos_cnum= c}
in
let loc_end : Lexing.position =
{ pos_fname
; pos_lnum
; pos_bol= c
; pos_cnum= c + String.length (String.strip s) }
in
{loc_start; loc_end; loc_ghost= false}
in
(c + String.length (String.strip s) + 1, mkloc (String.strip s) loc) )
end
module Longident = struct
include Longident
let lident s =
assert (not (String.contains s '.')) ;
Lident s
end
|
