Skip to content

Commit ae8c8a0

Browse files
cristianoccristianoc
committed
Adapt remaining files.
1 parent ebef8f6 commit ae8c8a0

File tree

6 files changed

+90
-6
lines changed

6 files changed

+90
-6
lines changed

‎src/Arnold.ml‎

Lines changed: 28 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -515,7 +515,7 @@ module ExtendFunctionTable = struct
515515
( Nonrecursive,
516516
[
517517
{
518-
vb_pat = {pat_desc = Tpat_var (_, _)};
518+
vb_pat = {pat_desc = Tpat_var _};
519519
vb_expr = {exp_desc = Texp_ident (path, {loc}, _)};
520520
vb_loc = {loc_ghost = true};
521521
};
@@ -779,7 +779,13 @@ module Compile = struct
779779
| Texp_apply (expr, args) -> expr |> expression ~ctx |> evalArgs ~args ~ctx
780780
| Texp_let
781781
( Recursive,
782-
[{vb_pat = {pat_desc = Tpat_var (id, _); pat_loc}; vb_expr}],
782+
[{vb_pat = {pat_desc =
783+
#if OCAML_VERSION < (5, 2, 0)
784+
Tpat_var (id, _);
785+
#else
786+
Tpat_var (id, _, _);
787+
#endif
788+
pat_loc}; vb_expr}],
783789
inExpr ) ->
784790
let oldFunctionName = Ident.name id in
785791
let newFunctionName = currentFunctionName ^ "$" ^ oldFunctionName in
@@ -836,7 +842,12 @@ module Compile = struct
836842
let open Command in
837843
c +++ ConstrOption Rnone
838844
| _ -> c)
839-
| Texp_function {cases} -> cases |> List.map (case ~ctx) |> Command.nondet
845+
#if OCAML_VERSION < (5, 2, 0)
846+
| Texp_function {cases} ->
847+
#else
848+
| Texp_function (_, Tfunction_cases {cases; _}) ->
849+
#endif
850+
cases |> List.map (case ~ctx) |> Command.nondet
840851
| Texp_match _ when not (expr.exp_desc |> Compat.texpMatchHasExceptions)
841852
-> (
842853
(* No exceptions *)
@@ -1226,7 +1237,11 @@ let traverseAst ~valueBindingsTable =
12261237
valueBindings
12271238
|> List.iter (fun (vb : CL.Typedtree.value_binding) ->
12281239
match vb.vb_pat.pat_desc with
1240+
#if OCAML_VERSION < (5, 2, 0)
12291241
| Tpat_var (id, {loc = {loc_start = pos}}) ->
1242+
#else
1243+
| Tpat_var (id, {loc = {loc_start = pos}}, _) ->
1244+
#endif
12301245
let callees = lazy (FindFunctionsCalled.findCallees vb.vb_expr) in
12311246
Hashtbl.replace valueBindingsTable (CL.Ident.name id)
12321247
(pos, vb.vb_expr, callees)
@@ -1248,7 +1263,11 @@ let traverseAst ~valueBindingsTable =
12481263
(StringSet.of_list newProgressFunctions)
12491264
progressFunctions,
12501265
match valueBinding.vb_pat.pat_desc with
1266+
#if OCAML_VERSION < (5, 2, 0)
12511267
| Tpat_var (id, _) ->
1268+
#else
1269+
| Tpat_var (id, _, _) ->
1270+
#endif
12521271
(CL.Ident.name id, valueBinding.vb_expr.exp_loc)
12531272
:: functionsToAnalyze
12541273
| _ -> functionsToAnalyze )))
@@ -1265,7 +1284,12 @@ let traverseAst ~valueBindingsTable =
12651284
List.fold_left
12661285
(fun defs (valueBinding : CL.Typedtree.value_binding) ->
12671286
match valueBinding.vb_pat.pat_desc with
1268-
| Tpat_var (id, _) -> CL.Ident.name id :: defs
1287+
#if OCAML_VERSION < (5, 2, 0)
1288+
| Tpat_var (id, _) ->
1289+
#else
1290+
| Tpat_var (id, _, _) ->
1291+
#endif
1292+
CL.Ident.name id :: defs
12691293
| _ -> defs)
12701294
[] valueBindings
12711295
|> List.rev

