implement safer safe-navigation operator (closes #10622) (#10740)

* implement safer safe-navigation operator (closes #10622)

* add test

* use safe field access position also for else null expression and the whole if expression, that sounds more correct

not sure about that, but i guess we'll see

* fix force-inline call within safe navigation typing

* remove todo, add test

* side-step #10743 as it's unrelated

src/context/typecore.ml

@@ -193,7 +193,6 @@ type dot_path_part_case =
 type dot_path_part = {
 	name : string;
 	case : dot_path_part_case;
-	kind : efield_kind;
 	pos : pos
 }
 

src/typing/calls.ml

@@ -193,6 +193,23 @@ let rec acc_get ctx g p =
 	match g with
 	| AKNo f -> typing_error ("Field " ^ f ^ " cannot be accessed for reading") p
 	| AKExpr e -> e
+	| AKSafeNav sn ->
+		(* generate null-check branching for the safe navigation chain *)
+		let eobj = sn.sn_base in
+		let enull = Builder.make_null eobj.etype sn.sn_pos in
+		let eneq = Builder.binop OpNotEq eobj enull ctx.t.tbool sn.sn_pos in
+		let ethen = acc_get ctx sn.sn_access p in
+		let tnull = ctx.t.tnull ethen.etype in
+		let ethen = if not (is_nullable ethen.etype) then
+			mk (TCast(ethen,None)) tnull ethen.epos
+		else
+			ethen
+		in
+		let eelse = Builder.make_null tnull sn.sn_pos in
+		let eif = mk (TIf(eneq,ethen,Some eelse)) tnull sn.sn_pos in
+		(match sn.sn_temp_var with
+		| None -> eif
+		| Some evar -> { eif with eexpr = TBlock [evar; eif] })
 	| AKAccess _ -> die "" __LOC__
 	| AKResolve(sea,name) ->
 		(dispatcher ())#resolve_call sea name
@@ -254,27 +271,41 @@ let rec acc_get ctx g p =
 			make_call ctx ewrap [e] tcallb p
 		| _ -> die "" __LOC__)
 
-let build_call ?(mode=MGet) ctx acc el (with_type:WithType.t) p =
+let check_dynamic_super_method_call ctx fa p =
+	match fa with
+	| { fa_on = { eexpr = TConst TSuper } ; fa_field = { cf_kind = Method MethDynamic; cf_name = name } } ->
+		ctx.com.error ("Cannot call super." ^ name ^ " since it's a dynamic method") p
+	| _ ->
+		()
+
+let rec build_call_access ctx acc el mode with_type p =
 	let dispatch = new call_dispatcher ctx mode with_type p in
 	match acc with
 	| AKField fa ->
-		dispatch#field_call fa [] el
+		check_dynamic_super_method_call ctx fa p;
+		AKExpr (dispatch#field_call fa [] el)
 	| AKUsingField sea ->
 		let eparam = sea.se_this in
-		dispatch#field_call sea.se_access [eparam] el
+		AKExpr (dispatch#field_call sea.se_access [eparam] el)
 	| AKResolve(sea,name) ->
-		dispatch#expr_call (dispatch#resolve_call sea name) [] el
+		AKExpr (dispatch#expr_call (dispatch#resolve_call sea name) [] el)
 	| AKNo _ | AKAccess _ ->
 		ignore(acc_get ctx acc p);
 		typing_error ("Unexpected access mode, please report this: " ^ (s_access_kind acc)) p
 	| AKAccessor fa ->
 		let e = dispatch#field_call fa [] [] in
-		dispatch#expr_call e [] el
+		AKExpr (dispatch#expr_call e [] el)
 	| AKUsingAccessor sea ->
 		let e = dispatch#field_call sea.se_access [sea.se_this] [] in
-		dispatch#expr_call e [] el
+		AKExpr (dispatch#expr_call e [] el)
 	| AKExpr e ->
-		dispatch#expr_call e [] el
+		AKExpr (dispatch#expr_call e [] el)
+	| AKSafeNav sn ->
+		(* pack the call inside the safe navigation chain *)
+		AKSafeNav { sn with sn_access = build_call_access ctx sn.sn_access el mode with_type p }
+
+let build_call ?(mode=MGet) ctx acc el (with_type:WithType.t) p =
+	acc_get ctx (build_call_access ctx acc el mode with_type p) p
 
 let rec needs_temp_var e =
 	match e.eexpr with
@@ -460,21 +491,19 @@ let array_access ctx e1 e2 mode p =
 	return a new `access_mode->access_kind` getter for the whole field access chain.
 *)
 let field_chain ctx path access mode with_type =
-	let type_field e part =
-		let cfg = {TypeFieldConfig.default with
-			safe = part.kind = EFSafe
-		} in
-		type_field cfg ctx e part.name part.pos
-	in
 	let rec loop access path = match path with
 		| [] ->
 			access
-		| [part] ->
-			let e = acc_get ctx access part.pos in
-			type_field e part mode with_type
 		| part :: path ->
 			let e = acc_get ctx access part.pos in
-			let access = type_field e part MGet WithType.value in
+			let mode, with_type =
+				if path <> [] then
+					(* intermediate field access are just reading the value *)
+					MGet, WithType.value
+				else
+					mode, with_type
+			in
+			let access = type_field_default_cfg ctx e part.name part.pos mode with_type in
 			loop access path
 	in
 	loop access path

src/typing/fields.ml

@@ -11,7 +11,6 @@ module TypeFieldConfig = struct
 	type t = {
 		allow_resolve : bool;
 		do_resume : bool;
-		safe : bool;
 	}
 
 	let allow_resolve cfg = cfg.allow_resolve
@@ -21,13 +20,11 @@ module TypeFieldConfig = struct
 	let default = {
 		allow_resolve = true;
 		do_resume = false;
-		safe = false;
 	}
 
 	let create resume = {
 		allow_resolve = true;
 		do_resume = resume;
-		safe = false;
 	}
 
 	let with_resume cfg = {cfg with do_resume = true}
@@ -567,29 +564,6 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 		end;
 		AKExpr (mk (TField (e,FDynamic i)) (spawn_monomorph ctx p) p)
 
-(* Deal with safe-access mode here *)
-let type_field cfg ctx e i p mode (with_type : WithType.t) =
-	if not cfg.TypeFieldConfig.safe then
-		type_field cfg ctx e i p mode with_type
-	else begin
-		let vr = new value_reference ctx in
-		let e1 = vr#get_expr "tmp" e in
-		let enull = Builder.make_null e.etype e.epos in
-		let eneq = Builder.binop OpNotEq e1 enull ctx.t.tbool e.epos in
-		let acc_then = type_field cfg ctx e1 i p mode with_type in
-		(* SAFE TODO: check if we want a custom AK mode for this *)
-		let ethen = !acc_get_ref ctx acc_then p in
-		let tnull = ctx.t.tnull ethen.etype in
-		let ethen = if not (is_nullable ethen.etype) then
-			mk (TCast(ethen,None)) tnull e.epos
-		else
-			ethen
-		in
-		let eelse = Builder.make_null tnull ethen.epos in
-		let eif = mk (TIf(eneq,ethen,Some eelse)) tnull p in
-		AKExpr (vr#to_texpr eif)
-	end
-
 let type_field_default_cfg = type_field TypeFieldConfig.default
 
 (**

src/typing/forLoop.ml

@@ -78,7 +78,6 @@ module IterationKind = struct
 	let type_field_config = {
 		Fields.TypeFieldConfig.do_resume = true;
 		allow_resolve = false;
-		safe = false;
 	}
 
 	let get_next_array_element arr iexpr pt p =
@@ -121,14 +120,14 @@ module IterationKind = struct
 					)
 			in
 			try
-				let acc = type_field ({do_resume = true;allow_resolve = false;safe = false}) ctx e s e.epos (MCall []) (WithType.with_type t) in
+				let acc = type_field ({do_resume = true;allow_resolve = false}) ctx e s e.epos (MCall []) (WithType.with_type t) in
 				try_acc acc;
 			with Not_found ->
 				try_last_resort (fun () ->
 					match !dynamic_iterator with
 					| Some e -> e
 					| None ->
-						let acc = type_field ({do_resume = resume;allow_resolve = false;safe = false}) ctx e s e.epos (MCall []) (WithType.with_type t) in
+						let acc = type_field ({do_resume = resume;allow_resolve = false}) ctx e s e.epos (MCall []) (WithType.with_type t) in
 						try_acc acc
 				)
 		in

src/typing/operators.ml

@@ -557,7 +557,7 @@ let type_assign ctx e1 e2 with_type p =
 	in
 	match e1 with
 	| AKNo s -> typing_error ("Cannot access field or identifier " ^ s ^ " for writing") p
-	| AKUsingField _ ->
+	| AKUsingField _ | AKSafeNav _ ->
 		typing_error "Invalid operation" p
 	| AKExpr { eexpr = TLocal { v_kind = VUser TVOLocalFunction; v_name = name } } ->
 		typing_error ("Cannot access function " ^ name ^ " for writing") p
@@ -654,7 +654,7 @@ let type_assign_op ctx op e1 e2 with_type p =
 		(try type_non_assign_op ctx op e1 e2 true true with_type p
 		with Not_found -> typing_error ("Cannot access field or identifier " ^ s ^ " for writing") p
 		)
-	| AKUsingField _ ->
+	| AKUsingField _ | AKSafeNav _ ->
 		typing_error "Invalid operation" p
 	| AKExpr e ->
 		let e,vr = process_lhs_expr ctx "lhs" e in
@@ -898,5 +898,5 @@ let type_unop ctx op flag e with_type p =
 				let e = mk_array_get_call ctx (AbstractCast.find_array_access ctx a tl ekey None p) c ebase p in
 				find_overload_or_make e
 			end
-		| AKUsingField _ | AKResolve _ ->
+		| AKUsingField _ | AKResolve _ | AKSafeNav _ ->
 			typing_error "Invalid operation" p

src/typing/typer.ml

@@ -535,23 +535,48 @@ and handle_efield ctx e p0 mode with_type =
 	in
 
 	(* loop through the given EField expression to figure out whether it's a dot-path that we have to resolve,
-	   or a simple field access chain *)
+	   or a field access chain *)
 	let rec loop dot_path_acc (e,p) =
 		match e with
-		| EField (e,s,efk) ->
+		| EField (e,s,EFNormal) ->
 			(* field access - accumulate and check further *)
-			loop ((mk_dot_path_part s efk p) :: dot_path_acc) e
+			loop ((mk_dot_path_part s p) :: dot_path_acc) e
 		| EConst (Ident i) ->
 			(* it's a dot-path, so it might be either fully-qualified access (pack.Class.field)
 			   or normal field access of a local/global/field identifier, proceed figuring this out *)
-			dot_path (mk_dot_path_part i EFNormal p) dot_path_acc
+			dot_path (mk_dot_path_part i p) dot_path_acc mode with_type
+		| EField ((eobj,pobj),s,EFSafe) ->
+			(* safe navigation field access - definitely NOT a fully-qualified access,
+			   create safe navigation chain from the object expression *)
+			let acc_obj = type_access ctx eobj pobj MGet WithType.value in
+			let eobj = acc_get ctx acc_obj pobj in
+			let eobj, tempvar = match (Texpr.skip eobj).eexpr with
+				| TLocal _ | TTypeExpr _ | TConst _ ->
+					eobj, None
+				| _ ->
+					let v = alloc_var VGenerated "tmp" eobj.etype eobj.epos in
+					let temp_var = mk (TVar(v, Some eobj)) ctx.t.tvoid v.v_pos in
+					let eobj = mk (TLocal v) v.v_type v.v_pos in
+					eobj, Some temp_var
+			in
+			let access = field_chain ctx ((mk_dot_path_part s p) :: dot_path_acc) (AKExpr eobj) mode with_type in
+			AKSafeNav {
+				sn_pos = p;
+				sn_base = eobj;
+				sn_temp_var = tempvar;
+				sn_access = access;
+			}
 		| _ ->
 			(* non-ident expr occured: definitely NOT a fully-qualified access,
 			   resolve the field chain against this expression *)
-			let e = type_access ctx e p MGet WithType.value in
-			field_chain ctx dot_path_acc e
+			(match (type_access ctx e p MGet WithType.value) with
+			| AKSafeNav sn ->
+				(* further field access continues the safe navigation chain (after a non-field access inside the chain) *)
+				AKSafeNav { sn with sn_access = field_chain ctx dot_path_acc sn.sn_access mode with_type }
+			| e ->
+				field_chain ctx dot_path_acc e mode with_type)
 	in
-	loop [] (e,p0) mode with_type
+	loop [] (e,p0)
 
 and type_access ctx e p mode with_type =
 	match e with
@@ -598,15 +623,25 @@ and type_access ctx e p mode with_type =
 		handle_efield ctx e p mode with_type
 	| EArray (e1,e2) ->
 		type_array_access ctx e1 e2 p mode
+	| ECall (e, el) ->
+		type_call_access ctx e el mode with_type None p
 	| EDisplay (e,dk) ->
 		AKExpr (TyperDisplay.handle_edisplay ctx e dk mode with_type)
 	| _ ->
 		AKExpr (type_expr ~mode ctx (e,p) with_type)
 
 and type_array_access ctx e1 e2 p mode =
-	let e1 = type_expr ctx e1 WithType.value in
+	let e1, p1 = e1 in
+	let a1 = type_access ctx e1 p1 MGet WithType.value in
 	let e2 = type_expr ctx e2 WithType.value in
-	Calls.array_access ctx e1 e2 mode p
+	match a1 with
+	| AKSafeNav sn ->
+		(* pack the array access inside the safe navigation chain *)
+		let e1 = acc_get ctx sn.sn_access sn.sn_pos in
+		AKSafeNav { sn with sn_access = Calls.array_access ctx e1 e2 mode p }
+	| _ ->
+		let e1 = acc_get ctx a1 p1 in
+		Calls.array_access ctx e1 e2 mode p
 
 and type_vars ctx vl p =
 	let vl = List.map (fun ev ->
@@ -1598,7 +1633,7 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
 		| (Meta.Inline,_,pinline) ->
 			begin match fst e1 with
 			| ECall(e1,el) ->
-				type_call ctx e1 el WithType.value (Some pinline) p
+				acc_get ctx (type_call_access ctx e1 el MGet WithType.value (Some pinline) p) p
 			| ENew (t,el) ->
 				let e = type_new ctx t el with_type true p in
 				{e with eexpr = TMeta((Meta.Inline,[],null_pos),e)}
@@ -1625,34 +1660,32 @@ and type_call_target ctx e el with_type p_inline =
 	match p_inline with
 	| None ->
 		e
-	| Some pinline -> match e with
-		| AKField fa ->
-			check_inline fa.fa_field pinline;
-			AKField({fa with fa_inline = true})
-		| AKUsingField sea ->
-			check_inline sea.se_access.fa_field pinline;
-			AKUsingField {sea with se_access = {sea.se_access with fa_inline = true}}
-		| AKExpr {eexpr = TLocal _} ->
-			display_error ctx.com "Cannot force inline on local functions" pinline;
-			e
-		| _ ->
-			e
+	| Some pinline ->
+		let rec loop e =
+			match e with
+			| AKSafeNav sn ->
+				AKSafeNav { sn with sn_access = loop sn.sn_access }
+			| AKField fa ->
+				check_inline fa.fa_field pinline;
+				AKField({fa with fa_inline = true})
+			| AKUsingField sea ->
+				check_inline sea.se_access.fa_field pinline;
+				AKUsingField {sea with se_access = {sea.se_access with fa_inline = true}}
+			| AKExpr {eexpr = TLocal _} ->
+				display_error ctx.com "Cannot force inline on local functions" pinline;
+				e
+			| _ ->
+				e
+		in
+		loop e
 
-and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) p_inline p =
+and type_call_access ctx e el mode with_type p_inline p =
 	try
-		type_call_builtin ctx e el mode with_type p
+		let e = type_call_builtin ctx e el mode with_type p in
+		AKExpr e
 	with Exit ->
 		let acc = type_call_target ctx e el with_type p_inline in
-		let e = build_call ~mode ctx acc el with_type p in
-		check_dynamic_super_method_call ctx e;
-		e
-
-and check_dynamic_super_method_call ctx e =
-	match e.eexpr with
-	| TCall ({ eexpr = TField ({ eexpr = TConst TSuper }, FInstance(_, _, { cf_kind = Method MethDynamic; cf_name = name })); epos = p }, _) ->
-		ctx.com.error ("Cannot call super." ^ name ^ " since it's a dynamic method") p
-	| _ ->
-		()
+		build_call_access ctx acc el mode with_type p
 
 and type_call_builtin ctx e el mode with_type p =
 	match e, el with
@@ -1750,7 +1783,8 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		let e = maybe_type_against_enum ctx (fun () -> type_ident ctx s p mode with_type) with_type false p in
 		acc_get ctx e p
 	| EField _
-	| EArray _ ->
+	| EArray _
+	| ECall _ ->
 		acc_get ctx (type_access ctx e p mode with_type) p
 	| EConst (Regexp (r,opt)) ->
 		let str = mk (TConst (TString r)) ctx.t.tstring p in
@@ -1902,8 +1936,6 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	| EThrow e ->
 		let e = type_expr ctx e WithType.value in
 		mk (TThrow e) (spawn_monomorph ctx p) p
-	| ECall (e,el) ->
-		type_call ~mode ctx e el with_type None p
 	| ENew (t,el) ->
 		type_new ctx t el with_type false p
 	| EUnop (op,flag,e) ->

src/typing/typerBase.ml

@@ -9,6 +9,8 @@ type access_kind =
 	| AKNo of string
 	(* Access on arbitrary expression. *)
 	| AKExpr of texpr
+	(* Safe navigation access chain *)
+	| AKSafeNav of safe_nav_access
 	(* Access on non-property field. *)
 	| AKField of field_access
 	(* Access on property field. The field is the property, not the accessor. *)
@@ -23,6 +25,17 @@ type access_kind =
 	(* Access on abstract via resolve method. *)
 	| AKResolve of static_extension_access * string
 
+and safe_nav_access = {
+	(* position of the safe navigation chain start (the initial ?.field expression) *)
+	sn_pos : pos;
+	(* starting value to be checked for null *)
+	sn_base : texpr;
+	(* temp var declaration to store complex base expression *)
+	sn_temp_var : texpr option;
+	(* safe navigation access to be done if the base value is not null *)
+	sn_access : access_kind;
+}
+
 type object_decl_kind =
 	| ODKWithStructure of tanon
 	| ODKWithClass of tclass * tparams
@@ -192,12 +205,13 @@ let s_static_extension_access sea =
 		"se_access",s_field_access "\t" sea.se_access
 	]
 
-let s_access_kind acc =
+let rec s_access_kind acc =
 	let st = s_type (print_context()) in
 	let se = s_expr_pretty true "" false st in
 	match acc with
 	| AKNo s -> "AKNo " ^ s
 	| AKExpr e -> "AKExpr " ^ (se e)
+	| AKSafeNav sn -> Printf.sprintf  "AKSafeNav(%s)" (s_safe_nav_access sn)
 	| AKField fa -> Printf.sprintf "AKField(%s)" (s_field_access "" fa)
 	| AKAccessor fa -> Printf.sprintf "AKAccessor(%s)" (s_field_access "" fa)
 	| AKUsingField sea -> Printf.sprintf "AKUsingField(%s)" (s_static_extension_access sea)
@@ -205,6 +219,15 @@ let s_access_kind acc =
 	| AKAccess(a,tl,c,e1,e2) -> Printf.sprintf "AKAccess(%s, [%s], %s, %s, %s)" (s_type_path a.a_path) (String.concat ", " (List.map st tl)) (s_type_path c.cl_path) (se e1) (se e2)
 	| AKResolve(_) -> ""
 
+and s_safe_nav_access sn =
+	let st = s_type (print_context()) in
+	let se = s_expr_pretty true "" false st in
+	Printer.s_record_fields "" [
+		"sn_base",se sn.sn_base;
+		"sn_temp_var",Option.map_default (fun e -> "Some " ^ (se e)) "None" sn.sn_temp_var;
+		"sn_access",s_access_kind sn.sn_access
+	]
+
 let get_constructible_constraint ctx tl p =
 	let extract_function t = match follow t with
 		| TFun(tl,tr) -> tl,tr

src/typing/typerDotPath.ml

@@ -26,12 +26,11 @@ open Fields
 open TFunctions
 open Error
 
-let mk_dot_path_part s efk p : dot_path_part =
+let mk_dot_path_part s p : dot_path_part =
 	let case = if is_lower_ident s p then PLowercase else PUppercase in
 	{
 		name = s;
 		case = case;
-		kind = efk;
 		pos = p
 	}
 

tests/misc/projects/Issue7638/compile-fail.hxml.stderr

@@ -1 +1 @@
-Main.hx:13: characters 3-18 : Cannot call super.dynMethod since it's a dynamic method
+Main.hx:13: characters 3-20 : Cannot call super.dynMethod since it's a dynamic method

tests/optimization/src/TestJs.hx

@@ -671,6 +671,16 @@ class TestJs {
 	static function testIssue10737_avoidInstanceMethodClosure2() {
 		run(new Issue10737().process.bind(42));
 	}
+
+	@:js('
+		var tmp = Issue10740.inst;
+		if(tmp != null) {
+			Issue10740.use(tmp.value);
+		}
+	')
+	static function testIssue10740_forceInlineInSafeNav() {
+		inline Issue10740.inst?.f();
+	}
 }
 
 class Issue9227 {
@@ -695,3 +705,17 @@ class Issue10737 {
 	public function new() {}
 	public function process(value:Int) {}
 }
+
+class Issue10740 {
+	public static var inst:Issue10740;
+
+	public final value:Int;
+	public function new() {
+		value = 42;
+	}
+	public function f() {
+		use(value);
+	}
+	@:pure(false)
+	static function use(v:Int) {}
+}

tests/unit/src/unit/issues/Issue10740.hx

@@ -0,0 +1,77 @@
+package unit.issues;
+
+import unit.HelperMacros.typeString;
+
+class Issue10740 extends Test {
+	// not local vars to prevent optimizations
+	var o:Null<S> = null;
+	var o2:Null<S & {sideEffectCount:() -> Int}> = {
+		var sideEffectCount = 0;
+		{
+			field1: 42,
+			field2: "hallo",
+			field3: {field4: true},
+			field5: function() {
+				sideEffectCount++;
+				return [{field6: 28}];
+			},
+			sideEffectCount: () -> sideEffectCount
+		};
+	};
+
+	function testTyping() {
+		// simple field access
+		eq("Null<Int>", typeString(o?.field1));
+		eq("Null<String>", typeString(o?.field2));
+
+		// field chain
+		eq("Null<Bool>", typeString(o?.field3.field4));
+
+		// complex chain
+		eq("Null<Int>", typeString(o?.field5()[0].field6));
+
+		// nested chain
+		eq("Null<Int>", typeString(o?.field5()[0]?.field6));
+	}
+
+	function testNull() {
+		// simple field access
+		eq(null, o?.field1);
+		eq(null, o?.field2);
+
+		// field chain
+		eq(null, o?.field3.field4);
+
+		// complex chain
+		eq(null, o?.field5()[0].field6);
+
+		// nested chain
+		eq(null, o?.field5()[0]?.field6);
+	}
+
+	function testNonNull() {
+		// simple field access
+		eq(42, o2?.field1);
+		eq("hallo", o2?.field2);
+
+		// field chain
+		eq(true, o2?.field3.field4);
+
+		// complex chain
+		eq(28, o2?.field5()[0].field6);
+		eq(1, o2.sideEffectCount());
+
+		// nested chain
+		eq(28, o2?.field5()[0]?.field6);
+		eq(2, o2.sideEffectCount());
+		eq(null, o2?.field5()[1]?.field6);
+		eq(3, o2.sideEffectCount());
+	}
+}
+
+private typedef S = {
+	var field1:Int;
+	var field2:String;
+	var field3:{field4:Bool};
+	var field5:() -> Array<{field6:Null<Int>}>;
+}