Browse Source

[macro] clean up some internal data structures

and remove the crude TFor change
Simon Krajewski 1 year ago
parent
commit
e60332de3b

+ 2 - 2
src/context/abstractCast.ml

@@ -14,8 +14,8 @@ let rec make_static_call ctx c cf a pl args t p =
 				let e,f = push_this ctx e in
 				let e,f = push_this ctx e in
 				ctx.with_type_stack <- (WithType.with_type t) :: ctx.with_type_stack;
 				ctx.with_type_stack <- (WithType.with_type t) :: ctx.with_type_stack;
 				let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name [e] p with
 				let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name [e] p with
-					| Some e -> type_expr ctx e (WithType.with_type t)
-					| None ->  type_expr ctx (EConst (Ident "null"),p) WithType.value
+					| MSuccess e -> type_expr ctx e (WithType.with_type t)
+					| _ ->  type_expr ctx (EConst (Ident "null"),p) WithType.value
 				in
 				in
 				ctx.with_type_stack <- List.tl ctx.with_type_stack;
 				ctx.with_type_stack <- List.tl ctx.with_type_stack;
 				let e = try cast_or_unify_raise ctx t e p with Error { err_message = Unify _ } -> raise Not_found in
 				let e = try cast_or_unify_raise ctx t e p with Error { err_message = Unify _ } -> raise Not_found in

+ 6 - 1
src/context/typecore.ml

@@ -86,6 +86,11 @@ type build_info = {
 	build_apply : Type.t list -> Type.t;
 	build_apply : Type.t list -> Type.t;
 }
 }
 
 
+type macro_result =
+	| MSuccess of expr
+	| MError
+	| MMacroInMacro
+
 type typer_globals = {
 type typer_globals = {
 	mutable delayed : delay list;
 	mutable delayed : delay list;
 	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
 	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
@@ -103,7 +108,7 @@ type typer_globals = {
 	mutable load_only_cached_modules : bool;
 	mutable load_only_cached_modules : bool;
 	functional_interface_lut : (path,tclass_field) lookup;
 	functional_interface_lut : (path,tclass_field) lookup;
 	(* api *)
 	(* api *)
-	do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> expr option;
+	do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> macro_result;
 	do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field);
 	do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field);
 	do_load_module : typer -> path -> pos -> module_def;
 	do_load_module : typer -> path -> pos -> module_def;
 	do_load_type_def : typer -> pos -> type_path -> module_type;
 	do_load_type_def : typer -> pos -> type_path -> module_type;

+ 15 - 6
src/typing/callUnification.ml

@@ -453,13 +453,21 @@ object(self)
 		ctx.macro_depth <- ctx.macro_depth + 1;
 		ctx.macro_depth <- ctx.macro_depth + 1;
 		ctx.with_type_stack <- with_type :: ctx.with_type_stack;
 		ctx.with_type_stack <- with_type :: ctx.with_type_stack;
 		let ethis_f = ref (fun () -> ()) in
 		let ethis_f = ref (fun () -> ()) in
+		let macro_in_macro () =
+			(fun () ->
+				let e = (EThrow((EConst(String("macro-in-macro",SDoubleQuotes))),p),p) in
+				type_expr ~mode ctx e with_type
+			)
+		in
 		let f = (match ethis.eexpr with
 		let f = (match ethis.eexpr with
 		| TTypeExpr (TClassDecl c) ->
 		| TTypeExpr (TClassDecl c) ->
 			DeprecationCheck.check_cf (create_deprecation_context ctx) cf p;
 			DeprecationCheck.check_cf (create_deprecation_context ctx) cf p;
-			(match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
-			| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
-			| Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)
-			| Some e -> (fun() -> type_expr ~mode ctx e with_type))
+			begin match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
+				| MError -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
+				| MSuccess (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)
+				| MSuccess e -> (fun() -> type_expr ~mode ctx e with_type)
+				| MMacroInMacro -> macro_in_macro ()
+			end
 		| _ ->
 		| _ ->
 			(* member-macro call : since we will make a static call, let's find the actual class and not its subclass *)
 			(* member-macro call : since we will make a static call, let's find the actual class and not its subclass *)
 			(match follow ethis.etype with
 			(match follow ethis.etype with
@@ -469,8 +477,9 @@ object(self)
 						let eparam,f = push_this ctx ethis in
 						let eparam,f = push_this ctx ethis in
 						ethis_f := f;
 						ethis_f := f;
 						let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with
 						let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with
-							| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
-							| Some e -> (fun() -> type_expr ~mode ctx e WithType.value)
+							| MError -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
+							| MSuccess e -> (fun() -> type_expr ~mode ctx e with_type)
+							| MMacroInMacro -> macro_in_macro ()
 						in
 						in
 						e
 						e
 					else
 					else

+ 1 - 4
src/typing/forLoop.ml

@@ -536,7 +536,4 @@ let type_for_loop ctx handle_display it e2 p =
 	in
 	in
 	let ik,e1 = loop None it in
 	let ik,e1 = loop None it in
 	let e1 = type_expr ctx e1 WithType.value in
 	let e1 = type_expr ctx e1 WithType.value in
-	if DeadEnd.has_dead_end e1 then
-		e1
-	else
-		type_for_loop ctx handle_display ik e1 e2 p
+	type_for_loop ctx handle_display ik e1 e2 p

+ 4 - 4
src/typing/instanceBuilder.ml

@@ -39,8 +39,8 @@ let build_macro_type ctx pl p =
 	) in
 	) in
 	let old = ctx.ret in
 	let old = ctx.ret in
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
-		| None -> spawn_monomorph ctx p
-		| Some _ -> ctx.ret
+		| MError | MMacroInMacro -> spawn_monomorph ctx p
+		| MSuccess _ -> ctx.ret
 	) in
 	) in
 	ctx.ret <- old;
 	ctx.ret <- old;
 	t
 	t
@@ -58,8 +58,8 @@ let build_macro_build ctx c pl cfl p =
 	let old = ctx.ret,ctx.get_build_infos in
 	let old = ctx.ret,ctx.get_build_infos in
 	ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
 	ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
-		| None -> spawn_monomorph ctx p
-		| Some _ -> ctx.ret
+		| MError | MMacroInMacro -> spawn_monomorph ctx p
+		| MSuccess _ -> ctx.ret
 	) in
 	) in
 	ctx.ret <- fst old;
 	ctx.ret <- fst old;
 	ctx.get_build_infos <- snd old;
 	ctx.get_build_infos <- snd old;