‎src/DeadCommon.ml‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -336,8 +336,13 @@ module ProcessDeadAnnotations = struct
336336
({vb_attributes; vb_pat} as value_binding : CL.Typedtree.value_binding)
337337
=
338338
(match vb_pat.pat_desc with
339+
#if OCAML_VERSION < (5, 2, 0)
339340
| Tpat_var (id, {loc = {loc_start = pos}})
340341
| Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}) ->
342+
#else
343+
| Tpat_var (id, {loc = {loc_start = pos}}, _)
344+
| Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}, _) ->
345+
#endif
341346
if !currentlyDisableWarnings then pos |> annotateLive;
342347
vb_attributes
343348
|> processAttributes ~doGenType ~name:(id |> CL.Ident.name) ~pos

‎src/DeadValue.ml‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,9 +21,15 @@ let collectValueBinding super self (vb : CL.Typedtree.value_binding) =
2121
checkAnyValueBindingWithNoSideEffects vb;
2222
let loc =
2323
match vb.vb_pat.pat_desc with
24+
#if OCAML_VERSION < (5, 2, 0)
2425
| Tpat_var (id, {loc = {loc_start; loc_ghost} as loc})
2526
| Tpat_alias
2627
({pat_desc = Tpat_any}, id, {loc = {loc_start; loc_ghost} as loc})
28+
#else
29+
| Tpat_var (id, {loc = {loc_start; loc_ghost} as loc}, _)
30+
| Tpat_alias
31+
({pat_desc = Tpat_any}, id, {loc = {loc_start; loc_ghost} as loc}, _)
32+
#endif
2733
when (not loc_ghost) && not vb.vb_loc.loc_ghost ->
2834
let name = CL.Ident.name id |> Name.create ~isInterface:false in
2935
let optionalArgs =
@@ -143,7 +149,11 @@ let rec collectExpr super self (e : CL.Typedtree.expression) =
143149
Nonrecursive,
144150
[
145151
{
152+
#if OCAML_VERSION < (5, 2, 0)
146153
vb_pat = {pat_desc = Tpat_var (idArg, _)};
154+
#else
155+
vb_pat = {pat_desc = Tpat_var (idArg, _, _)};
156+
#endif
147157
vb_expr =
148158
{
149159
exp_desc =
@@ -157,6 +167,7 @@ let rec collectExpr super self (e : CL.Typedtree.expression) =
157167
],
158168
{
159169
exp_desc =
170+
#if OCAML_VERSION < (5, 2, 0)
160171
Texp_function
161172
{
162173
cases =
@@ -172,6 +183,23 @@ let rec collectExpr super self (e : CL.Typedtree.expression) =
172183
};
173184
];
174185
};
186+
#else
187+
Texp_function(_,
188+
Tfunction_cases {
189+
cases =
190+
[
191+
{
192+
c_lhs = {pat_desc = Tpat_var (etaArg, _, _)};
193+
c_rhs =
194+
{
195+
exp_desc =
196+
Texp_apply
197+
({exp_desc = Texp_ident (idArg2, _, _)}, args);
198+
};
199+
};
200+
];
201+
});
202+
#endif
175203
} )
176204
when CL.Ident.name idArg = "arg"
177205
&& CL.Ident.name etaArg = "eta"

‎src/Exception.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -478,7 +478,11 @@ let traverseAst () =
478478
&& Compat.unboxPatCstrTxt vb.vb_pat.pat_desc
479479
= CL.Longident.Lident "()" ->
480480
processBinding "()"
481+
#if OCAML_VERSION < (5, 2, 0)
481482
| Tpat_var (id, {loc = {loc_ghost}})
483+
#else
484+
| Tpat_var (id, {loc = {loc_ghost}}, _)
485+
#endif
482486
when (isFunction || isToplevel) && (not loc_ghost)
483487
&& not vb.vb_loc.loc_ghost ->
484488
processBinding (id |> CL.Ident.name)

