Browse Source

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

Simon Krajewski 10 years ago
parent
commit
b96718d722

+ 1 - 0
extra/CHANGES.txt

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

+ 16 - 6
interp.ml

@@ -106,6 +106,7 @@ type extern_api = {
 	on_type_not_found : (string -> value) -> unit;
 	on_type_not_found : (string -> value) -> unit;
 	parse_string : string -> Ast.pos -> bool -> Ast.expr;
 	parse_string : string -> Ast.pos -> bool -> Ast.expr;
 	type_expr : Ast.expr -> Type.texpr;
 	type_expr : Ast.expr -> Type.texpr;
+	type_macro_expr : Ast.expr -> Type.texpr;
 	store_typed_expr : Type.texpr -> Ast.expr;
 	store_typed_expr : Type.texpr -> Ast.expr;
 	get_display : string -> string;
 	get_display : string -> string;
 	allow_package : string -> unit;
 	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_path_ref = ref (fun _ -> assert false)
 let decode_import_ref = ref (fun _ -> assert false)
 let decode_import_ref = ref (fun _ -> assert false)
 let encode_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 get_ctx() = (!get_ctx_ref)()
 let enc_array (l:value list) : value = (!enc_array_ref) l
 let enc_array (l:value list) : value = (!enc_array_ref) l
 let dec_array (l:value) : value list = (!dec_array_ref) l
 let dec_array (l:value) : value list = (!dec_array_ref) l
@@ -2689,6 +2691,13 @@ let macro_lib =
 			in
 			in
 			encode_type (apply_params tpl tl (map (decode_type t)))
 			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 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
 	match e with
 	| EConst c ->
 	| EConst c ->
 		(match c with
 		(match c with
@@ -3618,10 +3631,6 @@ let add_types ctx types ready =
 	let e = (EBlock (Genneko.build ctx.gen types), null_pos) in
 	let e = (EBlock (Genneko.build ctx.gen types), null_pos) in
 	ignore(catch_errors ctx (fun() -> ignore((eval ctx e)())))
 	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 get_path ctx path p =
 	let rec loop = function
 	let rec loop = function
 		| [] -> assert false
 		| [] -> assert false
@@ -5107,5 +5116,6 @@ encode_texpr_ref := encode_texpr;
 decode_texpr_ref := decode_texpr;
 decode_texpr_ref := decode_texpr;
 encode_tvar_ref := encode_tvar;
 encode_tvar_ref := encode_tvar;
 decode_path_ref := decode_path;
 decode_path_ref := decode_path;
+encode_import_ref := encode_import;
 decode_import_ref := decode_import;
 decode_import_ref := decode_import;
-encode_import_ref := encode_import;
+eval_expr_ref := eval_expr;

+ 28 - 0
std/haxe/macro/Context.hx

@@ -492,6 +492,34 @@ class Context {
 		return load("store_typed_expr",1)(t);
 		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
 		Manually adds a dependency between module `modulePath` and an external
 		file `externFile`.
 		file `externFile`.

+ 21 - 0
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};
+	}
+}

+ 19 - 0
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");
+	}
+}

+ 5 - 0
tests/misc/projects/Issue2278/MyTools.hx

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

+ 2 - 0
tests/misc/projects/Issue2278/compile.hxml

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

+ 8 - 0
tests/misc/projects/Issue2278/compile.hxml.stderr

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

+ 37 - 5
typer.ml

@@ -4335,6 +4335,8 @@ let typing_timer ctx f =
 			exit();
 			exit();
 			raise e
 			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 make_macro_api ctx p =
 	let parse_expr_string s p inl =
 	let parse_expr_string s p inl =
 		typing_timer ctx (fun() -> parse_expr_string ctx 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 ->
 		Interp.type_expr = (fun e ->
 			typing_timer ctx (fun() -> (type_expr ctx e Value))
 			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 ->
 		Interp.store_typed_expr = (fun te ->
 			let p = te.epos in
 			let p = te.epos in
 			let id = get_next_stored_typed_expr_id() in
 			let id = get_next_stored_typed_expr_id() in
@@ -4776,6 +4787,11 @@ let load_macro ctx cpath f p =
 	in
 	in
 	mctx, meth, call
 	mctx, meth, call
 
 
+type macro_arg_type =
+	| MAExpr
+	| MAFunction
+	| MAOther
+
 let type_macro ctx mode cpath f (el:Ast.expr list) p =
 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 mctx, (margs,mret,mclass,mfield), call_macro = load_macro ctx cpath f p in
 	let mpos = mfield.cf_pos 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
 			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
 			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
 			but we want to be able to get it back after it's been padded with nulls
@@ -4857,7 +4880,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 		) el in
 		) el in
 		let elt, _ = unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false 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.iter (fun f -> f()) (!todo);
-		List.map2 (fun (_,ise) e ->
+		List.map2 (fun (_,mct) e ->
 			let e, et = (match e.eexpr with
 			let e, et = (match e.eexpr with
 				(* get back our index and real expression *)
 				(* get back our index and real expression *)
 				| TArray ({ eexpr = TArrayDecl [e] }, { eexpr = TConst (TInt index) }) -> List.nth el (Int32.to_int index), e
 				| TArray ({ eexpr = TArrayDecl [e] }, { eexpr = TConst (TInt index) }) -> List.nth el (Int32.to_int index), e
@@ -4865,9 +4888,17 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 				| TConst TNull -> (EConst (Ident "null"),e.epos), e
 				| TConst TNull -> (EConst (Ident "null"),e.epos), e
 				| _ -> assert false
 				| _ -> assert false
 			) in
 			) in
-			if ise then
+			let ictx = Interp.get_ctx() in
+			match mct with
+			| MAExpr ->
 				Interp.encode_expr e
 				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
 				| None -> assert false
 				| Some v -> v
 				| Some v -> v
 		) eargs elt
 		) eargs elt
@@ -5100,4 +5131,5 @@ get_constructor_ref := get_constructor;
 cast_or_unify_ref := Codegen.AbstractCast.cast_or_unify_raise;
 cast_or_unify_ref := Codegen.AbstractCast.cast_or_unify_raise;
 type_module_type_ref := type_module_type;
 type_module_type_ref := type_module_type;
 find_array_access_raise_ref := Codegen.AbstractCast.find_array_access_raise;
 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