浏览代码

added Context.getTypedExpr, allow to inspect compiled expressions

Nicolas Cannasse 13 年之前
父节点
当前提交
e383b709eb
共有 2 个文件被更改,包括 38 次插入4 次删除
  1. 31 4
      interp.ml
  2. 7 0
      std/haxe/macro/Context.hx

+ 31 - 4
interp.ml

@@ -169,12 +169,14 @@ let decode_type_ref = ref (fun t -> assert false)
 let encode_expr_ref = ref (fun e -> assert false)
 let encode_expr_ref = ref (fun e -> assert false)
 let decode_expr_ref = ref (fun e -> assert false)
 let decode_expr_ref = ref (fun e -> assert false)
 let enc_array_ref = ref (fun l -> assert false)
 let enc_array_ref = ref (fun l -> assert false)
+let make_ast_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 encode_type (t:Type.t) : value = (!encode_type_ref) t
 let encode_type (t:Type.t) : value = (!encode_type_ref) t
 let decode_type (v:value) : Type.t = (!decode_type_ref) v
 let decode_type (v:value) : Type.t = (!decode_type_ref) v
 let encode_expr (e:Ast.expr) : value = (!encode_expr_ref) e
 let encode_expr (e:Ast.expr) : value = (!encode_expr_ref) e
 let decode_expr (e:value) : Ast.expr = (!decode_expr_ref) e
 let decode_expr (e:value) : Ast.expr = (!decode_expr_ref) e
+let make_ast (e:texpr) : Ast.expr = (!make_ast_ref) e
 
 
 let to_int f = int_of_float (mod_float f 2147483648.0)
 let to_int f = int_of_float (mod_float f 2147483648.0)
 
 
@@ -1969,6 +1971,12 @@ let macro_lib =
 				VNull
 				VNull
 			| _ -> error()
 			| _ -> error()
 		);
 		);
+		"get_typed_expr", Fun1 (fun e ->
+			match e with
+			| VAbstract (ATExpr e) ->
+				encode_expr (make_ast e)
+			| _ -> error()
+		);
 	]
 	]
 
 
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
@@ -3824,11 +3832,12 @@ let rec make_ast e =
 		| _ -> Some (mk_type t)
 		| _ -> Some (mk_type t)
 	in
 	in
 	let eopt = function None -> None | Some e -> Some (make_ast e) in
 	let eopt = function None -> None | Some e -> Some (make_ast e) in
+	let is_ident n = n.[0] < 'A' || n.[0] > 'Z' in
 	((match e.eexpr with
 	((match e.eexpr with
 	| TConst c ->
 	| TConst c ->
 		EConst (mk_const c)
 		EConst (mk_const c)
-	| TLocal v -> EConst (Ident v.v_name)
-	| TEnumField (en,f) -> EField (mk_path en.e_path e.epos,f)
+	| TLocal v -> EConst (if is_ident v.v_name then Ident v.v_name else Type v.v_name)
+	| TEnumField (en,f) -> if is_ident f then EField (mk_path en.e_path e.epos,f) else EType (mk_path en.e_path e.epos,f)
 	| TArray (e1,e2) -> EArray (make_ast e1,make_ast e2)
 	| TArray (e1,e2) -> EArray (make_ast e1,make_ast e2)
 	| TBinop (op,e1,e2) -> EBinop (op, make_ast e1, make_ast e2)
 	| TBinop (op,e1,e2) -> EBinop (op, make_ast e1, make_ast e2)
 	| TField (e,f) | TClosure (e,f) -> EField (make_ast e, f)
 	| TField (e,f) | TClosure (e,f) -> EField (make_ast e, f)
@@ -3851,9 +3860,26 @@ let rec make_ast e =
 	| TIf (e,e1,e2) -> EIf (make_ast e,make_ast e1,eopt e2)
 	| TIf (e,e1,e2) -> EIf (make_ast e,make_ast e1,eopt e2)
 	| TWhile (e1,e2,flag) -> EWhile (make_ast e1, make_ast e2, flag)
 	| TWhile (e1,e2,flag) -> EWhile (make_ast e1, make_ast e2, flag)
 	| TSwitch (e,cases,def) -> ESwitch (make_ast e,List.map (fun (vl,e) -> List.map make_ast vl, make_ast e) cases,eopt def)
 	| TSwitch (e,cases,def) -> ESwitch (make_ast e,List.map (fun (vl,e) -> List.map make_ast vl, make_ast e) cases,eopt def)
-	| TMatch (e,en,cases,def) ->
+	| TMatch (e,(en,_),cases,def) ->		
 		let scases (idx,args,e) =
 		let scases (idx,args,e) =
-			assert false
+			let p = e.epos in
+			let unused = (EConst (Ident "_"),p) in
+			let args = (match args with
+				| None -> None
+				| Some l -> Some (List.map (function None -> unused | Some v -> (EConst (if is_ident v.v_name then Ident v.v_name else Type v.v_name),p)) l)
+			) in
+			let mk_args n =
+				match args with 
+				| None -> [unused]
+				| Some args -> 
+					args @ Array.to_list (Array.make (n - List.length args) unused)
+			in
+			List.map (fun i -> 
+				let c = (try List.nth en.e_names i with _ -> assert false) in
+				let cfield = (try PMap.find c en.e_constrs with Not_found -> assert false) in
+				let c = (EConst (if is_ident c then Ident c else Type c),p) in
+				(match follow cfield.ef_type with TFun (eargs,_) -> (ECall (c,mk_args (List.length eargs)),p) | _ -> c)
+			) idx, make_ast e
 		in
 		in
 		ESwitch (make_ast e,List.map scases cases,eopt def)
 		ESwitch (make_ast e,List.map scases cases,eopt def)
 	| TTry (e,catches) -> ETry (make_ast e,List.map (fun (v,e) -> v.v_name, mk_type v.v_type, make_ast e) catches)
 	| TTry (e,catches) -> ETry (make_ast e,List.map (fun (v,e) -> v.v_name, mk_type v.v_type, make_ast e) catches)
@@ -3865,6 +3891,7 @@ let rec make_ast e =
 	,e.epos)
 	,e.epos)
 
 
 ;;
 ;;
+make_ast_ref := make_ast;
 enc_array_ref := enc_array;
 enc_array_ref := enc_array;
 encode_type_ref := encode_type;
 encode_type_ref := encode_type;
 decode_type_ref := decode_type;
 decode_type_ref := decode_type;

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

@@ -199,6 +199,13 @@ class Context {
 	}
 	}
 
 
 
 
+	/**
+		Return the raw expression corresponding to the given typed expression.
+	**/
+	public static function getTypedExpr( t : Type.TypedExpr ) : Expr {
+		return load("get_typed_expr",1)(t);
+	}
+
 	/**
 	/**
 		Manually add a dependency between a module and a third party file :
 		Manually add a dependency between a module and a third party file :
 		make sure the module gets recompiled (if it was cached) in case the extern file has been modified as well.
 		make sure the module gets recompiled (if it was cached) in case the extern file has been modified as well.