Support ocaml 5.2

.github/workflows/ci.yml

@@ -56,6 +56,10 @@ jobs:
             target: ocaml.5.1
             ocaml-compiler: 5.1.x
             build: opam exec -- dune build
+          - os: ubuntu-latest
+            target: ocaml.5.2
+            ocaml-compiler: 5.2.x
+            build: opam exec -- dune build
 
     runs-on: ${{matrix.os}}
 

Changes.md

@@ -1,3 +1,7 @@
+# 2.25.0
+
+- Support OCaml 5.2.
+
 # 2.24.0
 
 - Add `-native-build-target` option to explicitly specify a build target path for native OCaml projects.

package.json

@@ -1,6 +1,6 @@
 {
   "name": "reanalyze",
-  "version": "2.24.0",
+  "version": "2.25.0",
   "private": true,
   "description": "Analyzers for Dead Code/Types and termination",
   "license": "MIT",

reanalyze.opam

@@ -10,7 +10,7 @@ homepage: "https://github.com/rescript-association/reanalyze"
 bug-reports: "https://github.com/rescript-association/reanalyze/issues"
 depends: [
   "dune" {>= "2.0"}
-  "ocaml" {>= "4.08.0" & < "5.2"}
+  "ocaml" {>= "4.08.0" & < "5.3"}
   "cppo" {build}
 ]
 build: [

src/Arnold.ml

@@ -515,7 +515,7 @@ module ExtendFunctionTable = struct
               ( Nonrecursive,
                 [
                   {
-                    vb_pat = {pat_desc = Tpat_var (_, _)};
+                    vb_pat = {pat_desc = Tpat_var _};
                     vb_expr = {exp_desc = Texp_ident (path, {loc}, _)};
                     vb_loc = {loc_ghost = true};
                   };
@@ -779,7 +779,13 @@ module Compile = struct
     | Texp_apply (expr, args) -> expr |> expression ~ctx |> evalArgs ~args ~ctx
     | Texp_let
         ( Recursive,
-          [{vb_pat = {pat_desc = Tpat_var (id, _); pat_loc}; vb_expr}],
+          [{vb_pat = {pat_desc =
+          #if OCAML_VERSION < (5, 2, 0)
+            Tpat_var (id, _);
+          #else
+            Tpat_var (id, _, _);
+          #endif
+            pat_loc}; vb_expr}],
           inExpr ) ->
       let oldFunctionName = Ident.name id in
       let newFunctionName = currentFunctionName ^ "$" ^ oldFunctionName in
@@ -836,7 +842,12 @@ module Compile = struct
         let open Command in
         c +++ ConstrOption Rnone
       | _ -> c)
-    | Texp_function {cases} -> cases |> List.map (case ~ctx) |> Command.nondet
+    #if OCAML_VERSION < (5, 2, 0)
+    | Texp_function {cases} ->
+    #else
+    | Texp_function (_, Tfunction_cases {cases; _}) ->
+    #endif
+       cases |> List.map (case ~ctx) |> Command.nondet
     | Texp_match _ when not (expr.exp_desc |> Compat.texpMatchHasExceptions)
       -> (
       (* No exceptions *)
@@ -1226,7 +1237,11 @@ let traverseAst ~valueBindingsTable =
     valueBindings
     |> List.iter (fun (vb : CL.Typedtree.value_binding) ->
            match vb.vb_pat.pat_desc with
+           #if OCAML_VERSION < (5, 2, 0)
            | Tpat_var (id, {loc = {loc_start = pos}}) ->
+           #else
+           | Tpat_var (id, {loc = {loc_start = pos}}, _) ->
+           #endif
              let callees = lazy (FindFunctionsCalled.findCallees vb.vb_expr) in
              Hashtbl.replace valueBindingsTable (CL.Ident.name id)
                (pos, vb.vb_expr, callees)
@@ -1248,7 +1263,11 @@ let traverseAst ~valueBindingsTable =
                        (StringSet.of_list newProgressFunctions)
                        progressFunctions,
                      match valueBinding.vb_pat.pat_desc with
+                     #if OCAML_VERSION < (5, 2, 0)
                      | Tpat_var (id, _) ->
+                     #else
+                     | Tpat_var (id, _, _) ->
+                     #endif
                        (CL.Ident.name id, valueBinding.vb_expr.exp_loc)
                        :: functionsToAnalyze
                      | _ -> functionsToAnalyze )))
@@ -1265,7 +1284,12 @@ let traverseAst ~valueBindingsTable =
         List.fold_left
           (fun defs (valueBinding : CL.Typedtree.value_binding) ->
             match valueBinding.vb_pat.pat_desc with
-            | Tpat_var (id, _) -> CL.Ident.name id :: defs
+            #if OCAML_VERSION < (5, 2, 0)
+            | Tpat_var (id, _) ->
+            #else
+            | Tpat_var (id, _, _) ->
+            #endif
+               CL.Ident.name id :: defs
             | _ -> defs)
           [] valueBindings
         |> List.rev

src/DeadCommon.ml

@@ -336,8 +336,13 @@ module ProcessDeadAnnotations = struct
         ({vb_attributes; vb_pat} as value_binding : CL.Typedtree.value_binding)
         =
       (match vb_pat.pat_desc with
+      #if OCAML_VERSION < (5, 2, 0)
       | Tpat_var (id, {loc = {loc_start = pos}})
       | Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}) ->
+      #else
+      | Tpat_var (id, {loc = {loc_start = pos}}, _)
+      | Tpat_alias ({pat_desc = Tpat_any}, id, {loc = {loc_start = pos}}, _) ->
+      #endif
         if !currentlyDisableWarnings then pos |> annotateLive;
         vb_attributes
         |> processAttributes ~doGenType ~name:(id |> CL.Ident.name) ~pos

src/DeadValue.ml

@@ -21,9 +21,15 @@ let collectValueBinding super self (vb : CL.Typedtree.value_binding) =
   checkAnyValueBindingWithNoSideEffects vb;
   let loc =
     match vb.vb_pat.pat_desc with
+    #if OCAML_VERSION < (5, 2, 0)
     | Tpat_var (id, {loc = {loc_start; loc_ghost} as loc})
     | Tpat_alias
         ({pat_desc = Tpat_any}, id, {loc = {loc_start; loc_ghost} as loc})
+    #else
+    | Tpat_var (id, {loc = {loc_start; loc_ghost} as loc}, _)
+    | Tpat_alias
+        ({pat_desc = Tpat_any}, id, {loc = {loc_start; loc_ghost} as loc}, _)
+    #endif
       when (not loc_ghost) && not vb.vb_loc.loc_ghost ->
       let name = CL.Ident.name id |> Name.create ~isInterface:false in
       let optionalArgs =
@@ -143,7 +149,11 @@ let rec collectExpr super self (e : CL.Typedtree.expression) =
       Nonrecursive,
         [
           {
+            #if OCAML_VERSION < (5, 2, 0)
             vb_pat = {pat_desc = Tpat_var (idArg, _)};
+            #else
+            vb_pat = {pat_desc = Tpat_var (idArg, _, _)};
+            #endif
             vb_expr =
               {
                 exp_desc =
@@ -157,6 +167,7 @@ let rec collectExpr super self (e : CL.Typedtree.expression) =
         ],
         {
           exp_desc =
+            #if OCAML_VERSION < (5, 2, 0)
             Texp_function
               {
                 cases =
@@ -172,6 +183,23 @@ let rec collectExpr super self (e : CL.Typedtree.expression) =
                     };
                   ];
               };
+            #else
+              Texp_function(_,
+              Tfunction_cases {
+                cases =
+                  [
+                    {
+                      c_lhs = {pat_desc = Tpat_var (etaArg, _, _)};
+                      c_rhs =
+                        {
+                          exp_desc =
+                            Texp_apply
+                              ({exp_desc = Texp_ident (idArg2, _, _)}, args);
+                        };
+                    };
+                  ];
+              });
+            #endif
         } )
     when CL.Ident.name idArg = "arg"
          && CL.Ident.name etaArg = "eta"

