Skip to content

Commit 11c61e8

Browse files
zthzth
committed
wip
1 parent fdaa98f commit 11c61e8

File tree

3 files changed

+242
-45
lines changed

3 files changed

+242
-45
lines changed

‎analysis/src/CompletionFrontEndNew.ml

+180-33
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,7 @@ end
5454
type completionCategory = Type | Value | Module | Field
5555

5656
type ctxPath =
57+
| CUnknown (** Something that cannot be resolved right now *)
5758
| CId of string list * completionCategory
5859
(** A regular id of an expected category. `let fff = thisIsAnId<com>` and `let fff = SomePath.alsoAnId<com>` *)
5960
| CVariantPayload of {itemNum: int}
@@ -62,9 +63,25 @@ type ctxPath =
6263
(** A record field. `let f = {on: true, s<com>}` seenFields = [on], prefix = "s",*)
6364
| COption of ctxPath (** An option with an inner type. *)
6465
| CArray of ctxPath option (** An array with an inner type. *)
66+
| CTuple of ctxPath list (** A tuple. *)
67+
| CBool
68+
| CString
69+
| CInt
70+
| CFloat
71+
| CFunction of {returnType: ctxPath} (** A function *)
6572

6673
let rec ctxPathToString (ctxPath : ctxPath) =
6774
match ctxPath with
75+
| CUnknown -> "CUnknown"
76+
| CBool -> "CBool"
77+
| CFloat -> "CFloat"
78+
| CInt -> "CInt"
79+
| CString -> "CString"
80+
| CFunction {returnType} ->
81+
Printf.sprintf "CFunction () -> %s" (ctxPathToString returnType)
82+
| CTuple ctxPaths ->
83+
Printf.sprintf "CTuple(%s)"
84+
(ctxPaths |> List.map ctxPathToString |> String.concat ", ")
6885
| CId (prefix, typ) ->
6986
Printf.sprintf "CId(%s)=%s"
7087
(match typ with
@@ -82,22 +99,53 @@ let rec ctxPathToString (ctxPath : ctxPath) =
8299
| None -> ""
83100
| Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]")
84101

85-
type currentlyExpecting = Type of ctxPath
102+
type currentlyExpecting =
103+
| Unit
104+
| Type of ctxPath
105+
| FunctionReturnType of ctxPath
86106

87107
let currentlyExpectingToString (c : currentlyExpecting) =
88108
match c with
109+
| Unit -> "Unit"
89110
| Type ctxPath -> Printf.sprintf "Type<%s>" (ctxPathToString ctxPath)
111+
| FunctionReturnType ctxPath ->
112+
Printf.sprintf "FunctionReturnType<%s>" (ctxPathToString ctxPath)
90113

91-
type completionContext = {
92-
positionContext: PositionContext.t;
93-
scope: Scope.t;
94-
currentlyExpecting: currentlyExpecting list;
95-
ctxPath: ctxPath list;
96-
}
114+
module CompletionContext = struct
115+
type t = {
116+
positionContext: PositionContext.t;
117+
scope: Scope.t;
118+
currentlyExpecting: currentlyExpecting list;
119+
ctxPath: ctxPath list;
120+
}
121+
122+
let make positionContext =
123+
{
124+
positionContext;
125+
scope = Scope.create ();
126+
currentlyExpecting = [];
127+
ctxPath = [];
128+
}
97129

98-
type completionResult = (ctxPath list * completionContext) option
130+
let withResetCtx completionContext =
131+
{completionContext with currentlyExpecting = []; ctxPath = []}
99132

