From fa8f59fa1c2674574e7c9d25454b497f99d422b8 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 26 May 2024 11:45:56 +0200 Subject: [PATCH 1/5] Support ocaml 5.02 Fixes https://github.com/rescript-association/reanalyze/issues/196 --- src/Log_.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Log_.ml b/src/Log_.ml index 85f87f3f..c01ff57f 100644 --- a/src/Log_.ml +++ b/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, 02, 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 From fc28224e32631db25079bcf2e4f66873ab17e997 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 26 May 2024 18:56:36 +0200 Subject: [PATCH 2/5] Adapt remaining files. --- src/Arnold.ml | 32 ++++++++++++++++++++++++++++---- src/DeadCommon.ml | 5 +++++ src/DeadValue.ml | 28 ++++++++++++++++++++++++++++ src/Exception.ml | 4 ++++ src/Log_.ml | 2 +- src/Noalloc.ml | 25 ++++++++++++++++++++++++- 6 files changed, 90 insertions(+), 6 deletions(-) diff --git a/src/Arnold.ml b/src/Arnold.ml index 4d5fb5fe..4081313d 100644 --- a/src/Arnold.ml +++ b/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 diff --git a/src/DeadCommon.ml b/src/DeadCommon.ml index c11c4bb9..fdab04a6 100644 --- a/src/DeadCommon.ml +++ b/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 diff --git a/src/DeadValue.ml b/src/DeadValue.ml index 6be12a71..66a44a5c 100644 --- a/src/DeadValue.ml +++ b/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" diff --git a/src/Exception.ml b/src/Exception.ml index a8d22ae0..9889d243 100644 --- a/src/Exception.ml +++ b/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) diff --git a/src/Log_.ml b/src/Log_.ml index c01ff57f..1ec39d09 100644 --- a/src/Log_.ml +++ b/src/Log_.ml @@ -55,7 +55,7 @@ module Color = struct 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 - #if OCAML_VERSION < (5, 02, 0) + #if OCAML_VERSION < (5, 2, 0) CL.Misc.Color.setup (Some Never); #else Misc.Style.setup (Some Never); diff --git a/src/Noalloc.ml b/src/Noalloc.ml index 22ef8fb7..314d52ab 100644 --- a/src/Noalloc.ml +++ b/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,6 +97,7 @@ 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; @@ -98,6 +105,14 @@ let rec processFunDef ~funDef ~env ~mem ~params (expr : CL.Typedtree.expression) 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 | _ -> ()); From 69b13c9f5cfa2572745c7d61db68b21eaf331762 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 26 May 2024 19:00:09 +0200 Subject: [PATCH 3/5] Add 5.2 in CI. --- .github/workflows/ci.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 05cfaa4c..be2c3854 100644 --- a/.github/workflows/ci.yml +++ b/.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}} From 5cbd90839fe4e1f37bbfc77f2fc78669deff4cac Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sun, 26 May 2024 19:06:28 +0200 Subject: [PATCH 4/5] Allow 5.2 in opam file --- reanalyze.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reanalyze.opam b/reanalyze.opam index 850b0336..afab90fc 100644 --- a/reanalyze.opam +++ b/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: [ From 6ac1e4842b3c0aad19c956d8c7e3a4e9ca061ce0 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sun, 26 May 2024 19:25:07 +0200 Subject: [PATCH 5/5] Version 2.25.0 --- Changes.md | 4 ++++ examples/deadcode/package-lock.json | 2 +- package-lock.json | 4 ++-- package.json | 2 +- src/Version.ml | 2 +- 5 files changed, 9 insertions(+), 5 deletions(-) diff --git a/Changes.md b/Changes.md index 0cb01c1e..b0014e71 100644 --- a/Changes.md +++ b/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. diff --git a/examples/deadcode/package-lock.json b/examples/deadcode/package-lock.json index c979f18b..024cfc8b 100644 --- a/examples/deadcode/package-lock.json +++ b/examples/deadcode/package-lock.json @@ -20,7 +20,7 @@ } }, "../..": { - "version": "2.24.0", + "version": "2.25.0", "license": "MIT", "bin": { "reanalyze.exe": "_build/install/default/bin/reanalyze.exe" diff --git a/package-lock.json b/package-lock.json index 283e9171..5741f1ee 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "reanalyze", - "version": "2.24.0", + "version": "2.25.0", "lockfileVersion": 3, "requires": true, "packages": { "": { "name": "reanalyze", - "version": "2.24.0", + "version": "2.25.0", "license": "MIT", "bin": { "reanalyze.exe": "_build/install/default/bin/reanalyze.exe" diff --git a/package.json b/package.json index eeb4272e..af3e3c2b 100644 --- a/package.json +++ b/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", diff --git a/src/Version.ml b/src/Version.ml index 5b9ccfd8..31b56ffb 100644 --- a/src/Version.ml +++ b/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";