Browse Source

added Context.follow

Nicolas Cannasse 14 years ago
parent
commit
3d5708087b
2 changed files with 45 additions and 13 deletions
  1. 38 13
      interp.ml
  2. 7 0
      std/haxe/macro/Context.hx

+ 38 - 13
interp.ml

@@ -56,6 +56,7 @@ and vabstract =
 	| ASocket of Unix.file_descr
 	| ATExpr of texpr
 	| ATDecl of module_type
+	| AUnsafe of Obj.t
 
 and vfunction =
 	| Fun0 of (unit -> value)
@@ -143,12 +144,14 @@ exception Return of value
 
 let get_ctx_ref = ref (fun() -> assert false)
 let encode_type_ref = ref (fun t -> assert false)
+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 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
 
@@ -1696,6 +1699,9 @@ let macro_lib =
 			| None -> VNull
 			| Some c -> encode_type (TInst (c,[]))
 		);
+		"follow", Fun1 (fun v ->
+			encode_type (follow (decode_type v))
+		);
 	]
 
 (* ---------------------------------------------------------------------- *)
@@ -2751,21 +2757,21 @@ let rec decode_path t =
 
 and decode_tparam v =
 	match decode_enum v with
-	| 0,[t] -> TPType (decode_type t)
+	| 0,[t] -> TPType (decode_ctype t)
 	| 1,[c] -> TPConst (decode_const c)
 	| _ -> raise Invalid_expr
 
 and decode_field v =
 	let ftype = match decode_enum (field v "type") with
 		| 0, [t] ->
-			AFVar (decode_type t)
+			AFVar (decode_ctype t)
 		| 1, [t;get;set] ->
-			AFProp (decode_type t, dec_string get, dec_string set)
+			AFProp (decode_ctype t, dec_string get, dec_string set)
 		| 2, [pl;t] ->
 			let pl = List.map (fun p ->
-				(dec_string (field p "name"),dec_bool (field p "opt"),decode_type (field p "type"))
+				(dec_string (field p "name"),dec_bool (field p "opt"),decode_ctype (field p "type"))
 			) (dec_array pl) in
-			AFFun (pl, decode_type t)
+			AFFun (pl, decode_ctype t)
 		| _ ->
 			raise Invalid_expr
 	in
@@ -2776,16 +2782,16 @@ and decode_field v =
 		decode_pos (field v "pos")
 	)
 
-and decode_type t =
+and decode_ctype t =
 	match decode_enum t with
 	| 0, [p] ->
 		CTPath (decode_path p)
 	| 1, [a;r] ->
-		CTFunction (List.map decode_type (dec_array a), decode_type r)
+		CTFunction (List.map decode_ctype (dec_array a), decode_ctype r)
 	| 2, [fl] ->
 		CTAnonymous (List.map decode_field (dec_array fl))
 	| 3, [t] ->
-		CTParent (decode_type t)
+		CTParent (decode_ctype t)
 	| 4, [t;fl] ->
 		CTExtend (decode_path t, List.map decode_field (dec_array fl))
 	| _ ->
@@ -2822,14 +2828,14 @@ let decode_expr v =
 			EUnop (decode_unop op,(if f then Postfix else Prefix),loop e)
 		| 11, [vl] ->
 			EVars (List.map (fun v ->
-				(dec_string (field v "name"),opt decode_type (field v "type"),opt loop (field v "expr"))
+				(dec_string (field v "name"),opt decode_ctype (field v "type"),opt loop (field v "expr"))
 			) (dec_array vl))
 		| 12, [f] ->
 			let ft = {
 				f_args = List.map (fun o ->
-					(dec_string (field o "name"),dec_bool (field o "opt"),opt decode_type (field o "type"),opt loop (field o "value"))
+					(dec_string (field o "name"),dec_bool (field o "opt"),opt decode_ctype (field o "type"),opt loop (field o "value"))
 				) (dec_array (field f "args"));
-				f_type = opt decode_type (field f "ret");
+				f_type = opt decode_ctype (field f "ret");
 				f_expr = loop (field f "expr");
 			} in
 			EFunction (opt dec_string (field f "name"),ft)
@@ -2848,7 +2854,7 @@ let decode_expr v =
 			ESwitch (loop e,cases,opt loop eo)
 		| 18, [e;catches] ->
 			let catches = List.map (fun c ->
-				(dec_string (field c "name"),decode_type (field c "type"),loop (field c "expr"))
+				(dec_string (field c "name"),decode_ctype (field c "type"),loop (field c "expr"))
 			) (dec_array catches) in
 			ETry (loop e, catches)
 		| 19, [e] ->
@@ -2862,7 +2868,7 @@ let decode_expr v =
 		| 23, [e] ->
 			EThrow (loop e)
 		| 24, [e;t] ->
-			ECast (loop e,opt decode_type t)
+			ECast (loop e,opt decode_ctype t)
 		| 25, [e;f] ->
 			EDisplay (loop e,dec_bool f)
 		| 26, [t] ->
@@ -2882,8 +2888,14 @@ let encode_ref v convert tostr =
 		"get", VFunction (Fun0 (fun() -> convert v));
 		"__string", VFunction (Fun0 (fun() -> VString (tostr())));
 		"toString", VFunction (Fun0 (fun() -> enc_string (tostr())));
+		"$", VAbstract (AUnsafe (Obj.repr v));
 	]
 
+let decode_ref v : 'a =
+	match field v "$" with
+	| VAbstract (AUnsafe t) -> Obj.obj t
+	| _ -> raise Invalid_expr
+
 let encode_pmap convert m =
 	let h = Hashtbl.create 0 in
 	PMap.iter (fun k v -> Hashtbl.add h (VString k) (convert v)) m;
@@ -3079,6 +3091,18 @@ and encode_type t =
 	let tag, pl = loop t in
 	enc_enum IType tag pl
 
+and decode_type t =
+	match decode_enum t with
+	| 0, [] -> TMono (ref None)
+	| 1, [e; pl] -> TEnum (decode_ref e, List.map decode_type (dec_array pl))
+	| 2, [c; pl] -> TInst (decode_ref c, List.map decode_type (dec_array pl))
+	| 3, [t; pl] -> TType (decode_ref t, List.map decode_type (dec_array pl))
+	| 4, [pl; r] -> TFun (List.map (fun p -> dec_string (field p "name"), dec_bool (field p "opt"), decode_type (field p "t")) (dec_array pl), decode_type r)
+	| 5, [a] -> TAnon (decode_ref a)
+	| 6, [VNull] -> t_dynamic
+	| 6, [t] -> TDynamic (decode_type t)	
+	| _ -> raise Invalid_expr
+
 and encode_texpr e =
 	VAbstract (ATExpr e)
 
@@ -3215,5 +3239,6 @@ let rec make_ast e =
 ;;
 enc_array_ref := enc_array;
 encode_type_ref := encode_type;
+decode_type_ref := decode_type;
 encode_expr_ref := encode_expr;
 decode_expr_ref := decode_expr

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

@@ -131,6 +131,13 @@ class Context {
 		return load("typeof", 1)(e);
 	}
 
+	/**
+		Follow all typedefs to reach the actual real type
+	**/
+	public static function follow( t : Type ) : Type {
+		return load("follow", 1)(t);
+	}
+	
 	/**
 		Get the informations stored into a given position.
 	**/