Browse Source

[typer] remove extra position from acc_get

closes #11004
Simon Krajewski 2 years ago
parent
commit
c21431d9d9

+ 11 - 9
src/typing/calls.ml

@@ -110,9 +110,10 @@ let abstract_using_param_type sea = match follow sea.se_this.etype with
 	| TAbstract(a,tl) when has_class_field_flag sea.se_access.fa_field CfImpl -> apply_params a.a_params tl a.a_this
 	| _ -> sea.se_this.etype
 
-let rec acc_get ctx g p =
+let rec acc_get ctx g =
 	let inline_read fa =
 		let cf = fa.fa_field in
+		let p = fa.fa_pos in
 		(* do not create a closure for static calls *)
 		let apply_params = match fa.fa_host with
 			| FHStatic c ->
@@ -188,7 +189,7 @@ let rec acc_get ctx g p =
 			typing_error "Recursive inline is not supported" p
 		end
 	in
-	let dispatcher () = new call_dispatcher ctx MGet WithType.value p in
+	let dispatcher p = new call_dispatcher ctx MGet WithType.value p in
 	match g with
 	| AKNo(_,p) -> typing_error ("This expression cannot be accessed for reading") p
 	| AKExpr e -> e
@@ -197,7 +198,7 @@ let rec acc_get ctx g p =
 		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 ethen = acc_get ctx sn.sn_access 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
@@ -211,7 +212,7 @@ let rec acc_get ctx g p =
 		| Some evar -> { eif with eexpr = TBlock [evar; eif] })
 	| AKAccess _ -> die "" __LOC__
 	| AKResolve(sea,name) ->