100-
let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext)
133+
let withScope scope completionContext = {completionContext with scope}
134+
135+
let addCurrentlyExpecting currentlyExpecting completionContext =
136+
{
137+
completionContext with
138+
currentlyExpecting =
139+
currentlyExpecting :: completionContext.currentlyExpecting;
140+
}
141+
142+
let withResetCurrentlyExpecting completionContext =
143+
{completionContext with currentlyExpecting = [Unit]}
144+
end
145+
146+
type completionResult = (ctxPath list * CompletionContext.t) option
147+
148+
let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t)
101149
(lid : Longident.t Location.loc) =
102150
(* Flatten an identifier keeping track of whether the current cursor
103151
is after a "." in the id followed by a blank character.
@@ -122,8 +170,31 @@ let rec ctxPathFromCoreType ~completionContext (coreType : Parsetree.core_type)
122170
|> Option.map (fun innerTyp -> COption innerTyp)
123171
| Ptyp_constr ({txt = Lident "array"}, [innerTyp]) ->
124172
Some (CArray (innerTyp |> ctxPathFromCoreType ~completionContext))
125-
| Ptyp_constr (lid, _) ->
173+
| Ptyp_constr ({txt = Lident "bool"}, []) -> Some CBool
174+
| Ptyp_constr ({txt = Lident "int"}, []) -> Some CInt
175+
| Ptyp_constr ({txt = Lident "float"}, []) -> Some CFloat
176+
| Ptyp_constr ({txt = Lident "string"}, []) -> Some CString
177+
| Ptyp_constr (lid, []) ->
126178
Some (CId (lid |> flattenLidCheckDot ~completionContext, Type))
179+
| Ptyp_tuple types ->
180+
let types =
181+
types
182+
|> List.map (fun (t : Parsetree.core_type) ->
183+
match t |> ctxPathFromCoreType ~completionContext with
184+
| None -> CUnknown
185+
| Some ctxPath -> ctxPath)
186+
in
187+
Some (CTuple types)
188+
| Ptyp_arrow _ -> (
189+
let rec loopFnTyp (ct : Parsetree.core_type) =
190+
match ct.ptyp_desc with
191+
| Ptyp_arrow (_arg, _argTyp, nextTyp) -> loopFnTyp nextTyp
192+
| _ -> ct
193+
in
194+
let returnType = loopFnTyp coreType in
195+
match ctxPathFromCoreType ~completionContext returnType with
196+
| None -> None
197+
| Some returnType -> Some (CFunction {returnType}))
127198
| _ -> None
128199

129200
let findCurrentlyLookingForInPattern ~completionContext
@@ -141,7 +212,16 @@ let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option)
141212
| None -> list
142213
| Some currentlyExpecting -> currentlyExpecting :: list
143214

144-
let contextWithNewScope scope context = {context with scope}
215+
let contextWithNewScope scope (context : CompletionContext.t) =
216+
{context with scope}
217+
218+
(* An expression with that's an expr hole and that has an empty cursor. TODO Explain *)
219+
let checkIfExprHoleEmptyCursor ~(completionContext : CompletionContext.t)
220+
(exp : Parsetree.expression) =
221+
CompletionExpressions.isExprHole exp
222+
&& CursorPosition.classifyLoc exp.pexp_loc
223+
~pos:completionContext.positionContext.beforeCursor
224+
= EmptyLoc
145225

146226
(** Scopes *)
147227
let rec scopePattern ~scope (pat : Parsetree.pattern) =
@@ -218,8 +298,8 @@ let rec completeFromStructure ~completionContext
218298
|> Utils.findMap (fun (item : Parsetree.structure_item) ->
219299
completeStructureItem ~completionContext item)
220300

221-
and completeStructureItem ~completionContext (item : Parsetree.structure_item) :
222-
completionResult =
301+
and completeStructureItem ~(completionContext : CompletionContext.t)
302+
(item : Parsetree.structure_item) : completionResult =
223303
match item.pstr_desc with
224304
| Pstr_value (recFlag, valueBindings) ->
225305
let scopeFromBindings =
@@ -240,7 +320,9 @@ and completeStructureItem ~completionContext (item : Parsetree.structure_item) :
240320
completeValueBinding
241321
~completionContext:
242322
(if recFlag = Recursive then
243-
completionContext |> contextWithNewScope scopeFromBindings
323+
completionContext
324+
|> contextWithNewScope scopeFromBindings
325+
|> CompletionContext.withResetCtx
244326
else completionContext)
245327
vb)
246328
else None
@@ -269,8 +351,7 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) :
269351
|> CursorPosition.classifyLoc
270352
~pos:completionContext.positionContext.beforeCursor
271353
= HasCursor
272-
then (
273-
print_endline "completing expression";
354+
then
274355
let currentlyExpecting =
275356
findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat
276357
in
@@ -283,7 +364,7 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) :
283364
mergeCurrentlyLookingFor currentlyExpecting
284365
completionContext.currentlyExpecting;
285366
}
286-
vb.pvb_expr)
367+
vb.pvb_expr
287368
else None
288369

