[display] rethink completion handling

* merge toplevel and default modes: If the parser doesn't find a resume, we show toplevel completion
* distinguish completion/non-completion in the parser
* insert some expressions to make the parser more robust
* allow toplevel without block

src/compiler/displayOutput.ml

@@ -658,6 +658,8 @@ let handle_display_argument com file_pos pre_compilation did_something =
 		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
 		let file = unquote file in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
+		Parser.is_completion := false;
+		Parser.had_resume := false;
 		let mode = match smode with
 			| "position" ->
 				Common.define com Define.NoCOpt;
@@ -675,7 +677,7 @@ let handle_display_argument com file_pos pre_compilation did_something =
 				DMHover
 			| "toplevel" ->
 				Common.define com Define.NoCOpt;
-				DMToplevel
+				DMDefault
 			| "module-symbols" ->
 				Common.define com Define.NoCOpt;
 				DMModuleSymbols None;
@@ -689,6 +691,7 @@ let handle_display_argument com file_pos pre_compilation did_something =
 				Common.define com Define.NoCOpt;
 				DMSignature
 			| "" ->
+				Parser.is_completion := true;
 				DMDefault
 			| _ ->
 				let smode,arg = try ExtString.String.split smode "@" with _ -> pos,"" in
@@ -699,6 +702,7 @@ let handle_display_argument com file_pos pre_compilation did_something =
 						Common.define com Define.NoCOpt;
 						DMModuleSymbols (Some arg)
 					| _ ->
+						Parser.is_completion := true;
 						DMDefault
 		in
 		let pos = try int_of_string pos with _ -> failwith ("Invalid format: "  ^ pos) in
@@ -706,6 +710,7 @@ let handle_display_argument com file_pos pre_compilation did_something =
 		Common.display_default := mode;
 		Common.define_value com Define.Display (if smode <> "" then smode else "1");
 		Parser.use_doc := true;
+		Parser.legacy_display := true;
 		Parser.resume_display := {
 			pfile = Path.unique_full_path file;
 			pmin = pos;

src/compiler/main.ml

@@ -807,7 +807,7 @@ try
 	let ext = Initialize.initialize_target ctx com classes in
 	(* if we are at the last compilation step, allow all packages accesses - in case of macros or opening another project file *)
 	if com.display.dms_display then begin match com.display.dms_kind with
-		| DMToplevel -> ()
+		| DMDefault -> ()
 		| _ -> if not ctx.has_next then com.package_rules <- PMap.foldi (fun p r acc -> match r with Forbidden -> acc | _ -> PMap.add p r acc) com.package_rules PMap.empty;
 	end;
 	com.config <- get_config com; (* make sure to adapt all flags changes defined after platform *)

src/context/display.ml

@@ -32,73 +32,68 @@ let is_display_position p =
 	encloses_position !Parser.resume_display p
 
 module ExprPreprocessing = struct
-	let find_enclosing com dk e =
+	let find_before_pos com is_completion dk e =
 		let display_pos = ref (!Parser.resume_display) in
-		let mk_null p = (EDisplay(((EConst(Ident "null")),p),dk),p) in
-		let encloses_display_pos p =
-			if really_encloses_position !display_pos p then begin
-				let p = !display_pos in
-				display_pos := { pfile = ""; pmin = -2; pmax = -2 };
-				Some p
-			end else
-				None
+		let is_annotated p = p.pmin < !display_pos.pmin && p.pmax >= !display_pos.pmax in
+		let annotate e =
+			display_pos := { pfile = ""; pmin = -2; pmax = -2 };
+			(EDisplay(e,dk),pos e)
 		in
-		let rec loop e = match fst e with
-			| EBlock el ->
-				let p = pos e in
-				(* We want to find the innermost block which contains the display position. *)
-				let el = List.map loop el in
-				let el = match encloses_display_pos p with
-					| None ->
-						el
-					| Some p2 ->
-						let b,el = List.fold_left (fun (b,el) e ->
-							let p = pos e in
-							if b || p.pmax <= p2.pmin then begin
-								(b,e :: el)
-							end else begin
-								let e_d = (EDisplay(mk_null p,dk)),p in
-								(true,e :: e_d :: el)
-							end
-						) (false,[]) el in
-						let el = if b then
-							el
-						else begin
-							mk_null p :: el
-						end in
-						List.rev el
-				in
-				(EBlock el),(pos e)
-			| _ ->
-				Ast.map_expr loop e
-		in
-		loop e
-
-	let find_before_pos com dk e =
-		let display_pos = ref (!Parser.resume_display) in
-		let is_annotated p =
-			if p.pmin <= !display_pos.pmin && p.pmax >= !display_pos.pmax then begin
-				display_pos := { pfile = ""; pmin = -2; pmax = -2 };
-				true
-			end else
-				false
+		let mk_null p = annotate ((EConst(Ident "null")),p) in
+		let loop_el el =
+			let pr = !Parser.resume_display in
+			let rec loop el = match el with
+				| [] -> [mk_null pr]
+				| e :: el ->
+					if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el
+					else e :: loop el
+			in
+			(* print_endline (Printf.sprintf "%i-%i: PR" pr.pmin pr.pmax);
+			List.iter (fun e ->
+				print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e));
+			) el; *)
+			match el with
+			| [] -> [mk_null pr]
+			| e :: el ->
+				if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el
+				else loop (e :: el)
 		in