-		(dispatcher ())#resolve_call sea name
+		(dispatcher sea.se_access.fa_pos)#resolve_call sea name
 	| AKUsingAccessor sea | AKUsingField sea when ctx.in_display ->
 		(* Generate a TField node so we can easily match it for position/usage completion (issue #1968) *)
 		let e_field = FieldAccess.get_field_expr sea.se_access FGet in
@@ -229,7 +230,7 @@ let rec acc_get ctx g p =
 			if ctx.in_display then
 				FieldAccess.get_field_expr fa FRead
 			else
-				typing_error "Invalid macro access" p
+				typing_error "Invalid macro access" fa.fa_pos
 		| _ ->
 			if fa.fa_inline then
 				inline_read fa
@@ -237,15 +238,16 @@ let rec acc_get ctx g p =
 				FieldAccess.get_field_expr fa FRead
 		end
 	| AKAccessor fa ->
-		(dispatcher())#field_call fa [] []
+		(dispatcher fa.fa_pos)#field_call fa [] []
 	| AKUsingAccessor sea ->
-		(dispatcher())#field_call sea.se_access [sea.se_this] []
+		(dispatcher sea.se_access.fa_pos)#field_call sea.se_access [sea.se_this] []
 	| AKUsingField sea ->
 		let e = sea.se_this in
 		let e_field = FieldAccess.get_field_expr sea.se_access FGet in
 		(* build a closure with first parameter applied *)
 		(match follow e_field.etype with
 		| TFun ((_,_,t0) :: args,ret) ->
+			let p = sea.se_access.fa_pos in
 			let te = abstract_using_param_type sea in
 			unify ctx te t0 e.epos;
 			let tcallb = TFun (args,ret) in
@@ -319,7 +321,7 @@ let rec build_call_access ctx acc el mode with_type p =
 		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
+	acc_get ctx (build_call_access ctx acc el mode with_type p)
 
 let rec needs_temp_var e =
 	match e.eexpr with
@@ -509,7 +511,7 @@ let field_chain ctx path access mode with_type =
 		| [] ->
 			access
 		| part :: path ->
-			let e = acc_get ctx access part.pos in
+			let e = acc_get ctx access in
 			let mode, with_type =
 				if path <> [] then
 					(* intermediate field access are just reading the value *)

+ 2 - 2
src/typing/forLoop.ml

@@ -515,8 +515,8 @@ let type_for_loop ctx handle_display it e2 p =
 		let enext = build_call ctx (type_field_default_cfg ctx etmp "next" etmp.epos (MCall []) WithType.value (* WITHTYPETODO *)) [] WithType.value etmp.epos in
 		let v = gen_local ctx pt e1.epos in
 		let ev = make_local v v.v_pos in
-		let ekey = Calls.acc_get ctx (type_field_default_cfg ctx ev "key" ev.epos MGet WithType.value) ev.epos in
-		let evalue = Calls.acc_get ctx (type_field_default_cfg ctx ev "value" ev.epos MGet WithType.value) ev.epos in
+		let ekey = Calls.acc_get ctx (type_field_default_cfg ctx ev "key" ev.epos MGet WithType.value) in
+		let evalue = Calls.acc_get ctx (type_field_default_cfg ctx ev "value" ev.epos MGet WithType.value) in
 		let vkey = add_local_with_origin ctx TVOForVariable ikey ekey.etype pkey in
 		let vvalue = add_local_with_origin ctx TVOForVariable ivalue evalue.etype pvalue in
 		let e2 = type_expr ctx e2 NoValue in

+ 2 - 2
src/typing/matcher.ml

@@ -39,7 +39,7 @@ let make_offset_list left right middle other =
 	(ExtList.List.make left other) @ [middle] @ (ExtList.List.make right other)
 
 let type_field_access ctx ?(resume=false) e name =
-	Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos MGet WithType.value) e.epos
+	Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos MGet WithType.value)
 
 let unapply_type_parameters params monos =
 	let unapplied = ref [] in
@@ -1011,7 +1011,7 @@ module Compile = struct
 		| ConArray i ->
 			ExtList.List.init i (fun i ->
 				let ei = make_int mctx.ctx.com.basic i e.epos in
-				Calls.acc_get mctx.ctx (Calls.array_access mctx.ctx e ei MGet e.epos) e.epos
+				Calls.acc_get mctx.ctx (Calls.array_access mctx.ctx e ei MGet e.epos)
 			)
 		| ConConst _ | ConTypeExpr _ | ConStatic _ ->
 			[]

+ 6 - 6
src/typing/operators.ml

@@ -196,7 +196,7 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 			| KInt | KFloat | KString -> e
 			| KUnk | KDyn | KNumParam _ | KStrParam _ | KOther ->
 				let std = type_type ctx ([],"Std") e.epos in
-				let acc = acc_get ctx (type_field_default_cfg ctx std "string" e.epos (MCall []) with_type) e.epos in
+				let acc = acc_get ctx (type_field_default_cfg ctx std "string" e.epos (MCall []) with_type) in
 				ignore(follow acc.etype);
 				let acc = (match acc.eexpr with TField (e,FClosure (Some (c,tl),f)) -> { acc with eexpr = TField (e,FInstance (c,tl,f)) } | _ -> acc) in
 				make_call ctx acc [e] ctx.t.tstring e.epos
@@ -625,7 +625,7 @@ let process_lhs_expr ctx name e_lhs =
 let type_assign_op ctx op e1 e2 with_type p =
 	let field_rhs_by_name op name ev with_type =
 		let access_get = type_field_default_cfg ctx ev name p MGet with_type in
-		let e_get = acc_get ctx access_get p in
+		let e_get = acc_get ctx access_get in
 		e_get.etype,type_binop2 ctx op e_get e2 true WithType.value p
 	in
 	let field_rhs op cf ev =
@@ -822,7 +822,7 @@ let type_unop ctx op flag e with_type p =
 		unexpected_spread p
 	| Not | Neg | NegBits ->
 		let access_get = !type_access_ref ctx (fst e) (snd e) MGet WithType.value (* WITHTYPETODO *) in
-		let e = acc_get ctx access_get p in
+		let e = acc_get ctx access_get in
 		find_overload_or_make e
 	| Increment | Decrement ->
 		let binop = if op = Increment then OpAdd else OpSub in
@@ -836,7 +836,7 @@ let type_unop ctx op flag e with_type p =
 		in
 		let read_on vr ef fa =
 			let access_get = type_field_default_cfg ctx ef fa.fa_field.cf_name p MGet WithType.value in
-			let e_lhs = acc_get ctx access_get p in
+			let e_lhs = acc_get ctx access_get in
 			let e_lhs,e_out = maybe_tempvar_postfix vr e_lhs in
 			e_lhs,e_out
 		in
@@ -848,7 +848,7 @@ let type_unop ctx op flag e with_type p =
 		match access_set with
 		| AKNo(acc,p) ->
 			begin try
-				try_abstract_unop_overloads (acc_get ctx acc p)
+				try_abstract_unop_overloads (acc_get ctx acc)
 			with Not_found ->
 				typing_error "This expression cannot be accessed for writing" p
 			end
@@ -864,7 +864,7 @@ let type_unop ctx op flag e with_type p =
 				find_overload_or_make e,None
 			| _ ->
 				let e_set = FieldAccess.get_field_expr {fa with fa_on = ef} FWrite in
-				let e_lhs = acc_get ctx access_get p in
+				let e_lhs = acc_get ctx access_get in
 				let e_lhs,e_out = maybe_tempvar_postfix vr e_lhs in
 				let e_op = mk (TBinop(binop,e_lhs,e_one)) e_lhs.etype p in
 				mk (TBinop(OpAssign,e_set,e_op)) e_set.etype p,e_out

+ 6 - 7
src/typing/typer.ml

@@ -594,7 +594,7 @@ and handle_efield ctx e p0 mode with_type =
 			(* 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 = acc_get ctx acc_obj in
 			let eobj, tempvar = match (Texpr.skip eobj).eexpr with
 				| TLocal _ | TTypeExpr _ | TConst _ ->
 					eobj, None
@@ -682,10 +682,10 @@ and type_array_access ctx e1 e2 p mode =
 	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
+		let e1 = acc_get ctx sn.sn_access in
 		AKSafeNav { sn with sn_access = Calls.array_access ctx e1 e2 mode p }
 	| _ ->
-		let e1 = acc_get ctx a1 p1 in
+		let e1 = acc_get ctx a1 in
 		Calls.array_access ctx e1 e2 mode p
 
 and type_vars ctx vl p =
@@ -1669,7 +1669,7 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
 		| (Meta.Inline,_,pinline) ->
 			begin match fst e1 with
 			| ECall(e1,el) ->
-				acc_get ctx (type_call_access ctx e1 el MGet WithType.value (Some pinline) p) p
+				acc_get ctx (type_call_access ctx e1 el MGet WithType.value (Some pinline) 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)}
@@ -1820,11 +1820,11 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	| EConst (Ident s) ->
 		if s = "super" && with_type <> WithType.NoValue && not ctx.in_display then typing_error "Cannot use super as value" p;
 		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
+		acc_get ctx e
 	| EField _
 	| EArray _
 	| ECall _ ->
-		acc_get ctx (type_access ctx e p mode with_type) p
+		acc_get ctx (type_access ctx e p mode with_type)
 	| EConst (Regexp (r,opt)) ->
 		let str = mk (TConst (TString r)) ctx.t.tstring p in
 		let opt = mk (TConst (TString opt)) ctx.t.tstring p in
@@ -2186,4 +2186,3 @@ make_call_ref := make_call;
 type_call_target_ref := type_call_target;
 type_access_ref := type_access;
 type_block_ref := type_block;
-acc_get_ref := acc_get

+ 9 - 2
src/typing/typerBase.ml

@@ -44,7 +44,6 @@ type object_decl_kind =
 
 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 acc_get_ref : (typer -> access_kind -> pos -> texpr) ref = ref (fun _ _ _ -> assert false)
 
 class value_reference (ctx : typer) =
 
@@ -196,7 +195,8 @@ let s_field_access tabs fa =
 		"fa_on",se fa.fa_on;
 		"fa_field",fa.fa_field.cf_name;
 		"fa_host",sfa fa.fa_host;
-		"fa_inline",string_of_bool fa.fa_inline
+		"fa_inline",string_of_bool fa.fa_inline;
+		"fa_pos",(Printf.sprintf "%s(%i-%i)" fa.fa_pos.pfile fa.fa_pos.pmin fa.fa_pos.pmax);
 	]
 
 let s_static_extension_access sea =