src/Exception.ml

@@ -478,7 +478,11 @@ let traverseAst () =
            && Compat.unboxPatCstrTxt vb.vb_pat.pat_desc
               = CL.Longident.Lident "()" ->
       processBinding "()"
+    #if OCAML_VERSION < (5, 2, 0)
     | Tpat_var (id, {loc = {loc_ghost}})
+    #else
+    | Tpat_var (id, {loc = {loc_ghost}}, _)
+    #endif
       when (isFunction || isToplevel) && (not loc_ghost)
            && not vb.vb_loc.loc_ghost ->
       processBinding (id |> CL.Ident.name)

src/Log_.ml

@@ -54,7 +54,12 @@ module Color = struct
   let setup () =
     Format.pp_set_mark_tags Format.std_formatter true;
     Compat.pp_set_formatter_tag_functions Format.std_formatter color_functions;
-    if not (get_color_enabled ()) then CL.Misc.Color.setup (Some Never);
+    if not (get_color_enabled ()) then
+    #if OCAML_VERSION < (5, 2, 0)
+      CL.Misc.Color.setup (Some Never);
+    #else
+      Misc.Style.setup (Some Never);
+    #endif
     (* Print a dummy thing once in the beginning, as otherwise flushing does not work. *)
     CL.Location.print_loc Format.str_formatter CL.Location.none
 

