Skip to content

Commit 30296e7

Browse files
zthcristianoc
zth
authored and
cristianoc
committed
setup + minimum needed to understand aliases
1 parent e5d0050 commit 30296e7

File tree

7 files changed

+282
-160
lines changed

7 files changed

+282
-160
lines changed

‎analysis/src/Cfg.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1 +1,3 @@
11
let supportsSnippets = ref false
2+
3+
let debugFollowCtxPath = false

‎analysis/src/CompletionBackEnd.ml

Lines changed: 42 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -243,6 +243,7 @@ let kindToDetail name (kind : Completion.kind) =
243243
^ ")")
244244
^ "\n\n" ^ s
245245
| Snippet s -> s
246+
| FollowContextPath _ -> ""
246247
| ExtractedType (extractedType, _) ->
247248
TypeUtils.extractedTypeToString extractedType
248249

@@ -262,7 +263,7 @@ let findAllCompletions ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed
262263
completionForExportedFields ~env ~prefix ~exact ~namesUsed
263264
@ completionForExportedModules ~env ~prefix ~exact ~namesUsed
264265

265-
let processLocalValue name loc ~prefix ~exact ~env
266+
let processLocalValue name loc contextPath ~prefix ~exact ~env
266267
~(localTables : LocalTables.t) =
267268
if Utils.checkName name ~prefix ~exact then
268269
match Hashtbl.find_opt localTables.valueTable (name, Loc.start loc) with
@@ -284,10 +285,13 @@ let processLocalValue name loc ~prefix ~exact ~env
284285
localTables.resultRev <-
285286
Completion.create name ~env
286287
~kind:
287-
(Value
288-
(Ctype.newconstr
289-
(Path.Pident (Ident.create "Type Not Known"))
290-
[]))
288+
(match contextPath with
289+
| Some contextPath -> FollowContextPath contextPath
290+
| None ->
291+
Value
292+
(Ctype.newconstr
293+
(Path.Pident (Ident.create "Type Not Known"))
294+
[]))
291295
:: localTables.resultRev
292296

293297
let processLocalConstructor name loc ~prefix ~exact ~env
@@ -616,27 +620,47 @@ let completionsGetCompletionType ~full = function
616620

617621
type getCompletionsForContextPathMode = Regular | Pipe
618622