289370
and completeExpr ~completionContext (expr : Parsetree.expression) :
@@ -384,7 +465,8 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
384465
in
385466
match fieldToComplete with
386467
| None -> (
387-
(* Check if there's a expr hole with an empty cursor for a field. This means completing for an empty field `{someField: <com>}`. *)
468+
(* Check if there's a expr hole with an empty cursor for a field.
469+
This means completing for an empty field `{someField: <com>}`. *)
388470
let fieldNameWithExprHole =
389471
fields
390472
|> Utils.findMap (fun (fieldName, fieldExpr) ->
@@ -420,11 +502,85 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
420502
if lid.loc |> locHasPos then
421503
Some (CId (lidPath, Value) :: completionContext.ctxPath, completionContext)
422504
else None
423-
| Pexp_match _ | Pexp_unreachable | Pexp_constant _
424-
| Pexp_let (_, _, _)
425-
| Pexp_function _
426-
| Pexp_fun (_, _, _, _)
427-
| Pexp_apply (_, _)
505+
| Pexp_let (_recFlag, _valueBindings, nextExpr) ->
506+
(* A let binding. `let a = b` *)
507+
(* TODO: Handle recflag, scope, and complete in value bindings *)
508+
if locHasPos nextExpr.pexp_loc then completeExpr ~completionContext nextExpr
509+
else None
510+
| Pexp_ifthenelse (condition, then_, maybeElse) -> (
511+
if locHasPos condition.pexp_loc then
512+
(* TODO: I guess we could set looking for to "bool" here, since it's the if condition *)
513+
completeExpr
514+
~completionContext:(CompletionContext.withResetCtx completionContext)
515+
condition
516+
else if locHasPos then_.pexp_loc then completeExpr ~completionContext then_
517+
else
518+
match maybeElse with
519+
| Some else_ ->
520+
if locHasPos else_.pexp_loc then completeExpr ~completionContext else_
521+
else if checkIfExprHoleEmptyCursor ~completionContext else_ then
522+
Some (CId ([], Value) :: completionContext.ctxPath, completionContext)
523+
else None
524+
| _ ->
525+
(* Check then_ too *)
526+
if checkIfExprHoleEmptyCursor ~completionContext then_ then
527+
Some (CId ([], Value) :: completionContext.ctxPath, completionContext)
528+
else None)
529+
| Pexp_sequence (evalExpr, nextExpr) ->
530+
if locHasPos evalExpr.pexp_loc then
531+
completeExpr
532+
~completionContext:(CompletionContext.withResetCtx completionContext)
533+
evalExpr
534+
else if locHasPos nextExpr.pexp_loc then
535+
completeExpr ~completionContext nextExpr
536+
else None
537+
| Pexp_apply (fnExpr, _args) ->
538+
if locHasPos fnExpr.pexp_loc then
539+
completeExpr
540+
~completionContext:(CompletionContext.withResetCtx completionContext)
541+
fnExpr
542+
else (* TODO: Complete args. Pipes *)
543+
None
544+
| Pexp_fun _ ->
545+
(* We've found a function definition, like `let whatever = (someStr: string) => {}` *)
546+
let rec loopFnExprs ~(completionContext : CompletionContext.t)
547+
(expr : Parsetree.expression) =
548+
(* TODO: Handle completing in default expressions and patterns *)
549+
match expr.pexp_desc with
550+
| Pexp_fun (_arg, _defaultExpr, pattern, nextExpr) ->
551+
let scopeFromPattern =
552+
scopePattern ~scope:completionContext.scope pattern
553+
in
554+
loopFnExprs
555+
~completionContext:
556+
(completionContext |> CompletionContext.withScope scopeFromPattern)
557+
nextExpr
558+
| Pexp_constraint (expr, typ) ->
559+
(expr, completionContext, ctxPathFromCoreType ~completionContext typ)
560+
| _ -> (expr, completionContext, None)
561+
in
562+
let expr, completionContext, fnReturnConstraint =
563+
loopFnExprs ~completionContext expr
564+
in
565+
(* Set the expected type correctly for the expr body *)
566+
let completionContext =
567+
match fnReturnConstraint with
568+
| None -> (
569+
match completionContext.currentlyExpecting with
570+
| Type ctxPath :: _ ->
571+
(* Having a Type here already means the binding itself had a constraint on it. Since we're now moving into the function body,
572+
we'll need to ensure it's the function return type we use for completion, not the function type itself *)
573+
CompletionContext.addCurrentlyExpecting (FunctionReturnType ctxPath)
574+
completionContext
575+
| _ -> completionContext)
576+
| Some ctxPath ->
577+
CompletionContext.addCurrentlyExpecting (Type ctxPath) completionContext
578+
in
579+
if locHasPos expr.pexp_loc then completeExpr ~completionContext expr
580+
else if checkIfExprHoleEmptyCursor ~completionContext expr then
581+
Some (CId ([], Value) :: completionContext.ctxPath, completionContext)
582+
else None
583+
| Pexp_match _ | Pexp_unreachable | Pexp_constant _ | Pexp_function _
428584
| Pexp_try (_, _)
429585
| Pexp_tuple _
430586
| Pexp_construct (_, _)
@@ -433,8 +589,6 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
433589
| Pexp_field (_, _)
434590
| Pexp_setfield (_, _, _)
435591
| Pexp_array _
436-
| Pexp_ifthenelse (_, _, _)
437-
| Pexp_sequence (_, _)
438592
| Pexp_while (_, _)
439593
| Pexp_for (_, _, _, _, _)
440594
| Pexp_constraint (_, _)
@@ -455,14 +609,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
455609

456610
let completion ~currentFile ~path ~debug ~offset ~posCursor text =
457611
let positionContext = PositionContext.make ~offset ~posCursor text in
458-
let completionContext : completionContext =
459-
{
460-
positionContext;
461-
scope = Scope.create ();
462-
currentlyExpecting = [];
463-
ctxPath = [];
464-
}
465-
in
612+
let completionContext = CompletionContext.make positionContext in
466613
if Filename.check_suffix path ".res" then
467614
let parser =
468615
Res_driver.parsingEngine.parseImplementation ~forPrinter:false

‎analysis/tests/src/CompletionNew.res

+27
Original file line numberDiff line numberDiff line change
@@ -45,3 +45,30 @@ type someRecord = {nested: option<nestedRecord>, variant: someVariant}
4545

4646
// let myFunc: someRecord = {nested: {maybeVariant: One}, }
4747
// ^co2
48+
49+
// This should reset the context, meaning it should just complete for the identifier
50+
// let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, }
51+
// ^co2
52+
53+
// This is the last expression
54+
// let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, }
55+
// ^co2
56+
57+
// Complete as the last expression (looking for the record field type)
58+
// let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {v}}}, }
59+
// ^co2
60+
61+
// Complete on the identifier, no context
62+
// let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {v}}}, }
63+
// ^co2
64+
65+
type fn = (~name: string=?, string) => bool
66+
67+
// let getBool = (name): bool =>
68+
// ^co2
69+
70+
// let someFun: fn = (str, ~name) => {}
71+
// ^co2
72+
73+
// let someFun: fn = (str, ~name) => {let whatever = true; if whatever {}}
74+
// ^co2

0 commit comments

Comments
 (0)