add Context.storeTypedExpr (closes #3906)

ast.ml

@@ -144,6 +144,7 @@ module Meta = struct
 		| SkipCtor
 		| SkipReflection
 		| Sound
+		| StoredTypedExpr
 		| Struct
 		| StructAccess
 		| SuppressWarnings

common.ml

@@ -133,6 +133,7 @@ type context = {
 	mutable get_macros : unit -> context option;
 	mutable run_command : string -> int;
 	file_lookup_cache : (string,string option) Hashtbl.t;
+	mutable stored_typed_exprs : (int, texpr) PMap.t;
 	(* output *)
 	mutable file : string;
 	mutable flash_version : float;
@@ -463,6 +464,7 @@ module MetaInfo = struct
 		| RuntimeValue -> ":runtimeValue",("Marks an abstract as being a runtime value",[UsedOn TAbstract])
 		| SelfCall -> ":selfCall",("Translates method calls into calling object directly",[UsedOn TClassField; Platform Js])
 		| Setter -> ":setter",("Generates a native getter function on the given field",[HasParam "Class field name";UsedOn TClassField;Platform Flash])
+		| StoredTypedExpr -> ":storedTypedExpr",("Used internally to reference a typed expression returned from a macro",[Internal])
 		| SkipCtor -> ":skipCtor",("Used internally to generate a constructor as if it were a native type (no __hx_ctor)",[Platforms [Java;Cs]; Internal])
 		| SkipReflection -> ":skipReflection",("Used internally to annotate a field that shouldn't have its reflection data generated",[Platforms [Java;Cs]; UsedOn TClassField; Internal])
 		| Sound -> ":sound",( "Includes a given .wav or .mp3 file into the target Swf and associates it with the class (must extend flash.media.Sound)",[HasParam "File path";UsedOn TClass;Platform Flash])
@@ -735,6 +737,7 @@ let create v args =
 			tarray = (fun _ -> assert false);
 		};
 		file_lookup_cache = Hashtbl.create 0;
+		stored_typed_exprs = PMap.empty;
 		memory_marker = memory_marker;
 	}
 

extra/CHANGES.txt

@@ -72,6 +72,7 @@
 	macro : [breaking] extended TAnonymous structures now have AExtend status instead of AClosed
 	macro : added Context.getDefines
 	macro : fixed file_seek from end (position was inversed)
+	macro : added Context.storeTypedExpr
 
 	Deprecations:
 

interp.ml

@@ -106,6 +106,7 @@ type extern_api = {
 	on_type_not_found : (string -> value) -> unit;
 	parse_string : string -> Ast.pos -> bool -> Ast.expr;
 	type_expr : Ast.expr -> Type.texpr;
+	store_typed_expr : Type.texpr -> Ast.expr;
 	get_display : string -> string;
 	allow_package : string -> unit;
 	type_patch : string -> string -> bool -> string option -> unit;
@@ -2628,6 +2629,10 @@ let macro_lib =
 			let e = decode_texpr e in
 			encode_expr (make_ast e)
 		);
+		"store_typed_expr", Fun1 (fun e ->
+			let e = try decode_texpr e with Invalid_expr -> error() in
+			encode_expr ((get_ctx()).curapi.store_typed_expr e)
+		);
 		"get_output", Fun0 (fun() ->
 			VString (ccom()).file
 		);

std/haxe/macro/Context.hx

@@ -465,6 +465,24 @@ class Context {
 		return load("get_typed_expr",1)(t);
 	}
 
