2
0
Simon Krajewski 5 сар өмнө
parent
commit
f5244f842b

+ 22 - 0
src/context/typecore.ml

@@ -655,6 +655,28 @@ let safe_mono_close ctx m p =
 let relative_path ctx file =
 	ctx.com.class_paths#relative_path file
 
+let mk_infos_t =
+	let fileName = ("fileName",null_pos,NoQuotes) in
+	let lineNumber = ("lineNumber",null_pos,NoQuotes) in
+	let className = ("className",null_pos,NoQuotes) in
+	let methodName = ("methodName",null_pos,NoQuotes) in
+	(fun ctx p params t ->
+		let file = if ctx.com.is_macro_context then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in
+		let line = Lexer.get_error_line p in
+		let class_name = s_type_path ctx.c.curclass.cl_path in
+		let fields =
+			(fileName,Texpr.Builder.make_string ctx.com.basic file p) ::
+			(lineNumber,Texpr.Builder.make_int ctx.com.basic line p) ::
+			(className,Texpr.Builder.make_string ctx.com.basic class_name p) ::
+			if ctx.f.curfield.cf_name = "" then
+				params
+			else
+				(methodName,Texpr.Builder.make_string ctx.com.basic ctx.f.curfield.cf_name p) ::
+				params
+		in
+		mk (TObjectDecl fields) t p
+	)
+
 let mk_infos ctx p params =
 	let file = if ctx.com.is_macro_context then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in
 	(EObjectDecl (

+ 1 - 2
src/typing/callUnification.ml

@@ -20,8 +20,7 @@ let unify_call_args ctx el args r callp inline force_inline in_overload =
 	in
 
 	let mk_pos_infos t =
-		let infos = mk_infos ctx callp [] in
-		type_expr ctx infos (WithType.with_type t)
+		mk_infos_t ctx callp [] t
 	in
 	let default_value name t =
 		if is_pos_infos t then

+ 4 - 4
src/typing/calls.ml

@@ -15,8 +15,8 @@ let make_call ctx e params t ?(force_inline=false) p =
 		| TFun (expected_args,_) ->
 			(match List.rev expected_args with
 			| (_,true,t) :: rest when is_pos_infos t && List.length rest = List.length params ->
-				let infos = mk_infos ctx p [] in
-				params @ [type_expr ctx infos (WithType.with_type t)]
+				let infos = mk_infos_t ctx p [] t in
+				params @ [infos]
 			| _ -> params
 			)
 		| _ -> params
@@ -369,8 +369,8 @@ let type_bind ctx (e : texpr) (args,ret) params safe p =
 		| [], [] -> given_args,missing_args,ordered_args
 		| [], _ -> raise_typing_error "Too many callback arguments" p
 		| [n,o,t] , [] when o && is_pos_infos t ->
-			let infos = mk_infos ctx p [] in
-			let ordered_args = ordered_args @ [type_expr ctx infos (WithType.with_argument t n)] in
+			let infos = mk_infos_t ctx p [] t in
+			let ordered_args = ordered_args @ [infos] in
 			given_args,missing_args,ordered_args
 		| (n,o,t) :: _ , (EConst(Ident "_"),p) :: _ when not ctx.com.config.pf_can_skip_non_nullable_argument && o && not (is_nullable t) ->
 			raise_typing_error "Usage of _ is not supported for optional non-nullable arguments" p