Browse Source

[typer] remove extra pos for type_call_target

Simon Krajewski 3 years ago
parent
commit
03e60ff8a4

+ 0 - 1
src/context/display/statistics.ml

@@ -99,7 +99,6 @@ let collect_statistics ctx pos_filters with_expressions =
 		| _,None -> raise Not_found
 		| _,None -> raise Not_found
 	in
 	in
 	let var_decl v = declare (SKVariable v) v.v_pos in
 	let var_decl v = declare (SKVariable v) v.v_pos in
-	let patch_string_pos p s = { p with pmin = p.pmax - String.length s } in
 	let related_fields = Hashtbl.create 0 in
 	let related_fields = Hashtbl.create 0 in
 	let field_reference co cf p =
 	let field_reference co cf p =
 		let p1 = patch_string_pos p cf.cf_name in
 		let p1 = patch_string_pos p cf.cf_name in

+ 3 - 0
src/core/globals.ml

@@ -91,6 +91,9 @@ let s_version_full =
 		| Some (_,build) -> s_version ^ "+" ^ build
 		| Some (_,build) -> s_version ^ "+" ^ build
 		| _ -> s_version
 		| _ -> s_version
 
 
+
+let patch_string_pos p s = { p with pmin = p.pmax - String.length s }
+
 (**
 (**
 	Terminates compiler process and prints user-friendly instructions about filing an issue.
 	Terminates compiler process and prints user-friendly instructions about filing an issue.
 	Usage: `die message __LOC__`, where `__LOC__` is a built-in ocaml constant
 	Usage: `die message __LOC__`, where `__LOC__` is a built-in ocaml constant

+ 1 - 1
src/syntax/reification.ml

@@ -255,7 +255,7 @@ let reify in_macro =
 		| EBinop (op,e1,e2) ->
 		| EBinop (op,e1,e2) ->
 			expr "EBinop" [to_binop op p; loop e1; loop e2]
 			expr "EBinop" [to_binop op p; loop e1; loop e2]
 		| EField (e,s,efk) ->
 		| EField (e,s,efk) ->
-			let p = {p with pmin = p.pmax - String.length s} in
+			let p = patch_string_pos p s in
 			let efk = match efk with
 			let efk = match efk with
 				| EFNormal -> "Normal"
 				| EFNormal -> "Normal"
 				| EFSafe -> "Safe"
 				| EFSafe -> "Safe"

+ 1 - 1
src/typing/typeload.ml

@@ -439,7 +439,7 @@ and load_instance ctx ?(allow_display=false) ((_,pn) as tp) allow_no_params =
 		t
 		t
 	with Error (Module_not_found path,_) when ctx.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in pn ->
 	with Error (Module_not_found path,_) when ctx.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in pn ->
 		let s = s_type_path path in
 		let s = s_type_path path in
-		DisplayToplevel.collect_and_raise ctx TKType NoValue CRTypeHint (s,pn) {pn with pmin = pn.pmax - String.length s;}
+		DisplayToplevel.collect_and_raise ctx TKType NoValue CRTypeHint (s,pn) (patch_string_pos pn s)
 
 
 (*
 (*
 	build an instance from a complex type
 	build an instance from a complex type

+ 14 - 12
src/typing/typer.ml

@@ -1588,10 +1588,10 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
 			let e = e () in
 			let e = e () in
 			(if ctx.bypass_accessor > old_counter then display_error ctx.com "Field access expression expected after @:bypassAccessor metadata" p);
 			(if ctx.bypass_accessor > old_counter then display_error ctx.com "Field access expression expected after @:bypassAccessor metadata" p);
 			e
 			e
-		| (Meta.Inline,_,_) ->
+		| (Meta.Inline,_,pinline) ->
 			begin match fst e1 with
 			begin match fst e1 with
 			| ECall(e1,el) ->
 			| ECall(e1,el) ->
-				type_call ctx e1 el WithType.value true p
+				type_call ctx e1 el WithType.value (Some pinline) p
 			| ENew (t,el) ->
 			| ENew (t,el) ->
 				let e = type_new ctx t el with_type true p in
 				let e = type_new ctx t el with_type true p in
 				{e with eexpr = TMeta((Meta.Inline,[],null_pos),e)}
 				{e with eexpr = TMeta((Meta.Inline,[],null_pos),e)}
@@ -1609,29 +1609,31 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
 	ctx.meta <- old;
 	ctx.meta <- old;
 	e
 	e
 
 
-and type_call_target ctx e el with_type inline p =
+and type_call_target ctx e el with_type p_inline =
+	let p = (pos e) in
 	let e = maybe_type_against_enum ctx (fun () -> type_access ctx (fst e) (snd e) (MCall el) with_type) with_type true p in
 	let e = maybe_type_against_enum ctx (fun () -> type_access ctx (fst e) (snd e) (MCall el) with_type) with_type true p in
-	let check_inline cf =
+	let check_inline cf p =
 		if (has_class_field_flag cf CfAbstract) then display_error ctx.com "Cannot force inline on abstract method" p
 		if (has_class_field_flag cf CfAbstract) then display_error ctx.com "Cannot force inline on abstract method" p
 	in
 	in
-	if not inline then
+	match p_inline with
+	| None ->
 		e
 		e
-	else match e with
+	| Some pinline -> match e with
 		| AKField fa ->
 		| AKField fa ->
-			check_inline fa.fa_field;
+			check_inline fa.fa_field pinline;
 			AKField({fa with fa_inline = true})
 			AKField({fa with fa_inline = true})
 		| AKUsingField sea ->
 		| AKUsingField sea ->
-			check_inline sea.se_access.fa_field;
+			check_inline sea.se_access.fa_field pinline;
 			AKUsingField {sea with se_access = {sea.se_access with fa_inline = true}}
 			AKUsingField {sea with se_access = {sea.se_access with fa_inline = true}}
 		| AKExpr {eexpr = TLocal _} ->
 		| AKExpr {eexpr = TLocal _} ->
-			display_error ctx.com "Cannot force inline on local functions" p;
+			display_error ctx.com "Cannot force inline on local functions" pinline;
 			e
 			e
 		| _ ->
 		| _ ->
 			e
 			e
 
 
-and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p =
+and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) p_inline p =
 	let def () =
 	let def () =
-		let e = type_call_target ctx e el with_type inline p in
+		let e = type_call_target ctx e el with_type p_inline in
 		build_call ~mode ctx e el with_type p;
 		build_call ~mode ctx e el with_type p;
 	in
 	in
 	match e, el with
 	match e, el with
@@ -1886,7 +1888,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		let e = type_expr ctx e WithType.value in
 		let e = type_expr ctx e WithType.value in
 		mk (TThrow e) (spawn_monomorph ctx p) p
 		mk (TThrow e) (spawn_monomorph ctx p) p
 	| ECall (e,el) ->
 	| ECall (e,el) ->
-		type_call ~mode ctx e el with_type false p
+		type_call ~mode ctx e el with_type None p
 	| ENew (t,el) ->
 	| ENew (t,el) ->
 		type_new ctx t el with_type false p
 		type_new ctx t el with_type false p
 	| EUnop (op,flag,e) ->
 	| EUnop (op,flag,e) ->

+ 1 - 1
src/typing/typerBase.ml

@@ -29,7 +29,7 @@ type object_decl_kind =
 	| ODKPlain
 	| ODKPlain
 	| ODKFailed
 	| ODKFailed
 
 
-let type_call_target_ref : (typer -> expr -> expr list -> WithType.t -> bool -> pos -> access_kind) ref = ref (fun _ _ _ _ _ -> die "" __LOC__)
+let type_call_target_ref : (typer -> expr -> expr list -> WithType.t -> pos option -> access_kind) ref = ref (fun _ _ _ _ -> die "" __LOC__)
 let type_access_ref : (typer -> expr_def -> pos -> access_mode -> WithType.t -> access_kind) ref = ref (fun _ _ _ _ _ -> assert false)
 let type_access_ref : (typer -> expr_def -> pos -> access_mode -> WithType.t -> access_kind) ref = ref (fun _ _ _ _ _ -> assert false)
 let acc_get_ref : (typer -> access_kind -> pos -> texpr) ref = ref (fun _ _ _ -> assert false)
 let acc_get_ref : (typer -> access_kind -> pos -> texpr) ref = ref (fun _ _ _ -> assert false)
 
 

+ 1 - 1
src/typing/typerDisplay.ml

@@ -261,7 +261,7 @@ let rec handle_signature_display ctx e_ast with_type =
 		| ECall(e1,el) ->
 		| ECall(e1,el) ->
 			let def () =
 			let def () =
 				try
 				try
-					acc_get ctx (!type_call_target_ref ctx e1 el with_type false (pos e1)) (pos e1)
+					acc_get ctx (!type_call_target_ref ctx e1 el with_type None) (pos e1)
 				with
 				with
 				| Error (Unknown_ident "trace",_) ->
 				| Error (Unknown_ident "trace",_) ->
 					let e = expr_of_type_path (["haxe";"Log"],"trace") p in
 					let e = expr_of_type_path (["haxe";"Log"],"trace") p in

+ 1 - 1
tests/misc/projects/Issue9619/abstract-expression-inline/compile-fail.hxml.stderr

@@ -1 +1 @@
-Main.hx:8: characters 3-30 : Cannot force inline on abstract method
+Main.hx:8: characters 3-9 : Cannot force inline on abstract method