From bd0c48f5b17da4575f471f1fdd81720de136e6a1 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 27 Apr 2021 04:44:36 +0200 Subject: [PATCH 1/2] Refactor: clean up loc type, now called locItem. --- analysis/src/Commands.ml | 51 ++++++++++++++++----------------- analysis/src/Hover.ml | 4 +-- analysis/src/ProcessCmt.ml | 36 +++++++++++------------ analysis/src/References.ml | 57 ++++++++++++++++++------------------- analysis/src/SharedTypes.ml | 8 ++++-- 5 files changed, 76 insertions(+), 80 deletions(-) diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 11d46b2fd..e726d1d41 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -1,12 +1,13 @@ -let dumpLocations ~package ~file ~extra = - let locations = extra.SharedTypes.locations in - locations - |> List.map (fun ((location : Location.t), loc) -> - let hoverText = Hover.newHover ~package ~file loc in +let dumpLocations ~package ~file ~extra:{SharedTypes.locItems} = + locItems + |> List.map (fun locItem -> + let hoverText = Hover.newHover ~package ~file locItem in let hover = match hoverText with None -> "" | Some s -> String.escaped s in - let uriLocOpt = References.definitionForLoc ~package ~file loc in + let uriLocOpt = + References.definitionForLocItem ~package ~file locItem + in let def = match uriLocOpt with | None -> Protocol.null @@ -14,7 +15,7 @@ let dumpLocations ~package ~file ~extra = Protocol.stringifyLocation {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc} in - Protocol.stringifyRange (Utils.cmtLocToRange location) + Protocol.stringifyRange (Utils.cmtLocToRange locItem.loc) ^ "\n Hover: " ^ hover ^ "\n Definition: " ^ def) |> String.concat "\n\n" @@ -49,17 +50,16 @@ let complete ~path ~line ~col ~currentFile = print_endline result let hover ~file ~line ~col ~extra ~package = - let locations = extra.SharedTypes.locations in let pos = Utils.protocolLineColToCmtLoc ~line ~col in - match References.locForPos ~extra:{extra with locations} pos with + match References.locItemForPos ~extra pos with | None -> Protocol.null - | Some (_, loc) -> ( - let locIsModule = - match loc with + | Some locItem -> ( + let isModule = + match locItem.locType with | SharedTypes.LModule _ | TopLevelModule _ -> true | TypeDefinition _ | Typed _ | Constant _ -> false in - let uriLocOpt = References.definitionForLoc ~package ~file loc in + let uriLocOpt = References.definitionForLocItem ~package ~file locItem in let skipZero = match uriLocOpt with | None -> false @@ -69,11 +69,11 @@ let hover ~file ~line ~col ~extra ~package = (not isInterface) && pos_lnum = 1 && pos_cnum - pos_bol = 0 in (* Skip if range is all zero, unless it's a module *) - (not locIsModule) && posIsZero loc.loc_start && posIsZero loc.loc_end + (not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end in if skipZero then Protocol.null else - let hoverText = Hover.newHover ~file ~package loc in + let hoverText = Hover.newHover ~file ~package locItem in match hoverText with | None -> Protocol.null | Some s -> Protocol.stringifyHover {contents = s}) @@ -88,18 +88,17 @@ let hover ~path ~line ~col = print_endline result let definition ~file ~line ~col ~extra ~package = - let locations = extra.SharedTypes.locations in let pos = Utils.protocolLineColToCmtLoc ~line ~col in - match References.locForPos ~extra:{extra with locations} pos with + match References.locItemForPos ~extra pos with | None -> Protocol.null - | Some (_, loc) -> ( - let locIsModule = - match loc with + | Some locItem -> ( + let isModule = + match locItem.locType with | SharedTypes.LModule _ | TopLevelModule _ -> true | TypeDefinition _ | Typed _ | Constant _ -> false in - let uriLocOpt = References.definitionForLoc ~package ~file loc in + let uriLocOpt = References.definitionForLocItem ~package ~file locItem in match uriLocOpt with | None -> Protocol.null | Some (uri2, loc) -> @@ -109,7 +108,7 @@ let definition ~file ~line ~col ~extra ~package = in (* Skip if range is all zero, unless it's a module *) let skipZero = - (not locIsModule) && posIsZero loc.loc_start && posIsZero loc.loc_end + (not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end in if skipZero then Protocol.null else @@ -126,14 +125,12 @@ let definition ~path ~line ~col = print_endline result let references ~file ~line ~col ~extra ~package = - let locations = extra.SharedTypes.locations in let pos = Utils.protocolLineColToCmtLoc ~line ~col in - - match References.locForPos ~extra:{extra with locations} pos with + match References.locItemForPos ~extra pos with | None -> Protocol.null - | Some (_, loc) -> + | Some locItem -> let allReferences = - References.allReferencesForLoc ~package ~file ~extra loc + References.allReferencesForLocItem ~package ~file ~extra locItem in let allLocs = allReferences diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index 2ac4c873b..4903fe115 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -47,8 +47,8 @@ let showModule ~docstring ~(file : SharedTypes.file) ~name showModuleTopLevel ~docstring ~name topLevel | Some {item = Ident _} -> Some "Unable to resolve module reference" -let newHover ~(file : SharedTypes.file) ~package loc = - match loc with +let newHover ~(file : SharedTypes.file) ~package locItem = + match locItem.SharedTypes.locType with | SharedTypes.TypeDefinition (name, decl, _stamp) -> let typeDef = Shared.declToString name decl in Some (codeBlock typeDef) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index da8525944..d354284ad 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -521,12 +521,12 @@ let fileForCmt ~moduleName ~uri cmt = | Error e -> Error e | Ok infos -> Ok (forCmt ~moduleName ~uri infos) +let addLocItem extra loc locType = + if not loc.Warnings.loc_ghost then + extra.locItems <- {loc; locType} :: extra.locItems + let extraForFile ~(file : SharedTypes.file) = let extra = initExtra () in - let addLocation loc ident = - if not loc.Warnings.loc_ghost then - extra.locations <- (loc, ident) :: extra.locations - in let addReference stamp loc = Hashtbl.replace extra.internalReferences stamp (loc @@ -537,15 +537,15 @@ let extraForFile ~(file : SharedTypes.file) = in file.stamps.modules |> Hashtbl.iter (fun stamp d -> - addLocation d.name.loc (LModule (Definition (stamp, Module))); + addLocItem extra d.name.loc (LModule (Definition (stamp, Module))); addReference stamp d.name.loc); file.stamps.values |> Hashtbl.iter (fun stamp d -> - addLocation d.name.loc (Typed (d.item, Definition (stamp, Value))); + addLocItem extra d.name.loc (Typed (d.item, Definition (stamp, Value))); addReference stamp d.name.loc); file.stamps.types |> Hashtbl.iter (fun stamp d -> - addLocation d.name.loc + addLocItem extra d.name.loc (TypeDefinition (d.name.txt, d.item.Type.decl, stamp)); addReference stamp d.name.loc; match d.item.Type.kind with @@ -553,7 +553,7 @@ let extraForFile ~(file : SharedTypes.file) = labels |> List.iter (fun {stamp; fname; typ} -> addReference stamp fname.loc; - addLocation fname.loc + addLocItem extra fname.loc (Typed (typ, Definition (d.stamp, Field fname.txt)))) | Variant constructos -> constructos @@ -571,7 +571,7 @@ let extraForFile ~(file : SharedTypes.file) = ref Types.Mnil ); } in - addLocation cname.loc + addLocItem extra cname.loc (Typed (t, Definition (d.stamp, Constructor cname.txt)))) | _ -> ()); extra @@ -684,8 +684,6 @@ struct | None -> () | Some relpath -> tracker.used <- (relpath, tip, loc) :: tracker.used) - let addLocation loc ident = extra.locations <- (loc, ident) :: extra.locations - let addReference stamp loc = Hashtbl.replace extra.internalReferences stamp (loc @@ -732,7 +730,7 @@ struct | None -> NotFound) | `GlobalMod _ -> NotFound in - addLocation loc (Typed (typ, locType)) + addLocItem extra loc (Typed (typ, locType)) let addForPathParent path loc = let locType = @@ -754,7 +752,7 @@ struct LModule (LocalReference (stamp, Module)) | None -> LModule NotFound) in - addLocation loc locType + addLocItem extra loc locType let getTypeAtPath ~env path = match fromCompilerPath ~env path with @@ -809,7 +807,7 @@ struct GlobalReference (moduleName, path, Field name) | _ -> NotFound in - addLocation nameLoc (Typed (lbl_res, locType)) + addLocItem extra nameLoc (Typed (lbl_res, locType)) | _ -> () let addForRecord recordType items = @@ -837,7 +835,7 @@ struct GlobalReference (moduleName, path, Field name) | _ -> NotFound in - addLocation nameLoc (Typed (lbl_res, locType))) + addLocItem extra nameLoc (Typed (lbl_res, locType))) | _ -> () let addForConstructor constructorType {Asttypes.txt; loc} {Types.cstr_name} = @@ -863,7 +861,7 @@ struct GlobalReference (moduleName, path, Constructor name) | _ -> NotFound in - addLocation nameLoc (Typed (constructorType, locType)) + addLocItem extra nameLoc (Typed (constructorType, locType)) | _ -> () let currentScopeExtent () = @@ -973,7 +971,7 @@ struct in Hashtbl.add Collector.file.stamps.values stamp declared; addReference stamp name.loc; - addLocation name.loc + addLocItem extra name.loc (Typed (val_desc.ctyp_type, Definition (stamp, Value)))) | _ -> () @@ -1000,7 +998,7 @@ struct in Hashtbl.add Collector.file.stamps.values stamp declared; addReference stamp name.loc; - addLocation name.loc (Typed (pat_type, Definition (stamp, Value)))) + addLocItem extra name.loc (Typed (pat_type, Definition (stamp, Value)))) in (* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *) match pat_desc with @@ -1035,7 +1033,7 @@ struct | Overridden (loc, _) -> Some (loc, desc, ()) | _ -> None)) | Texp_constant constant -> - addLocation expression.exp_loc (Constant constant) + addLocItem extra expression.exp_loc (Constant constant) (* Skip unit and list literals *) | Texp_construct ({txt = Lident ("()" | "::"); loc}, _, _args) when loc.loc_end.pos_cnum - loc.loc_start.pos_cnum <> 2 -> diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 017c009e5..1d8abc768 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -14,31 +14,33 @@ let checkPos (line, char) then false else true -let locsForPos ~extra pos = - extra.locations |> List.filter (fun (loc, _l) -> checkPos pos loc) +let locItemsForPos ~extra pos = + extra.locItems |> List.filter (fun {loc; locType = _} -> checkPos pos loc) -let locForPos ~extra pos = - let locs = locsForPos ~extra pos in - match locs with - | [(loc1, Typed (_, LocalReference _)); ((loc3, _) as l3)] when loc1 = loc3 -> +let locItemForPos ~extra pos = + let locItems = locItemsForPos ~extra pos in + match locItems with + | [({locType = Typed (_, LocalReference _)} as li1); li3] + when li1.loc = li3.loc -> (* JSX and compiler combined: ~x becomes Props#x heuristic for: [Props, x], give loc of `x` *) - Some l3 + Some li3 | [ - (loc1, Typed (_, LocalReference _)); - (loc2, Typed (_, GlobalReference ("Js_OO", Tip "unsafe_downgrade", _))); - ((loc3, _) as l3); + ({locType = Typed (_, LocalReference _)} as li1); + ({locType = Typed (_, GlobalReference ("Js_OO", Tip "unsafe_downgrade", _))} + as li2); + li3; ] (* For older compiler 9.0 or earlier *) - when loc1 = loc2 && loc2 = loc3 -> + when li1.loc = li2.loc && li2.loc = li3.loc -> (* JSX and compiler combined: ~x becomes Js_OO.unsafe_downgrade(Props)#x heuristic for: [Props, unsafe_downgrade, x], give loc of `x` *) - Some l3 + Some li3 | [ - ((_, Typed (_, LocalReference (_, Value))) as _l1); - ((_, Typed (_, Definition (_, Value))) as l2); + {locType = Typed (_, LocalReference (_, Value))}; + ({locType = Typed (_, Definition (_, Value))} as li2); ] -> (* JSX on type-annotated labeled (~arg:t): (~arg:t) becomes Props#arg @@ -48,17 +50,17 @@ let locForPos ~extra pos = (* Printf.eprintf "l1 %s\nl2 %s\n" (SharedTypes.locationToString _l1) (SharedTypes.locationToString l2); *) - Some l2 - | [(loc1, _); ((loc2, _) as l); (loc3, _)] when loc1 = loc2 && loc2 = loc3 -> + Some li2 + | [li1; li2; li3] when li1.loc = li2.loc && li2.loc = li3.loc -> (* JSX with at most one child heuristic for: [makeProps, make, createElement], give the loc of `make` *) - Some l - | [(loc1, _); (loc2, _); ((loc3, _) as l); (loc4, _)] - when loc1 = loc2 && loc2 = loc3 && loc3 = loc4 -> + Some li2 + | [li1; li2; li3; li4] + when li1.loc = li2.loc && li2.loc = li3.loc && li3.loc = li4.loc -> (* JSX variadic, e.g. {x} {y} heuristic for: [makeProps , React.null, make, createElementVariadic], give the loc of `make` *) - Some l - | l :: _ -> Some l + Some li3 + | li :: _ -> Some li | _ -> None let declaredForTip ~stamps stamp tip = @@ -292,8 +294,8 @@ let orLog message v = None | _ -> v -let definitionForLoc ~package ~file loc = - match loc with +let definitionForLocItem ~package ~file locItem = + match locItem.locType with | Typed (_, Definition (stamp, tip)) -> ( maybeLog "Trying to find a defintion for a definition"; match declaredForTip ~stamps:file.stamps stamp tip with @@ -445,12 +447,9 @@ let forLocalStamp ~package ~file ~extra stamp tip = in (file.uri, local) :: externals) -let allReferencesForLoc ~package ~file ~extra loc = - match loc with - | Typed (_, NotFound) - | LModule NotFound - | TopLevelModule _ | Constant _ -> - [] +let allReferencesForLocItem ~package ~file ~extra locItem = + match locItem.locType with + | Typed (_, NotFound) | LModule NotFound | TopLevelModule _ | Constant _ -> [] | TypeDefinition (_, _, stamp) -> forLocalStamp ~package ~file ~extra stamp Type | Typed (_, (LocalReference (stamp, tip) | Definition (stamp, tip))) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 383577091..af20334fd 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -174,13 +174,15 @@ type locKind = | NotFound | Definition of int * tip -type loc = +type locType = | Typed of Types.type_expr * locKind | Constant of Asttypes.constant | LModule of locKind | TopLevelModule of string | TypeDefinition of string * Types.type_declaration * int +type locItem = {loc : Location.t; locType : locType} + type openTracker = { path : Path.t; loc : Location.t; @@ -191,7 +193,7 @@ type openTracker = { type extra = { internalReferences : (int, Location.t list) Hashtbl.t; externalReferences : (string, (path * tip * Location.t) list) Hashtbl.t; - mutable locations : (Location.t * loc) list; + mutable locItems : locItem list; (* This is the "open location", like the location... or maybe the >> location of the open ident maybe *) (* OPTIMIZE: using a stack to come up with this would cut the computation time of this considerably. *) @@ -205,7 +207,7 @@ let initExtra () = { internalReferences = Hashtbl.create 10; externalReferences = Hashtbl.create 10; - locations = []; + locItems = []; opens = Hashtbl.create 10; } From 13c53a47b735dbb56023dc4fcd64c108fa659be0 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 27 Apr 2021 04:52:01 +0200 Subject: [PATCH 2/2] Remove some comments. --- analysis/src/ProcessCmt.ml | 4 ---- analysis/src/References.ml | 17 ++++------------- 2 files changed, 4 insertions(+), 17 deletions(-) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index d354284ad..f7f6f6075 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -137,9 +137,6 @@ let rec forSignatureTypeItem env (exported : SharedTypes.exported) item = env.stamps.types in [{declared with item = MType (declared.item, recStatus)}] - (* | Sig_module({stamp, name}, {md_type: Mty_ident(path) | Mty_alias(path), md_attributes, md_loc}, _) => - let declared = addItem(~contents=Module.Ident(path), ~name=Location.mknoloc(name), ~stamp, ~env, md_attributes, exported.modules, env.stamps.modules); - [{...declared, contents: Module.Module(declared.contents)}, ...items] *) | Sig_module (ident, {md_type; md_attributes; md_loc}, _) -> let declared = addItem ~extent:md_loc @@ -978,7 +975,6 @@ struct let enter_core_type {ctyp_type; ctyp_desc} = match ctyp_desc with | Ttyp_constr (path, {txt; loc}, _args) -> - (* addForPath(path, txt, loc, Shared.makeFlexible(ctyp_type), Type) *) addForLongident (Some (ctyp_type, Type)) path txt loc | _ -> () diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 1d8abc768..a92bdd6ac 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -207,9 +207,7 @@ let resolveModuleReference ~file ~package (declared : moduleKind declared) = | Some stamp -> ( match Hashtbl.find_opt env.qFile.stamps.modules stamp with | None -> None - | Some md -> - Some (env.qFile, Some md) - (* Some((env.file.uri, validateLoc(md.name.loc, md.extentLoc))) *))) + | Some md -> Some (env.qFile, Some md))) | `Global (moduleName, path) -> ( match ProcessCmt.fileForModule ~package moduleName with | None -> None @@ -223,22 +221,15 @@ let resolveModuleReference ~file ~package (declared : moduleKind declared) = | Some stamp -> ( match Hashtbl.find_opt env.qFile.stamps.modules stamp with | None -> None - | Some md -> - Some (env.qFile, Some md) - (* Some((env.file.uri, validateLoc(md.name.loc, md.extentLoc))) *) - )))) + | Some md -> Some (env.qFile, Some md))))) | `Stamp stamp -> ( match Hashtbl.find_opt file.stamps.modules stamp with | None -> None - | Some md -> - Some (file, Some md) - (* Some((file.uri, validateLoc(md.name.loc, md.extentLoc))) *)) + | Some md -> Some (file, Some md)) | `GlobalMod name -> ( match ProcessCmt.fileForModule ~package name with | None -> None - | Some file -> - (* maybeLog("Congrats, found a global mod"); *) - Some (file, None)) + | Some file -> Some (file, None)) | _ -> None) let validateLoc (loc : Location.t) (backup : Location.t) =