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
|
open! Base
module Compact_loc = struct
type t =
{ start_bol : int
; start_pos : int
; end_pos : int
}
let equal a b =
a.start_bol = b.start_bol && a.start_pos = b.start_pos && a.end_pos = b.end_pos
;;
let compare_character_range =
Comparable.lexicographic
[ Comparable.lift compare_int ~f:(fun t -> t.start_pos)
; Comparable.lift compare_int ~f:(fun t -> t.end_pos)
]
;;
end
module Expect_node_formatting = struct
type t =
{ indent : int
; always_on_own_line : bool
; extension_sigil : string
; attribute_sigil : string
}
let default =
{ indent = 2
; always_on_own_line = false
; extension_sigil = "%"
; attribute_sigil = "@@"
}
;;
module Flexibility = struct
type nonrec t =
| Flexible_modulo of t
| Exactly_formatted
end
end
module Virtual_loc = struct
type t =
{ loc : Compact_loc.t
; body_loc : Compact_loc.t
}
end
module Expectation_id = struct
include Int
let mint =
let counter = ref 0 in
fun () ->
let id = !counter in
counter := id + 1;
id
;;
end
module String_node_format = struct
type longhand = Longhand
type shorthand = Shorthand
module Hand = struct
type _ t =
| Longhand : longhand t
| Shorthand : shorthand t
end
module Kind = struct
type _ t =
| Attribute : longhand t
| Extension : _ t
end
module Shape = struct
type 'hand unpacked =
{ name : string
; hand : 'hand Hand.t
; kind : 'hand Kind.t
}
type t = T : _ unpacked -> t [@@unboxed]
end
module Delimiter = struct
type _ unpacked =
| Quote : longhand unpacked
| Tag : string -> _ unpacked
type t = T : _ unpacked -> t [@@unboxed]
let default = T (Tag "")
let longhand = function
| T ((Quote | Tag _) as unpacked) -> unpacked
;;
let shorthand = function
| T (Tag _ as unpacked) -> unpacked
| T Quote -> Tag ""
;;
let handed : type a. t -> a Hand.t -> a unpacked =
fun t hand ->
match hand with
| Longhand -> longhand t
| Shorthand -> shorthand t
;;
end
type 'a unpacked =
{ shape : 'a Shape.unpacked
; delimiter : 'a Delimiter.unpacked
}
type t = T : _ unpacked -> t [@@unboxed]
end
|
