Skip to content

Commit 4c6b9db

Browse files
liam923maxmwang
liam923
and
maxmwang
authored
Ppx improvements (#177)
* merlin document support for PPXs (#167) * initial working with tests * temp update * temp * major refactors, add support for .mli files * refactoring and cleanup * move all logic into override_document.ml; cleanup code; add logging * add many more tests; handle edge cases * revert std.ml changes * improve comments * update more comments * suggested changes * test nested ppx * document payload test * some more tests * resolve final comments * add test on floating attribute * add test for attribute in an extension's payload * Fix function syntax * merlin overrides: merlin locate support for PPXs (#171) * merlin document support for PPXs (#167) * initial working with tests * temp update * temp * major refactors, add support for .mli files * refactoring and cleanup * move all logic into override_document.ml; cleanup code; add logging * add many more tests; handle edge cases * revert std.ml changes * improve comments * update more comments * suggested changes * test nested ppx * document payload test * some more tests * resolve final comments * add test on floating attribute * add test for attribute in an extension's payload * Fix function syntax * working parsing of new merlin.document structure * fix document tests with new merlin.document structure * replicate merlin.document tests for merlin.locate * generalize comments, code for all overrides * delete duplicate files from merge conflict * add test overriding locate of a non-PPX * add test on overriding default behavior of document * format * combine document and locate tests into single file * adjust for new attribute structure * update comment documenting expected attribute structure * fix typo * remove named parameter * merlin locate outputs absolute paths using source_root --------- Co-authored-by: Liam Stevenson <[email protected]> * merlin overrides use interval tree instead of list (#173) * interval tree interface * interval tree implementation and basic test * use array for construction, add more tests * add and update comments * fix error messages, validate inputs * use list instead of array, add tests, add comments * integrate into overrides.ml * add test for empty tree * resolve requested changes * add test for zero-width interval * undo test reformat * update outdated comment * update another oudated comment * update comment * Cache overrides interval trees using Phase_cache (#176) * implementation but failing tests * working overrides caching with tests * add USE_PPX_CACHE, add all cache entries to tests * update comments * use Option.map * move comment * fix overrides caching mechanism, functorize caches, add cache invalidation test * add comments, rename * cleanup test output, and resolve other comments * remove unnecessary sed commands from tests * add commentsg --------- Co-authored-by: Max Wang <[email protected]>
1 parent fe6b12c commit 4c6b9db

File tree

15 files changed

+1906
-184
lines changed

15 files changed

+1906
-184
lines changed

‎src/frontend/query_commands.ml‎

Lines changed: 90 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -530,25 +530,33 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
530530
let typer = Mpipeline.typer_result pipeline in
531531
let pos = Mpipeline.get_lexing_pos pipeline pos in
532532
Refactor_open.get_rewrites ~mode typer pos
533-
| Document (patho, pos) ->
534-
let typer = Mpipeline.typer_result pipeline in
535-
let local_defs = Mtyper.get_typedtree typer in
536-
let config = Mpipeline.final_config pipeline in
533+
| Document (patho, pos) -> (
537534
let pos = Mpipeline.get_lexing_pos pipeline pos in
538-
let comments = Mpipeline.reader_comments pipeline in
539-
let env, _ = Mbrowse.leaf_node (Mtyper.node_at typer pos) in
540-
let path =
541-
match patho with
542-
| Some p -> p
543-
| None ->
544-
let path = Misc_utils.reconstruct_identifier pipeline pos None in
545-
let path = Mreader_lexer.identifier_suffix path in
546-
let path = List.map ~f:(fun { Location.txt; _ } -> txt) path in
547-
String.concat ~sep:"." path
548-
in
549-
if path = "" then `Invalid_context
550-
else
551-
Locate.get_doc ~config ~env ~local_defs ~comments ~pos (`User_input path)
535+
let from_document_override_attribute =
536+
pipeline |> Mpipeline.document_overrides |> Overrides.find ~cursor:pos
537+
|> Option.map ~f:Overrides.Override.payload
538+
in
539+
match from_document_override_attribute with
540+
| Some document_override -> `Found document_override
541+
| None ->
542+
let typer = Mpipeline.typer_result pipeline in
543+
let local_defs = Mtyper.get_typedtree typer in
544+
let config = Mpipeline.final_config pipeline in
545+
let comments = Mpipeline.reader_comments pipeline in
546+
let env, _ = Mbrowse.leaf_node (Mtyper.node_at typer pos) in
547+
let path =
548+
match patho with
549+
| Some p -> p
550+
| None ->
551+
let path = Misc_utils.reconstruct_identifier pipeline pos None in
552+
let path = Mreader_lexer.identifier_suffix path in
553+
let path = List.map ~f:(fun { Location.txt; _ } -> txt) path in
554+
String.concat ~sep:"." path
555+
in
556+
if path = "" then `Invalid_context
557+
else
558+
Locate.get_doc ~config ~env ~local_defs ~comments ~pos
559+
(`User_input path))
552560
| Syntax_document pos -> (
553561
let typer = Mpipeline.typer_result pipeline in
554562
let pos = Mpipeline.get_lexing_pos pipeline pos in
@@ -567,60 +575,74 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
567575
`Found
568576
(Ppx_expand.get_ppxed_source ~ppxed_parsetree ~pos ppx_kind_with_attr)
569577
| None -> `No_ppx)
570-
| Locate (patho, ml_or_mli, pos, context) ->
571-
let typer = Mpipeline.typer_result pipeline in
572-
let local_defs = Mtyper.get_typedtree typer in
578+
| Locate (patho, ml_or_mli, pos, context) -> (
573579
let pos = Mpipeline.get_lexing_pos pipeline pos in
574-
let let_pun_behavior = Mbrowse.Let_pun_behavior.Prefer_expression in
575-
let env, _ = Mbrowse.leaf_node (Mtyper.node_at typer pos) in
576-
let path =
577-
match patho with
578-
| Some p -> p
579-
| None ->
580-
let path = Misc_utils.reconstruct_identifier pipeline pos None in
581-
let path = Mreader_lexer.identifier_suffix path in
582-
let path = List.map ~f:(fun { Location.txt; _ } -> txt) path in
583-
let path = String.concat ~sep:"." path in
584-
Locate.log ~title:"reconstructed identifier" "%s" path;
585-
path
586-
in
587-
if path = "" then `Invalid_context
588-
else
589-
let ml_or_mli =
590-
match ml_or_mli with
591-
| `ML -> `Smart
592-
| `MLI -> `MLI
580+
let mconfig = Mpipeline.final_config pipeline in
581+
let from_locate_override_attribute =
582+
pipeline |> Mpipeline.locate_overrides |> Overrides.find ~cursor:pos
583+
|> Option.map ~f:Overrides.Override.payload
584+
in
585+
match from_locate_override_attribute with
586+
| Some source_position ->
587+
let absolute_file_path =
588+
(* Path returned is always an absolute path because [mconfig.merlin.source_root]
589+
is absolute (see [dot_merlin_reader.ml#prepend_config]) and, when
590+
[mconfig.merlin.source_root = None], [canonicalize_filenmae] defaults to
591+
[Sys.getcwd ()]. *)
592+
Misc.canonicalize_filename ?cwd:mconfig.merlin.source_root
593+
source_position.pos_fname
593594
in
594-
let config =
595-
Locate.
596-
{ mconfig = Mpipeline.final_config pipeline;
597-
ml_or_mli;
598-
traverse_aliases = true
599-
}
595+
let source_position =
596+
{ source_position with pos_fname = absolute_file_path }
600597
in
601-
begin
602-
let namespaces =
603-
Option.map context ~f:(fun ctx ->
604-
Locate.Namespace_resolution.From_context ctx)
598+
`Found (Some absolute_file_path, source_position)
599+
| None ->
600+
let typer = Mpipeline.typer_result pipeline in
601+
let local_defs = Mtyper.get_typedtree typer in
602+
let let_pun_behavior = Mbrowse.Let_pun_behavior.Prefer_expression in
603+
let env, _ = Mbrowse.leaf_node (Mtyper.node_at typer pos) in
604+
let path =
605+
match patho with
606+
| Some p -> p
607+
| None ->
608+
let path = Misc_utils.reconstruct_identifier pipeline pos None in
609+
let path = Mreader_lexer.identifier_suffix path in
610+
let path = List.map ~f:(fun { Location.txt; _ } -> txt) path in
611+
let path = String.concat ~sep:"." path in
612+
Locate.log ~title:"reconstructed identifier" "%s" path;
613+
path
614+
in
615+
if path = "" then `Invalid_context
616+
else
617+
let ml_or_mli =
618+
match ml_or_mli with
619+
| `ML -> `Smart
620+
| `MLI -> `MLI
605621
in
606-
match
607-
Locate.from_string ~config ~env ~local_defs ~pos ?namespaces
608-
~let_pun_behavior path
609-
with
610-
| `Found { file; location; _ } ->
611-
Locate.log ~title:"result" "found: %s" file;
612-
`Found (Some file, location.loc_start)
613-
| `Missing_labels_namespace ->
614-
(* Can't happen because we haven't passed a namespace as input. *)
615-
assert false
616-
| `Builtin (_, s) ->
617-
Locate.log ~title:"result" "found builtin %s" s;
618-
`Builtin s
619-
| `File_not_found { file = reason; _ } -> `File_not_found reason
620-
| (`Not_found _ | `At_origin | `Not_in_env _) as otherwise ->
621-
Locate.log ~title:"result" "not found";
622-
otherwise
623-
end
622+
let config = Locate.{ mconfig; ml_or_mli; traverse_aliases = true } in
623+
begin
624+
let namespaces =
625+
Option.map context ~f:(fun ctx ->
626+
Locate.Namespace_resolution.From_context ctx)
627+
in
628+
match
629+
Locate.from_string ~config ~env ~local_defs ~pos ?namespaces
630+
~let_pun_behavior path
631+
with
632+
| `Found { file; location; _ } ->
633+
Locate.log ~title:"result" "found: %s" file;
634+
`Found (Some file, location.loc_start)
635+
| `Missing_labels_namespace ->
636+
(* Can't happen because we haven't passed a namespace as input. *)
637+
assert false
638+
| `Builtin (_, s) ->
639+
Locate.log ~title:"result" "found builtin %s" s;
640+
`Builtin s
641+
| `File_not_found { file = reason; _ } -> `File_not_found reason
642+
| (`Not_found _ | `At_origin | `Not_in_env _) as otherwise ->
643+
Locate.log ~title:"result" "not found";
644+
otherwise
645+
end)
624646
| Jump (target, pos) ->
625647
let typer = Mpipeline.typer_result pipeline in
626648
let typedtree = Mtyper.get_typedtree typer in

0 commit comments

Comments
 (0)