From 923ddf72bf93e40e31786f26f8681f7286b70e1b Mon Sep 17 00:00:00 2001 From: Ulysse <5031221+voodoos@users.noreply.github.com> Date: Mon, 1 Jul 2024 16:39:46 +0200 Subject: [PATCH 1/5] Remove ocaml-index pin-dependency --- merlin.opam | 3 --- 1 file changed, 3 deletions(-) diff --git a/merlin.opam b/merlin.opam index ff3f8f67e..478ec627d 100644 --- a/merlin.opam +++ b/merlin.opam @@ -71,6 +71,3 @@ See https://github.com/OCamlPro/opam-user-setup " {success & !user-setup:installed} ] -pin-depends: [ - ["ocaml-index.1.0" "git+https://github.com/voodoos/ocaml-index#82b08987921884daeeb5dccc345a2dcb667fe113"] -] From 68fdaf49ca2ae2c083dd7c17fba2b680a7636362 Mon Sep 17 00:00:00 2001 From: Sora Morimoto Date: Tue, 2 Jul 2024 18:15:27 +0900 Subject: [PATCH 2/5] Update ocaml/setup-ocaml to v3 (#1791) Signed-off-by: Sora Morimoto --- .github/dependabot.yml | 8 ++++++++ .github/workflows/emacs-lint.yml | 4 ++-- .github/workflows/fuzzy-ci.yml | 26 +++++++++++++------------- .github/workflows/main.yml | 3 +-- .github/workflows/nix.yml | 4 ++-- .github/workflows/ocaml-lsp-compat.yml | 5 ++--- 6 files changed, 28 insertions(+), 22 deletions(-) create mode 100644 .github/dependabot.yml diff --git a/.github/dependabot.yml b/.github/dependabot.yml new file mode 100644 index 000000000..fcde0c288 --- /dev/null +++ b/.github/dependabot.yml @@ -0,0 +1,8 @@ +version: 2 +updates: + - package-ecosystem: github-actions + directory: / + schedule: + interval: weekly + labels: + - no changelog diff --git a/.github/workflows/emacs-lint.yml b/.github/workflows/emacs-lint.yml index 0f337cad9..5a24c9687 100644 --- a/.github/workflows/emacs-lint.yml +++ b/.github/workflows/emacs-lint.yml @@ -25,10 +25,10 @@ jobs: EMACS_PACKAGE_LINT_IGNORE: ${{ matrix.package_lint_ignore }} EMACS_BYTECOMP_WARN_IGNORE: ${{ matrix.bytecomp_warn_ignore }} steps: - - uses: purcell/setup-emacs@master + - uses: purcell/setup-emacs@v6.0 with: version: ${{ matrix.emacs_version }} - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - name: Run tests run: 'cd emacs && ./check.sh' diff --git a/.github/workflows/fuzzy-ci.yml b/.github/workflows/fuzzy-ci.yml index cffc02a32..08be7fb02 100644 --- a/.github/workflows/fuzzy-ci.yml +++ b/.github/workflows/fuzzy-ci.yml @@ -87,7 +87,7 @@ jobs: echo "version=$v" | tee -a $GITHUB_OUTPUT - name: Install OCaml - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ steps.compiler.outputs.version }} dune-cache: true @@ -105,7 +105,7 @@ jobs: opam exec -- dune install -p merlin-lib,dot-merlin-reader,merlin - name: Pull irmin and its deps from cache if possible - uses: actions/cache@v3 + uses: actions/cache@v4 id: irmin-cache with: path: irmin/ @@ -161,7 +161,7 @@ jobs: working-directory: irmin - name: Pull merl-an from cache if possible - uses: actions/cache@v3 + uses: actions/cache@v4 id: merl-an-cache with: path: /usr/local/bin/merl-an @@ -203,7 +203,7 @@ jobs: run: echo "name=$${{ matrix.commit }}_artifact_name" >> $GITHUB_OUTPUT - name: Upload data - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: ${{ steps.artifact_name.outputs.name }} path: ${{ env.data_dir }} @@ -217,7 +217,7 @@ jobs: - name: Upload diff tool if: ${{ matrix.commit == 'merge_branch' }} - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: diff_tool path: create_diff @@ -234,13 +234,13 @@ jobs: diff_dir: diff steps: - name: Download base branch data - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 with: name: ${{ env.BASE_BRANCH_ARTIFACT_NAME }} path: ${{ env.base_data_dir }} - name: Download merge branch data - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 with: name: ${{ env.MERGE_BRANCH_ARTIFACT_NAME }} path: ${{ env.merge_data_dir }} @@ -249,7 +249,7 @@ jobs: run: mkdir -p "$diff_dir" - name: Download diff tool - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 with: name: diff_tool @@ -293,7 +293,7 @@ jobs: | ./create_diff "--input-separator--" "--diff-cmd-separator--" "$diff_dir/$DISTILLED_DIFF_FILE" - name: Upload diff(s) - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: ${{ env.DIFF_ARTIFACT_NAME }} path: ${{ env.diff_dir }} @@ -312,7 +312,7 @@ jobs: - name: Download current diff(s) if: ${{ env.current_diff_exists == 'true' }} - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 with: name: ${{ env.DIFF_ARTIFACT_NAME }} @@ -370,7 +370,7 @@ jobs: - name: Upload instruction to delete label if: ${{ env.earlier_diff_was_approved == 'true' && steps.approved_diff.outputs.hash != steps.current_diff.outputs.hash }} - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: forwarded_instructions path: forward/ @@ -453,7 +453,7 @@ jobs: - name: Upload instruction to delete label if: ${{ steps.diff_metadata.outputs.exists == 'false' }} - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: forwarded_instructions path: forward/ @@ -498,7 +498,7 @@ jobs: '{instruction: $instruction, endpoint: $endpoint, artifacts_url: $artifacts_url, hash: $hash}' > ./forward/instruction.json - name: Upload instruction to comment on PR - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: forwarded_instructions path: forward/ diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index e1c81f68f..825f18c80 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -55,13 +55,12 @@ jobs: uses: actions/checkout@v4 - name: Set-up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - name: Install dependencies run: | - opam depext conf-jq --yes # opam depext bug opam pin menhirLib 20201216 --no-action opam install --yes ppx_string ppx_compare opam install . --deps-only --with-test --yes diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml index 02d9769f7..1821f53b3 100644 --- a/.github/workflows/nix.yml +++ b/.github/workflows/nix.yml @@ -27,11 +27,11 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: submodules: true - name: nix - uses: cachix/install-nix-action@v21 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixos-unstable - run: nix develop -c dune build @check @runtest -p merlin-lib,dot-merlin-reader,merlin diff --git a/.github/workflows/ocaml-lsp-compat.yml b/.github/workflows/ocaml-lsp-compat.yml index 6c0e05a8a..b7a4ccd14 100644 --- a/.github/workflows/ocaml-lsp-compat.yml +++ b/.github/workflows/ocaml-lsp-compat.yml @@ -41,17 +41,16 @@ jobs: # Steps represent a sequence of tasks that will be executed as part of the job steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: # Version of the OCaml compiler to initialise ocaml-compiler: ${{ matrix.ocaml-compiler }} - name: Check that Merlin and OCaml-LSP are co-installable run: | - opam depext conf-jq # opam depext bug opam --cli=2.1 pin --with-version=dev --no-action https://github.com/voodoos/ocaml-lsp.git#5.2-preview opam --cli=2.1 pin --with-version=5.0-502 --no-action . opam install ocaml-lsp-server --with-test --ignore-constraints-on=ocamlformat From 5ed20c399d57e74d968f2a321ef3531fa87e9a7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 21 Jun 2024 16:58:36 +0200 Subject: [PATCH 3/5] Move voodoos/ocaml-index --- .github/workflows/main.yml | 2 +- merlin-lib.opam | 2 +- ocaml-index.opam | 36 ++++ src/ocaml-index/CHANGES.md | 10 + src/ocaml-index/README.md | 62 ++++++ src/ocaml-index/bin/dune | 9 + src/ocaml-index/bin/ocaml_index.ml | 105 ++++++++++ src/ocaml-index/lib/dune | 17 ++ src/ocaml-index/lib/index.ml | 181 ++++++++++++++++++ src/ocaml-index/lib/log.ml | 29 +++ src/ocaml-index/lib/log.mli | 9 + src/ocaml-index/tests/dune | 10 + src/ocaml-index/tests/tests-dirs/cmd.t | 16 ++ src/ocaml-index/tests/tests-dirs/flags.t | 33 ++++ .../tests/tests-dirs/index-project.t | 134 +++++++++++++ src/ocaml-index/tests/tests-dirs/interfaces.t | 23 +++ .../tests-dirs/local-shape-and-include.t | 56 ++++++ .../tests/tests-dirs/transitive-deps.t | 53 +++++ tests/test-dirs/occurrences/project-wide/dune | 5 +- 19 files changed, 788 insertions(+), 4 deletions(-) create mode 100644 ocaml-index.opam create mode 100644 src/ocaml-index/CHANGES.md create mode 100644 src/ocaml-index/README.md create mode 100644 src/ocaml-index/bin/dune create mode 100644 src/ocaml-index/bin/ocaml_index.ml create mode 100644 src/ocaml-index/lib/dune create mode 100644 src/ocaml-index/lib/index.ml create mode 100644 src/ocaml-index/lib/log.ml create mode 100644 src/ocaml-index/lib/log.mli create mode 100644 src/ocaml-index/tests/dune create mode 100644 src/ocaml-index/tests/tests-dirs/cmd.t create mode 100644 src/ocaml-index/tests/tests-dirs/flags.t create mode 100644 src/ocaml-index/tests/tests-dirs/index-project.t create mode 100644 src/ocaml-index/tests/tests-dirs/interfaces.t create mode 100644 src/ocaml-index/tests/tests-dirs/local-shape-and-include.t create mode 100644 src/ocaml-index/tests/tests-dirs/transitive-deps.t diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 825f18c80..803d3c3e0 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -68,7 +68,7 @@ jobs: - name: Build and test in release mode (windows) if: matrix.os == 'windows-latest' run: | - opam exec -- dune runtest -p merlin-lib,dot-merlin-reader,merlin + opam exec -- dune runtest -p merlin-lib,dot-merlin-reader,merlin,ocaml-index - name: Build and test in release mode (macos/linux) if: matrix.os != 'windows-latest' diff --git a/merlin-lib.opam b/merlin-lib.opam index 8f4e8c3e2..c78fbd3fb 100644 --- a/merlin-lib.opam +++ b/merlin-lib.opam @@ -11,7 +11,7 @@ build: [ ] depends: [ "ocaml" {>= "5.2" & < "5.3"} - "dune" {>= "2.9.0"} + "dune" {>= "3.0.0"} "csexp" {>= "1.5.1"} "menhir" {dev & >= "20201216"} "menhirLib" {dev & >= "20201216"} diff --git a/ocaml-index.opam b/ocaml-index.opam new file mode 100644 index 000000000..511bd5a49 --- /dev/null +++ b/ocaml-index.opam @@ -0,0 +1,36 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A tool that indexes value usages from cmt files" +description: + "ocaml-index should integrate with the build system to index codebase and allow tools such as Merlin to perform project-wide occurrences queries." +maintainer: ["ulysse@tarides.com"] +authors: ["ulysse@tarides.com"] +license: "MIT" +homepage: "https://github.com/voodoos/ocaml-index" +bug-reports: "https://github.com/voodoos/ocaml-index/issues" +depends: [ + "dune" {>= "3.0.0"} + "ocaml" {>= "5.2"} + "merlin-lib" {>= "5.1-502"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "--promote-install-files=false" + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["dune" "install" "-p" name "--create-install-files" name] +] +dev-repo: "git+https://github.com/voodoos/ocaml-index.git" +pin-depends: [ + ["merlin-lib.5.1-502" "git+https://github.com/ocaml/merlin"] +] diff --git a/src/ocaml-index/CHANGES.md b/src/ocaml-index/CHANGES.md new file mode 100644 index 000000000..b14a5452e --- /dev/null +++ b/src/ocaml-index/CHANGES.md @@ -0,0 +1,10 @@ +1.0 (2024-06-18) +---------------- + +### Added + +- Initial release. +- The `aggregate`` command that finishes reduction of shapes in cmt files and + store the output in a single index file. +- The `stats` command that prints information about an index file. +- The `dump` command that prints all locs of an index. diff --git a/src/ocaml-index/README.md b/src/ocaml-index/README.md new file mode 100644 index 000000000..a78ab6c84 --- /dev/null +++ b/src/ocaml-index/README.md @@ -0,0 +1,62 @@ +# ocaml-index + +Ocaml-index is a tool that indexes values from CMT files. Its current purpose is +to provide project-wide occurrences for OCaml codebases. The tool iterate on +given cmt's occurrences list (`cmt_ident_occurrences`) and determines the +definition of every value found in it. It then write an index to disk where +values corresponding to the same definition are grouped together. The tool can +also take multiple input files, index them and merge the results into a single +index. + +# Usage + +## Process cmt files and merge indexes + + +> ocaml-index aggregate [-o _output_file_] _cmt_file_ ... _index_file_ ... [-I _dir_] ... [--no-cmt-load-path] + + +- Input `cmt` files are indexed and merged into the final output +- Input index files are directly merged into the output +- If no input files is provided an empty index is created +- The default output file name is `project.ocaml-index` + +### Load path: +Identifying definitions while processing `cmt` files may require loading any of +the `cmt` files of every transitive dependency of the compilation unit. By +default the `cmt_load_path` of the first input `cmt` file will be used to search +for these other units. One can add more paths to the load path using the `-I` +option. Usage of the cmt's loadpath can be disabled using the +`--no-cmt-load-path` option. + +### Paths: +By default, the paths stored in the cmt's locations are relative to the +directory where the compiler was called. for build systems that do not always +call the compiler from the same root folder it might be useful to rewrite these +paths. + +Using the `--root ` option stores the given path in the output file. +Additionally, the ` --rewrite-root` option will prepend `root` to all paths in +indexed location. + +[Note: this feature is not used in the reference Dune rules, it might evolve in +the future if needed] + +## Querying indexes + +The tool does not provide actual queries but one can dump an entire index: + +> ocaml-index dump _index_file_ ... + +Or only print the number of definitions it stores: + +> ocaml-index stats _index_file_ ... + +```bash +$ ocaml-index stats _build/default/src/dune_rules/.dune_rules.objs/cctx.ocaml-index +Index ".../cctx.ocaml-index" contains: +- 28083 definitions +- 86850 locations +- 0 approximated definitions +- 0 compilation units shapes +``` diff --git a/src/ocaml-index/bin/dune b/src/ocaml-index/bin/dune new file mode 100644 index 000000000..2e4c04990 --- /dev/null +++ b/src/ocaml-index/bin/dune @@ -0,0 +1,9 @@ +(executable + (name ocaml_index) + (public_name ocaml-index) + (package ocaml-index) + (libraries lib ocaml_typing merlin_index_format) + (flags + :standard + -open Ocaml_typing + -open Merlin_index_format)) diff --git a/src/ocaml-index/bin/ocaml_index.ml b/src/ocaml-index/bin/ocaml_index.ml new file mode 100644 index 000000000..a4fc1f3f9 --- /dev/null +++ b/src/ocaml-index/bin/ocaml_index.ml @@ -0,0 +1,105 @@ +(** The indexer's binary *) + +open Lib + +let usage_msg = + "ocaml-index [COMMAND] [-verbose] [] ... -o " + +let verbose = ref false +let debug = ref false +let input_files = ref [] +let build_path = ref [] +let output_file = ref "project.ocaml-index" +let root = ref "" +let rewrite_root = ref false +let store_shapes = ref false +let do_not_use_cmt_loadpath = ref false + +type command = Aggregate | Dump | Stats + +let parse_command = function + | "aggregate" -> Some Aggregate + | "dump" -> Some Dump + | "stats" -> Some Stats + | _ -> None + +let command = ref None + +let anon_fun arg = + match !command with + | None -> ( + match parse_command arg with + | Some cmd -> command := Some cmd + | None -> + command := Some Aggregate; + input_files := arg :: !input_files) + | Some _ -> input_files := arg :: !input_files + +let speclist = + [ + ("--verbose", Arg.Set verbose, "Output more information"); + ("--debug", Arg.Set debug, "Output debugging information"); + ("-o", Arg.Set_string output_file, "Set output file name"); + ( "--root", + Arg.Set_string root, + "Set the root path for all relative locations" ); + ( "--rewrite-root", + Arg.Set rewrite_root, + "Rewrite locations paths using the provided root" ); + ( "--store-shapes", + Arg.Set store_shapes, + "Aggregate input-indexes shapes and store them in the new index" ); + ( "-I", + Arg.String (fun arg -> build_path := arg :: !build_path), + "An extra directory to add to the load path" ); + ( "--no-cmt-load-path", + Arg.Set do_not_use_cmt_loadpath, + "Do not initialize the load path with the paths found in the first input \ + cmt file" ); + ] + +let set_log_level debug verbose = + Log.set_log_level Error; + if verbose then Log.set_log_level Warning; + if debug then Log.set_log_level Debug + +let () = + Arg.parse speclist anon_fun usage_msg; + set_log_level !debug !verbose; + (match !command with + | Some Aggregate -> + let root = if String.equal "" !root then None else Some !root in + Index.from_files ~store_shapes:!store_shapes ~root + ~rewrite_root:!rewrite_root ~output_file:!output_file + ~build_path:!build_path + ~do_not_use_cmt_loadpath:!do_not_use_cmt_loadpath !input_files + | Some Dump -> + List.iter + (fun file -> + Index_format.( + read_exn ~file |> pp Format.std_formatter)) + !input_files + | Some Stats -> + List.iter + (fun file -> + let open Merlin_index_format.Index_format in + let { defs; approximated; cu_shape; root_directory; _ } = + read_exn ~file + in + Printf.printf + "Index %S contains:\n\ + - %i definitions\n\ + - %i locations\n\ + - %i approximated definitions\n\ + - %i compilation units shapes\n\ + - root dir: %s\n\n" + file (Uid_map.cardinal defs) + (Uid_map.fold + (fun _uid locs acc -> acc + Lid_set.cardinal locs) + defs 0) + (Uid_map.cardinal approximated) + (Hashtbl.length cu_shape) + (Option.value ~default:"none" root_directory)) + !input_files + | _ -> Printf.printf "Nothing to do.\n%!"); + exit 0 diff --git a/src/ocaml-index/lib/dune b/src/ocaml-index/lib/dune new file mode 100644 index 000000000..f21f905bd --- /dev/null +++ b/src/ocaml-index/lib/dune @@ -0,0 +1,17 @@ +(library + (name lib) + (libraries + ocaml_typing + ocaml_parsing + ocaml_utils + merlin_utils + merlin_analysis + merlin_index_format) + (flags + :standard + -open Ocaml_typing + -open Ocaml_parsing + -open Ocaml_utils + -open Merlin_utils + -open Merlin_analysis + -open Merlin_index_format)) diff --git a/src/ocaml-index/lib/index.ml b/src/ocaml-index/lib/index.ml new file mode 100644 index 000000000..05d62307d --- /dev/null +++ b/src/ocaml-index/lib/index.ml @@ -0,0 +1,181 @@ +module Kind = Shape.Sig_component_kind +open Index_format + +let with_root ?root file = + match root with None -> file | Some root -> Filename.concat root file + +let add_root ~root (lid : Longident.t Location.loc) = + match root with + | None -> lid + | Some root -> + let pos_fname = Filename.concat root lid.loc.loc_start.pos_fname in + { + lid with + loc = + { + lid.loc with + loc_start = { lid.loc.loc_start with pos_fname }; + loc_end = { lid.loc.loc_end with pos_fname }; + }; + } + +let merge m m' = + Shape.Uid.Map.union + (fun _uid locs locs' -> Some (Lid_set.union locs locs')) + m m' + +(** Cmt files contains a table of declarations' Uids associated to a typedtree + fragment. [add_locs_from_fragments] gather locations from these *) +let gather_locs_from_fragments ~root ~rewrite_root map fragments = + let to_located_lid (name : string Location.loc) = + { name with txt = Longident.Lident name.txt } + in + let add_loc uid fragment acc = + match Misc_utils.loc_of_decl ~uid fragment with + | None -> acc + | Some lid -> + let lid = to_located_lid lid in + let lid = if rewrite_root then add_root ~root lid else lid in + Shape.Uid.Map.add uid (Lid_set.singleton lid) acc + in + Shape.Uid.Tbl.fold add_loc fragments map + +module Reduce_conf = struct + let fuel = 10 + + let try_load ~unit_name () = + let cmt = Format.sprintf "%s.cmt" unit_name in + match Cmt_cache.read (Load_path.find_normalized cmt) with + | cmt_item -> + Log.debug "Loaded CMT %s" cmt; + cmt_item.cmt_infos.cmt_impl_shape + | exception Not_found -> + Log.warn "Failed to load file %S in load_path: @[%s@]\n%!" cmt + @@ String.concat "; " (Load_path.get_path_list ()); + None + + let read_unit_shape ~unit_name = + Log.debug "Read unit shape: %s\n%!" unit_name; + try_load ~unit_name () +end + +let init_load_path_once ~do_not_use_cmt_loadpath = + let loaded = ref false in + fun ~dirs cmt_loadpath -> + if not !loaded then ( + let cmt_visible, cmt_hidden = + if do_not_use_cmt_loadpath then ([], []) + else (cmt_loadpath.Load_path.visible, cmt_loadpath.Load_path.hidden) + in + let visible = List.concat [ cmt_visible; dirs ] in + Load_path.(init ~auto_include:no_auto_include ~visible ~hidden:cmt_hidden); + loaded := true) + +let index_of_cmt ~root ~rewrite_root ~build_path ~do_not_use_cmt_loadpath + cmt_infos = + let { + Cmt_format.cmt_loadpath; + cmt_impl_shape; + cmt_modname; + cmt_uid_to_decl; + cmt_ident_occurrences; + cmt_initial_env; + cmt_sourcefile; + cmt_source_digest; + _; + } = + cmt_infos + in + init_load_path_once ~do_not_use_cmt_loadpath ~dirs:build_path cmt_loadpath; + let module Reduce = Shape_reduce.Make (Reduce_conf) in + let defs = + if Option.is_none cmt_impl_shape then Shape.Uid.Map.empty + else + gather_locs_from_fragments ~root ~rewrite_root Shape.Uid.Map.empty + cmt_uid_to_decl + in + (* The list [cmt_ident_occurrences] associate each ident usage location in the + module with its (partially) reduced shape. We finish the reduction and + group together all the locations that share the same definition uid. *) + let defs, approximated = + List.fold_left + (fun ((acc_defs, acc_apx) as acc) (lid, (item : Shape_reduce.result)) -> + let lid = if rewrite_root then add_root ~root lid else lid in + let resolved = + match item with + | Unresolved shape -> Reduce.reduce_for_uid cmt_initial_env shape + | Resolved _ when Option.is_none cmt_impl_shape -> + (* Right now, without additional information we cannot take the + risk to mix uids from interfaces with the ones from + implementations. We simply ignore items defined in an interface. *) + Internal_error_missing_uid + | result -> result + in + match Locate.uid_of_result ~traverse_aliases:false resolved with + | Some uid, false -> (add acc_defs uid (Lid_set.singleton lid), acc_apx) + | Some uid, true -> (acc_defs, add acc_apx uid (Lid_set.singleton lid)) + | None, _ -> acc) + (defs, Shape.Uid.Map.empty) + cmt_ident_occurrences + in + let cu_shape = Hashtbl.create 1 in + Option.iter (Hashtbl.add cu_shape cmt_modname) cmt_impl_shape; + let stats = + match cmt_sourcefile with + | None -> Stats.empty + | Some src -> ( + let rooted_src = with_root ?root src in + try + let stats = Unix.stat rooted_src in + let src = if rewrite_root then rooted_src else src in + Stats.singleton src + { + mtime = stats.st_mtime; + size = stats.st_size; + source_digest = cmt_source_digest; + } + with Unix.Unix_error _ -> Stats.empty) + in + { defs; approximated; cu_shape; stats; root_directory = None } + +let merge_index ~store_shapes ~into index = + let defs = merge index.defs into.defs in + let approximated = merge index.approximated into.approximated in + let stats = Stats.union (fun _ f1 _f2 -> Some f1) into.stats index.stats in + if store_shapes then + Hashtbl.add_seq index.cu_shape (Hashtbl.to_seq into.cu_shape); + { into with defs; approximated; stats } + +let from_files ~store_shapes ~output_file ~root ~rewrite_root ~build_path + ~do_not_use_cmt_loadpath files = + Log.debug "Debug log is enabled"; + let initial_index = + { + defs = Shape.Uid.Map.empty; + approximated = Shape.Uid.Map.empty; + cu_shape = Hashtbl.create 64; + stats = Stats.empty; + root_directory = root; + } + in + let final_index = + Ocaml_utils.Local_store.with_store (Ocaml_utils.Local_store.fresh ()) + @@ fun () -> + List.fold_left + (fun into file -> + let index = + match Cmt_cache.read file with + | cmt_item -> + index_of_cmt ~root ~rewrite_root ~build_path + ~do_not_use_cmt_loadpath cmt_item.cmt_infos + | exception _ -> ( + match read ~file with + | Index index -> index + | _ -> + Log.error "Unknown file type: %s" file; + exit 1) + in + merge_index ~store_shapes index ~into) + initial_index files + in + write ~file:output_file final_index diff --git a/src/ocaml-index/lib/log.ml b/src/ocaml-index/lib/log.ml new file mode 100644 index 000000000..ecce9f5ed --- /dev/null +++ b/src/ocaml-index/lib/log.ml @@ -0,0 +1,29 @@ +module Level = struct + type t = Debug | Warning | Error + + let int_of_t = function Debug -> 0 | Warning -> 1 | Error -> 2 + + let string_of_t = function + | Debug -> "debug" + | Warning -> "warning" + | Error -> "error" + + let ( >= ) a b = int_of_t a >= int_of_t b +end + +let log_level = ref Level.Error +let set_log_level level = log_level := level + +let log ~level = + let print = + let formatter = + if level = Level.Error then Format.err_formatter else Format.std_formatter + in + Format.fprintf formatter "[%s] %s\n%!" (Level.string_of_t level) + in + if Level.(level >= !log_level) then Format.kasprintf print + else Format.ikfprintf ignore Format.std_formatter + +let debug fmt = log ~level:Level.Debug fmt +let warn fmt = log ~level:Level.Warning fmt +let error fmt = log ~level:Level.Error fmt diff --git a/src/ocaml-index/lib/log.mli b/src/ocaml-index/lib/log.mli new file mode 100644 index 000000000..a02cb6e70 --- /dev/null +++ b/src/ocaml-index/lib/log.mli @@ -0,0 +1,9 @@ +module Level : sig + type t = Debug | Warning | Error +end + +val set_log_level : Level.t -> unit +val log : level:Level.t -> ('a, Format.formatter, unit, unit) format4 -> 'a +val debug : ('a, Format.formatter, unit, unit) format4 -> 'a +val warn : ('a, Format.formatter, unit, unit) format4 -> 'a +val error : ('a, Format.formatter, unit, unit) format4 -> 'a diff --git a/src/ocaml-index/tests/dune b/src/ocaml-index/tests/dune new file mode 100644 index 000000000..e304a31f6 --- /dev/null +++ b/src/ocaml-index/tests/dune @@ -0,0 +1,10 @@ +(alias + (name ocaml-index-test-deps) + (deps + (package ocaml-index))) + +(cram + (package ocaml-index) + (applies_to :whole_subtree) + (deps + (alias ocaml-index-test-deps))) diff --git a/src/ocaml-index/tests/tests-dirs/cmd.t b/src/ocaml-index/tests/tests-dirs/cmd.t new file mode 100644 index 000000000..ade4fee5a --- /dev/null +++ b/src/ocaml-index/tests/tests-dirs/cmd.t @@ -0,0 +1,16 @@ + $ ocaml-index aggregate + $ ocaml-index aggregate --debug + [debug] Debug log is enabled + + $ ocaml-index --help + ocaml-index [COMMAND] [-verbose] [] ... -o + --verbose Output more information + --debug Output debugging information + -o Set output file name + --root Set the root path for all relative locations + --rewrite-root Rewrite locations paths using the provided root + --store-shapes Aggregate input-indexes shapes and store them in the new index + -I An extra directory to add to the load path + --no-cmt-load-path Do not initialize the load path with the paths found in the first input cmt file + -help Display this list of options + --help Display this list of options diff --git a/src/ocaml-index/tests/tests-dirs/flags.t b/src/ocaml-index/tests/tests-dirs/flags.t new file mode 100644 index 000000000..1ea8399ca --- /dev/null +++ b/src/ocaml-index/tests/tests-dirs/flags.t @@ -0,0 +1,33 @@ + $ cat >main.ml < let x = 42 + > let () = print_int x + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -c main.ml + + $ ocaml-index aggregate main.cmt + +Default output file: + $ ls project.ocaml-index + project.ocaml-index + +Set output file: + $ ocaml-index aggregate main.cmt -o out + $ ls out + out + +No root dir was given: + $ ocaml-index stats project.ocaml-index | grep root + - root dir: none + +We provide one: + $ ocaml-index aggregate main.cmt --root /tmp/ + $ ocaml-index stats project.ocaml-index | grep root + - root dir: /tmp/ + +Rewrite locations: + $ ocaml-index aggregate main.cmt --root /tmp/ --rewrite-root + $ ocaml-index dump project.ocaml-index | grep File + "x": File "/tmp/main.ml", line 1, characters 4-5; + "x": File "/tmp/main.ml", line 2, characters 19-20 + "print_int": File "/tmp/main.ml", line 2, characters 9-18 diff --git a/src/ocaml-index/tests/tests-dirs/index-project.t b/src/ocaml-index/tests/tests-dirs/index-project.t new file mode 100644 index 000000000..d521d6918 --- /dev/null +++ b/src/ocaml-index/tests/tests-dirs/index-project.t @@ -0,0 +1,134 @@ + $ cat >main.ml < let x = Foo.x + Foo.y + > let y = Foo.y + Bar.z + > type pouet = Foo.t + > let _, z = let x = 1 in x + y, 42 + > module A = struct + > let ina = 42 + > let _ = ina + > end + > let _ = A.ina + > module _ = Foo + > include Foo + > EOF + + $ cat >foo.ml < type t + > let x = 42 + > let y = 36 + Bar.z + x + > EOF + + $ cat >bar.ml < let z = 42 + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -c bar.ml foo.ml main.ml + + $ ocaml-index aggregate -o main.uideps main.cmt + $ ocaml-index aggregate -o foo.uideps foo.cmt + $ ocaml-index aggregate -o bar.uideps bar.cmt + + $ ocaml-index dump main.uideps + 13 uids: + {uid: Foo; locs: + "Foo": File "main.ml", line 10, characters 11-14; + "Foo": File "main.ml", line 11, characters 8-11 + uid: Bar.0; locs: "Bar.z": File "main.ml", line 2, characters 16-21 + uid: Foo.0; locs: "Foo.t": File "main.ml", line 3, characters 13-18 + uid: Foo.1; locs: "Foo.x": File "main.ml", line 1, characters 8-13 + uid: Foo.2; locs: + "Foo.y": File "main.ml", line 1, characters 16-21; + "Foo.y": File "main.ml", line 2, characters 8-13 + uid: Main.0; locs: "x": File "main.ml", line 1, characters 4-5 + uid: Main.1; locs: + "y": File "main.ml", line 2, characters 4-5; + "y": File "main.ml", line 4, characters 28-29 + uid: Main.2; locs: "pouet": File "main.ml", line 3, characters 5-10 + uid: Main.3; locs: "z": File "main.ml", line 4, characters 7-8 + uid: Main.4; locs: + "x": File "main.ml", line 4, characters 15-16; + "x": File "main.ml", line 4, characters 24-25 + uid: Main.5; locs: + "ina": File "main.ml", line 6, characters 6-9; + "ina": File "main.ml", line 7, characters 10-13; + "A.ina": File "main.ml", line 9, characters 8-13 + uid: Main.6; locs: "A": File "main.ml", line 5, characters 7-8 + uid: Stdlib.53; locs: + "+": File "main.ml", line 1, characters 14-15; + "+": File "main.ml", line 2, characters 14-15; + "+": File "main.ml", line 4, characters 26-27 + }, 0 approx shapes: {}, and shapes for CUS . + + $ ocaml-index dump foo.uideps + 5 uids: + {uid: Bar.0; locs: "Bar.z": File "foo.ml", line 3, characters 13-18 + uid: Foo.0; locs: "t": File "foo.ml", line 1, characters 5-6 + uid: Foo.1; locs: + "x": File "foo.ml", line 2, characters 4-5; + "x": File "foo.ml", line 3, characters 21-22 + uid: Foo.2; locs: "y": File "foo.ml", line 3, characters 4-5 + uid: Stdlib.53; locs: + "+": File "foo.ml", line 3, characters 11-12; + "+": File "foo.ml", line 3, characters 19-20 + }, 0 approx shapes: {}, and shapes for CUS . + + + + $ ocaml-index -o test.uideps main.cmt foo.cmt bar.cmt + $ ocaml-index dump test.uideps + 13 uids: + {uid: Foo; locs: + "Foo": File "main.ml", line 10, characters 11-14; + "Foo": File "main.ml", line 11, characters 8-11 + uid: Bar.0; locs: + "z": File "bar.ml", line 1, characters 4-5; + "Bar.z": File "foo.ml", line 3, characters 13-18; + "Bar.z": File "main.ml", line 2, characters 16-21 + uid: Foo.0; locs: + "t": File "foo.ml", line 1, characters 5-6; + "Foo.t": File "main.ml", line 3, characters 13-18 + uid: Foo.1; locs: + "x": File "foo.ml", line 2, characters 4-5; + "x": File "foo.ml", line 3, characters 21-22; + "Foo.x": File "main.ml", line 1, characters 8-13 + uid: Foo.2; locs: + "y": File "foo.ml", line 3, characters 4-5; + "Foo.y": File "main.ml", line 1, characters 16-21; + "Foo.y": File "main.ml", line 2, characters 8-13 + uid: Main.0; locs: "x": File "main.ml", line 1, characters 4-5 + uid: Main.1; locs: + "y": File "main.ml", line 2, characters 4-5; + "y": File "main.ml", line 4, characters 28-29 + uid: Main.2; locs: "pouet": File "main.ml", line 3, characters 5-10 + uid: Main.3; locs: "z": File "main.ml", line 4, characters 7-8 + uid: Main.4; locs: + "x": File "main.ml", line 4, characters 15-16; + "x": File "main.ml", line 4, characters 24-25 + uid: Main.5; locs: + "ina": File "main.ml", line 6, characters 6-9; + "ina": File "main.ml", line 7, characters 10-13; + "A.ina": File "main.ml", line 9, characters 8-13 + uid: Main.6; locs: "A": File "main.ml", line 5, characters 7-8 + uid: Stdlib.53; locs: + "+": File "foo.ml", line 3, characters 11-12; + "+": File "foo.ml", line 3, characters 19-20; + "+": File "main.ml", line 1, characters 14-15; + "+": File "main.ml", line 2, characters 14-15; + "+": File "main.ml", line 4, characters 26-27 + }, 0 approx shapes: {}, and shapes for CUS . + + $ ocaml-index stats foo.uideps test.uideps + Index "test.uideps" contains: + - 13 definitions + - 29 locations + - 0 approximated definitions + - 0 compilation units shapes + - root dir: none + + Index "foo.uideps" contains: + - 5 definitions + - 7 locations + - 0 approximated definitions + - 0 compilation units shapes + - root dir: none + diff --git a/src/ocaml-index/tests/tests-dirs/interfaces.t b/src/ocaml-index/tests/tests-dirs/interfaces.t new file mode 100644 index 000000000..2232ed41b --- /dev/null +++ b/src/ocaml-index/tests/tests-dirs/interfaces.t @@ -0,0 +1,23 @@ + $ cat >main.mli <<'EOF' + > type t = Float.t + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -c main.mli + + $ ls + main.cmi + main.cmti + main.mli + + $ ocamlobjinfo -quiet -index main.cmti + Indexed shapes: + Unresolved: CU Stdlib . "Float"[module] . "t"[type] : + Float.t (File "main.mli", line 1, characters 9-16) + + $ ocaml-index aggregate main.cmti -o main.index + + $ ocaml-index dump main.index + 1 uids: + {uid: Stdlib__Float.81; locs: + "Float.t": File "main.mli", line 1, characters 9-16 + }, 0 approx shapes: {}, and shapes for CUS . diff --git a/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t b/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t new file mode 100644 index 000000000..120db8e51 --- /dev/null +++ b/src/ocaml-index/tests/tests-dirs/local-shape-and-include.t @@ -0,0 +1,56 @@ + $ cat >main.ml < let f = String.equal + > module B : sig + > val g : string -> string -> bool + > end = struct + > module C = struct + > include External + > let g = equal + > end + > let g = C.g + > end + > EOF + + $ cat >external.ml < let equal = String.equal + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -c external.ml main.ml + + $ ocaml-index aggregate -o main.uideps main.cmt + + $ ocaml-index aggregate -o test.uideps main.uideps + + $ ocaml-index dump main.uideps + 9 uids: + {uid: External; locs: "External": File "main.ml", line 6, characters 12-20 + uid: External.0; locs: "equal": File "main.ml", line 7, characters 12-17 + uid: Main.0; locs: "f": File "main.ml", line 1, characters 4-5 + uid: Main.1; locs: + "g": File "main.ml", line 7, characters 8-9; + "C.g": File "main.ml", line 9, characters 10-13 + uid: Main.2; locs: "C": File "main.ml", line 5, characters 9-10 + uid: Main.3; locs: "g": File "main.ml", line 9, characters 6-7 + uid: Main.4; locs: "g": File "main.ml", line 3, characters 6-7 + uid: Main.5; locs: "B": File "main.ml", line 2, characters 7-8 + uid: Stdlib__String.173; locs: + "String.equal": File "main.ml", line 1, characters 8-20 + }, 0 approx shapes: {}, and shapes for CUS . + + + $ ocaml-index dump test.uideps + 9 uids: + {uid: External; locs: "External": File "main.ml", line 6, characters 12-20 + uid: External.0; locs: "equal": File "main.ml", line 7, characters 12-17 + uid: Main.0; locs: "f": File "main.ml", line 1, characters 4-5 + uid: Main.1; locs: + "g": File "main.ml", line 7, characters 8-9; + "C.g": File "main.ml", line 9, characters 10-13 + uid: Main.2; locs: "C": File "main.ml", line 5, characters 9-10 + uid: Main.3; locs: "g": File "main.ml", line 9, characters 6-7 + uid: Main.4; locs: "g": File "main.ml", line 3, characters 6-7 + uid: Main.5; locs: "B": File "main.ml", line 2, characters 7-8 + uid: Stdlib__String.173; locs: + "String.equal": File "main.ml", line 1, characters 8-20 + }, 0 approx shapes: {}, and shapes for CUS . + diff --git a/src/ocaml-index/tests/tests-dirs/transitive-deps.t b/src/ocaml-index/tests/tests-dirs/transitive-deps.t new file mode 100644 index 000000000..416469105 --- /dev/null +++ b/src/ocaml-index/tests/tests-dirs/transitive-deps.t @@ -0,0 +1,53 @@ + $ cat >main.ml < let x = List.init Foo.x (fun n -> n) + > EOF + + $ mkdir lib1 + $ cat >lib1/foo.ml < include Bar + > EOF + + $ mkdir lib2 + $ cat >lib2/bar.ml < let x = 21 + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -c lib2/bar.ml + $ ocamlc -bin-annot -bin-annot-occurrences -c lib1/foo.ml -I lib2 + +# Here we have an implicit transitive dependency on lib2: + $ ocamlc -bin-annot -bin-annot-occurrences -c main.ml -I lib1 -I /Users/ulysse/tmp/occurrences/_opam/lib/fpath + +# We pass explicitely the implicit transitive dependency over lib2: + $ ocaml-index aggregate -o main.uideps main.cmt -I lib2 + $ ocaml-index aggregate -o lib1/foo.uideps lib1/foo.cmt + $ ocaml-index aggregate -o lib2/bar.uideps lib2/bar.cmt + + $ ocaml-index aggregate -o test.uideps main.uideps lib1/foo.uideps lib2/bar.uideps + + $ ocaml-index dump main.uideps + 4 uids: + {uid: Bar.0; locs: "Foo.x": File "main.ml", line 1, characters 18-23 + uid: Main.0; locs: "x": File "main.ml", line 1, characters 4-5 + uid: Main.1; locs: "n": File "main.ml", line 1, characters 34-35 + uid: Stdlib__List.45; locs: + "List.init": File "main.ml", line 1, characters 8-17 + }, 0 approx shapes: {}, and shapes for CUS . + + $ ocaml-index dump lib1/foo.uideps + 1 uids: + {uid: Bar; locs: "Bar": File "lib1/foo.ml", line 1, characters 8-11 }, + 0 approx shapes: {}, and shapes for CUS . + + $ ocaml-index dump test.uideps + 5 uids: + {uid: Bar; locs: "Bar": File "lib1/foo.ml", line 1, characters 8-11 + uid: Bar.0; locs: + "x": File "lib2/bar.ml", line 1, characters 4-5; + "Foo.x": File "main.ml", line 1, characters 18-23 + uid: Main.0; locs: "x": File "main.ml", line 1, characters 4-5 + uid: Main.1; locs: "n": File "main.ml", line 1, characters 34-35 + uid: Stdlib__List.45; locs: + "List.init": File "main.ml", line 1, characters 8-17 + }, 0 approx shapes: {}, and shapes for CUS . + diff --git a/tests/test-dirs/occurrences/project-wide/dune b/tests/test-dirs/occurrences/project-wide/dune index 45fd154be..9b429078a 100644 --- a/tests/test-dirs/occurrences/project-wide/dune +++ b/tests/test-dirs/occurrences/project-wide/dune @@ -1,10 +1,11 @@ (cram (applies_to :whole_subtree) - (enabled_if %{bin-available:ocaml-index})) + (deps + %{bin:ocaml-index})) (cram (applies_to pwo-ml-gen) - (enabled_if (and %{bin-available:ocaml-index} (>= %{read:version/dune.txt} "3.16")))) + (enabled_if (>= %{read:version/dune.txt} "3.16"))) (subdir version From 627a5a6ab958afd5ed1d9769d1a842a4754e7608 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 21 Jun 2024 16:59:57 +0200 Subject: [PATCH 4/5] Update opam file --- .github/workflows/main.yml | 2 +- ocaml-index.opam | 9 +++------ 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 803d3c3e0..927de5ed9 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -68,7 +68,7 @@ jobs: - name: Build and test in release mode (windows) if: matrix.os == 'windows-latest' run: | - opam exec -- dune runtest -p merlin-lib,dot-merlin-reader,merlin,ocaml-index + opam exec -- dune runtest -p merlin-lib,dot-merlin-reader,ocaml-index,merlin - name: Build and test in release mode (macos/linux) if: matrix.os != 'windows-latest' diff --git a/ocaml-index.opam b/ocaml-index.opam index 511bd5a49..f0615f66c 100644 --- a/ocaml-index.opam +++ b/ocaml-index.opam @@ -6,8 +6,8 @@ description: maintainer: ["ulysse@tarides.com"] authors: ["ulysse@tarides.com"] license: "MIT" -homepage: "https://github.com/voodoos/ocaml-index" -bug-reports: "https://github.com/voodoos/ocaml-index/issues" +homepage: "https://github.com/ocaml/merlin/ocaml-index" +bug-reports: "https://github.com/ocaml/merlin/issues" depends: [ "dune" {>= "3.0.0"} "ocaml" {>= "5.2"} @@ -30,7 +30,4 @@ build: [ ] ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/voodoos/ocaml-index.git" -pin-depends: [ - ["merlin-lib.5.1-502" "git+https://github.com/ocaml/merlin"] -] +dev-repo: "git+https://github.com/ocaml/merlin.git" From 05ac636f727b7083bf8a4568dc7ef506b0dde919 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 4 Jul 2024 16:59:56 +0200 Subject: [PATCH 5/5] nix ci --- .github/workflows/nix.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml index 1821f53b3..521fb1dd4 100644 --- a/.github/workflows/nix.yml +++ b/.github/workflows/nix.yml @@ -34,4 +34,4 @@ jobs: uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixos-unstable - - run: nix develop -c dune build @check @runtest -p merlin-lib,dot-merlin-reader,merlin + - run: nix develop -c dune build @check @runtest -p merlin-lib,dot-merlin-reader,ocaml-index,merlin