@@ -228,6 +228,13 @@ and s_safe_nav_access sn =
 		"sn_access",s_access_kind sn.sn_access
 	]
 
+let s_dot_path_part part =
+	Printer.s_record_fields "" [
+		"name",part.name;
+		"case",(match part.case with PUppercase -> "PUppercase" | PLowercase -> "PLowercase");
+		"pos",(Printf.sprintf "%s(%i-%i)" part.pos.pfile part.pos.pmin part.pos.pmax);
+	]
+
 let get_constructible_constraint ctx tl p =
 	let extract_function t = match follow t with
 		| TFun(tl,tr) -> tl,tr

+ 1 - 1
src/typing/typerDisplay.ml

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

+ 49 - 0
tests/misc/projects/Issue11004/Bar.hx

@@ -0,0 +1,49 @@
+package;
+
+#if macro
+import haxe.macro.Context;
+import haxe.macro.Expr;
+import haxe.macro.Type;
+
+using haxe.macro.ExprTools;
+using haxe.macro.TypeTools;
+#end
+
+class Bar
+{
+  public function new()
+  {
+    trace('New Bar');
+  }
+
+  public function nonmacro_func(val:String)
+  {
+    trace('Hello runtime: $val');
+  }
+
+  public macro function macro_func(this_expr:Expr) // :this (should refer to the Bar instance on the Foo)
+  {
+    var this_ident:String = get_this_ident(this_expr);
+    trace('${ this_expr.toString() } computed this_ident as: ${ this_ident }');
+
+    var code = '${ this_ident }.nonmacro_func("${ this_ident }")';
+    return Context.parse(code, Context.currentPos());
+  }
+
+  #if macro
+  static function get_this_ident(this_expr:Expr):String
+  {
+    // Read the ident from the source code
+    return switch (this_expr.expr) {
+      case EMeta(_, e):
+        var info = Context.getPosInfos(this_expr.pos);
+        var bytes = sys.io.File.getBytes(info.file);
+        bytes.getString(info.min, info.max-info.min);
+      default:
+        // Not in the above form? Hmm...
+        trace('Unexpected this resolution: ${ this_expr.toString() }');
+        this_expr.toString();
+    }
+  }
+  #end
+}

+ 13 - 0
tests/misc/projects/Issue11004/Foo.hx

@@ -0,0 +1,13 @@
+class Foo
+{
+  var _bar_private:Bar;
+
+  public function new()
+  {
+    trace('New foo');
+    _bar_private = new Bar();
+  }
+
+  public var bar(get,null):Bar;
+  public function get_bar():Bar return _bar_private;
+}

+ 8 - 0
tests/misc/projects/Issue11004/Main.hx

@@ -0,0 +1,8 @@
+class Main
+{
+  public static function main()
+  {
+    var foo = new Foo();
+    foo.bar.macro_func();
+  }
+}

+ 1 - 0
tests/misc/projects/Issue11004/build.hxml

@@ -0,0 +1 @@
+Main

+ 1 - 0
tests/misc/projects/Issue11004/build.hxml.stdout

@@ -0,0 +1 @@
+Bar.hx:27: @:storedTypedExpr 3 computed this_ident as: foo.bar