Skip to content

Loc item #158

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Apr 27, 2021
Merged

Loc item #158

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
bd0c48f
Refactor: clean up loc type, now called locItem.
cristianoc Apr 27, 2021
13c53a4
Remove some comments.
cristianoc Apr 27, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
51 changes: 24 additions & 27 deletions analysis/src/Commands.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,20 +1,21 @@
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
| Some (uri2, loc) ->
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"

Expand Down Expand Up @@ -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
Expand All @@ -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})
Expand All @@ -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) ->
Expand All @@ -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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions analysis/src/Hover.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
40 changes: 17 additions & 23 deletions analysis/src/ProcessCmt.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -521,12 +518,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
Expand All @@ -537,23 +534,23 @@ 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
| Record labels ->
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
Expand All @@ -571,7 +568,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
Expand Down Expand Up @@ -684,8 +681,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
Expand Down Expand Up @@ -732,7 +727,7 @@ struct
| None -> NotFound)
| `GlobalMod _ -> NotFound
in
addLocation loc (Typed (typ, locType))
addLocItem extra loc (Typed (typ, locType))

let addForPathParent path loc =
let locType =
Expand All @@ -754,7 +749,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
Expand Down Expand Up @@ -809,7 +804,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 =
Expand Down Expand Up @@ -837,7 +832,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} =
Expand All @@ -863,7 +858,7 @@ struct
GlobalReference (moduleName, path, Constructor name)
| _ -> NotFound
in
addLocation nameLoc (Typed (constructorType, locType))
addLocItem extra nameLoc (Typed (constructorType, locType))
| _ -> ()

let currentScopeExtent () =
Expand Down Expand Up @@ -973,14 +968,13 @@ 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))))
| _ -> ()

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
| _ -> ()

Expand All @@ -1000,7 +994,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
Expand Down Expand Up @@ -1035,7 +1029,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 ->
Expand Down
Loading