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
module Position = Lexbuf.Position
type t =
| No_loc
| In_file of string
| Lexbuf_loc of Lexbuf.Loc.t
| Same_file of
{ pos_fname : string
; start : Compact_position.t
; stop : Compact_position.t
}
| Same_line of
{ pos_fname : string
; loc : Compact_position.Same_line_loc.t
}
open Lexbuf.Loc
let to_lexbuf_loc = function
| No_loc -> Lexbuf.Loc.none
| Lexbuf_loc loc -> loc
| In_file fname -> Lexbuf.Loc.in_file ~fname
| Same_file { pos_fname; start; stop } ->
let start = Compact_position.to_position start ~fname:pos_fname in
let stop = Compact_position.to_position stop ~fname:pos_fname in
{ Lexbuf.Loc.start; stop }
| Same_line { pos_fname; loc } ->
Compact_position.Same_line_loc.to_loc loc ~fname:pos_fname
;;
let in_file ~fname = In_file fname
let of_lexbuf_loc loc =
if Lexbuf.Loc.(equal none loc)
then No_loc
else if Lexbuf.Loc.is_file_only loc
then In_file loc.start.pos_fname
else (
let pos_fname = loc.start.pos_fname in
match Compact_position.of_loc loc with
| Same_line loc -> Same_line { pos_fname; loc }
| Loc { start; stop } -> Same_file { pos_fname; start; stop }
| Loc_does_not_fit -> Lexbuf_loc loc)
;;
let start = function
| No_loc -> Lexbuf.Loc.none.start
| Lexbuf_loc loc -> loc.start
| In_file fname -> Position.in_file ~fname
| Same_file { pos_fname; start; stop = _ } ->
Compact_position.to_position start ~fname:pos_fname
| Same_line { pos_fname; loc } ->
Compact_position.Same_line_loc.start loc ~fname:pos_fname
;;
let stop = function
| No_loc -> Lexbuf.Loc.none.stop
| Lexbuf_loc loc -> loc.stop
| In_file fname -> Position.in_file ~fname
| Same_file { pos_fname; stop; start = _ } ->
Compact_position.to_position stop ~fname:pos_fname
| Same_line { pos_fname; loc } ->
Compact_position.Same_line_loc.stop loc ~fname:pos_fname
;;
let compare = Poly.compare
let equal = Poly.equal
let none = No_loc
let is_none = function
| No_loc -> true
| _ -> false
;;
let to_dyn t = Lexbuf.Loc.to_dyn (to_lexbuf_loc t)
let set_stop t stop = of_lexbuf_loc { (to_lexbuf_loc t) with stop }
let set_start t start = of_lexbuf_loc { (to_lexbuf_loc t) with start }
let create ~start ~stop = of_lexbuf_loc { start; stop }
let map_pos t ~f = to_lexbuf_loc t |> Lexbuf.Loc.map_pos ~f |> of_lexbuf_loc
let set_start_to_stop = function
| (No_loc | In_file _) as t -> t
| Lexbuf_loc loc -> of_lexbuf_loc { loc with start = loc.stop }
| Same_file t -> Same_file { t with start = t.stop }
| Same_line t ->
let loc = Compact_position.Same_line_loc.set_start_to_stop t.loc in
Same_line { t with loc }
;;
let start_pos_cnum = function
| No_loc | In_file _ -> Lexbuf.Loc.none.start.pos_cnum
| Lexbuf_loc loc -> loc.start.pos_cnum
| Same_file t -> Compact_position.cnum t.start
| Same_line t -> Compact_position.Same_line_loc.start_cnum t.loc
;;
let stop_pos_cnum = function
| No_loc | In_file _ -> Lexbuf.Loc.none.stop.pos_cnum
| Lexbuf_loc loc -> loc.stop.pos_cnum
| Same_file t -> Compact_position.cnum t.stop
| Same_line t -> Compact_position.Same_line_loc.stop_cnum t.loc
;;