+ 6 - 5
src/typing/macroContext.ml

@@ -966,11 +966,12 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 	in
 	in
 	let call() =
 	let call() =
 		match call_macro args with
 		match call_macro args with
-		| None -> None
+		| None ->
+			MError
 		| Some v ->
 		| Some v ->
 			let expected,process = match mode with
 			let expected,process = match mode with
 				| MExpr | MDisplay ->
 				| MExpr | MDisplay ->
-					"Expr",(fun () -> Some (Interp.decode_expr v))
+					"Expr",(fun () -> MSuccess (Interp.decode_expr v))
 				| MBuild ->
 				| MBuild ->
 					"Array<Field>",(fun () ->
 					"Array<Field>",(fun () ->
 						let fields = if v = Interp.vnull then
 						let fields = if v = Interp.vnull then
@@ -980,7 +981,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 							else
 							else
 								List.map Interp.decode_field (Interp.decode_array v)
 								List.map Interp.decode_field (Interp.decode_array v)
 						in
 						in
-						Some (EVars [mk_evar ~t:(CTAnonymous fields,p) ("fields",null_pos)],p)
+						MSuccess (EVars [mk_evar ~t:(CTAnonymous fields,p) ("fields",null_pos)],p)
 					)
 					)
 				| MMacroType ->
 				| MMacroType ->
 					"ComplexType",(fun () ->
 					"ComplexType",(fun () ->
@@ -993,13 +994,13 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 							Interp.decode_type v
 							Interp.decode_type v
 						in
 						in
 						ctx.ret <- t;
 						ctx.ret <- t;
-						Some (EBlock [],p)
+						MSuccess (EBlock [],p)
 					)
 					)
 			in
 			in
 			safe_decode ctx.com v expected mret p process
 			safe_decode ctx.com v expected mret p process
 	in
 	in
 	let e = if ctx.com.is_macro_context then
 	let e = if ctx.com.is_macro_context then
-		Some (EThrow((EConst(String("macro-in-macro",SDoubleQuotes))),p),p)
+		MMacroInMacro
 	else
 	else
 		call()
 		call()
 	in
 	in

+ 2 - 2
src/typing/typeloadFields.ml

@@ -481,8 +481,8 @@ let build_module_def ctx mt meta fvars fbuild =
 				let r = try ctx.g.do_macro ctx MBuild cpath meth el p with e -> ctx.get_build_infos <- old; raise e in
 				let r = try ctx.g.do_macro ctx MBuild cpath meth el p with e -> ctx.get_build_infos <- old; raise e in
 				ctx.get_build_infos <- old;
 				ctx.get_build_infos <- old;
 				(match r with
 				(match r with
-				| None -> raise_typing_error "Build failure" p
-				| Some e -> fbuild e)
+				| MError | MMacroInMacro -> raise_typing_error "Build failure" p
+				| MSuccess e -> fbuild e)
 			) :: f_build
 			) :: f_build
 		| Meta.Using,el,p -> (fun () ->
 		| Meta.Using,el,p -> (fun () ->
 			List.iter (fun e ->
 			List.iter (fun e ->

+ 0 - 13
tests/unit/src/unit/issues/Issue11403.hx

@@ -1,13 +0,0 @@
-package unit.issues;
-
-class Issue11403 extends Test {
-	public static macro function getValues() {
-		return macro [1];
-	}
-
-	function test() {
-		for (v in getValues()) {
-			eq(1, v);
-		}
-	}
-}