‎src/Log_.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ module Color = struct
5555
Format.pp_set_mark_tags Format.std_formatter true;
5656
Compat.pp_set_formatter_tag_functions Format.std_formatter color_functions;
5757
if not (get_color_enabled ()) then
58-
#if OCAML_VERSION < (5, 02, 0)
58+
#if OCAML_VERSION < (5, 2, 0)
5959
CL.Misc.Color.setup (Some Never);
6060
#else
6161
Misc.Style.setup (Some Never);

‎src/Noalloc.ml‎

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,13 @@ let rec emitLocalSetBackwards ~(funDef : Il.funDef) ~(scope : Il.scope) =
6464

6565
let rec processFunDefPat ~funDef ~env ~mem (pat : CL.Typedtree.pattern) =
6666
match pat.pat_desc with
67-
| Tpat_var (id, _) | Tpat_alias ({pat_desc = Tpat_any}, id, _) ->
67+
#if OCAML_VERSION < (5, 2, 0)
68+
| Tpat_var (id, _)
69+
| Tpat_alias ({pat_desc = Tpat_any}, id, _) ->
70+
#else
71+
| Tpat_var (id, _, _)
72+
| Tpat_alias ({pat_desc = Tpat_any}, id, _, _) ->
73+
#endif
6874
let scope = pat.pat_type |> processTyp ~funDef ~loc:pat.pat_loc in
6975
let newEnv =
7076
env |> Il.Env.add ~id:(id |> CL.Ident.name) ~def:(LocalScope scope)
@@ -91,13 +97,22 @@ let rec processFunDefPat ~funDef ~env ~mem (pat : CL.Typedtree.pattern) =
9197
let rec processFunDef ~funDef ~env ~mem ~params (expr : CL.Typedtree.expression)
9298
=
9399
match expr.exp_desc with
100+
#if OCAML_VERSION < (5, 2, 0)
94101
| Texp_function
95102
{
96103
arg_label = Nolabel;
97104
param;
98105
cases = [{c_lhs; c_guard = None; c_rhs}];
99106
partial = Total;
100107
} ->
108+
#else
109+
| Texp_function(_,
110+
Tfunction_cases {
111+
param;
112+
cases = [{c_lhs; c_guard = None; c_rhs}];
113+
partial = Total;
114+
}) ->
115+
#endif
101116
let newEnv, typ = c_lhs |> processFunDefPat ~funDef ~env ~mem in
102117
c_rhs
103118
|> processFunDef ~funDef ~env:newEnv ~mem ~params:((param, typ) :: params)
@@ -132,7 +147,11 @@ let processConst ~funDef ~loc ~mem (const_ : CL.Asttypes.constant) =
132147
let rec processLocalBinding ~env ~(pat : CL.Typedtree.pattern)
133148
~(scope : Il.scope) =
134149
match (pat.pat_desc, scope) with
150+
#if OCAML_VERSION < (5, 2, 0)
135151
| Tpat_var (id, _), _ ->
152+
#else
153+
| Tpat_var (id, _, _), _ ->
154+
#endif
136155
env |> Il.Env.add ~id:(id |> CL.Ident.name) ~def:(LocalScope scope)
137156
| Tpat_tuple pats, Tuple scopes ->
138157
let patsAndScopes = (List.combine pats scopes [@doesNotRaise]) in
@@ -283,7 +302,11 @@ let processValueBinding ~id ~(expr : CL.Typedtree.expression) =
283302

284303
let collectValueBinding super self (vb : CL.Typedtree.value_binding) =
285304
(match vb.vb_pat.pat_desc with
305+
#if OCAML_VERSION < (5, 2, 0)
286306
| Tpat_var (id, _)
307+
#else
308+
| Tpat_var (id, _, _)
309+
#endif
287310
when vb.vb_attributes |> Annotation.hasAttribute (( = ) "noalloc") ->
288311
processValueBinding ~id ~expr:vb.CL.Typedtree.vb_expr
289312
| _ -> ());

0 commit comments

Comments
 (0)