From 79822fbf0a6a882d272b35741f48d74bbdc42306 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 12:04:48 +0100 Subject: [PATCH 1/9] Support autocomplete for objects from another module `M.x[...`. Fixes https://github.com/rescript-lang/rescript-vscode/issues/360 --- CHANGELOG.md | 1 + analysis/src/NewCompletions.ml | 118 ++++++++++-------- analysis/src/PartialParser.ml | 15 ++- analysis/tests/src/Completion.res | 2 + analysis/tests/src/Obj.res | 2 + .../tests/src/expected/Completion.res.txt | 15 +++ 6 files changed, 97 insertions(+), 56 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 516db9122..d2af01db5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ ## master - Fix issue where using paths of the form `./something` would show multiple copies of the same file in vscode. - When hovering on a field access, show the instantiated type of the field. +- Support autocomplete for objects from another module `M.x[...`. ## 1.2.1 diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index 3ec5a1d7b..ba2e95d60 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -672,15 +672,19 @@ let localValueCompletions ~pos ~(env : QueryEnv.t) suffix = {(emptyDeclared c.cname.txt) with item = Constructor (c, t)})) else results in - if suffix = "" || not (isCapitalized suffix) then - results - @ completionForDeclareds ~pos env.file.stamps.values suffix (fun v -> - Value v) - @ completionForDeclareds ~pos env.file.stamps.types suffix (fun t -> Type t) - @ (completionForFields env.exported.types env.file.stamps.types suffix - |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)})) - else results + let results = + if suffix = "" || not (isCapitalized suffix) then + results + @ completionForDeclareds ~pos env.file.stamps.values suffix (fun v -> + Value v) + @ completionForDeclareds ~pos env.file.stamps.types suffix (fun t -> + Type t) + @ (completionForFields env.exported.types env.file.stamps.types suffix + |> List.map (fun (f, t) -> + {(emptyDeclared f.fname.txt) with item = Field (f, t)})) + else results + in + results |> List.map (fun r -> (r, env)) let valueCompletions ~(env : QueryEnv.t) suffix = Log.log (" - Completing in " ^ Uri2.toString env.file.uri); @@ -705,17 +709,20 @@ let valueCompletions ~(env : QueryEnv.t) suffix = {(emptyDeclared c.cname.txt) with item = Constructor (c, t)}))) else results in - if suffix = "" || not (isCapitalized suffix) then ( - Log.log " -- not capitalized"; - results - @ completionForExporteds env.exported.values env.file.stamps.values suffix - (fun v -> Value v) - @ completionForExporteds env.exported.types env.file.stamps.types suffix - (fun t -> Type t) - @ (completionForFields env.exported.types env.file.stamps.types suffix - |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)}))) - else results + let results = + if suffix = "" || not (isCapitalized suffix) then ( + Log.log " -- not capitalized"; + results + @ completionForExporteds env.exported.values env.file.stamps.values suffix + (fun v -> Value v) + @ completionForExporteds env.exported.types env.file.stamps.types suffix + (fun t -> Type t) + @ (completionForFields env.exported.types env.file.stamps.types suffix + |> List.map (fun (f, t) -> + {(emptyDeclared f.fname.txt) with item = Field (f, t)}))) + else results + in + results |> List.map (fun r -> (r, env)) let attributeCompletions ~(env : QueryEnv.t) ~suffix = let results = [] in @@ -726,15 +733,18 @@ let attributeCompletions ~(env : QueryEnv.t) ~suffix = suffix (fun m -> Module m) else results in - if suffix = "" || not (isCapitalized suffix) then - results - @ completionForExporteds env.exported.values env.file.stamps.values suffix - (fun v -> Value v) - (* completionForExporteds(env.exported.types, env.file.stamps.types, suffix, t => Type(t)) @ *) - @ (completionForFields env.exported.types env.file.stamps.types suffix - |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)})) - else results + let results = + if suffix = "" || not (isCapitalized suffix) then + results + @ completionForExporteds env.exported.values env.file.stamps.values suffix + (fun v -> Value v) + (* completionForExporteds(env.exported.types, env.file.stamps.types, suffix, t => Type(t)) @ *) + @ (completionForFields env.exported.types env.file.stamps.types suffix + |> List.map (fun (f, t) -> + {(emptyDeclared f.fname.txt) with item = Field (f, t)})) + else results + in + results |> List.map (fun r -> (r, env)) (* TODO filter out things that are defined after the current position *) let resolveRawOpens ~env ~rawOpens ~package = @@ -804,7 +814,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = (fun results env -> let completionsFromThisOpen = valueCompletions ~env suffix in List.filter - (fun declared -> + (fun (declared, _env) -> if Hashtbl.mem alreadyUsedIdentifiers declared.name.txt then false else ( @@ -819,7 +829,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = allFiles |> FileSet.elements |> Utils.filterMap (fun name -> if Utils.startsWith name suffix && not (String.contains name '-') - then Some {(emptyDeclared name) with item = FileModule name} + then Some ({(emptyDeclared name) with item = FileModule name}, env) else None) in locallyDefinedValues @ valuesFromOpens @ localModuleNames @@ -863,15 +873,16 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = (Some (env, fields, typ)) with | None -> [] - | Some (_env, fields, typ) -> + | Some (env, fields, typ) -> fields |> Utils.filterMap (fun field -> if Utils.startsWith field.fname.txt lastField then Some - { - (emptyDeclared field.fname.txt) with - item = Field (field, typ); - } + ( { + (emptyDeclared field.fname.txt) with + item = Field (field, typ); + }, + env ) else None)))) | None -> []) | QualifiedRecordAccess path -> ( @@ -924,7 +935,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let declareds = processDotPath ~exact:true (componentPath @ ["make"]) in let labels = match declareds with - | {SharedTypes.item = Value typ} :: _ -> + | ({SharedTypes.item = Value typ}, _env) :: _ -> let rec getFields (texp : Types.type_expr) = match texp.desc with | Tfield (name, _, t1, t2) -> @@ -984,7 +995,9 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens (* TODO(#107): figure out why we're getting duplicates. *) declareds |> Utils.dedup |> List.map - (fun {SharedTypes.name = {txt = name}; deprecated; docstring; item} -> + (fun + ({SharedTypes.name = {txt = name}; deprecated; docstring; item}, _env) + -> mkItem ~name ~kind:(kindToInt item) ~deprecated ~detail:(detail name item) ~docstring) | Cpipe (pipe, partialName) -> ( @@ -1044,8 +1057,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens match String.split_on_char '.' pipeId with | x :: fieldNames -> ( match [x] |> processDotPath ~exact:true with - | {SharedTypes.item = Value typ} :: _ -> ( - let env = QueryEnv.fromFile full.file in + | ({SharedTypes.item = Value typ}, env) :: _ -> ( match getFields ~env ~typ fieldNames with | None -> None | Some (typ1, _env1) -> fromType typ1) @@ -1096,10 +1108,12 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let dotpath = modulePath @ [partialName] in let declareds = dotpath |> processDotPath ~exact:false in declareds - |> List.filter (fun {item} -> + |> List.filter (fun ({item}, _env) -> match item with Value _ -> true | _ -> false) |> List.map - (fun {SharedTypes.name = {txt = name}; deprecated; docstring; item} + (fun + ( {SharedTypes.name = {txt = name}; deprecated; docstring; item}, + _env ) -> mkItem ~name:(completionName name) ~kind:(kindToInt item) ~detail:(detail name item) ~deprecated ~docstring) @@ -1152,7 +1166,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens | Clabel (funPath, prefix, identsSeen) -> let labels = match funPath |> processDotPath ~exact:true with - | {SharedTypes.item = Value typ} :: _ -> + | ({SharedTypes.item = Value typ}, _env) :: _ -> let rec getLabels (t : Types.type_expr) = match t.desc with | Tlink t1 | Tsubst t1 -> getLabels t1 @@ -1200,8 +1214,8 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens in let env0 = QueryEnv.fromFile full.file in let env, fields = - match [lhs] |> processDotPath ~exact:true with - | {SharedTypes.item = Value typ} :: _ -> getObjectFields ~env:env0 typ + match lhs |> processDotPath ~exact:true with + | ({SharedTypes.item = Value typ}, env) :: _ -> getObjectFields ~env typ | _ -> (env0, []) in let labels = resolvePath ~env fields path in @@ -1225,7 +1239,9 @@ let getCompletable ~textOpt ~pos = match PartialParser.findCompletable text offset with | None -> None | Some completable -> - let rawOpens = PartialParser.findOpens text offset in + let offsetFromLineStart = offset - snd pos in + (* try to avoid confusion e.g. unclosed quotes at current position *) + let rawOpens = PartialParser.findOpens text offsetFromLineStart in Some (completable, rawOpens))) let computeCompletions ~completable ~full ~pos ~rawOpens = @@ -1239,17 +1255,17 @@ let computeCompletions ~completable ~full ~pos ~rawOpens = Take the last position before pos if any, or just return the first element. *) let rec prioritize decls = match decls with - | d1 :: d2 :: rest -> + | (d1, e1) :: (d2, e2) :: rest -> let pos2 = d2.extentLoc.loc_start |> Utils.tupleOfLexing in - if pos2 >= pos then prioritize (d1 :: rest) + if pos2 >= pos then prioritize ((d1, e1) :: rest) else let pos1 = d1.extentLoc.loc_start |> Utils.tupleOfLexing in - if pos1 <= pos2 then prioritize (d2 :: rest) - else prioritize (d1 :: rest) + if pos1 <= pos2 then prioritize ((d2, e2) :: rest) + else prioritize ((d1, e1) :: rest) | [] | [_] -> decls in declareds - |> List.filter (fun {SharedTypes.name = {txt}} -> txt = last) + |> List.filter (fun ({SharedTypes.name = {txt}}, _env) -> txt = last) |> prioritize | _ -> declareds in diff --git a/analysis/src/PartialParser.ml b/analysis/src/PartialParser.ml index 485b257dc..ec0a04ab5 100644 --- a/analysis/src/PartialParser.ml +++ b/analysis/src/PartialParser.ml @@ -190,8 +190,8 @@ type completable = | Cdotpath of string list (** e.g. ["M", "foo"] for M.foo *) | Cjsx of string list * string * string list (** E.g. (["M", "Comp"], "id", ["id1", "id2"]) for foo" *) let isLowercaseIdent id = @@ -238,10 +238,13 @@ let findCompletable text offset = let mkObj ~off ~partialName = let off = skipWhite text off in let rec loop off path i = - if i < 0 then Some ([], String.sub text 0 (i - 1)) + if i < 0 then + let id = String.sub text 0 (i - 1) in + Some ([], [id]) else match text.[i] with - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> loop off path (i - 1) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '.' -> + loop off path (i - 1) | ']' when i > 1 && text.[i - 1] = '"' -> let i0 = i - 2 in let i1 = startOfLident text i0 in @@ -249,7 +252,9 @@ let findCompletable text offset = if ident <> "" && i1 > 1 && text.[i1 - 1] = '"' && text.[i1 - 2] = '[' then loop (off - i + i1 - 3) (ident :: path) (i1 - 3) else None - | _ -> Some (path, String.sub text (i + 1) (off - i)) + | _ -> + let id = String.sub text (i + 1) (off - i) in + Some (path, Str.split (Str.regexp_string ".") id) in match loop off [] off with | None -> None diff --git a/analysis/tests/src/Completion.res b/analysis/tests/src/Completion.res index 2a93f1010..0d433ad25 100644 --- a/analysis/tests/src/Completion.res +++ b/analysis/tests/src/Completion.res @@ -98,3 +98,5 @@ let make = () => { // ^com my <> } + +// ^com Obj.object[" diff --git a/analysis/tests/src/Obj.res b/analysis/tests/src/Obj.res index 8844b6fd4..4718f3746 100644 --- a/analysis/tests/src/Obj.res +++ b/analysis/tests/src/Obj.res @@ -7,3 +7,5 @@ module Rec = { let recordVal: recordt = assert false } + +let object: objT = {"name": "abc", "age": 4} diff --git a/analysis/tests/src/expected/Completion.res.txt b/analysis/tests/src/expected/Completion.res.txt index d31b2e349..e9cb17fca 100644 --- a/analysis/tests/src/expected/Completion.res.txt +++ b/analysis/tests/src/expected/Completion.res.txt @@ -729,3 +729,18 @@ Complete tests/src/Completion.res 96:3 "documentation": null }] +Complete tests/src/Completion.res 100:3 +[{ + "label": "name", + "kind": 4, + "tags": [], + "detail": "string", + "documentation": null + }, { + "label": "age", + "kind": 4, + "tags": [], + "detail": "int", + "documentation": null + }] + From d749abd138f3c0cf8dab05d797ca9285159cc7f2 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 12:39:17 +0100 Subject: [PATCH 2/9] refactor completion functions --- analysis/src/NewCompletions.ml | 122 +++++++++++++++------------------ 1 file changed, 57 insertions(+), 65 deletions(-) diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index ba2e95d60..e4e7cddda 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -496,6 +496,23 @@ let resolveOpens ~env ~previous opens ~package = (* loop(previous) *) previous opens +type kind = + | Module of moduleKind + | Value of Types.type_expr + | Type of Type.t + | Constructor of constructor * Type.t declared + | Field of field * Type.t declared + | FileModule of string + +let kindToInt kind = + match kind with + | Module _ -> 9 + | FileModule _ -> 9 + | Constructor (_, _) -> 4 + | Field (_, _) -> 5 + | Type _ -> 22 + | Value _ -> 12 + let completionForDeclareds ~pos declareds prefix transformContents = (* Log.log("completion for declares " ++ prefix); *) Hashtbl.fold @@ -521,33 +538,47 @@ let completionForExporteds exporteds else results) exporteds [] -let completionForConstructors exportedTypes - (stamps : (int, SharedTypes.Type.t SharedTypes.declared) Hashtbl.t) prefix = +let completionForExportedsModules ~env ~suffix = + completionForExporteds env.QueryEnv.exported.modules env.file.stamps.modules + suffix (fun m -> Module m) + +let completionForExportedsValues ~env ~suffix = + completionForExporteds env.QueryEnv.exported.values env.file.stamps.values + suffix (fun v -> Value v) + +let completionForExportedsTypes ~env ~suffix = + completionForExporteds env.QueryEnv.exported.types env.file.stamps.types + suffix (fun t -> Type t) + +let completionForConstructors ~(env : QueryEnv.t) ~suffix = Hashtbl.fold (fun _name stamp results -> - let t = Hashtbl.find stamps stamp in + let t = Hashtbl.find env.file.stamps.types stamp in match t.item.kind with | SharedTypes.Type.Variant constructors -> (constructors - |> List.filter (fun c -> Utils.startsWith c.cname.txt prefix) + |> List.filter (fun c -> Utils.startsWith c.cname.txt suffix) |> List.map (fun c -> (c, t))) @ results | _ -> results) - exportedTypes [] + env.exported.types [] + |> List.map (fun (c, t) -> + {(emptyDeclared c.cname.txt) with item = Constructor (c, t)}) -let completionForFields exportedTypes - (stamps : (int, SharedTypes.Type.t SharedTypes.declared) Hashtbl.t) prefix = +let completionForFields ~(env : QueryEnv.t) ~suffix = Hashtbl.fold (fun _name stamp results -> - let t = Hashtbl.find stamps stamp in + let t = Hashtbl.find env.file.stamps.types stamp in match t.item.kind with | Record fields -> (fields - |> List.filter (fun f -> Utils.startsWith f.fname.txt prefix) + |> List.filter (fun f -> Utils.startsWith f.fname.txt suffix) |> List.map (fun f -> (f, t))) @ results | _ -> results) - exportedTypes [] + env.exported.types [] + |> List.map (fun (f, t) -> + {(emptyDeclared f.fname.txt) with item = Field (f, t)}) let isCapitalized name = if name = "" then false @@ -626,23 +657,6 @@ let getEnvWithOpens ~pos ~(env : QueryEnv.t) ~package ~(opens : QueryEnv.t list) in loop opens -type kind = - | Module of moduleKind - | Value of Types.type_expr - | Type of Type.t - | Constructor of constructor * Type.t declared - | Field of field * Type.t declared - | FileModule of string - -let kindToInt kind = - match kind with - | Module _ -> 9 - | FileModule _ -> 9 - | Constructor (_, _) -> 4 - | Field (_, _) -> 5 - | Type _ -> 22 - | Value _ -> 12 - let detail name contents = match contents with | Type {decl} -> decl |> Shared.declToString name @@ -657,19 +671,18 @@ let detail name contents = | Constructor (c, t) -> showConstructor c ^ "\n\n" ^ (t.item.decl |> Shared.declToString t.name.txt) +let completionForDeclaredsModules ~pos ~env ~suffix = + completionForDeclareds ~pos env.QueryEnv.file.stamps.modules suffix (fun m -> + Module m) + let localValueCompletions ~pos ~(env : QueryEnv.t) suffix = let results = [] in Log.log "---------------- LOCAL VAL"; let results = if suffix = "" || isCapitalized suffix then results - @ completionForDeclareds ~pos env.file.stamps.modules suffix (fun m -> - Module m) - @ (completionForConstructors env.exported.types env.file.stamps.types - (* TODO declared thingsz *) - suffix - |> List.map (fun (c, t) -> - {(emptyDeclared c.cname.txt) with item = Constructor (c, t)})) + @ completionForDeclaredsModules ~pos ~env ~suffix + @ completionForConstructors ~env ~suffix else results in let results = @@ -679,9 +692,7 @@ let localValueCompletions ~pos ~(env : QueryEnv.t) suffix = Value v) @ completionForDeclareds ~pos env.file.stamps.types suffix (fun t -> Type t) - @ (completionForFields env.exported.types env.file.stamps.types suffix - |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)})) + @ completionForFields ~env ~suffix else results in results |> List.map (fun r -> (r, env)) @@ -695,31 +706,18 @@ let valueCompletions ~(env : QueryEnv.t) suffix = env.exported.modules |> Hashtbl.filter_map_inplace (fun name key -> if isCapitalized name then Some key else None); - let moduleCompletions = - completionForExporteds env.exported.modules env.file.stamps.modules - suffix (fun m -> Module m) - in - (* Log.log(" -- capitalized " ++ string_of_int(Hashtbl.length(env.exported.types)) ++ " exported types"); *) - (* env.exported.types |> Hashtbl.iter((name, _) => Log.log(" > " ++ name)); *) - results @ moduleCompletions - @ ((* TODO declared thingsz *) - completionForConstructors env.exported.types env.file.stamps.types - suffix - |> List.map (fun (c, t) -> - {(emptyDeclared c.cname.txt) with item = Constructor (c, t)}))) + results + @ completionForExportedsModules ~env ~suffix + @ completionForConstructors ~env ~suffix) else results in let results = if suffix = "" || not (isCapitalized suffix) then ( Log.log " -- not capitalized"; results - @ completionForExporteds env.exported.values env.file.stamps.values suffix - (fun v -> Value v) - @ completionForExporteds env.exported.types env.file.stamps.types suffix - (fun t -> Type t) - @ (completionForFields env.exported.types env.file.stamps.types suffix - |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)}))) + @ completionForExportedsValues ~env ~suffix + @ completionForExportedsTypes ~env ~suffix + @ completionForFields ~env ~suffix) else results in results |> List.map (fun r -> (r, env)) @@ -728,20 +726,14 @@ let attributeCompletions ~(env : QueryEnv.t) ~suffix = let results = [] in let results = if suffix = "" || isCapitalized suffix then - results - @ completionForExporteds env.exported.modules env.file.stamps.modules - suffix (fun m -> Module m) + results @ completionForExportedsModules ~env ~suffix else results in let results = if suffix = "" || not (isCapitalized suffix) then results - @ completionForExporteds env.exported.values env.file.stamps.values suffix - (fun v -> Value v) - (* completionForExporteds(env.exported.types, env.file.stamps.types, suffix, t => Type(t)) @ *) - @ (completionForFields env.exported.types env.file.stamps.types suffix - |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)})) + @ completionForExportedsValues ~env ~suffix + @ completionForFields ~env ~suffix else results in results |> List.map (fun r -> (r, env)) From e437ff566351607faa952695dbd14d46105a2072 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 12:45:15 +0100 Subject: [PATCH 3/9] More refactor. --- analysis/src/NewCompletions.ml | 40 +++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index e4e7cddda..68718f482 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -526,6 +526,18 @@ let completionForDeclareds ~pos declareds prefix transformContents = results) declareds [] +let completionForDeclaredModules ~pos ~env ~suffix = + completionForDeclareds ~pos env.QueryEnv.file.stamps.modules suffix (fun m -> + Module m) + +let completionForDeclaredValues ~pos ~env ~suffix = + completionForDeclareds ~pos env.QueryEnv.file.stamps.values suffix (fun m -> + Value m) + +let completionForDeclaredTypes ~pos ~env ~suffix = + completionForDeclareds ~pos env.QueryEnv.file.stamps.types suffix (fun m -> + Type m) + let completionForExporteds exporteds (stamps : (int, 'a SharedTypes.declared) Hashtbl.t) prefix transformContents = @@ -538,15 +550,15 @@ let completionForExporteds exporteds else results) exporteds [] -let completionForExportedsModules ~env ~suffix = +let completionForExportedModules ~env ~suffix = completionForExporteds env.QueryEnv.exported.modules env.file.stamps.modules suffix (fun m -> Module m) -let completionForExportedsValues ~env ~suffix = +let completionForExportedValues ~env ~suffix = completionForExporteds env.QueryEnv.exported.values env.file.stamps.values suffix (fun v -> Value v) -let completionForExportedsTypes ~env ~suffix = +let completionForExportedTypes ~env ~suffix = completionForExporteds env.QueryEnv.exported.types env.file.stamps.types suffix (fun t -> Type t) @@ -671,27 +683,21 @@ let detail name contents = | Constructor (c, t) -> showConstructor c ^ "\n\n" ^ (t.item.decl |> Shared.declToString t.name.txt) -let completionForDeclaredsModules ~pos ~env ~suffix = - completionForDeclareds ~pos env.QueryEnv.file.stamps.modules suffix (fun m -> - Module m) - let localValueCompletions ~pos ~(env : QueryEnv.t) suffix = let results = [] in Log.log "---------------- LOCAL VAL"; let results = if suffix = "" || isCapitalized suffix then results - @ completionForDeclaredsModules ~pos ~env ~suffix + @ completionForDeclaredModules ~pos ~env ~suffix @ completionForConstructors ~env ~suffix else results in let results = if suffix = "" || not (isCapitalized suffix) then results - @ completionForDeclareds ~pos env.file.stamps.values suffix (fun v -> - Value v) - @ completionForDeclareds ~pos env.file.stamps.types suffix (fun t -> - Type t) + @ completionForDeclaredValues ~pos ~env ~suffix + @ completionForDeclaredTypes ~pos ~env ~suffix @ completionForFields ~env ~suffix else results in @@ -707,7 +713,7 @@ let valueCompletions ~(env : QueryEnv.t) suffix = |> Hashtbl.filter_map_inplace (fun name key -> if isCapitalized name then Some key else None); results - @ completionForExportedsModules ~env ~suffix + @ completionForExportedModules ~env ~suffix @ completionForConstructors ~env ~suffix) else results in @@ -715,8 +721,8 @@ let valueCompletions ~(env : QueryEnv.t) suffix = if suffix = "" || not (isCapitalized suffix) then ( Log.log " -- not capitalized"; results - @ completionForExportedsValues ~env ~suffix - @ completionForExportedsTypes ~env ~suffix + @ completionForExportedValues ~env ~suffix + @ completionForExportedTypes ~env ~suffix @ completionForFields ~env ~suffix) else results in @@ -726,13 +732,13 @@ let attributeCompletions ~(env : QueryEnv.t) ~suffix = let results = [] in let results = if suffix = "" || isCapitalized suffix then - results @ completionForExportedsModules ~env ~suffix + results @ completionForExportedModules ~env ~suffix else results in let results = if suffix = "" || not (isCapitalized suffix) then results - @ completionForExportedsValues ~env ~suffix + @ completionForExportedValues ~env ~suffix @ completionForFields ~env ~suffix else results in From 7795ca2648c534a6eeae6c52b0cceb5746d919d2 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 18:05:52 +0100 Subject: [PATCH 4/9] Refactor sharedtypes. --- analysis/src/Commands.ml | 6 +- analysis/src/Hover.ml | 8 +- analysis/src/NewCompletions.ml | 51 +++++------- analysis/src/ProcessCmt.ml | 21 ++--- analysis/src/References.ml | 30 +++---- analysis/src/SharedTypes.ml | 142 +++++++++++++++++++-------------- 6 files changed, 132 insertions(+), 126 deletions(-) diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 86569384e..ffec1d48d 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -174,10 +174,10 @@ let documentSymbol ~path = | None -> Protocol.null | Some {file} -> let open SharedTypes in - let rec getItems {topLevel} = + let rec getItems {ModuleKind.topLevel} = let rec getItem = function - | MValue v -> (v |> SharedTypes.variableKind, []) - | MType (t, _) -> (t.decl |> SharedTypes.declarationKind, []) + | ModuleKind.Value v -> (v |> SharedTypes.variableKind, []) + | Type (t, _) -> (t.decl |> SharedTypes.declarationKind, []) | Module (Structure contents) -> (Module, getItems contents) | Module (Constraint (_, modTypeItem)) -> getItem (Module modTypeItem) | Module (Ident _) -> (Module, []) diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index fc34f25cd..30740a420 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -1,16 +1,16 @@ let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code let showModuleTopLevel ~docstring ~name - (topLevel : SharedTypes.moduleItem SharedTypes.declared list) = + (topLevel : SharedTypes.ModuleKind.moduleItem SharedTypes.declared list) = let contents = topLevel |> List.map (fun item -> match item.SharedTypes.item with (* TODO pretty print module contents *) - | SharedTypes.MType ({decl}, recStatus) -> + | SharedTypes.ModuleKind.Type ({decl}, recStatus) -> " " ^ (decl |> Shared.declToString ~recStatus item.name.txt) | Module _ -> " module " ^ item.name.txt - | MValue typ -> + | Value typ -> " let " ^ item.name.txt ^ ": " ^ (typ |> Shared.typeToString)) (* TODO indent *) |> String.concat "\n" @@ -24,7 +24,7 @@ let showModuleTopLevel ~docstring ~name Some (doc ^ full) let rec showModule ~docstring ~(file : SharedTypes.File.t) ~name - (declared : SharedTypes.moduleKind SharedTypes.declared option) = + (declared : SharedTypes.ModuleKind.t SharedTypes.declared option) = match declared with | None -> showModuleTopLevel ~docstring ~name file.contents.topLevel | Some {item = Structure {topLevel}} -> diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index 68718f482..ec9c4a385 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -496,23 +496,6 @@ let resolveOpens ~env ~previous opens ~package = (* loop(previous) *) previous opens -type kind = - | Module of moduleKind - | Value of Types.type_expr - | Type of Type.t - | Constructor of constructor * Type.t declared - | Field of field * Type.t declared - | FileModule of string - -let kindToInt kind = - match kind with - | Module _ -> 9 - | FileModule _ -> 9 - | Constructor (_, _) -> 4 - | Field (_, _) -> 5 - | Type _ -> 22 - | Value _ -> 12 - let completionForDeclareds ~pos declareds prefix transformContents = (* Log.log("completion for declares " ++ prefix); *) Hashtbl.fold @@ -528,15 +511,15 @@ let completionForDeclareds ~pos declareds prefix transformContents = let completionForDeclaredModules ~pos ~env ~suffix = completionForDeclareds ~pos env.QueryEnv.file.stamps.modules suffix (fun m -> - Module m) + Kind.Module m) let completionForDeclaredValues ~pos ~env ~suffix = completionForDeclareds ~pos env.QueryEnv.file.stamps.values suffix (fun m -> - Value m) + Kind.Value m) let completionForDeclaredTypes ~pos ~env ~suffix = completionForDeclareds ~pos env.QueryEnv.file.stamps.types suffix (fun m -> - Type m) + Kind.Type m) let completionForExporteds exporteds (stamps : (int, 'a SharedTypes.declared) Hashtbl.t) prefix transformContents @@ -552,15 +535,15 @@ let completionForExporteds exporteds let completionForExportedModules ~env ~suffix = completionForExporteds env.QueryEnv.exported.modules env.file.stamps.modules - suffix (fun m -> Module m) + suffix (fun m -> Kind.Module m) let completionForExportedValues ~env ~suffix = completionForExporteds env.QueryEnv.exported.values env.file.stamps.values - suffix (fun v -> Value v) + suffix (fun v -> Kind.Value v) let completionForExportedTypes ~env ~suffix = completionForExporteds env.QueryEnv.exported.types env.file.stamps.types - suffix (fun t -> Type t) + suffix (fun t -> Kind.Type t) let completionForConstructors ~(env : QueryEnv.t) ~suffix = Hashtbl.fold @@ -575,7 +558,7 @@ let completionForConstructors ~(env : QueryEnv.t) ~suffix = | _ -> results) env.exported.types [] |> List.map (fun (c, t) -> - {(emptyDeclared c.cname.txt) with item = Constructor (c, t)}) + {(emptyDeclared c.cname.txt) with item = Kind.Constructor (c, t)}) let completionForFields ~(env : QueryEnv.t) ~suffix = Hashtbl.fold @@ -590,7 +573,7 @@ let completionForFields ~(env : QueryEnv.t) ~suffix = | _ -> results) env.exported.types [] |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Field (f, t)}) + {(emptyDeclared f.fname.txt) with item = Kind.Field (f, t)}) let isCapitalized name = if name = "" then false @@ -669,8 +652,8 @@ let getEnvWithOpens ~pos ~(env : QueryEnv.t) ~package ~(opens : QueryEnv.t list) in loop opens -let detail name contents = - match contents with +let detail name (kind : Kind.t) = + match kind with | Type {decl} -> decl |> Shared.declToString name | Value typ -> typ |> Shared.typeToString | Module _ -> "module" @@ -827,7 +810,9 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = allFiles |> FileSet.elements |> Utils.filterMap (fun name -> if Utils.startsWith name suffix && not (String.contains name '-') - then Some ({(emptyDeclared name) with item = FileModule name}, env) + then + Some + ({(emptyDeclared name) with item = Kind.FileModule name}, env) else None) in locallyDefinedValues @ valuesFromOpens @ localModuleNames @@ -878,7 +863,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = Some ( { (emptyDeclared field.fname.txt) with - item = Field (field, typ); + item = Kind.Field (field, typ); }, env ) else None)))) @@ -933,7 +918,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let declareds = processDotPath ~exact:true (componentPath @ ["make"]) in let labels = match declareds with - | ({SharedTypes.item = Value typ}, _env) :: _ -> + | ({SharedTypes.item = Kind.Value typ}, _env) :: _ -> let rec getFields (texp : Types.type_expr) = match texp.desc with | Tfield (name, _, t1, t2) -> @@ -996,7 +981,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens (fun ({SharedTypes.name = {txt = name}; deprecated; docstring; item}, _env) -> - mkItem ~name ~kind:(kindToInt item) ~deprecated + mkItem ~name ~kind:(Kind.toInt item) ~deprecated ~detail:(detail name item) ~docstring) | Cpipe (pipe, partialName) -> ( let arrayModulePath = ["Js"; "Array2"] in @@ -1107,13 +1092,13 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let declareds = dotpath |> processDotPath ~exact:false in declareds |> List.filter (fun ({item}, _env) -> - match item with Value _ -> true | _ -> false) + match item with Kind.Value _ -> true | _ -> false) |> List.map (fun ( {SharedTypes.name = {txt = name}; deprecated; docstring; item}, _env ) -> - mkItem ~name:(completionName name) ~kind:(kindToInt item) + mkItem ~name:(completionName name) ~kind:(Kind.toInt item) ~detail:(detail name item) ~deprecated ~docstring) | _ -> []) | None -> []) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 89bf33747..046a1adbf 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -50,7 +50,7 @@ let rec forTypeSignatureItem ~env ~(exported : SharedTypes.exported) ~extent:loc ~stamp:(Ident.binding_time ident) ~env ~item val_attributes exported.values env.stamps.values in - [{declared with item = MValue declared.item}] + [{declared with item = ModuleKind.Value declared.item}] | Sig_type ( ident, ({type_loc; type_kind; type_manifest; type_attributes} as decl), @@ -122,7 +122,7 @@ let rec forTypeSignatureItem ~env ~(exported : SharedTypes.exported) ~stamp:(Ident.binding_time ident) ~env type_attributes exported.types env.stamps.types in - [{declared with item = MType (declared.item, recStatus)}] + [{declared with item = Type (declared.item, recStatus)}] | Sig_module (ident, {md_type; md_attributes; md_loc}, _) -> let declared = addItem ~extent:md_loc @@ -141,7 +141,7 @@ and forTypeSignature env signature = (fun item items -> forTypeSignatureItem ~env ~exported item @ items) signature [] in - {docstring = []; exported; topLevel} + {ModuleKind.docstring = []; exported; topLevel} and forTypeModule env moduleType = match moduleType with @@ -213,7 +213,7 @@ let forTypeDeclaration ~env ~(exported : exported) } ~name ~stamp ~env typ_attributes exported.types env.stamps.types in - {declared with item = MType (declared.item, recStatus)} + {declared with item = ModuleKind.Type (declared.item, recStatus)} let rec forSignatureItem ~env ~(exported : exported) (item : Typedtree.signature_item) = @@ -225,7 +225,7 @@ let rec forSignatureItem ~env ~(exported : exported) ~extent:val_loc ~item:val_desc.ctyp_type ~env val_attributes exported.values env.stamps.values in - [{declared with item = MValue declared.item}] + [{declared with item = ModuleKind.Value declared.item}] | Tsig_type (recFlag, decls) -> decls |> List.mapi (fun i decl -> @@ -281,14 +281,14 @@ let forSignature ~env items = | None -> [] | Some d -> [d] in - {docstring; exported; topLevel} + {ModuleKind.docstring; exported; topLevel} let forTreeModuleType ~env {mty_desc} = match mty_desc with | Tmty_ident _ -> None | Tmty_signature {sig_items} -> let contents = forSignature ~env sig_items in - Some (Structure contents) + Some (ModuleKind.Structure contents) | _ -> None let rec getModulePath mod_desc = @@ -315,7 +315,8 @@ let rec forStructureItem ~env ~(exported : exported) item = ~extent:pat.pat_loc ~item attributes exported.values env.stamps.values in - declareds := {declared with item = MValue declared.item} :: !declareds + declareds := + {declared with item = ModuleKind.Value declared.item} :: !declareds | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) -> pats |> List.iter (fun p -> handlePattern [] p) | Tpat_or (p, _, _) -> handlePattern [] p @@ -382,7 +383,7 @@ let rec forStructureItem ~env ~(exported : exported) item = ~stamp:(Ident.binding_time val_id) ~env val_attributes exported.values env.stamps.values in - [{declared with item = MValue declared.item}] + [{declared with item = Value declared.item}] | Tstr_type (recFlag, decls) -> decls |> List.mapi (fun i decl -> @@ -1319,7 +1320,7 @@ let rec getSourceUri ~(env : QueryEnv.t) ~package path = | Some (env, _declared) -> env.file.uri) | ExportedModule (_, inner) -> getSourceUri ~env ~package inner -let exportedForTip ~(env : QueryEnv.t) name tip = +let exportedForTip ~(env : QueryEnv.t) name (tip : Tip.t) = match tip with | Value -> Hashtbl.find_opt env.exported.values name | Field _ | Constructor _ | Type -> Hashtbl.find_opt env.exported.types name diff --git a/analysis/src/References.ml b/analysis/src/References.ml index f5f137d1d..f611e7830 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -1,7 +1,6 @@ open SharedTypes let debugReferences = ref true - let maybeLog m = if !debugReferences then Log.log ("[ref] " ^ m) let checkPos (line, char) @@ -91,7 +90,7 @@ let getLocItem ~full ~line ~col = | li :: _ -> Some li | _ -> None -let declaredForTip ~stamps stamp tip = +let declaredForTip ~stamps stamp (tip : Tip.t) = let open Infix in match tip with | Value -> @@ -123,16 +122,16 @@ let getConstructor (file : File.t) stamp name = | _ -> None) let definedForLoc ~file ~package locKind = - let inner ~file stamp tip = + let inner ~file stamp (tip : Tip.t) = match tip with | Constructor name -> ( match getConstructor file stamp name with | None -> None | Some constructor -> Some ([], `Constructor constructor)) - | Field _name -> Some([], `Field) + | Field _name -> Some ([], `Field) | _ -> ( maybeLog - ("Trying for declared " ^ tipToString tip ^ " " ^ string_of_int stamp + ("Trying for declared " ^ Tip.toString tip ^ " " ^ string_of_int stamp ^ " in file " ^ Uri2.toString file.uri); match declaredForTip ~stamps:file.stamps stamp tip with | None -> None @@ -158,7 +157,7 @@ let definedForLoc ~file ~package locKind = match ProcessCmt.exportedForTip ~env name tip with | None -> Log.log - ("Exported not found for tip " ^ name ^ " > " ^ tipToString tip); + ("Exported not found for tip " ^ name ^ " > " ^ Tip.toString tip); None | Some stamp -> ( maybeLog ("Getting for " ^ string_of_int stamp ^ " in " ^ name); @@ -170,7 +169,8 @@ let definedForLoc ~file ~package locKind = maybeLog "Yes!! got it"; Some res)))) -let declaredForExportedTip ~(stamps : stamps) ~(exported : exported) name tip = +let declaredForExportedTip ~(stamps : stamps) ~(exported : exported) name + (tip : Tip.t) = let open Infix in match tip with | Value -> @@ -208,7 +208,7 @@ let alternateDeclared ~(file : File.t) ~package declared tip = None) let rec resolveModuleReference ?(pathsSeen = []) ~file ~package - (declared : moduleKind declared) = + (declared : ModuleKind.t declared) = match declared.item with | Structure _ -> Some (file, Some declared) | Constraint (_moduleItem, moduleTypeItem) -> @@ -277,7 +277,7 @@ let resolveModuleDefinition ~(file : File.t) ~package stamp = in Some (file.uri, loc)) -let definition ~file ~package stamp tip = +let definition ~file ~package stamp (tip : Tip.t) = match tip with | Constructor name -> ( match getConstructor file stamp name with @@ -310,7 +310,7 @@ let definitionForLocItem ~full:{file; package} locItem = | Typed (_, _, Definition (stamp, tip)) -> ( maybeLog ("Typed Definition stamp:" ^ string_of_int stamp ^ " tip:" - ^ tipToString tip); + ^ Tip.toString tip); match declaredForTip ~stamps:file.stamps stamp tip with | None -> None | Some declared -> @@ -337,13 +337,13 @@ let definitionForLocItem ~full:{file; package} locItem = Some (uri, Uri2.toTopLevelLoc uri)) | LModule (LocalReference (stamp, tip)) | Typed (_, _, LocalReference (stamp, tip)) -> - maybeLog ("Local defn " ^ tipToString tip); + maybeLog ("Local defn " ^ Tip.toString tip); definition ~file ~package stamp tip | LModule (GlobalReference (moduleName, path, tip)) | Typed (_, _, GlobalReference (moduleName, path, tip)) -> ( maybeLog ("Typed GlobalReference moduleName:" ^ moduleName ^ " path:" - ^ pathToString path ^ " tip:" ^ tipToString tip); + ^ pathToString path ^ " tip:" ^ Tip.toString tip); match ProcessCmt.fileForModule ~package moduleName with | None -> None | Some file -> ( @@ -415,7 +415,7 @@ type references = { locOpt : Location.t option; (* None: reference to a toplevel module *) } -let forLocalStamp ~full:{file; extra; package} stamp tip = +let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) = let env = QueryEnv.fromFile file in let open Infix in match @@ -535,7 +535,7 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) -> maybeLog ("Finding references for " ^ Uri2.toString file.uri ^ " and stamp " - ^ string_of_int stamp ^ " and tip " ^ tipToString tip); + ^ string_of_int stamp ^ " and tip " ^ Tip.toString tip); forLocalStamp ~full stamp tip | LModule (GlobalReference (moduleName, path, tip)) | Typed (_, _, GlobalReference (moduleName, path, tip)) -> ( @@ -555,5 +555,5 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = maybeLog ("Finding references for (global) " ^ Uri2.toString env.file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " - ^ tipToString tip); + ^ Tip.toString tip); forLocalStamp ~full stamp tip)))) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 2ff2850a5..d8eb08169 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -4,20 +4,6 @@ type visibilityPath = | IncludedModule of Path.t * visibilityPath | ExportedModule of string * visibilityPath -type 't declared = { - name : string Location.loc; - extentLoc : Location.t; - scopeLoc : Location.t; - stamp : int; - modulePath : visibilityPath; - isExported : bool; - deprecated : string option; - docstring : string list; - item : 't; -} - -type 't stampMap = (int, 't) Hashtbl.t - type field = {stamp : int; fname : string Location.loc; typ : Types.type_expr} type constructor = { @@ -38,8 +24,8 @@ module Type = struct type t = {kind : kind; decl : Types.type_declaration} end +type 't stampMap = (int, 't) Hashtbl.t type 't namedMap = (string, 't) Hashtbl.t - type namedStampMap = int namedMap type exported = { @@ -48,6 +34,52 @@ type exported = { modules : namedStampMap; } +type 't declared = { + name : string Location.loc; + extentLoc : Location.t; + scopeLoc : Location.t; + stamp : int; + modulePath : visibilityPath; + isExported : bool; + deprecated : string option; + docstring : string list; + item : 't; +} + +module ModuleKind = struct + type moduleItem = + | Value of Types.type_expr + | Type of Type.t * Types.rec_status + | Module of t + + and contents = { + docstring : string list; + exported : exported; + topLevel : moduleItem declared list; + } + + and t = Ident of Path.t | Structure of contents | Constraint of t * t +end + +module Kind = struct + type t = + | Module of ModuleKind.t + | Value of Types.type_expr + | Type of Type.t + | Constructor of constructor * Type.t declared + | Field of field * Type.t declared + | FileModule of string + + let toInt kind = + match kind with + | Module _ -> 9 + | FileModule _ -> 9 + | Constructor (_, _) -> 4 + | Field (_, _) -> 5 + | Type _ -> 22 + | Value _ -> 12 +end + let initExported () = { types = Hashtbl.create 10; @@ -55,26 +87,10 @@ let initExported () = modules = Hashtbl.create 10; } -type moduleItem = - | MValue of Types.type_expr - | MType of Type.t * Types.rec_status - | Module of moduleKind - -and moduleContents = { - docstring : string list; - exported : exported; - topLevel : moduleItem declared list; -} - -and moduleKind = - | Ident of Path.t - | Structure of moduleContents - | Constraint of moduleKind * moduleKind - type stamps = { types : Type.t declared stampMap; values : Types.type_expr declared stampMap; - modules : moduleKind declared stampMap; + modules : ModuleKind.t declared stampMap; constructors : constructor declared stampMap; } @@ -93,7 +109,7 @@ module File = struct uri : Uri2.t; stamps : stamps; moduleName : string; - contents : moduleContents; + contents : ModuleKind.contents; } let create moduleName uri = @@ -167,25 +183,27 @@ let emptyDeclared name = item = (); } -type tip = Value | Type | Field of string | Constructor of string | Module +module Tip = struct + type t = Value | Type | Field of string | Constructor of string | Module -let tipToString tip = - match tip with - | Value -> "Value" - | Type -> "Type" - | Field f -> "Field(" ^ f ^ ")" - | Constructor a -> "Constructor(" ^ a ^ ")" - | Module -> "Module" + let toString tip = + match tip with + | Value -> "Value" + | Type -> "Type" + | Field f -> "Field(" ^ f ^ ")" + | Constructor a -> "Constructor(" ^ a ^ ")" + | Module -> "Module" +end type path = string list let pathToString (path : path) = path |> String.concat "." type locKind = - | LocalReference of int * tip - | GlobalReference of string * string list * tip + | LocalReference of int * Tip.t + | GlobalReference of string * string list * Tip.t | NotFound - | Definition of int * tip + | Definition of int * Tip.t type locType = | Typed of string * Types.type_expr * locKind @@ -207,7 +225,7 @@ end) type extra = { internalReferences : (int, Location.t list) Hashtbl.t; externalReferences : - (string, (string list * tip * Location.t) list) Hashtbl.t; + (string, (string list * Tip.t * Location.t) list) Hashtbl.t; fileReferences : (string, LocationSet.t) Hashtbl.t; mutable locItems : locItem list; (* This is the "open location", like the location... @@ -255,10 +273,10 @@ let state = } let locKindToString = function - | LocalReference (_, tip) -> "(LocalReference " ^ tipToString tip ^ ")" + | LocalReference (_, tip) -> "(LocalReference " ^ Tip.toString tip ^ ")" | GlobalReference _ -> "GlobalReference" | NotFound -> "NotFound" - | Definition (_, tip) -> "(Definition " ^ tipToString tip ^ ")" + | Definition (_, tip) -> "(Definition " ^ Tip.toString tip ^ ")" let locTypeToString = function | Typed (name, e, locKind) -> @@ -278,23 +296,25 @@ let locItemToString {loc = {Location.loc_start; loc_end}; locType} = (* needed for debugging *) let _ = locItemToString -type kinds = - | Module - | Enum - | Interface - | Function - | Variable - | Array - | Object - | Null - | EnumMember - | TypeParameter +module SymbolKind = struct + type t = + | Module + | Enum + | Interface + | Function + | Variable + | Array + | Object + | Null + | EnumMember + | TypeParameter +end let rec variableKind t = match t.Types.desc with | Tlink t -> variableKind t | Tsubst t -> variableKind t - | Tarrow _ -> Function + | Tarrow _ -> SymbolKind.Function | Ttuple _ -> Array | Tconstr _ -> Variable | Tobject _ -> Object @@ -305,7 +325,7 @@ let rec variableKind t = | _ -> Variable let symbolKind = function - | Module -> 2 + | SymbolKind.Module -> 2 | Enum -> 10 | Interface -> 11 | Function -> 12 @@ -318,6 +338,6 @@ let symbolKind = function let declarationKind t = match t.Types.type_kind with - | Type_open | Type_abstract -> TypeParameter + | Type_open | Type_abstract -> SymbolKind.TypeParameter | Type_record _ -> Interface | Type_variant _ -> Enum From 319322f9bee4f99babc1c2d7d8a8f1b7db6fb101 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 18:20:11 +0100 Subject: [PATCH 5/9] Refactor exported and stamps. --- analysis/src/ProcessCmt.ml | 22 ++++++------- analysis/src/References.ml | 4 +-- analysis/src/SharedTypes.ml | 64 ++++++++++++++++++++----------------- 3 files changed, 47 insertions(+), 43 deletions(-) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 046a1adbf..5e8f27a82 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -39,7 +39,7 @@ let addItem ~name ~extent ~stamp ~env ~item attributes exported stamps = Hashtbl.add stamps stamp declared; declared -let rec forTypeSignatureItem ~env ~(exported : SharedTypes.exported) +let rec forTypeSignatureItem ~env ~(exported : SharedTypes.Exported.t) (item : Types.signature_item) = match item with | Sig_value (ident, {val_type; val_attributes; val_loc = loc}) -> @@ -135,7 +135,7 @@ let rec forTypeSignatureItem ~env ~(exported : SharedTypes.exported) | _ -> [] and forTypeSignature env signature = - let exported = initExported () in + let exported = Exported.init () in let topLevel = List.fold_right (fun item items -> forTypeSignatureItem ~env ~exported item @ items) @@ -156,7 +156,7 @@ let getModuleTypePath mod_desc = | Tmty_ident (path, _) | Tmty_alias (path, _) -> Some path | Tmty_signature _ | Tmty_functor _ | Tmty_with _ | Tmty_typeof _ -> None -let forTypeDeclaration ~env ~(exported : exported) +let forTypeDeclaration ~env ~(exported : Exported.t) { typ_id; typ_loc; @@ -215,7 +215,7 @@ let forTypeDeclaration ~env ~(exported : exported) in {declared with item = ModuleKind.Type (declared.item, recStatus)} -let rec forSignatureItem ~env ~(exported : exported) +let rec forSignatureItem ~env ~(exported : Exported.t) (item : Typedtree.signature_item) = match item.sig_desc with | Tsig_value {val_id; val_loc; val_name = name; val_desc; val_attributes} -> @@ -267,7 +267,7 @@ let rec forSignatureItem ~env ~(exported : exported) | _ -> [] let forSignature ~env items = - let exported = initExported () in + let exported = Exported.init () in let topLevel = items |> List.map (forSignatureItem ~env ~exported) |> List.flatten in @@ -301,7 +301,7 @@ let rec getModulePath mod_desc = | Tmod_constraint (expr, _typ, _constraint, _coercion) -> getModulePath expr.mod_desc -let rec forStructureItem ~env ~(exported : exported) item = +let rec forStructureItem ~env ~(exported : Exported.t) item = match item.str_desc with | Tstr_value (_isRec, bindings) -> let declareds = ref [] in @@ -446,7 +446,7 @@ and forModule env mod_desc moduleName = Constraint (modKind, modTypeKind) and forStructure ~env items = - let exported = initExported () in + let exported = Exported.init () in let topLevel = List.fold_right (fun item results -> forStructureItem ~env ~exported item @ results) @@ -491,7 +491,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = let env = { scope = extent; - stamps = initStamps (); + stamps = Stamps.init (); modulePath = File (uri, moduleName); } in @@ -510,7 +510,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = let env = { scope = sigItemsExtent items; - stamps = initStamps (); + stamps = Stamps.init (); modulePath = File (uri, moduleName); } in @@ -520,7 +520,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = let env = { scope = impItemsExtent structure.str_items; - stamps = initStamps (); + stamps = Stamps.init (); modulePath = File (uri, moduleName); } in @@ -530,7 +530,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = let env = { scope = sigItemsExtent signature.sig_items; - stamps = initStamps (); + stamps = Stamps.init (); modulePath = File (uri, moduleName); } in diff --git a/analysis/src/References.ml b/analysis/src/References.ml index f611e7830..a70a62100 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -90,7 +90,7 @@ let getLocItem ~full ~line ~col = | li :: _ -> Some li | _ -> None -let declaredForTip ~stamps stamp (tip : Tip.t) = +let declaredForTip ~(stamps : Stamps.t) stamp (tip : Tip.t) = let open Infix in match tip with | Value -> @@ -169,7 +169,7 @@ let definedForLoc ~file ~package locKind = maybeLog "Yes!! got it"; Some res)))) -let declaredForExportedTip ~(stamps : stamps) ~(exported : exported) name +let declaredForExportedTip ~(stamps : Stamps.t) ~(exported : Exported.t) name (tip : Tip.t) = let open Infix in match tip with diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index d8eb08169..1b7c4858a 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -28,11 +28,20 @@ type 't stampMap = (int, 't) Hashtbl.t type 't namedMap = (string, 't) Hashtbl.t type namedStampMap = int namedMap -type exported = { - types : namedStampMap; - values : namedStampMap; - modules : namedStampMap; -} +module Exported = struct + type t = { + types : namedStampMap; + values : namedStampMap; + modules : namedStampMap; + } + + let init () = + { + types = Hashtbl.create 10; + values = Hashtbl.create 10; + modules = Hashtbl.create 10; + } +end type 't declared = { name : string Location.loc; @@ -54,7 +63,7 @@ module ModuleKind = struct and contents = { docstring : string list; - exported : exported; + exported : Exported.t; topLevel : moduleItem declared list; } @@ -80,34 +89,29 @@ module Kind = struct | Value _ -> 12 end -let initExported () = - { - types = Hashtbl.create 10; - values = Hashtbl.create 10; - modules = Hashtbl.create 10; +module Stamps = struct + type t = { + types : Type.t declared stampMap; + values : Types.type_expr declared stampMap; + modules : ModuleKind.t declared stampMap; + constructors : constructor declared stampMap; } -type stamps = { - types : Type.t declared stampMap; - values : Types.type_expr declared stampMap; - modules : ModuleKind.t declared stampMap; - constructors : constructor declared stampMap; -} - -let initStamps () = - { - types = Hashtbl.create 10; - values = Hashtbl.create 10; - modules = Hashtbl.create 10; - constructors = Hashtbl.create 10; - } + let init () = + { + types = Hashtbl.create 10; + values = Hashtbl.create 10; + modules = Hashtbl.create 10; + constructors = Hashtbl.create 10; + } +end -type env = {stamps : stamps; modulePath : visibilityPath; scope : Location.t} +type env = {stamps : Stamps.t; modulePath : visibilityPath; scope : Location.t} module File = struct type t = { uri : Uri2.t; - stamps : stamps; + stamps : Stamps.t; moduleName : string; contents : ModuleKind.contents; } @@ -115,14 +119,14 @@ module File = struct let create moduleName uri = { uri; - stamps = initStamps (); + stamps = Stamps.init (); moduleName; - contents = {docstring = []; exported = initExported (); topLevel = []}; + contents = {docstring = []; exported = Exported.init (); topLevel = []}; } end module QueryEnv = struct - type t = {file : File.t; exported : exported} + type t = {file : File.t; exported : Exported.t} let fromFile file = {file; exported = file.contents.exported} end From e52d28a0de6f07689dc62f3fd0ac66d7ca0dce98 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 18:25:36 +0100 Subject: [PATCH 6/9] Refactor constructor. --- analysis/src/NewCompletions.ml | 10 +++++++--- analysis/src/ProcessCmt.ml | 13 +++++++------ analysis/src/References.ml | 3 ++- analysis/src/SharedTypes.ml | 20 +++++++++++--------- 4 files changed, 27 insertions(+), 19 deletions(-) diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index ec9c4a385..a3d2ca4e6 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -444,7 +444,7 @@ let domLabels = ("suppressContentEditableWarning", "bool"); ] -let showConstructor {cname = {txt}; args; res} = +let showConstructor {Constructor.cname = {txt}; args; res} = txt ^ (match args with | [] -> "" @@ -552,13 +552,17 @@ let completionForConstructors ~(env : QueryEnv.t) ~suffix = match t.item.kind with | SharedTypes.Type.Variant constructors -> (constructors - |> List.filter (fun c -> Utils.startsWith c.cname.txt suffix) + |> List.filter (fun c -> + Utils.startsWith c.Constructor.cname.txt suffix) |> List.map (fun c -> (c, t))) @ results | _ -> results) env.exported.types [] |> List.map (fun (c, t) -> - {(emptyDeclared c.cname.txt) with item = Kind.Constructor (c, t)}) + { + (emptyDeclared c.Constructor.cname.txt) with + item = Kind.Constructor (c, t); + }) let completionForFields ~(env : QueryEnv.t) ~suffix = Hashtbl.fold diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 5e8f27a82..3849ca767 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -81,7 +81,7 @@ let rec forTypeSignatureItem ~env ~(exported : SharedTypes.Exported.t) let stamp = Ident.binding_time cd_id in let item = { - stamp; + Constructor.stamp; cname = Location.mknoloc name; args = (match cd_args with @@ -189,7 +189,7 @@ let forTypeDeclaration ~env ~(exported : Exported.t) |> List.map (fun {cd_id; cd_name = cname; cd_args; cd_res} -> let stamp = Ident.binding_time cd_id in { - stamp; + Constructor.stamp; cname; args = (match cd_args with @@ -579,9 +579,9 @@ let extraForFile ~(file : File.t) = addLocItem extra fname.loc (Typed (d.name.txt, typ, Definition (d.stamp, Field fname.txt)))) - | Variant constructos -> - constructos - |> List.iter (fun {stamp; cname} -> + | Variant constructors -> + constructors + |> List.iter (fun {Constructor.stamp; cname} -> addReference stamp cname.loc; let t = { @@ -825,7 +825,8 @@ struct match t with | `Local {stamp; item = {kind = Variant constructors}} -> ( match - constructors |> List.find_opt (fun c -> c.cname.txt = cstr_name) + constructors + |> List.find_opt (fun c -> c.Constructor.cname.txt = cstr_name) with | Some {stamp = cstamp} -> addReference cstamp nameLoc; diff --git a/analysis/src/References.ml b/analysis/src/References.ml index a70a62100..6543c817b 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -115,7 +115,8 @@ let getConstructor (file : File.t) stamp name = match kind with | Variant constructors -> ( match - constructors |> List.find_opt (fun const -> const.cname.txt = name) + constructors + |> List.find_opt (fun const -> const.Constructor.cname.txt = name) with | None -> None | Some const -> Some const) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 1b7c4858a..56c07e5f4 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -6,12 +6,14 @@ type visibilityPath = type field = {stamp : int; fname : string Location.loc; typ : Types.type_expr} -type constructor = { - stamp : int; - cname : string Location.loc; - args : (Types.type_expr * Location.t) list; - res : Types.type_expr option; -} +module Constructor = struct + type t = { + stamp : int; + cname : string Location.loc; + args : (Types.type_expr * Location.t) list; + res : Types.type_expr option; + } +end module Type = struct type kind = @@ -19,7 +21,7 @@ module Type = struct | Open | Tuple of Types.type_expr list | Record of field list - | Variant of constructor list + | Variant of Constructor.t list type t = {kind : kind; decl : Types.type_declaration} end @@ -75,7 +77,7 @@ module Kind = struct | Module of ModuleKind.t | Value of Types.type_expr | Type of Type.t - | Constructor of constructor * Type.t declared + | Constructor of Constructor.t * Type.t declared | Field of field * Type.t declared | FileModule of string @@ -94,7 +96,7 @@ module Stamps = struct types : Type.t declared stampMap; values : Types.type_expr declared stampMap; modules : ModuleKind.t declared stampMap; - constructors : constructor declared stampMap; + constructors : Constructor.t declared stampMap; } let init () = From 98c6e06c161b994b3ab5700d4123731ff16ab317 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 18:29:59 +0100 Subject: [PATCH 7/9] Clean up stamps and expored. --- analysis/src/SharedTypes.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 56c07e5f4..4549cdfaa 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -26,11 +26,9 @@ module Type = struct type t = {kind : kind; decl : Types.type_declaration} end -type 't stampMap = (int, 't) Hashtbl.t -type 't namedMap = (string, 't) Hashtbl.t -type namedStampMap = int namedMap - module Exported = struct + type namedStampMap = (string, int) Hashtbl.t + type t = { types : namedStampMap; values : namedStampMap; @@ -92,11 +90,13 @@ module Kind = struct end module Stamps = struct + type 't stampMap = (int, 't declared) Hashtbl.t + type t = { - types : Type.t declared stampMap; - values : Types.type_expr declared stampMap; - modules : ModuleKind.t declared stampMap; - constructors : Constructor.t declared stampMap; + types : Type.t stampMap; + values : Types.type_expr stampMap; + modules : ModuleKind.t stampMap; + constructors : Constructor.t stampMap; } let init () = From 1dd3374a79c4bf176e1f3a757b368421f0eb7631 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 18:59:49 +0100 Subject: [PATCH 8/9] Refactor env. --- analysis/src/ProcessCmt.ml | 11 ++++++----- analysis/src/SharedTypes.ml | 12 +++++++----- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 3849ca767..19ab49f60 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -21,7 +21,8 @@ let impItemsExtent items = let sigItemsExtent items = items |> List.map (fun item -> item.Typedtree.sig_loc) |> locsExtent -let addItem ~name ~extent ~stamp ~env ~item attributes exported stamps = +let addItem ~name ~extent ~stamp ~(env : Env.t) ~item attributes exported stamps + = let declared = ProcessAttributes.newDeclared ~item ~scope: @@ -490,7 +491,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = in let env = { - scope = extent; + Env.scope = extent; stamps = Stamps.init (); modulePath = File (uri, moduleName); } @@ -509,7 +510,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = in let env = { - scope = sigItemsExtent items; + Env.scope = sigItemsExtent items; stamps = Stamps.init (); modulePath = File (uri, moduleName); } @@ -519,7 +520,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = | Implementation structure -> let env = { - scope = impItemsExtent structure.str_items; + Env.scope = impItemsExtent structure.str_items; stamps = Stamps.init (); modulePath = File (uri, moduleName); } @@ -529,7 +530,7 @@ let forCmt ~moduleName ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = | Interface signature -> let env = { - scope = sigItemsExtent signature.sig_items; + Env.scope = sigItemsExtent signature.sig_items; stamps = Stamps.init (); modulePath = File (uri, moduleName); } diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 4549cdfaa..a006ae30f 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -1,8 +1,8 @@ -type visibilityPath = +type modulePath = | File of Uri2.t * string | NotVisible - | IncludedModule of Path.t * visibilityPath - | ExportedModule of string * visibilityPath + | IncludedModule of Path.t * modulePath + | ExportedModule of string * modulePath type field = {stamp : int; fname : string Location.loc; typ : Types.type_expr} @@ -48,7 +48,7 @@ type 't declared = { extentLoc : Location.t; scopeLoc : Location.t; stamp : int; - modulePath : visibilityPath; + modulePath : modulePath; isExported : bool; deprecated : string option; docstring : string list; @@ -108,7 +108,9 @@ module Stamps = struct } end -type env = {stamps : Stamps.t; modulePath : visibilityPath; scope : Location.t} +module Env = struct + type t = {stamps : Stamps.t; modulePath : modulePath; scope : Location.t} +end module File = struct type t = { From 5aee69c1f289e8ec36afa90a674f07f1f2a3dacf Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 22 Feb 2022 19:12:17 +0100 Subject: [PATCH 9/9] Refactor declared. --- analysis/src/Cmt.ml | 4 +-- analysis/src/Commands.ml | 18 +++++----- analysis/src/Hover.ml | 22 ++++++------ analysis/src/NewCompletions.ml | 41 +++++++++++----------- analysis/src/Packages.ml | 12 +++---- analysis/src/ProcessAttributes.ml | 2 +- analysis/src/ProcessCmt.ml | 16 ++++----- analysis/src/References.ml | 8 ++--- analysis/src/SharedTypes.ml | 58 ++++++++++++++++--------------- 9 files changed, 92 insertions(+), 89 deletions(-) diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index acd3ad421..64b081d3f 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -10,7 +10,7 @@ let fromUri ~uri = in match Hashtbl.find_opt package.pathsForModule moduleName with | Some paths -> - let cmt = SharedTypes.getCmtPath ~uri paths in + let cmt = getCmtPath ~uri paths in ProcessCmt.fullForCmt ~moduleName ~package ~uri cmt | None -> prerr_endline ("can't find module " ^ moduleName); @@ -19,7 +19,7 @@ let fromUri ~uri = let fromModule ~package modname = if Hashtbl.mem package.pathsForModule modname then let paths = Hashtbl.find package.pathsForModule modname in - let uri = SharedTypes.getUri paths in + let uri = getUri paths in fromUri ~uri else None diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index ffec1d48d..e7d37dd3b 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -1,7 +1,9 @@ +open SharedTypes + let dumpLocations ~full = - full.SharedTypes.extra.locItems + full.extra.locItems |> List.map (fun locItem -> - let locItemTxt = SharedTypes.locItemToString locItem in + let locItemTxt = locItemToString locItem in let hoverText = Hover.newHover ~full locItem in let hover = match hoverText with None -> "" | Some s -> String.escaped s @@ -60,7 +62,7 @@ let hover ~path ~line ~col = | Some locItem -> ( let isModule = match locItem.locType with - | SharedTypes.LModule _ | TopLevelModule _ -> true + | LModule _ | TopLevelModule _ -> true | TypeDefinition _ | Typed _ | Constant _ -> false in let uriLocOpt = References.definitionForLocItem ~full locItem in @@ -102,7 +104,7 @@ let definition ~path ~line ~col = in let isModule = match locItem.locType with - | SharedTypes.LModule _ | TopLevelModule _ -> true + | LModule _ | TopLevelModule _ -> true | TypeDefinition _ | Typed _ | Constant _ -> false in let skipLoc = @@ -176,13 +178,13 @@ let documentSymbol ~path = let open SharedTypes in let rec getItems {ModuleKind.topLevel} = let rec getItem = function - | ModuleKind.Value v -> (v |> SharedTypes.variableKind, []) - | Type (t, _) -> (t.decl |> SharedTypes.declarationKind, []) + | ModuleKind.Value v -> (v |> variableKind, []) + | Type (t, _) -> (t.decl |> declarationKind, []) | Module (Structure contents) -> (Module, getItems contents) | Module (Constraint (_, modTypeItem)) -> getItem (Module modTypeItem) | Module (Ident _) -> (Module, []) in - let fn {name = {txt}; extentLoc; item} = + let fn {Declared.name = {txt}; extentLoc; item} = let item, siblings = getItem item in if extentLoc.loc_ghost then siblings else (txt, extentLoc, item) :: siblings @@ -201,7 +203,7 @@ let documentSymbol ~path = uri = Uri2.toString (Uri2.fromPath path); range = Utils.cmtLocToRange loc; }; - kind = SharedTypes.symbolKind kind; + kind = symbolKind kind; }) in "[\n" ^ (allSymbols |> String.concat ",\n") ^ "\n]" diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index 30740a420..e0560715f 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -1,13 +1,15 @@ +open SharedTypes + let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code let showModuleTopLevel ~docstring ~name - (topLevel : SharedTypes.ModuleKind.moduleItem SharedTypes.declared list) = + (topLevel : ModuleKind.moduleItem Declared.t list) = let contents = topLevel |> List.map (fun item -> - match item.SharedTypes.item with + match item.Declared.item with (* TODO pretty print module contents *) - | SharedTypes.ModuleKind.Type ({decl}, recStatus) -> + | ModuleKind.Type ({decl}, recStatus) -> " " ^ (decl |> Shared.declToString ~recStatus item.name.txt) | Module _ -> " module " ^ item.name.txt | Value typ -> @@ -23,8 +25,8 @@ let showModuleTopLevel ~docstring ~name in Some (doc ^ full) -let rec showModule ~docstring ~(file : SharedTypes.File.t) ~name - (declared : SharedTypes.ModuleKind.t SharedTypes.declared option) = +let rec showModule ~docstring ~(file : File.t) ~name + (declared : ModuleKind.t Declared.t option) = match declared with | None -> showModuleTopLevel ~docstring ~name file.contents.topLevel | Some {item = Structure {topLevel}} -> @@ -36,9 +38,9 @@ let rec showModule ~docstring ~(file : SharedTypes.File.t) ~name | Some {item = Ident path} -> Some ("Unable to resolve module reference " ^ Path.name path) -let newHover ~full:{SharedTypes.file; package} locItem = - match locItem.SharedTypes.locType with - | SharedTypes.TypeDefinition (name, decl, _stamp) -> +let newHover ~full:{file; package} locItem = + match locItem.locType with + | TypeDefinition (name, decl, _stamp) -> let typeDef = Shared.declToString name decl in Some (codeBlock typeDef) | LModule (Definition (stamp, _tip)) | LModule (LocalReference (stamp, _tip)) @@ -59,7 +61,7 @@ let newHover ~full:{SharedTypes.file; package} locItem = match ProcessCmt.fileForModule ~package moduleName with | None -> None | Some file -> ( - let env = SharedTypes.QueryEnv.fromFile file in + let env = QueryEnv.fromFile file in match ProcessCmt.resolvePath ~env ~path ~package with | None -> None | Some (env, name) -> ( @@ -101,7 +103,7 @@ let newHover ~full:{SharedTypes.file; package} locItem = let fromType ~docstring typ = let typeString = codeBlock (typ |> Shared.typeToString) in let extraTypeInfo = - let env = SharedTypes.QueryEnv.fromFile file in + let env = QueryEnv.fromFile file in match typ |> Shared.digConstructor with | None -> None | Some path -> ( diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index a3d2ca4e6..1f45e787d 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -499,7 +499,7 @@ let resolveOpens ~env ~previous opens ~package = let completionForDeclareds ~pos declareds prefix transformContents = (* Log.log("completion for declares " ++ prefix); *) Hashtbl.fold - (fun _stamp declared results -> + (fun _stamp (declared : _ Declared.t) results -> if Utils.startsWith declared.name.txt prefix && Utils.locationContainsFuzzy declared.scopeLoc pos @@ -522,8 +522,8 @@ let completionForDeclaredTypes ~pos ~env ~suffix = Kind.Type m) let completionForExporteds exporteds - (stamps : (int, 'a SharedTypes.declared) Hashtbl.t) prefix transformContents - = + (stamps : (int, _ Declared.t) Hashtbl.t) prefix + transformContents = Hashtbl.fold (fun name stamp results -> (* Log.log("checking exported: " ++ name); *) @@ -550,7 +550,7 @@ let completionForConstructors ~(env : QueryEnv.t) ~suffix = (fun _name stamp results -> let t = Hashtbl.find env.file.stamps.types stamp in match t.item.kind with - | SharedTypes.Type.Variant constructors -> + | Type.Variant constructors -> (constructors |> List.filter (fun c -> Utils.startsWith c.Constructor.cname.txt suffix) @@ -560,7 +560,7 @@ let completionForConstructors ~(env : QueryEnv.t) ~suffix = env.exported.types [] |> List.map (fun (c, t) -> { - (emptyDeclared c.Constructor.cname.txt) with + (Declared.empty c.Constructor.cname.txt) with item = Kind.Constructor (c, t); }) @@ -577,7 +577,7 @@ let completionForFields ~(env : QueryEnv.t) ~suffix = | _ -> results) env.exported.types [] |> List.map (fun (f, t) -> - {(emptyDeclared f.fname.txt) with item = Kind.Field (f, t)}) + {(Declared.empty f.fname.txt) with item = Kind.Field (f, t)}) let isCapitalized name = if name = "" then false @@ -799,7 +799,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = (fun results env -> let completionsFromThisOpen = valueCompletions ~env suffix in List.filter - (fun (declared, _env) -> + (fun ((declared : Kind.t Declared.t), _env) -> if Hashtbl.mem alreadyUsedIdentifiers declared.name.txt then false else ( @@ -816,7 +816,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = if Utils.startsWith name suffix && not (String.contains name '-') then Some - ({(emptyDeclared name) with item = Kind.FileModule name}, env) + ({(Declared.empty name) with item = Kind.FileModule name}, env) else None) in locallyDefinedValues @ valuesFromOpens @ localModuleNames @@ -833,7 +833,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = | RecordAccess (valuePath, middleFields, lastField) -> ( Log.log ("lastField :" ^ lastField); Log.log - ("-------------- Looking for " ^ (valuePath |> SharedTypes.pathToString)); + ("-------------- Looking for " ^ (valuePath |> pathToString)); match getEnvWithOpens ~pos ~env ~package ~opens valuePath with | Some (env, name) -> ( match ProcessCmt.findInScope pos name env.file.stamps.values with @@ -866,7 +866,7 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~dotpath = if Utils.startsWith field.fname.txt lastField then Some ( { - (emptyDeclared field.fname.txt) with + (Declared.empty field.fname.txt) with item = Kind.Field (field, typ); }, env ) @@ -922,7 +922,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let declareds = processDotPath ~exact:true (componentPath @ ["make"]) in let labels = match declareds with - | ({SharedTypes.item = Kind.Value typ}, _env) :: _ -> + | ({Declared.item = Kind.Value typ}, _env) :: _ -> let rec getFields (texp : Types.type_expr) = match texp.desc with | Tfield (name, _, t1, t2) -> @@ -982,8 +982,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens (* TODO(#107): figure out why we're getting duplicates. *) declareds |> Utils.dedup |> List.map - (fun - ({SharedTypes.name = {txt = name}; deprecated; docstring; item}, _env) + (fun ({Declared.name = {txt = name}; deprecated; docstring; item}, _env) -> mkItem ~name ~kind:(Kind.toInt item) ~deprecated ~detail:(detail name item) ~docstring) @@ -1028,7 +1027,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens match fields |> List.find_opt (fun field -> - field.SharedTypes.fname.txt = fieldName) + field.fname.txt = fieldName) with | None -> None | Some field -> Some (field.typ, env1)) @@ -1044,7 +1043,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens match String.split_on_char '.' pipeId with | x :: fieldNames -> ( match [x] |> processDotPath ~exact:true with - | ({SharedTypes.item = Value typ}, env) :: _ -> ( + | ({Declared.item = Value typ}, env) :: _ -> ( match getFields ~env ~typ fieldNames with | None -> None | Some (typ1, _env1) -> fromType typ1) @@ -1095,11 +1094,11 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let dotpath = modulePath @ [partialName] in let declareds = dotpath |> processDotPath ~exact:false in declareds - |> List.filter (fun ({item}, _env) -> + |> List.filter (fun ({Declared.item}, _env) -> match item with Kind.Value _ -> true | _ -> false) |> List.map (fun - ( {SharedTypes.name = {txt = name}; deprecated; docstring; item}, + ( {Declared.name = {txt = name}; deprecated; docstring; item}, _env ) -> mkItem ~name:(completionName name) ~kind:(Kind.toInt item) @@ -1153,7 +1152,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens | Clabel (funPath, prefix, identsSeen) -> let labels = match funPath |> processDotPath ~exact:true with - | ({SharedTypes.item = Value typ}, _env) :: _ -> + | ({Declared.item = Value typ}, _env) :: _ -> let rec getLabels (t : Types.type_expr) = match t.desc with | Tlink t1 | Tsubst t1 -> getLabels t1 @@ -1202,7 +1201,7 @@ let processCompletable ~processDotPath ~full ~package ~rawOpens let env0 = QueryEnv.fromFile full.file in let env, fields = match lhs |> processDotPath ~exact:true with - | ({SharedTypes.item = Value typ}, env) :: _ -> getObjectFields ~env typ + | ({Declared.item = Value typ}, env) :: _ -> getObjectFields ~env typ | _ -> (env0, []) in let labels = resolvePath ~env fields path in @@ -1243,7 +1242,7 @@ let computeCompletions ~completable ~full ~pos ~rawOpens = let rec prioritize decls = match decls with | (d1, e1) :: (d2, e2) :: rest -> - let pos2 = d2.extentLoc.loc_start |> Utils.tupleOfLexing in + let pos2 = d2.Declared.extentLoc.loc_start |> Utils.tupleOfLexing in if pos2 >= pos then prioritize ((d1, e1) :: rest) else let pos1 = d1.extentLoc.loc_start |> Utils.tupleOfLexing in @@ -1252,7 +1251,7 @@ let computeCompletions ~completable ~full ~pos ~rawOpens = | [] | [_] -> decls in declareds - |> List.filter (fun ({SharedTypes.name = {txt}}, _env) -> txt = last) + |> List.filter (fun ({Declared.name = {txt}}, _env) -> txt = last) |> prioritize | _ -> declareds in diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index fcb962230..58c5a2d58 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -1,4 +1,5 @@ open Infix +open SharedTypes (* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *) let makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths = @@ -37,8 +38,7 @@ let newBsPackage ~rootPath = ~sourceDirectories ~libBs in projectFilesAndPaths - |> List.iter (fun (_name, paths) -> - Log.log (SharedTypes.showPaths paths)); + |> List.iter (fun (_name, paths) -> Log.log (showPaths paths)); let pathsForModule = makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths in @@ -75,13 +75,11 @@ let newBsPackage ~rootPath = in Log.log ("Opens from bsconfig: " ^ (opens |> String.concat " ")); { - SharedTypes.rootPath; + rootPath; projectFiles = - projectFilesAndPaths |> List.map fst - |> SharedTypes.FileSet.of_list; + projectFilesAndPaths |> List.map fst |> FileSet.of_list; dependenciesFiles = - dependenciesFilesAndPaths |> List.map fst - |> SharedTypes.FileSet.of_list; + dependenciesFilesAndPaths |> List.map fst |> FileSet.of_list; pathsForModule; opens; namespace; diff --git a/analysis/src/ProcessAttributes.ml b/analysis/src/ProcessAttributes.ml index a08ab8b29..0836b7596 100644 --- a/analysis/src/ProcessAttributes.ml +++ b/analysis/src/ProcessAttributes.ml @@ -37,7 +37,7 @@ let rec findDeprecatedAttribute attributes = let newDeclared ~item ~scope ~extent ~name ~stamp ~modulePath isExported attributes = { - name; + Declared.name; stamp; extentLoc = extent; scopeLoc = scope; diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 19ab49f60..b916638bd 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -40,7 +40,7 @@ let addItem ~name ~extent ~stamp ~(env : Env.t) ~item attributes exported stamps Hashtbl.add stamps stamp declared; declared -let rec forTypeSignatureItem ~env ~(exported : SharedTypes.Exported.t) +let rec forTypeSignatureItem ~env ~(exported : Exported.t) (item : Types.signature_item) = match item with | Sig_value (ident, {val_type; val_attributes; val_loc = loc}) -> @@ -559,16 +559,16 @@ let extraForFile ~(file : File.t) = else [])) in file.stamps.modules - |> Hashtbl.iter (fun stamp d -> + |> Hashtbl.iter (fun stamp (d : ModuleKind.t Declared.t) -> addLocItem extra d.name.loc (LModule (Definition (stamp, Module))); addReference stamp d.name.loc); file.stamps.values - |> Hashtbl.iter (fun stamp d -> + |> Hashtbl.iter (fun stamp (d : Types.type_expr Declared.t) -> addLocItem extra d.name.loc (Typed (d.name.txt, d.item, Definition (stamp, Value))); addReference stamp d.name.loc); file.stamps.types - |> Hashtbl.iter (fun stamp d -> + |> Hashtbl.iter (fun stamp (d : Type.t Declared.t) -> addLocItem extra d.name.loc (TypeDefinition (d.name.txt, d.item.Type.decl, stamp)); addReference stamp d.name.loc; @@ -1183,9 +1183,9 @@ let fileForModule modname ~package = if Hashtbl.mem package.pathsForModule modname then ( let paths = Hashtbl.find package.pathsForModule modname in (* TODO: do better *) - let uri = SharedTypes.getUri paths in - let cmt = SharedTypes.getCmtPath ~uri paths in - Log.log ("fileForModule " ^ SharedTypes.showPaths paths); + let uri = getUri paths in + let cmt = getCmtPath ~uri paths in + Log.log ("fileForModule " ^ showPaths paths); match fileForCmt ~moduleName:modname ~cmt ~uri state with | None -> None | Some docs -> Some docs) @@ -1217,7 +1217,7 @@ let locationIsBefore {Location.loc_start} pos = tupleOfLexing loc_start <= pos let findInScope pos name stamps = (* Log.log("Find " ++ name ++ " with " ++ string_of_int(Hashtbl.length(stamps)) ++ " stamps"); *) Hashtbl.fold - (fun _stamp declared result -> + (fun _stamp (declared : _ Declared.t) result -> if declared.name.txt = name then (* Log.log("a stamp " ++ Utils.showLocation(declared.scopeLoc) ++ " " ++ string_of_int(l) ++ "," ++ string_of_int(c)); *) if locationIsBefore declared.scopeLoc pos then diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 6543c817b..4a396fec3 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -185,7 +185,7 @@ let declaredForExportedTip ~(stamps : Stamps.t) ~(exported : Exported.t) name Hashtbl.find_opt stamps.modules stamp |?>> fun x -> {x with item = ()} (** Find alternative declaration: from res in case of interface, or from resi in case of implementation *) -let alternateDeclared ~(file : File.t) ~package declared tip = +let alternateDeclared ~(file : File.t) ~package (declared : _ Declared.t) tip = match Hashtbl.find_opt package.pathsForModule file.moduleName with | None -> None | Some paths -> ( @@ -209,7 +209,7 @@ let alternateDeclared ~(file : File.t) ~package declared tip = None) let rec resolveModuleReference ?(pathsSeen = []) ~file ~package - (declared : ModuleKind.t declared) = + (declared : ModuleKind.t Declared.t) = match declared.item with | Structure _ -> Some (file, Some declared) | Constraint (_moduleItem, moduleTypeItem) -> @@ -381,7 +381,7 @@ let typeDefinitionForLocItem ~full:{file; package} locItem = | Constant _ | TopLevelModule _ | LModule _ -> None | TypeDefinition _ -> Some (file.uri, locItem.loc) | Typed (_, typ, _) -> ( - let env = SharedTypes.QueryEnv.fromFile file in + let env = QueryEnv.fromFile file in match Shared.digConstructor typ with | None -> None | Some path -> ( @@ -389,7 +389,7 @@ let typeDefinitionForLocItem ~full:{file; package} locItem = | Some (env, declared) -> Some (env.file.uri, declared.item.decl.type_loc) | None -> None)) -let isVisible (declared : _ SharedTypes.declared) = +let isVisible (declared : _ Declared.t) = declared.isExported && let rec loop v = diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index a006ae30f..b7c34aeca 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -43,17 +43,32 @@ module Exported = struct } end -type 't declared = { - name : string Location.loc; - extentLoc : Location.t; - scopeLoc : Location.t; - stamp : int; - modulePath : modulePath; - isExported : bool; - deprecated : string option; - docstring : string list; - item : 't; -} +module Declared = struct + type 'item t = { + name : string Location.loc; + extentLoc : Location.t; + scopeLoc : Location.t; + stamp : int; + modulePath : modulePath; + isExported : bool; + deprecated : string option; + docstring : string list; + item : 'item; + } + + let empty name = + { + name = Location.mknoloc name; + extentLoc = Location.none; + scopeLoc = Location.none; + stamp = 0; + modulePath = NotVisible; + isExported = false; + deprecated = None; + docstring = []; + item = (); + } +end module ModuleKind = struct type moduleItem = @@ -64,7 +79,7 @@ module ModuleKind = struct and contents = { docstring : string list; exported : Exported.t; - topLevel : moduleItem declared list; + topLevel : moduleItem Declared.t list; } and t = Ident of Path.t | Structure of contents | Constraint of t * t @@ -75,8 +90,8 @@ module Kind = struct | Module of ModuleKind.t | Value of Types.type_expr | Type of Type.t - | Constructor of Constructor.t * Type.t declared - | Field of field * Type.t declared + | Constructor of Constructor.t * Type.t Declared.t + | Field of field * Type.t Declared.t | FileModule of string let toInt kind = @@ -90,7 +105,7 @@ module Kind = struct end module Stamps = struct - type 't stampMap = (int, 't declared) Hashtbl.t + type 't stampMap = (int, 't Declared.t) Hashtbl.t type t = { types : Type.t stampMap; @@ -178,19 +193,6 @@ let getCmtPath ~uri p = let interface = Utils.endsWith (Uri2.toPath uri) "i" in if interface then cmti else cmt -let emptyDeclared name = - { - name = Location.mknoloc name; - extentLoc = Location.none; - scopeLoc = Location.none; - stamp = 0; - modulePath = NotVisible; - isExported = false; - deprecated = None; - docstring = []; - item = (); - } - module Tip = struct type t = Value | Type | Field of string | Constructor of string | Module