+
+	/**
+		Store typed expression `t` internally and give a syntax-level expression
+		that can be returned from a macro and will be replaced by the stored
+		typed expression.
+
+		If `t` is null or invalid, an exception is thrown.
+
+		NOTE: the returned value references an internally stored typed expression
+		that is reset between compilations, so care should be taken when storing
+		the expression returned by this method in a static variable and using the
+		compilation server.
+	**/
+	@:require(haxe_ver >= 3.2)
+	public static function storeTypedExpr( t : Type.TypedExpr ) : Expr {
+		return load("store_typed_expr",1)(t);
+	}
+
 	/**
 		Manually adds a dependency between module `modulePath` and an external
 		file `externFile`.

tests/unit/src/unit/issues/Issue3914.hx

@@ -0,0 +1,61 @@
+package unit.issues;
+
+class Issue3914 extends Test {
+    #if macro
+    static var storedExpr:haxe.macro.Expr;
+    #end
+
+    function test() {
+        storeExpr(function(a:Array<Int>) {
+            for (i in a) {
+                try throw i catch (v:Dynamic) {
+                    var v2 = v;
+                    return v2;
+                }
+            }
+            throw false;
+        });
+        eq(getStoredExpr()([3,2,1]), 3);
+    }
+
+    function test2() {
+        storeExpr(function(a:Array<Int>) {
+            for (i in a) {
+                try throw i catch (v:Dynamic) {
+                    var v2 = v;
+                    return v2;
+                }
+            }
+            throw false;
+        });
+        check2();
+    }
+
+    function check2() {
+        eq(getStoredExpr()([3,2,1]), 3);
+    }
+
+    function test3() {
+        store3();
+        eq(getStoredExpr()([3,2,1]), 3);
+    }
+
+    function store3() {
+        storeExpr(function(a:Array<Int>) {
+            for (i in a) {
+                try throw i catch (v:Dynamic) {
+                    var v2 = v;
+                    return v2;
+                }
+            }
+            throw false;
+        });
+    }
+
+    static macro function storeExpr(e) {
+        storedExpr = haxe.macro.Context.storeTypedExpr(haxe.macro.Context.typeExpr(e));
+        return macro {};
+    }
+
+    static macro function getStoredExpr() return storedExpr;
+}

typer.ml

@@ -3524,11 +3524,61 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			| (Meta.Analyzer,_,_) ->
 				let e = e() in
 				{e with eexpr = TMeta(m,e)}
+			| (Meta.StoredTypedExpr,_,_) ->
+				let id = match e1 with (EConst (Int s),_) -> int_of_string s | _ -> assert false in
+				get_stored_typed_expr ctx.com id
 			| _ -> e()
 		in
 		ctx.meta <- old;
 		e
 
+and get_next_stored_typed_expr_id =
+	let uid = ref 0 in
+	(fun() -> incr uid; !uid)
+
+and get_stored_typed_expr com id =
+	let vars = Hashtbl.create 0 in
+	let copy_var v =
+		let v2 = alloc_var v.v_name v.v_type in
+		v2.v_meta <- v.v_meta;
+		Hashtbl.add vars v.v_id v2;
+		v2;
+	in
+	let rec build_expr e =
+		match e.eexpr with
+		| TVar (v,eo) ->
+			let v2 = copy_var v in
+			{e with eexpr = TVar(v2, Option.map build_expr eo)}
+		| TFor (v,e1,e2) ->
+			let v2 = copy_var v in
+			{e with eexpr = TFor(v2, build_expr e1, build_expr e2)}
+		| TTry (e1,cl) ->
+			let cl = List.map (fun (v,e) ->
+				let v2 = copy_var v in
+				v2, build_expr e
+			) cl in
+			{e with eexpr = TTry(build_expr e1, cl)}
+		| TFunction f ->
+			let args = List.map (fun (v,c) -> copy_var v, c) f.tf_args in
+			let f = {
+				tf_args = args;
+				tf_type = f.tf_type;
+				tf_expr = build_expr f.tf_expr;
+			} in
+			{e with eexpr = TFunction f}
+		| TLocal v ->
+			(try
+				let v2 = Hashtbl.find vars v.v_id in
+				{e with eexpr = TLocal v2}
+			with _ ->
+				e)
+		| _ ->
+			map_expr build_expr e
+	in
+	let e = PMap.find id com.stored_typed_exprs in
+	build_expr  e
+
+
 and handle_display ctx e_ast iscall p =
 	let old = ctx.in_display in
 	ctx.in_display <- true;
@@ -4244,6 +4294,13 @@ let make_macro_api ctx p =
 		Interp.type_expr = (fun e ->
 			typing_timer ctx (fun() -> (type_expr ctx e Value))
 		);
+		Interp.store_typed_expr = (fun te ->
+			let p = te.epos in
+			let id = get_next_stored_typed_expr_id() in
+			ctx.com.stored_typed_exprs <- PMap.add id te ctx.com.stored_typed_exprs;
+			let eid = (EConst (Int (string_of_int id))), p in
+			(EMeta ((Meta.StoredTypedExpr,[],p), eid)), p
+		);
 		Interp.get_display = (fun s ->
 			let is_displaying = ctx.com.display <> DMNone in
 			let old_resume = !Parser.resume_display in