-		let loop e = match fst e with
+		let loop e =
+			(* print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e)); *)
+			match fst e with
 			| EVars vl ->
 				if List.exists (fun ((_,p),_,_) -> is_annotated p) vl then
-					(EDisplay(e,dk),(pos e))
+					annotate e
 				else
 					e
+			| EBlock el when is_annotated (pos e) && is_completion ->
+				let el = loop_el el in
+				EBlock el,(pos e)
+			| ECall(e1,el) when is_annotated (pos e) && is_completion ->
+				let el = loop_el el in
+				ECall(e1,el),(pos e)
+			| ENew((tp,pp),el) when is_annotated (pos e) && is_completion ->
+				if is_annotated pp || pp.pmax >= !Parser.resume_display.pmax then
+					annotate e
+				else begin
+					let el = loop_el el in
+					ENew((tp,pp),el),(pos e)
+				end
+			| EArrayDecl el when is_annotated (pos e) && is_completion ->
+				let el = loop_el el in
+				EArrayDecl el,(pos e)
+			| EDisplay _ ->
+				raise Exit
 			| _ ->
 				if is_annotated (pos e) then
-					(EDisplay(e,dk),(pos e))
+					annotate e
 				else
 					e
 		in
 		let rec map e =
 			loop (Ast.map_expr map e)
 		in
-		map e
+		try map e with Exit -> e
 
 	let find_display_call e =
 		let found = ref false in
@@ -120,8 +115,8 @@ module ExprPreprocessing = struct
 
 
 	let process_expr com e = match com.display.dms_kind with
-		| DMToplevel -> find_enclosing com DKToplevel e
-		| DMDefinition | DMUsage _ | DMHover -> find_before_pos com DKMarked e
+		| DMDefinition | DMUsage _ | DMHover -> find_before_pos com false DKMarked e
+		| DMDefault -> find_before_pos com true DKMarked e
 		| DMSignature -> find_display_call e
 		| _ -> e
 end

src/context/displayJson.ml

@@ -75,6 +75,8 @@ let parse_input com input =
 				pmax = pos;
 			}
 		in
+		Parser.is_completion := false;
+		Parser.legacy_display := false;
 		begin match name with
 			| "initialize" ->
 				raise (DisplayOutput.Completion (f_result (JObject [
@@ -82,6 +84,7 @@ let parse_input com input =
 				])))
 			| "textDocument/completion" ->
 				read_display_file (get_bool_param "wasAutoTriggered") true;
+				Parser.is_completion := true;
 				enable_display DMDefault;
 			| "textDocument/definition" ->
 				Common.define com Define.NoCOpt;

src/context/displayTypes.ml

