diff --git a/.ocamlformat b/.ocamlformat index 87496a125..ad5b55b6f 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,5 +1,5 @@ profile = default -version = 0.26.1 +version = 0.26.2 field-space = tight-decl break-cases = toplevel diff --git a/.vscode/settings.json b/.vscode/settings.json index c7e28bd31..7e7f928b2 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -4,7 +4,7 @@ "typescript.tsc.autoDetect": "off", "typescript.preferences.quoteStyle": "single", "editor.codeActionsOnSave": { - "source.fixAll.eslint": true + "source.fixAll.eslint": "explicit" }, "ocaml.sandbox": { "kind": "opam", diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 1a7a0668c..305d3552a 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -42,7 +42,7 @@ At the root: ```sh # If you haven't created the switch, do it. OPAM(https://opam.ocaml.org) -opam switch 4.14.0 # can also create local switch with opam switch create . 4.14.0 +opam switch 5.2.0 # can also create local switch with opam switch create . 5.2.0 # Install dev dependencies from OPAM opam install . --deps-only @@ -51,6 +51,9 @@ opam install . --deps-only opam install ocaml-lsp-server ocamlformat ``` +You need `dune` to build the OCaml source code, if it is not available in your shell try running `eval $(opam env)`. +If `dune` is present, run `make build` to build the OCaml projects and copy the binaries to the root. + ## Build & Run - `npm run compile`. You don't need this if you're developing this repo in VSCode. The compilation happens automatically in the background. diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index e78222053..64f10b1f1 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -813,10 +813,10 @@ module Compile = struct | _ -> Stats.logHygieneNamedArgValue ~label ~loc; raise ArgError - [@@raises ArgError] + [@@raises ArgError] in functionArg () - [@@raises ArgError] + [@@raises ArgError] in let functionArgsOpt = try Some (functionDefinition.kind |> List.map getFunctionArg) @@ -1320,7 +1320,7 @@ let traverseAst ~valueBindingsTable = progressFunctionsFromAttributes valueBinding.vb_attributes with | None -> (progressFunctions, functionsToAnalyze) - | Some newProgressFunctions -> ( + | Some newProgressFunctions -> ( StringSet.union (StringSet.of_list newProgressFunctions) progressFunctions, @@ -1328,7 +1328,7 @@ let traverseAst ~valueBindingsTable = | Tpat_var (id, _) -> (Ident.name id, valueBinding.vb_expr.exp_loc) :: functionsToAnalyze - | _ -> functionsToAnalyze ))) + | _ -> functionsToAnalyze )) (StringSet.empty, []) in (progressFunctions0, functionsToAnalyze0 |> List.rev) diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index ffbc8361b..791213e08 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -45,12 +45,12 @@ let collectValueBinding super self (vb : Typedtree.value_binding) = | _ -> false in (if (not exists) && not isFirstClassModule then - (* This is never toplevel currently *) - let isToplevel = oldLastBinding = Location.none in - let sideEffects = SideEffects.checkExpr vb.vb_expr in - name - |> addValueDeclaration ~isToplevel ~loc ~moduleLoc:currentModulePath.loc - ~optionalArgs ~path ~sideEffects); + (* This is never toplevel currently *) + let isToplevel = oldLastBinding = Location.none in + let sideEffects = SideEffects.checkExpr vb.vb_expr in + name + |> addValueDeclaration ~isToplevel ~loc + ~moduleLoc:currentModulePath.loc ~optionalArgs ~path ~sideEffects); (match PosHash.find_opt decls loc_start with | None -> () | Some decl -> diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index 2973c3946..95bade64a 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -138,20 +138,20 @@ module Event = struct if !Common.Cli.debug then Log_.item "%a@." print ev; let nestedExceptions = loop Exceptions.empty nestedEvents in (if Exceptions.isEmpty nestedExceptions (* catch-all *) then - let name = - match nestedEvents with - | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName - | _ -> "expression" |> Name.create - in - Log_.warning ~loc - (Common.ExceptionAnalysis - { - message = - Format.asprintf - "@{%s@} does not raise and is annotated with \ - redundant @doesNotRaise" - (name |> Name.toString); - })); + let name = + match nestedEvents with + | {kind = Call {callee}} :: _ -> callee |> Common.Path.toName + | _ -> "expression" |> Name.create + in + Log_.warning ~loc + (Common.ExceptionAnalysis + { + message = + Format.asprintf + "@{%s@} does not raise and is annotated with \ + redundant @doesNotRaise" + (name |> Name.toString); + })); loop exnSet rest | ({kind = Catches nestedEvents; exceptions} as ev) :: rest -> if !Common.Cli.debug then Log_.item "%a@." print ev; @@ -192,11 +192,11 @@ module Checks = struct let missingAnnotations = Exceptions.diff raiseSet exceptions in let redundantAnnotations = Exceptions.diff exceptions raiseSet in (if not (Exceptions.isEmpty missingAnnotations) then - let description = - Common.ExceptionAnalysisMissing - {exnName; exnTable; raiseSet; missingAnnotations; locFull} - in - Log_.warning ~loc description); + let description = + Common.ExceptionAnalysisMissing + {exnName; exnTable; raiseSet; missingAnnotations; locFull} + in + Log_.warning ~loc description); if not (Exceptions.isEmpty redundantAnnotations) then Log_.warning ~loc (Common.ExceptionAnalysis @@ -356,14 +356,14 @@ let traverseAst () = cases |> iterCases self | _ -> super.expr self expr |> ignore); (if isDoesNoRaise then - let nestedEvents = !currentEvents in - currentEvents := - { - Event.exceptions = Exceptions.empty; - loc; - kind = DoesNotRaise nestedEvents; - } - :: oldEvents); + let nestedEvents = !currentEvents in + currentEvents := + { + Event.exceptions = Exceptions.empty; + loc; + kind = DoesNotRaise nestedEvents; + } + :: oldEvents); expr in let getExceptionsFromAnnotations attributes = diff --git a/analysis/reanalyze/src/Log_.ml b/analysis/reanalyze/src/Log_.ml index ec98987cd..2bb6aa0e9 100644 --- a/analysis/reanalyze/src/Log_.ml +++ b/analysis/reanalyze/src/Log_.ml @@ -75,10 +75,10 @@ module Loc = struct pos_cnum = char; pos_fname = (let open Filename in - match is_implicit pos.pos_fname with - | _ when !Cli.ci -> basename pos.pos_fname - | true -> concat (Sys.getcwd ()) pos.pos_fname - | false -> pos.pos_fname); + match is_implicit pos.pos_fname with + | _ when !Cli.ci -> basename pos.pos_fname + | true -> concat (Sys.getcwd ()) pos.pos_fname + | false -> pos.pos_fname); } in Location.print_loc ppf diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index 0355c9cb7..e52a9c1f4 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -110,7 +110,7 @@ let cli () = let versionAndExit () = print_endline usage; exit 0 - [@@raises exit] + [@@raises exit] in let rec setAll cmtRoot = RunConfig.all (); @@ -216,7 +216,7 @@ let cli () = if !analysisKindSet = false then setConfig (); let cmtRoot = !cmtRootRef in runAnalysisAndReport ~cmtRoot - [@@raises exit] +[@@raises exit] module RunConfig = RunConfig module Log_ = Log_ diff --git a/analysis/reanalyze/src/WriteDeadAnnotations.ml b/analysis/reanalyze/src/WriteDeadAnnotations.ml index fb99fa24a..642bb3d87 100644 --- a/analysis/reanalyze/src/WriteDeadAnnotations.ml +++ b/analysis/reanalyze/src/WriteDeadAnnotations.ml @@ -42,33 +42,33 @@ let rec lineToString_ {original; declarations} = { original = (if String.length original >= col && col > 0 then - let original1, original2 = - try - ( String.sub original 0 col, - String.sub original col (originalLen - col) ) - with Invalid_argument _ -> (original, "") - in - if language = Res && declKind = VariantCase then - if - String.length original2 >= 2 - && (String.sub [@doesNotRaise]) original2 0 2 = "| " - then - original1 ^ "| " ^ annotationStr - ^ (String.sub [@doesNotRaise]) original2 2 - (String.length original2 - 2) - else if - String.length original2 >= 1 - && (String.sub [@doesNotRaise]) original2 0 1 = "|" - then - original1 ^ "|" ^ annotationStr - ^ (String.sub [@doesNotRaise]) original2 1 - (String.length original2 - 1) - else original1 ^ "| " ^ annotationStr ^ original2 - else original1 ^ annotationStr ^ original2 - else - match language = Ml with - | true -> original ^ annotationStr - | false -> annotationStr ^ original); + let original1, original2 = + try + ( String.sub original 0 col, + String.sub original col (originalLen - col) ) + with Invalid_argument _ -> (original, "") + in + if language = Res && declKind = VariantCase then + if + String.length original2 >= 2 + && (String.sub [@doesNotRaise]) original2 0 2 = "| " + then + original1 ^ "| " ^ annotationStr + ^ (String.sub [@doesNotRaise]) original2 2 + (String.length original2 - 2) + else if + String.length original2 >= 1 + && (String.sub [@doesNotRaise]) original2 0 1 = "|" + then + original1 ^ "|" ^ annotationStr + ^ (String.sub [@doesNotRaise]) original2 1 + (String.length original2 - 1) + else original1 ^ "| " ^ annotationStr ^ original2 + else original1 ^ annotationStr ^ original2 + else + match language = Ml with + | true -> original ^ annotationStr + | false -> annotationStr ^ original); declarations = nextDeclarations; } |> lineToString_ @@ -91,7 +91,7 @@ let readFile fileName = let line = {original = input_line channel; declarations = []} in lines := line :: !lines; loop () - [@@raises End_of_file] + [@@raises End_of_file] in try loop () with End_of_file -> @@ -122,9 +122,9 @@ let getLineAnnotation ~decl ~line = posAnnotation.pos_cnum - posAnnotation.pos_bol + offset ) ~text: (if decl.posAdjustment = FirstVariant then - (* avoid syntax error *) - "| @dead " - else "@dead ") + (* avoid syntax error *) + "| @dead " + else "@dead ") ~action:"Suppress dead code warning" else Format.asprintf "@. <-- line %d@. %s" decl.pos.pos_lnum diff --git a/analysis/src/ProcessExtra.ml b/analysis/src/ProcessExtra.ml index e0a90d656..e153c76cb 100644 --- a/analysis/src/ProcessExtra.ml +++ b/analysis/src/ProcessExtra.ml @@ -9,8 +9,8 @@ let addReference ~extra stamp loc = (loc :: (if Hashtbl.mem extra.internalReferences stamp then - Hashtbl.find extra.internalReferences stamp - else [])) + Hashtbl.find extra.internalReferences stamp + else [])) let extraForFile ~(file : File.t) = let extra = initExtra () in @@ -66,8 +66,8 @@ let addExternalReference ~extra moduleName path tip loc = ((path, tip, loc) :: (if Hashtbl.mem extra.externalReferences moduleName then - Hashtbl.find extra.externalReferences moduleName - else [])) + Hashtbl.find extra.externalReferences moduleName + else [])) let addFileReference ~extra moduleName loc = let newLocs = diff --git a/analysis/src/References.ml b/analysis/src/References.ml index e19439a20..e047a2ba1 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -66,7 +66,7 @@ let getLocItem ~full ~pos ~debug = | [ ({locType = Typed (_, _, LocalReference _)} as li1); ({locType = Typed (_, _, GlobalReference ("Js_OO", ["unsafe_downgrade"], _))} - as li2); + as li2); li3; ] (* For older compiler 9.0 or earlier *) diff --git a/analysis/src/Scope.ml b/analysis/src/Scope.ml index 54a6de558..0e092d2a4 100644 --- a/analysis/src/Scope.ml +++ b/analysis/src/Scope.ml @@ -14,7 +14,7 @@ let itemToString item = | Module (s, loc) -> "Module " ^ s ^ " " ^ Loc.toString loc | Value (s, loc, _, _) -> "Value " ^ s ^ " " ^ Loc.toString loc | Type (s, loc) -> "Type " ^ s ^ " " ^ Loc.toString loc - [@@live] +[@@live] let create () : t = [] let addConstructor ~name ~loc x = Constructor (name, loc) :: x @@ -24,12 +24,12 @@ let addOpen ~lid x = Open (Utils.flattenLongIdent lid @ ["place holder"]) :: x let addValue ~name ~loc ?contextPath x = let showDebug = !Cfg.debugFollowCtxPath in (if showDebug then - match contextPath with - | None -> Printf.printf "adding value '%s', no ctxPath\n" name - | Some contextPath -> - if showDebug then - Printf.printf "adding value '%s' with ctxPath: %s\n" name - (SharedTypes.Completable.contextPathToString contextPath)); + match contextPath with + | None -> Printf.printf "adding value '%s', no ctxPath\n" name + | Some contextPath -> + if showDebug then + Printf.printf "adding value '%s' with ctxPath: %s\n" name + (SharedTypes.Completable.contextPathToString contextPath)); Value (name, loc, contextPath, x) :: x let addType ~name ~loc x = Type (name, loc) :: x diff --git a/tools/bin/version.ml b/tools/bin/version.ml index d70940e28..8a00911bb 100644 --- a/tools/bin/version.ml +++ b/tools/bin/version.ml @@ -1 +1 @@ -let version = "0.6.4" \ No newline at end of file +let version = "0.6.4"