浏览代码

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 decode_expr_ref = ref (fun e -> 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 enc_array (l:value list) : value = (!enc_array_ref) l
 let encode_type (t:Type.t) : value = (!encode_type_ref) t
 let decode_type (v:value) : Type.t = (!decode_type_ref) v
 let encode_expr (e:Ast.expr) : value = (!encode_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)
 
@@ -1969,6 +1971,12 @@ let macro_lib =
 				VNull
 			| _ -> 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)
 	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
 	| TConst 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)
 	| TBinop (op,e1,e2) -> EBinop (op, make_ast e1, make_ast e2)
 	| 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)
 	| 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)
-	| TMatch (e,en,cases,def) ->
+	| TMatch (e,(en,_),cases,def) ->		
 		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
 		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)
@@ -3865,6 +3891,7 @@ let rec make_ast e =
 	,e.epos)
 
 ;;
+make_ast_ref := make_ast;
 enc_array_ref := enc_array;
 encode_type_ref := encode_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 :
 		make sure the module gets recompiled (if it was cached) in case the extern file has been modified as well.