@@ -156,7 +156,6 @@ module DisplayMode = struct
 		| DMDefault
 		| DMUsage of bool (* true = also report definition *)
 		| DMDefinition
-		| DMToplevel
 		| DMResolve of string
 		| DMPackage
 		| DMHover
@@ -225,7 +224,6 @@ module DisplayMode = struct
 				dms_display_file_policy = DFPAlso;
 				dms_exit_during_typing = false
 			}
-		| DMToplevel -> { settings with dms_full_typing = true; }
 		| DMModuleSymbols filter -> { settings with
 				dms_display_file_policy = if filter = None then DFPOnly else DFPNo;
 				dms_exit_during_typing = false;
@@ -256,7 +254,6 @@ module DisplayMode = struct
 		| DMHover -> "type"
 		| DMUsage true -> "rename"
 		| DMUsage false -> "references"
-		| DMToplevel -> "toplevel"
 		| DMModuleSymbols None -> "module-symbols"
 		| DMModuleSymbols (Some s) -> "workspace-symbols " ^ s
 		| DMDiagnostics b -> (if b then "global " else "") ^ "diagnostics"

src/syntax/grammar.mly

@@ -184,7 +184,7 @@ and parse_import s p1 =
 			let resume() =
 				type_path (List.map fst acc) true
 			in
-			if is_resuming p then resume();
+			check_resume p resume (fun () -> ());
 			(match s with parser
 			| [< '(Const (Ident k),p) >] ->
 				loop ((k,p) :: acc)
@@ -218,6 +218,7 @@ and parse_using s p1 =
 	let rec loop acc =
 		match s with parser
 		| [< '(Dot,p) >] ->
+			check_resume p (fun () -> type_path (List.map fst acc) false) (fun () -> ());
 			begin match s with parser
 			| [< '(Const (Ident k),p) >] ->
 				loop ((k,p) :: acc)
@@ -225,9 +226,6 @@ and parse_using s p1 =
 				loop (("macro",p) :: acc)
 			| [< '(Kwd Extern,p) >] ->
 				loop (("extern",p) :: acc)
-			| [< >] ->
-				if is_resuming p then type_path (List.map fst acc) false;
-				serror()
 			end
 		| [< '(Semicolon,p2) >] ->
 			p2,List.rev acc
@@ -350,10 +348,10 @@ and parse_meta_params pname s = match s with parser
 
 and parse_meta_entry = parser
 	[< '(At,p1); s >] ->
+		let meta = check_resume p1 (fun () -> Some (Meta.Last,[],p1)) (fun () -> None) in
 		match s with parser
 		| [< name,p = parse_meta_name p1; params = parse_meta_params p; s >] -> (name,params,p)
-		| [< >] ->
-			if is_resuming p1 then (Meta.Last,[],p1) else serror()
+		| [< >] -> match meta with None -> serror() | Some meta -> meta
 
 and parse_meta = parser
 	| [< entry = parse_meta_entry; s >] ->
@@ -372,9 +370,10 @@ and parse_meta_name_2 p1 acc s =
 
 and parse_meta_name p1 = parser
 	| [< '(DblDot,p) when p.pmin = p1.pmax; s >] ->
+		let meta = check_resume p (fun () -> Some (Meta.Last,p)) (fun() -> None) in
 		begin match s with parser
 		| [< name,p2 = parse_meta_name_2 p [] >] -> (Meta.parse (rev_concat "." name)),p2
-		| [< >] -> if is_resuming p then Meta.Last,p else raise Stream.Failure
+		| [< >] -> match meta with None -> raise Stream.Failure | Some meta -> meta
 		end
 	| [< name,p2 = parse_meta_name_2 p1 [] >] -> (Meta.Custom (rev_concat "." name)),p2
 
@@ -459,24 +458,23 @@ and parse_type_path2 p0 pack name p1 s =
 	if is_lower_ident name then
 		(match s with parser
 		| [< '(Dot,p) >] ->
-			if is_resuming p then
-				raise (TypePath (List.rev (name :: pack),None,false))
-			else
-				parse_type_path1 (match p0 with None -> Some p1 | Some _ -> p0) (name :: pack) s
+			check_resume p
+				(fun () -> raise (TypePath (List.rev (name :: pack),None,false)))
+				(fun () -> parse_type_path1 (match p0 with None -> Some p1 | Some _ -> p0) (name :: pack) s)
 		| [< '(Semicolon,_) >] ->
 			error (Custom "Type name should start with an uppercase letter") p1
 		| [< >] -> serror())
 	else
 		let sub,p2 = (match s with parser
 			| [< '(Dot,p); s >] ->
-				(if is_resuming p then
-					raise (TypePath (List.rev pack,Some (name,false),false))
-				else match s with parser
+				(check_resume p
+					(fun () -> raise (TypePath (List.rev pack,Some (name,false),false)))
+					(fun () -> match s with parser
 					| [< '(Const (Ident name),p2) when not (is_lower_ident name) >] -> Some name,p2
 					| [< '(Binop OpOr,_) when do_resume() >] ->
 						set_resume p;
 						raise (TypePath (List.rev pack,Some (name,false),false))
-					| [< >] -> serror())
+					| [< >] -> serror()))
 			| [< >] -> None,p1
 		) in
 		let params,p2 = (match s with parser
@@ -707,10 +705,7 @@ and block2 name ident p s =
 	match s with parser
 	| [< '(DblDot,_) >] ->
 		let e = try
-			begin match s with parser
-			| [< e = expr >] -> e
-			| [< >] -> serror()
-			end
+			secure_expr s
 		with Display e ->
 			let acc = [name,e] in
 			let e = EObjectDecl acc,punion p (pos e) in
@@ -765,10 +760,7 @@ and parse_obj_decl name e p0 s =
 			let next key = match s with parser
 				| [< '(DblDot,_) >] ->
 					let e = try
-						begin match s with parser
-						| [< e = expr >] -> e
-						| [< >] -> serror()
-						end
+						secure_expr s
 					with Display e ->
 						let acc = (key,e) :: acc in
 						let e = make_obj_decl acc (pos e) in
@@ -801,26 +793,32 @@ and parse_obj_decl name e p0 s =
 
 and parse_array_decl p1 s =
 	let secure_expr acc s = try
-		begin match s with parser
-		| [< e = expr >] -> e
-		end
+		expr s
 	with Display e ->
 		let acc = e :: acc in
 		let e = EArrayDecl (List.rev acc),punion p1 (pos e) in
 		display e
 	in
+	let resume_or_fail p1 =
+		if do_resume () then begin
+			let p = punion p1 (pos (next_token s)) in
+			[mk_null_expr p],p
+		end else serror()
+	in
 	let el,p2 = match s with parser
 		| [< '(BkClose,p2) >] -> [],p2
 		| [< e0 = secure_expr [] >] ->
 			let rec loop acc = match s with parser
-				| [< '(Comma,_) >] ->
+				| [< '(Comma,pk) >] ->
 					begin match s with parser
-					| [< e = secure_expr acc >] -> loop (e :: acc)
-					| [< '(BkClose,p2) >] -> acc,p2
+						| [< '(BkClose,p2) >] -> acc,p2
+						| [< e = secure_expr acc >] -> loop (e :: acc)
+						| [< >] -> resume_or_fail pk
 					end
 				| [< '(BkClose,p2) >] -> acc,p2
 			in
 			loop [e0]
+		| [< >] -> resume_or_fail p1
 	in
 	EArrayDecl (List.rev el),punion p1 p2
 
@@ -829,10 +827,7 @@ and parse_var_decl_head = parser
 
 and parse_var_assignment = parser
 	| [< '(Binop OpAssign,p1); s >] ->
-		begin match s with parser
-		| [< e = expr >] -> Some e
-		| [< >] -> error (Custom "expression expected after =") p1
-		end
+		Some (expr_or_fail (fun () -> error (Custom "expression expected after =") p1) s)
 	| [< >] -> None
 
 and parse_var_assignment_resume vl name pn t s =
@@ -929,11 +924,11 @@ and expr = parser
 		| Display e ->
 			display (make_meta name params e p)
 		| Stream.Failure | Stream.Error _ when Path.unique_full_path p.pfile = (!resume_display).pfile ->
-			let e = EConst (Ident "null"),p in
+			let e = EConst (Ident "null"),null_pos in
 			display (make_meta name params e p)
 		end
 	| [< '(BrOpen,p1); s >] ->
-		if is_resuming p1 then display (EDisplay ((EObjectDecl [],p1),DKStructure),p1);
+		check_resume p1 (fun() -> display (EDisplay ((EObjectDecl [],p1),DKStructure),p1)) (fun () -> ());
 		(match s with parser
 		| [< '(Binop OpOr,p2) when do_resume() >] ->
 			set_resume p1;
@@ -1073,7 +1068,7 @@ and expr_next' e1 = parser
 		| EConst(Ident n) -> expr_next (EMeta((Meta.from_string n,[],snd e1),eparam), punion p1 p2) s
 		| _ -> assert false)
 	| [< '(Dot,p); s >] ->
-		if is_resuming p then display (EDisplay (e1,DKDot),p);
+		check_resume p (fun () -> display (EDisplay (e1,DKDot),p)) (fun () -> ());
 		(match s with parser
 		| [< '(Kwd Macro,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"macro") , punion (pos e1) p2) s
 		| [< '(Kwd Extern,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"extern") , punion (pos e1) p2) s
@@ -1110,9 +1105,8 @@ and expr_next' e1 = parser
 			make_binop OpGt e1 e2)
 	| [< '(Binop op,_); s >] ->
 		(try
-			(match s with parser
-			| [< e2 = expr >] -> make_binop op e1 e2
-			| [< >] -> serror())
+			let e2 = secure_expr s in
+			make_binop op e1 e2
 		with Display e2 ->
 			raise (Display (make_binop op e1 e2)))
 	| [< '(Unop op,p) when is_postfix e1 op; s >] ->
@@ -1141,7 +1135,8 @@ and parse_switch_cases eswitch cases = parser
 		let l , def = parse_switch_cases eswitch cases s in
 		(match def with None -> () | Some _ -> error Duplicate_default p1);
 		l , Some b
-	| [< '(Kwd Case,p1); el = psep Comma expr_or_var; eg = popt parse_guard; '(DblDot,_); s >] ->
+	| [< '(Kwd Case,p1); el = psep Comma expr_or_var; eg = popt parse_guard; '(DblDot,pdot); s >] ->
+		if !was_auto_triggered then check_resume pdot (fun () -> ()) (fun () -> ());
 		(match el with
 		| [] -> error (Custom "case without a pattern is not allowed") p1
 		| _ ->
@@ -1177,14 +1172,15 @@ and parse_call_params f p1 s =
 		let e = f el p2 in
 		display (EDisplay(e,DKCall),pos e)
 	in
-	if is_resuming p1 then make_display_call [] p1;
+	if !legacy_display then check_resume p1 (fun () -> make_display_call [] p1) (fun () -> ());
 	let rec parse_next_param acc p1 =
 		let e = try
 			expr s
 		with
 		| Stream.Error _ | Stream.Failure as exc ->
 			let p2 = pos (next_token s) in
-			if encloses_resume (punion p1 p2) then make_display_call (List.rev acc) p2
+			if do_resume() then
+				mk_null_expr (punion p1 p2)
 			else raise exc
 		| Display e ->
 			display (f (List.rev (e :: acc)) (pos e))
@@ -1192,10 +1188,9 @@ and parse_call_params f p1 s =
 		match s with parser
 		| [< '(PClose,p2) >] -> f (List.rev (e :: acc)) p2
 		| [< '(Comma,p2) >] -> parse_next_param (e :: acc) p2
-		| [< '(Semicolon,p2) >] -> if encloses_resume (punion p1 p2) then make_display_call (List.rev acc) p2 else serror()
 		| [< >] ->
-			let p2 = pos (next_token s) in
-			if encloses_resume (punion p1 p2) then make_display_call (List.rev (e :: acc)) p2 else serror()
+			if do_resume() then f (List.rev (e :: acc)) (pos e)
+			else serror()
 	in
 	match s with parser
 	| [< '(PClose,p2) >] -> f [] p2
@@ -1213,7 +1208,12 @@ and toplevel_expr s =
 and secure_expr s =
 	match s with parser
 	| [< e = expr >] -> e
-	| [< >] -> serror()
+	| [< >] -> if do_resume() then mk_null_expr (punion (pos (last_token s)) (pos (next_token s))) else serror()
+
+and expr_or_fail fail s =
+	match s with parser
+	| [< e = expr >] -> e
+	| [< >] -> if do_resume() then mk_null_expr (punion (pos (last_token s)) (pos (next_token s))) else fail()
 
 let rec validate_macro_cond e = match fst e with
 	| EConst (Ident _)

src/syntax/parser.ml

@@ -77,6 +77,8 @@ end
 let last_doc : (string * int) option ref = ref None
 let use_doc = ref false
 let was_auto_triggered = ref false
+let is_completion = ref false
+let legacy_display = ref false
 let resume_display = ref null_pos
 let in_macro = ref false
 
@@ -115,6 +117,8 @@ let is_resuming p =
 let set_resume p =
 	resume_display := { p with pfile = Path.unique_full_path p.pfile }
 
+let had_resume = ref false
+
 let encloses_resume p =
 	p.pmin <= !resume_display.pmin && p.pmax >= !resume_display.pmax
 
@@ -194,4 +198,11 @@ let make_is e (t,p_t) p p_is =
 
 let next_token s = match Stream.peek s with
 	| Some tk -> tk
-	| _ -> last_token s
+	| _ -> last_token s
+
+let mk_null_expr p = (EConst(Ident "null"),p)
+
+let mk_display_expr p = (EDisplay(mk_null_expr p,DKMarked),p)
+
+let check_resume p fyes fno =
+	if !is_completion && is_resuming p then (had_resume := true; fyes()) else fno()

src/typing/typeloadFunction.ml

@@ -108,15 +108,15 @@ let type_function ctx args ret fmode f do_display p =
 	let e = if not do_display then
 		type_expr ctx e NoValue
 	else begin
-		let e = Display.ExprPreprocessing.process_expr ctx.com e in
+		let e = if !Parser.had_resume then e else Display.ExprPreprocessing.process_expr ctx.com e in
 		try
-			if Common.defined ctx.com Define.NoCOpt then raise Exit;
+			if Common.defined ctx.com Define.NoCOpt || not !Parser.had_resume then raise Exit;
 			type_expr ctx (Optimizer.optimize_completion_expr e) NoValue
 		with
 		| Parser.TypePath (_,None,_) | Exit ->
 			type_expr ctx e NoValue
 		| Display.DisplayType (t,_,_) when (match follow t with TMono _ -> true | _ -> false) ->
-			type_expr ctx (if ctx.com.display.dms_kind = DMToplevel then Display.ExprPreprocessing.find_enclosing ctx.com DKToplevel e else e) NoValue
+			type_expr ctx e NoValue
 	end in
 	let e = match e.eexpr with
 		| TMeta((Meta.MergeBlock,_,_), ({eexpr = TBlock el} as e1)) -> e1

src/typing/typerDisplay.ml

@@ -225,7 +225,7 @@ and display_expr ctx e_ast e dk with_type p =
 		in
 		let pl = loop e in
 		raise (Display.DisplayPosition pl);
-	| DMToplevel ->
+	| DMDefault when not (!Parser.had_resume)->
 		raise (Display.DisplayToplevel (DisplayToplevel.collect ctx false))
 	| DMDefault | DMNone | DMModuleSymbols _ | DMDiagnostics _ | DMStatistics ->
 		let fields = DisplayFields.collect ctx e_ast e dk with_type p in