619-
let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
623+
let rec completionsGetTypeEnv2 (completions : Completion.t list) ~full ~opens
624+
~rawOpens ~allFiles ~pos ~scope =
625+
match completions with
626+
| {Completion.kind = Value typ; env} :: _ -> Some (typ, env)
627+
| {Completion.kind = ObjLabel typ; env} :: _ -> Some (typ, env)
628+
| {Completion.kind = Field ({typ}, _); env} :: _ -> Some (typ, env)
629+
| {Completion.kind = FollowContextPath ctxPath; env} :: _ ->
630+
ctxPath
631+
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
632+
~exact:true ~scope
633+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
634+
| _ -> None
635+
636+
and getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
620637
~exact ~scope ?(mode = Regular) (contextPath : Completable.contextPath) =
621638
let package = full.package in
622639
match contextPath with
623640
| CPString ->
624641
[
625-
Completion.create "string" ~env
642+
Completion.create "dummy" ~env
626643
~kind:
627644
(Completion.Value
628645
(Ctype.newconstr (Path.Pident (Ident.create "string")) []));
629646
]
647+
| CPBool ->
648+
[
649+
Completion.create "dummy" ~env
650+
~kind:
651+
(Completion.Value
652+
(Ctype.newconstr (Path.Pident (Ident.create "bool")) []));
653+
]
630654
| CPInt ->
631655
[
632-
Completion.create "int" ~env
656+
Completion.create "dummy" ~env
633657
~kind:
634658
(Completion.Value
635659
(Ctype.newconstr (Path.Pident (Ident.create "int")) []));
636660
]
637661
| CPFloat ->
638662
[
639-
Completion.create "float" ~env
663+
Completion.create "dummy" ~env
640664
~kind:
641665
(Completion.Value
642666
(Ctype.newconstr (Path.Pident (Ident.create "float")) []));
@@ -694,7 +718,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
694718
cp
695719
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
696720
~exact:true ~scope
697-
|> completionsGetTypeEnv
721+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
698722
with
699723
| Some (typ, env) -> (
700724
let rec reconstructFunctionType args tRet =
@@ -740,7 +764,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
740764
cp
741765
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
742766
~exact:true ~scope
743-
|> completionsGetTypeEnv
767+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
744768
with
745769
| Some (typ, env) -> (
746770
match typ |> TypeUtils.extractRecordType ~env ~package with
@@ -764,7 +788,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
764788
cp
765789
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
766790
~exact:true ~scope
767-
|> completionsGetTypeEnv
791+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
768792
with
769793
| Some (typ, env) -> (
770794
match typ |> TypeUtils.extractObjectType ~env ~package with
@@ -791,7 +815,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
791815
cp
792816
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
793817
~exact:true ~scope ~mode:Pipe
794-
|> completionsGetTypeEnv
818+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
795819
with
796820
| None -> []
797821
| Some (typ, envFromCompletionItem) -> (
@@ -945,7 +969,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
945969
path
946970
|> getCompletionsForPath ~completionContext:Value ~exact:true ~package
947971
~opens ~allFiles ~pos ~env ~scope
948-
|> completionsGetTypeEnv
972+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
949973
in
950974
let lowercaseComponent =
951975
match pathToComponent with
@@ -991,7 +1015,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
9911015
functionContextPath
9921016
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos
9931017
~env ~exact:true ~scope
994-
|> completionsGetTypeEnv
1018+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
9951019
with
9961020
| Some (typ, env) -> (typ |> TypeUtils.getArgs ~full ~env, env)
9971021
| None -> ([], env)
@@ -1314,7 +1338,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
13141338
path
13151339
|> getCompletionsForPath ~completionContext:Value ~exact:true ~package
13161340
~opens ~allFiles ~pos ~env ~scope
1317-
|> completionsGetTypeEnv
1341+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
13181342
in
13191343
match completable with
13201344
| Cnone -> []
@@ -1380,7 +1404,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
13801404
cp
13811405
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos
13821406
~env ~exact:true ~scope
1383-
|> completionsGetTypeEnv
1407+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
13841408
with
13851409
| Some (typ, _env) ->
13861410
if debug then
@@ -1416,7 +1440,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
14161440
contextPath
14171441
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
14181442
~exact:true ~scope
1419-
|> completionsGetTypeEnv
1443+
|> completionsGetTypeEnv2 ~full ~opens ~rawOpens ~allFiles ~pos ~scope
14201444
with
14211445
| Some (typ, env) -> (
14221446
match

‎analysis/src/CompletionFrontEnd.ml

Lines changed: 25 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -141,6 +141,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
141141
| Pexp_constant (Pconst_string _) -> Some Completable.CPString
142142
| Pexp_constant (Pconst_integer _) -> Some CPInt
143143
| Pexp_constant (Pconst_float _) -> Some CPFloat
144+
| Pexp_construct ({txt = Lident ("true" | "false")}, None) -> Some CPBool
144145
| Pexp_array exprs ->
145146
Some
146147
(CPArray
@@ -271,30 +272,38 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
271272
scope :=
272273
!scope |> Scope.addValue ~name:vd.pval_name.txt ~loc:vd.pval_name.loc
273274
in
274-
let rec scopePattern (pat : Parsetree.pattern) =
275+
let rec scopePattern ?contextPath (pat : Parsetree.pattern) =
275276
match pat.ppat_desc with
276277
| Ppat_any -> ()
277-
| Ppat_var {txt; loc} -> scope := !scope |> Scope.addValue ~name:txt ~loc
278+
| Ppat_var {txt; loc} ->
279+
scope := !scope |> Scope.addValue ~name:txt ~loc ?contextPath
278280
| Ppat_alias (p, asA) ->
279281
scopePattern p;
280-
scope := !scope |> Scope.addValue ~name:asA.txt ~loc:asA.loc
282+
scope :=
283+
!scope
284+
|> Scope.addValue ~name:asA.txt ~loc:asA.loc
285+
?contextPath:
286+
(match p with
287+
| {ppat_desc = Ppat_var {txt}} -> Some (CPId ([txt], Value))
288+
| _ -> None)
281289
| Ppat_constant _ | Ppat_interval _ -> ()
282-
| Ppat_tuple pl -> pl |> List.iter scopePattern
290+
| Ppat_tuple pl -> pl |> List.iter (scopePattern ?contextPath)
283291
| Ppat_construct (_, None) -> ()
284-
| Ppat_construct (_, Some p) -> scopePattern p
292+
| Ppat_construct (_, Some p) -> scopePattern ?contextPath p
285293
| Ppat_variant (_, None) -> ()
286-
| Ppat_variant (_, Some p) -> scopePattern p
294+
| Ppat_variant (_, Some p) -> scopePattern ?contextPath p
287295
| Ppat_record (fields, _) ->
288-
fields |> List.iter (fun (_, p) -> scopePattern p)
289-
| Ppat_array pl -> pl |> List.iter scopePattern
290-
| Ppat_or (p1, _) -> scopePattern p1
291-
| Ppat_constraint (p, _) -> scopePattern p
296+
fields |> List.iter (fun (_, p) -> scopePattern ?contextPath p)
297+
| Ppat_array pl -> pl |> List.iter (scopePattern ?contextPath)
298+
| Ppat_or (p1, _) -> scopePattern ?contextPath p1
299+
| Ppat_constraint (p, _) -> scopePattern ?contextPath p
292300
| Ppat_type _ -> ()
293-
| Ppat_lazy p -> scopePattern p
294-
| Ppat_unpack {txt; loc} -> scope := !scope |> Scope.addValue ~name:txt ~loc
295-
| Ppat_exception p -> scopePattern p
301+
| Ppat_lazy p -> scopePattern ?contextPath p
302+
| Ppat_unpack {txt; loc} ->
303+
scope := !scope |> Scope.addValue ~name:txt ~loc ?contextPath
304+
| Ppat_exception p -> scopePattern ?contextPath p
296305
| Ppat_extension _ -> ()
297-
| Ppat_open (_, p) -> scopePattern p
306+
| Ppat_open (_, p) -> scopePattern ?contextPath p
298307
in
299308

300309
let lookingForPat = ref None in
@@ -322,7 +331,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
322331
| _ -> ()
323332
in
324333
let scopeValueBinding (vb : Parsetree.value_binding) =
325-
scopePattern vb.pvb_pat
334+
let contextPath = exprToContextPath vb.pvb_expr in
335+
scopePattern ?contextPath vb.pvb_pat
326336
in
327337
let scopeTypeKind (tk : Parsetree.type_kind) =
328338
match tk with

‎analysis/src/Scope.ml

Lines changed: 16 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ type item =
44
| Module of string * Location.t
55
| Open of string list
66
| Type of string * Location.t
7-
| Value of string * Location.t
7+
| Value of string * Location.t * SharedTypes.Completable.contextPath option
88

99
type t = item list
1010

@@ -16,7 +16,7 @@ let itemToString item =
1616
| Field (s, loc) -> "Field " ^ s ^ " " ^ Loc.toString loc
1717
| Open sl -> "Open " ^ list sl
1818
| Module (s, loc) -> "Module " ^ s ^ " " ^ Loc.toString loc
19-
| Value (s, loc) -> "Value " ^ s ^ " " ^ Loc.toString loc
19+
| Value (s, loc, _) -> "Value " ^ s ^ " " ^ Loc.toString loc
2020
| Type (s, loc) -> "Type " ^ s ^ " " ^ Loc.toString loc
2121
[@@live]
2222

@@ -25,14 +25,23 @@ let addConstructor ~name ~loc x = Constructor (name, loc) :: x
2525
let addField ~name ~loc x = Field (name, loc) :: x
2626
let addModule ~name ~loc x = Module (name, loc) :: x
2727
let addOpen ~lid x = Open (Utils.flattenLongIdent lid @ ["place holder"]) :: x
28-
let addValue ~name ~loc x = Value (name, loc) :: x
28+
let addValue ~name ~loc ?contextPath x =
29+
let showDebug = Cfg.debugFollowCtxPath in
30+
(if showDebug then
31+
match contextPath with
32+
| None -> Printf.printf "adding value '%s', no ctxPath\n" name
33+
| Some contextPath ->
34+
if showDebug then
35+
Printf.printf "adding value '%s' with ctxPath: %s\n" name
36+
(SharedTypes.Completable.contextPathToString contextPath));
37+
Value (name, loc, contextPath) :: x
2938
let addType ~name ~loc x = Type (name, loc) :: x
3039

3140
let iterValuesBeforeFirstOpen f x =
3241
let rec loop items =
3342
match items with
34-
| Value (s, loc) :: rest ->
35-
f s loc;
43+
| Value (s, loc, contextPath) :: rest ->
44+
f s loc contextPath;
3645
loop rest
3746
| Open _ :: _ -> ()
3847
| _ :: rest -> loop rest
@@ -43,8 +52,8 @@ let iterValuesBeforeFirstOpen f x =
4352
let iterValuesAfterFirstOpen f x =
4453
let rec loop foundOpen items =
4554
match items with
46-
| Value (s, loc) :: rest ->
47-
if foundOpen then f s loc;
55+
| Value (s, loc, contextPath) :: rest ->
56+
if foundOpen then f s loc contextPath;
4857
loop foundOpen rest
4958
| Open _ :: rest -> loop true rest
5059
| _ :: rest -> loop foundOpen rest

0 commit comments

Comments
 (0)