src/Noalloc.ml

@@ -64,7 +64,13 @@ let rec emitLocalSetBackwards ~(funDef : Il.funDef) ~(scope : Il.scope) =
 
 let rec processFunDefPat ~funDef ~env ~mem (pat : CL.Typedtree.pattern) =
   match pat.pat_desc with
-  | Tpat_var (id, _) | Tpat_alias ({pat_desc = Tpat_any}, id, _) ->
+  #if OCAML_VERSION < (5, 2, 0)
+  | Tpat_var (id, _)
+  | Tpat_alias ({pat_desc = Tpat_any}, id, _) ->
+  #else
+  | Tpat_var (id, _, _)
+  | Tpat_alias ({pat_desc = Tpat_any}, id, _, _) ->
+  #endif
     let scope = pat.pat_type |> processTyp ~funDef ~loc:pat.pat_loc in
     let newEnv =
       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) =
 let rec processFunDef ~funDef ~env ~mem ~params (expr : CL.Typedtree.expression)
     =
   match expr.exp_desc with
+  #if OCAML_VERSION < (5, 2, 0)
   | Texp_function
       {
         arg_label = Nolabel;
         param;
         cases = [{c_lhs; c_guard = None; c_rhs}];
         partial = Total;
       } ->
+  #else
+  | Texp_function(_,
+      Tfunction_cases {
+        param;
+        cases = [{c_lhs; c_guard = None; c_rhs}];
+        partial = Total;
+      }) ->
+  #endif
     let newEnv, typ = c_lhs |> processFunDefPat ~funDef ~env ~mem in
     c_rhs
     |> processFunDef ~funDef ~env:newEnv ~mem ~params:((param, typ) :: params)
@@ -132,7 +147,11 @@ let processConst ~funDef ~loc ~mem (const_ : CL.Asttypes.constant) =
 let rec processLocalBinding ~env ~(pat : CL.Typedtree.pattern)
     ~(scope : Il.scope) =
   match (pat.pat_desc, scope) with
+  #if OCAML_VERSION < (5, 2, 0)
   | Tpat_var (id, _), _ ->
+  #else
+  | Tpat_var (id, _, _), _ ->
+  #endif
     env |> Il.Env.add ~id:(id |> CL.Ident.name) ~def:(LocalScope scope)
   | Tpat_tuple pats, Tuple scopes ->
     let patsAndScopes = (List.combine pats scopes [@doesNotRaise]) in
@@ -283,7 +302,11 @@ let processValueBinding ~id ~(expr : CL.Typedtree.expression) =
 
 let collectValueBinding super self (vb : CL.Typedtree.value_binding) =
   (match vb.vb_pat.pat_desc with
+  #if OCAML_VERSION < (5, 2, 0)
   | Tpat_var (id, _)
+  #else
+  | Tpat_var (id, _, _)
+  #endif
     when vb.vb_attributes |> Annotation.hasAttribute (( = ) "noalloc") ->
     processValueBinding ~id ~expr:vb.CL.Typedtree.vb_expr
   | _ -> ());

src/Version.ml

@@ -2,4 +2,4 @@
 (* CREATED BY reanalyze/scripts/bump_version_module.js *)
 (* DO NOT MODIFY BY HAND, WILL BE AUTOMATICALLY UPDATED BY npm version *)
 
-let version = "2.24.0";
+let version = "2.25.0";