Skip to content

Commit 57baa60

Browse files
authored
Loc item (#158)
* Refactor: clean up loc type, now called locItem. * Remove some comments.
1 parent 85b546e commit 57baa60

File tree

5 files changed

+80
-97
lines changed

5 files changed

+80
-97
lines changed

analysis/src/Commands.ml

Lines changed: 24 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,21 @@
1-
let dumpLocations ~package ~file ~extra =
2-
let locations = extra.SharedTypes.locations in
3-
locations
4-
|> List.map (fun ((location : Location.t), loc) ->
5-
let hoverText = Hover.newHover ~package ~file loc in
1+
let dumpLocations ~package ~file ~extra:{SharedTypes.locItems} =
2+
locItems
3+
|> List.map (fun locItem ->
4+
let hoverText = Hover.newHover ~package ~file locItem in
65
let hover =
76
match hoverText with None -> "" | Some s -> String.escaped s
87
in
9-
let uriLocOpt = References.definitionForLoc ~package ~file loc in
8+
let uriLocOpt =
9+
References.definitionForLocItem ~package ~file locItem
10+
in
1011
let def =
1112
match uriLocOpt with
1213
| None -> Protocol.null
1314
| Some (uri2, loc) ->
1415
Protocol.stringifyLocation
1516
{uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc}
1617
in
17-
Protocol.stringifyRange (Utils.cmtLocToRange location)
18+
Protocol.stringifyRange (Utils.cmtLocToRange locItem.loc)
1819
^ "\n Hover: " ^ hover ^ "\n Definition: " ^ def)
1920
|> String.concat "\n\n"
2021

@@ -49,17 +50,16 @@ let complete ~path ~line ~col ~currentFile =
4950
print_endline result
5051

5152
let hover ~file ~line ~col ~extra ~package =
52-
let locations = extra.SharedTypes.locations in
5353
let pos = Utils.protocolLineColToCmtLoc ~line ~col in
54-
match References.locForPos ~extra:{extra with locations} pos with
54+
match References.locItemForPos ~extra pos with
5555
| None -> Protocol.null
56-
| Some (_, loc) -> (
57-
let locIsModule =
58-
match loc with
56+
| Some locItem -> (
57+
let isModule =
58+
match locItem.locType with
5959
| SharedTypes.LModule _ | TopLevelModule _ -> true
6060
| TypeDefinition _ | Typed _ | Constant _ -> false
6161
in
62-
let uriLocOpt = References.definitionForLoc ~package ~file loc in
62+
let uriLocOpt = References.definitionForLocItem ~package ~file locItem in
6363
let skipZero =
6464
match uriLocOpt with
6565
| None -> false
@@ -69,11 +69,11 @@ let hover ~file ~line ~col ~extra ~package =
6969
(not isInterface) && pos_lnum = 1 && pos_cnum - pos_bol = 0
7070
in
7171
(* Skip if range is all zero, unless it's a module *)
72-
(not locIsModule) && posIsZero loc.loc_start && posIsZero loc.loc_end
72+
(not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end
7373
in
7474
if skipZero then Protocol.null
7575
else
76-
let hoverText = Hover.newHover ~file ~package loc in
76+
let hoverText = Hover.newHover ~file ~package locItem in
7777
match hoverText with
7878
| None -> Protocol.null
7979
| Some s -> Protocol.stringifyHover {contents = s})
@@ -88,18 +88,17 @@ let hover ~path ~line ~col =
8888
print_endline result
8989

9090
let definition ~file ~line ~col ~extra ~package =
91-
let locations = extra.SharedTypes.locations in
9291
let pos = Utils.protocolLineColToCmtLoc ~line ~col in
9392

94-
match References.locForPos ~extra:{extra with locations} pos with
93+
match References.locItemForPos ~extra pos with
9594
| None -> Protocol.null
96-
| Some (_, loc) -> (
97-
let locIsModule =
98-
match loc with
95+
| Some locItem -> (
96+
let isModule =
97+
match locItem.locType with
9998
| SharedTypes.LModule _ | TopLevelModule _ -> true
10099
| TypeDefinition _ | Typed _ | Constant _ -> false
101100
in
102-
let uriLocOpt = References.definitionForLoc ~package ~file loc in
101+
let uriLocOpt = References.definitionForLocItem ~package ~file locItem in
103102
match uriLocOpt with
104103
| None -> Protocol.null
105104
| Some (uri2, loc) ->
@@ -109,7 +108,7 @@ let definition ~file ~line ~col ~extra ~package =
109108
in
110109
(* Skip if range is all zero, unless it's a module *)
111110
let skipZero =
112-
(not locIsModule) && posIsZero loc.loc_start && posIsZero loc.loc_end
111+
(not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end
113112
in
114113
if skipZero then Protocol.null
115114
else
@@ -126,14 +125,12 @@ let definition ~path ~line ~col =
126125
print_endline result
127126

128127
let references ~file ~line ~col ~extra ~package =
129-
let locations = extra.SharedTypes.locations in
130128
let pos = Utils.protocolLineColToCmtLoc ~line ~col in
131-
132-
match References.locForPos ~extra:{extra with locations} pos with
129+
match References.locItemForPos ~extra pos with
133130
| None -> Protocol.null
134-
| Some (_, loc) ->
131+
| Some locItem ->
135132
let allReferences =
136-
References.allReferencesForLoc ~package ~file ~extra loc
133+
References.allReferencesForLocItem ~package ~file ~extra locItem
137134
in
138135
let allLocs =
139136
allReferences

analysis/src/Hover.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,8 +47,8 @@ let showModule ~docstring ~(file : SharedTypes.file) ~name
4747
showModuleTopLevel ~docstring ~name topLevel
4848
| Some {item = Ident _} -> Some "Unable to resolve module reference"
4949

50-
let newHover ~(file : SharedTypes.file) ~package loc =
51-
match loc with
50+
let newHover ~(file : SharedTypes.file) ~package locItem =
51+
match locItem.SharedTypes.locType with
5252
| SharedTypes.TypeDefinition (name, decl, _stamp) ->
5353
let typeDef = Shared.declToString name decl in
5454
Some (codeBlock typeDef)

analysis/src/ProcessCmt.ml

Lines changed: 17 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -137,9 +137,6 @@ let rec forSignatureTypeItem env (exported : SharedTypes.exported) item =
137137
env.stamps.types
138138
in
139139
[{declared with item = MType (declared.item, recStatus)}]
140-
(* | Sig_module({stamp, name}, {md_type: Mty_ident(path) | Mty_alias(path), md_attributes, md_loc}, _) =>
141-
let declared = addItem(~contents=Module.Ident(path), ~name=Location.mknoloc(name), ~stamp, ~env, md_attributes, exported.modules, env.stamps.modules);
142-
[{...declared, contents: Module.Module(declared.contents)}, ...items] *)
143140
| Sig_module (ident, {md_type; md_attributes; md_loc}, _) ->
144141
let declared =
145142
addItem ~extent:md_loc
@@ -521,12 +518,12 @@ let fileForCmt ~moduleName ~uri cmt =
521518
| Error e -> Error e
522519
| Ok infos -> Ok (forCmt ~moduleName ~uri infos)
523520

521+
let addLocItem extra loc locType =
522+
if not loc.Warnings.loc_ghost then
523+
extra.locItems <- {loc; locType} :: extra.locItems
524+
524525
let extraForFile ~(file : SharedTypes.file) =
525526
let extra = initExtra () in
526-
let addLocation loc ident =
527-
if not loc.Warnings.loc_ghost then
528-
extra.locations <- (loc, ident) :: extra.locations
529-
in
530527
let addReference stamp loc =
531528
Hashtbl.replace extra.internalReferences stamp
532529
(loc
@@ -537,23 +534,23 @@ let extraForFile ~(file : SharedTypes.file) =
537534
in
538535
file.stamps.modules
539536
|> Hashtbl.iter (fun stamp d ->
540-
addLocation d.name.loc (LModule (Definition (stamp, Module)));
537+
addLocItem extra d.name.loc (LModule (Definition (stamp, Module)));
541538
addReference stamp d.name.loc);
542539
file.stamps.values
543540
|> Hashtbl.iter (fun stamp d ->
544-
addLocation d.name.loc (Typed (d.item, Definition (stamp, Value)));
541+
addLocItem extra d.name.loc (Typed (d.item, Definition (stamp, Value)));
545542
addReference stamp d.name.loc);
546543
file.stamps.types
547544
|> Hashtbl.iter (fun stamp d ->
548-
addLocation d.name.loc
545+
addLocItem extra d.name.loc
549546
(TypeDefinition (d.name.txt, d.item.Type.decl, stamp));
550547
addReference stamp d.name.loc;
551548
match d.item.Type.kind with
552549
| Record labels ->
553550
labels
554551
|> List.iter (fun {stamp; fname; typ} ->
555552
addReference stamp fname.loc;
556-
addLocation fname.loc
553+
addLocItem extra fname.loc
557554
(Typed (typ, Definition (d.stamp, Field fname.txt))))
558555
| Variant constructos ->
559556
constructos
@@ -571,7 +568,7 @@ let extraForFile ~(file : SharedTypes.file) =
571568
ref Types.Mnil );
572569
}
573570
in
574-
addLocation cname.loc
571+
addLocItem extra cname.loc
575572
(Typed (t, Definition (d.stamp, Constructor cname.txt))))
576573
| _ -> ());
577574
extra
@@ -684,8 +681,6 @@ struct
684681
| None -> ()
685682
| Some relpath -> tracker.used <- (relpath, tip, loc) :: tracker.used)
686683

687-
let addLocation loc ident = extra.locations <- (loc, ident) :: extra.locations
688-
689684
let addReference stamp loc =
690685
Hashtbl.replace extra.internalReferences stamp
691686
(loc
@@ -732,7 +727,7 @@ struct
732727
| None -> NotFound)
733728
| `GlobalMod _ -> NotFound
734729
in
735-
addLocation loc (Typed (typ, locType))
730+
addLocItem extra loc (Typed (typ, locType))
736731

737732
let addForPathParent path loc =
738733
let locType =
@@ -754,7 +749,7 @@ struct
754749
LModule (LocalReference (stamp, Module))
755750
| None -> LModule NotFound)
756751
in
757-
addLocation loc locType
752+
addLocItem extra loc locType
758753

759754
let getTypeAtPath ~env path =
760755
match fromCompilerPath ~env path with
@@ -809,7 +804,7 @@ struct
809804
GlobalReference (moduleName, path, Field name)
810805
| _ -> NotFound
811806
in
812-
addLocation nameLoc (Typed (lbl_res, locType))
807+
addLocItem extra nameLoc (Typed (lbl_res, locType))
813808
| _ -> ()
814809

815810
let addForRecord recordType items =
@@ -837,7 +832,7 @@ struct
837832
GlobalReference (moduleName, path, Field name)
838833
| _ -> NotFound
839834
in
840-
addLocation nameLoc (Typed (lbl_res, locType)))
835+
addLocItem extra nameLoc (Typed (lbl_res, locType)))
841836
| _ -> ()
842837

843838
let addForConstructor constructorType {Asttypes.txt; loc} {Types.cstr_name} =
@@ -863,7 +858,7 @@ struct
863858
GlobalReference (moduleName, path, Constructor name)
864859
| _ -> NotFound
865860
in
866-
addLocation nameLoc (Typed (constructorType, locType))
861+
addLocItem extra nameLoc (Typed (constructorType, locType))
867862
| _ -> ()
868863

869864
let currentScopeExtent () =
@@ -973,14 +968,13 @@ struct
973968
in
974969
Hashtbl.add Collector.file.stamps.values stamp declared;
975970
addReference stamp name.loc;
976-
addLocation name.loc
971+
addLocItem extra name.loc
977972
(Typed (val_desc.ctyp_type, Definition (stamp, Value))))
978973
| _ -> ()
979974

980975
let enter_core_type {ctyp_type; ctyp_desc} =
981976
match ctyp_desc with
982977
| Ttyp_constr (path, {txt; loc}, _args) ->
983-
(* addForPath(path, txt, loc, Shared.makeFlexible(ctyp_type), Type) *)
984978
addForLongident (Some (ctyp_type, Type)) path txt loc
985979
| _ -> ()
986980

@@ -1000,7 +994,7 @@ struct
1000994
in
1001995
Hashtbl.add Collector.file.stamps.values stamp declared;
1002996
addReference stamp name.loc;
1003-
addLocation name.loc (Typed (pat_type, Definition (stamp, Value))))
997+
addLocItem extra name.loc (Typed (pat_type, Definition (stamp, Value))))
1004998
in
1005999
(* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *)
10061000
match pat_desc with
@@ -1035,7 +1029,7 @@ struct
10351029
| Overridden (loc, _) -> Some (loc, desc, ())
10361030
| _ -> None))
10371031
| Texp_constant constant ->
1038-
addLocation expression.exp_loc (Constant constant)
1032+
addLocItem extra expression.exp_loc (Constant constant)
10391033
(* Skip unit and list literals *)
10401034
| Texp_construct ({txt = Lident ("()" | "::"); loc}, _, _args)
10411035
when loc.loc_end.pos_cnum - loc.loc_start.pos_cnum <> 2 ->

0 commit comments

Comments
 (0)