Source file compat_top.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
let lookup_type typ env =
#if OCAML_VERSION >= (4, 10, 0)
Env.find_type_by_name typ env |> fst
#else
Env.lookup_type typ env
#endif
let lookup_value v env =
#if OCAML_VERSION >= (4, 10, 0)
Env.find_value_by_name v env
#else
Env.lookup_value v env
#endif
let find_value env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_value ~loc id env
#else
Typetexp.find_value env loc id
#endif
let find_type env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_type ~loc id env
#else
Typetexp.find_type env loc id
#endif
let find_constructor env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_constructor ~loc Env.Positive id env
#else
Typetexp.find_constructor env loc id
#endif
let find_module env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_module ~loc id env
#else
Typetexp.find_module env loc id
#endif
let find_modtype env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_modtype ~loc id env
#else
Typetexp.find_modtype env loc id
#endif
let find_class env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_class ~loc id env
#else
Typetexp.find_class env loc id
#endif
let find_class_type env loc id =
#if OCAML_VERSION >= (4, 10, 0)
Env.lookup_cltype ~loc id env
#else
Typetexp.find_class_type env loc id
#endif
let type_structure env str loc =
#if OCAML_VERSION >= (4, 14, 0)
let tstr, _, _, _, env =
#else
let tstr, _, _, env =
#endif
#if OCAML_VERSION >= (4, 12, 0)
let _ = loc in
Typemod.type_structure env str
#else
Typemod.type_structure env str loc
#endif
in
tstr, env
let extension_constructor
~ext_type_path
~ext_type_params
~ext_args
~ext_ret_type
~ext_private
~ext_loc
~ext_attributes
=
let open Types in
let ext_args =
Cstr_tuple ext_args
in
{ ext_type_path
; ext_type_params
; ext_args
; ext_ret_type
; ext_private
; ext_loc
; ext_attributes
#if OCAML_VERSION >= (4, 11, 0)
; ext_uid = Uid.mk ~current_unit:"mdx"
#endif
}
let match_env
~value
~empty
~open_
~functor_arg
~constraints
~copy_types
~module_
~persistent
~type_
~modtype
~cltype
~class_
~extension
~value_unbound
~module_unbound
env =
ignore (constraints, persistent, copy_types, value_unbound, module_unbound);
match env with
| Env.Env_value (summary, id, _) ->
value summary id
| Env_empty -> empty ()
| Env_open (summary, pid) ->
open_ summary pid
| Env_functor_arg (summary, id) -> functor_arg summary id
| Env_module (summary, id, presence, _) ->
let present = match presence with
| Mp_present -> true
| Mp_absent -> false
in
module_ summary id ~present
| Env_type (summary, _, _) -> type_ summary
| Env_modtype (summary, _, _) -> modtype summary
| Env_cltype (summary, _, _) -> cltype summary
| Env_class (summary, id, _) -> class_ summary id
| Env_extension (summary, id, _) -> extension summary id
| Env_constraints (summary, _) -> constraints summary
#if OCAML_VERSION >= (4, 10, 0)
| Env_copy_types summary -> copy_types summary
| Env_value_unbound (summary, _, _) -> value_unbound summary
| Env_module_unbound (summary, _, _) -> module_unbound summary
#else
| Env_copy_types (summary, _) -> copy_types summary
#endif
| Env_persistent (summary, _) -> persistent summary
let ctype_is_equal =
#if OCAML_VERSION >= (4, 13, 0)
Ctype.is_equal
#else
Ctype.equal
#endif
let ctype_expand_head_and_get_desc env ty =
#if OCAML_VERSION >= (4, 14, 0)
Types.get_desc (Ctype.expand_head env ty)
#else
(Ctype.expand_head env ty).Types.desc
#endif
let ctype_get_desc ty =
#if OCAML_VERSION >= (4, 14, 0)
Types.get_desc ty
#else
(Ctype.repr ty).Types.desc
#endif