[macro] add Context.eval (closes HaxeFoundation#2278)

extra/CHANGES.txt

@@ -33,6 +33,7 @@
 
 	Macro features and changes:
 
+	macro : added Context.eval (#2278)
 	macro : added overloads field to ClassField (#3460)
 	macro : added Context.getLocalImports (#3560)
 

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;
+	type_macro_expr : Ast.expr -> Type.texpr;
 	store_typed_expr : Type.texpr -> Ast.expr;
 	get_display : string -> string;
 	allow_package : string -> unit;
@@ -214,6 +215,7 @@ let encode_tvar_ref = ref (fun _ -> assert false)
 let decode_path_ref = ref (fun _ -> assert false)
 let decode_import_ref = ref (fun _ -> assert false)
 let encode_import_ref = ref (fun _ -> assert false)
+let eval_expr_ref : (context -> texpr -> value option) ref = ref (fun _ _ -> assert false)
 let get_ctx() = (!get_ctx_ref)()
 let enc_array (l:value list) : value = (!enc_array_ref) l
 let dec_array (l:value) : value list = (!dec_array_ref) l
@@ -2689,6 +2691,13 @@ let macro_lib =
 			in
 			encode_type (apply_params tpl tl (map (decode_type t)))
 		);
+		"eval", Fun1 (fun v ->
+			let e = decode_expr v in
+			let e = ((get_ctx()).curapi.type_macro_expr e) in
+ 			match !eval_expr_ref (get_ctx()) e with
+			| Some v -> v
+			| None -> VNull
+		);
 	]
 
 (* ---------------------------------------------------------------------- *)
@@ -2732,7 +2741,11 @@ let get_ident ctx s =
 
 let no_env = [||]
 
-let rec eval ctx (e,p) =
+let rec eval_expr ctx e =
+	let e = Genneko.gen_expr ctx.gen e in
+	catch_errors ctx (fun() -> (eval ctx e)())
+
+and eval ctx (e,p) =
 	match e with
 	| EConst c ->
 		(match c with
@@ -3618,10 +3631,6 @@ let add_types ctx types ready =
 	let e = (EBlock (Genneko.build ctx.gen types), null_pos) in
 	ignore(catch_errors ctx (fun() -> ignore((eval ctx e)())))
 
-let eval_expr ctx e =
-	let e = Genneko.gen_expr ctx.gen e in
-	catch_errors ctx (fun() -> (eval ctx e)())
-
 let get_path ctx path p =
 	let rec loop = function
 		| [] -> assert false
@@ -5107,5 +5116,6 @@ encode_texpr_ref := encode_texpr;
 decode_texpr_ref := decode_texpr;
 encode_tvar_ref := encode_tvar;
 decode_path_ref := decode_path;
+encode_import_ref := encode_import;
 decode_import_ref := decode_import;
-encode_import_ref := encode_import;
+eval_expr_ref := eval_expr;

std/haxe/macro/Context.hx

@@ -492,6 +492,34 @@ class Context {
 		return load("store_typed_expr",1)(t);
 	}
 
+	/**
+		Evaluates `e` as macro code.
+
+		Any call to this function takes effect when the macro is executed, not
+		during typing. As a consequence, this function can not introduce new
+		local variables into the macro context and may have other restrictions.
+
+		Usage example:
+
+		```haxe
+		var e = macro function(i) return i * 2;
+		var f:Int -> Int = haxe.macro.Context.eval(e);
+		trace(f(2)); // 4
+		```
+
+		Code passed in from outside the macro cannot reference anything in its
+		context, such as local variables. However, it is possible to reference
+		static methods.
+
+		This method should be considered experimental.
+
+		If `e` is null, the result is unspecified.
+	**/
+	@:require(haxe_ver >= 3.3)
+	public static function eval( e : Expr ) : Dynamic {
+		return load("eval",1)(e);
+	}
+
 	/**
 		Manually adds a dependency between module `modulePath` and an external
 		file `externFile`.

tests/misc/projects/Issue2278/Macro.hx

@@ -0,0 +1,21 @@
+import haxe.macro.Expr;
+import haxe.macro.Context;
+
+class Macro {
+	macro static public function call(efun:ExprOf<Int->Int>, eval:Expr):Expr {
+		var vfun = Context.eval(efun);
+		var vval = Context.eval(eval);
+		var r = vfun(vval);
+		return macro $v{r};
+	}
+
+	macro static public function call2(efun:Int->Int, eval:Int):Expr {
+		var r = efun(eval);
+		return macro $v{r};
+	}
+
+	macro static public function call3(efun:Int->Int, eval:Expr):Expr {
+		var r = efun(Context.eval(eval));
+		return macro $v{r};
+	}
+}

tests/misc/projects/Issue2278/Main.hx

@@ -0,0 +1,19 @@
+using Macro;
+
+class Main {
+	static function main() {
+		write(Macro.call(function(x) return x * 3, 3));
+		write(Macro.call(MyTools.double, 3));
+		write(MyTools.double.call(3));
+		write(Macro.call(MyTools.double, Macro.call(MyTools.double, 3)));
+
+		write(Macro.call2(function(x) return x * 3, 3));
+		write(Macro.call2(MyTools.double, 3));
+		write(MyTools.double.call2(3));
+		write(Macro.call3(MyTools.double, Macro.call(MyTools.double, 3)));
+	}
+
+	static function write(i:Int) {
+		Sys.stderr().writeString(i + "\n");
+	}
+}

tests/misc/projects/Issue2278/MyTools.hx

@@ -0,0 +1,5 @@
+class MyTools {
+	static public function double(x:Int) {
+		return x * 2;
+	}
+}

tests/misc/projects/Issue2278/compile.hxml

@@ -0,0 +1,2 @@
+-main Main
+--interp

tests/misc/projects/Issue2278/compile.hxml.stderr

@@ -0,0 +1,8 @@
+9
+6
+6
+12
+9
+6
+6
+12

typer.ml

@@ -4335,6 +4335,8 @@ let typing_timer ctx f =
 			exit();
 			raise e
 
+let load_macro_ref : (typer -> path -> string -> pos -> (typer * ((string * bool * t) list * t * tclass * Type.tclass_field) * (Interp.value list -> Interp.value option))) ref = ref (fun _ _ _ _ -> assert false)
+
 let make_macro_api ctx p =
 	let parse_expr_string s p inl =
 		typing_timer ctx (fun() -> parse_expr_string ctx s p inl)
@@ -4392,6 +4394,15 @@ let make_macro_api ctx p =
 		Interp.type_expr = (fun e ->
 			typing_timer ctx (fun() -> (type_expr ctx e Value))
 		);
+		Interp.type_macro_expr = (fun e ->
+			let e = typing_timer ctx (fun() -> (type_expr ctx e Value)) in
+			let rec loop e = match e.eexpr with
+				| TField(_,FStatic(c,({cf_kind = Method _} as cf))) -> ignore(!load_macro_ref ctx c.cl_path cf.cf_name e.epos)
+				| _ -> Type.iter loop e
+			in
+			loop e;
+			e
+		);
 		Interp.store_typed_expr = (fun te ->
 			let p = te.epos in
 			let id = get_next_stored_typed_expr_id() in
@@ -4776,6 +4787,11 @@ let load_macro ctx cpath f p =
 	in
 	mctx, meth, call
 
+type macro_arg_type =
+	| MAExpr
+	| MAFunction
+	| MAOther
+
 let type_macro ctx mode cpath f (el:Ast.expr list) p =
 	let mctx, (margs,mret,mclass,mfield), call_macro = load_macro ctx cpath f p in
 	let mpos = mfield.cf_pos in
@@ -4829,7 +4845,14 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 		(*
 			force default parameter types to haxe.macro.Expr, and if success allow to pass any value type since it will be encoded
 		*)
-		let eargs = List.map (fun (n,o,t) -> try unify_raise mctx t expr p; (n, o, t_dynamic), true with Error (Unify _,_) -> (n,o,t), false) margs in
+		let eargs = List.map (fun (n,o,t) ->
+			try unify_raise mctx t expr p; (n, o, t_dynamic), MAExpr
+			with Error (Unify _,_) -> match follow t with
+				| TFun _ ->
+					(n,o,t_dynamic), MAFunction
+				| _ ->
+					(n,o,t), MAOther
+			) margs in
 		(*
 			this is quite tricky here : we want to use unify_call_args which will type our AST expr
 			but we want to be able to get it back after it's been padded with nulls
@@ -4857,17 +4880,25 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 		) el in
 		let elt, _ = unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false in
 		List.iter (fun f -> f()) (!todo);
-		List.map2 (fun (_,ise) e ->
+		List.map2 (fun (_,mct) e ->
 			let e, et = (match e.eexpr with
 				(* get back our index and real expression *)
 				| TArray ({ eexpr = TArrayDecl [e] }, { eexpr = TConst (TInt index) }) -> List.nth el (Int32.to_int index), e
 				(* added by unify_call_args *)
 				| TConst TNull -> (EConst (Ident "null"),e.epos), e
 				| _ -> assert false
 			) in
-			if ise then
+			let ictx = Interp.get_ctx() in
+			match mct with
+			| MAExpr ->
 				Interp.encode_expr e
-			else match Interp.eval_expr (Interp.get_ctx()) et with
+			| MAFunction ->
+				let e = ictx.Interp.curapi.Interp.type_macro_expr e in
+	 			begin match Interp.eval_expr ictx e with
+				| Some v -> v
+				| None -> Interp.VNull
+				end
+			| MAOther -> match Interp.eval_expr ictx et with
 				| None -> assert false
 				| Some v -> v
 		) eargs elt
@@ -5100,4 +5131,5 @@ get_constructor_ref := get_constructor;
 cast_or_unify_ref := Codegen.AbstractCast.cast_or_unify_raise;
 type_module_type_ref := type_module_type;
 find_array_access_raise_ref := Codegen.AbstractCast.find_array_access_raise;
-build_call_ref := build_call
+build_call_ref := build_call;
+load_macro_ref := load_macro