Browse Source

simplified metadata handling (no longer allow inline constants)
allow to modify metadata from within macros
added Context.eval

Nicolas Cannasse 14 years ago
parent
commit
4896ae4e5e
10 changed files with 270 additions and 223 deletions
  1. 46 18
      codegen.ml
  2. 1 0
      doc/CHANGES.txt
  3. 3 3
      genswf9.ml
  4. 2 2
      genxml.ml
  5. 168 128
      interp.ml
  6. 7 0
      std/haxe/macro/Context.hx
  7. 9 3
      std/haxe/macro/Type.hx
  8. 12 12
      type.ml
  9. 12 51
      typeload.ml
  10. 10 6
      typer.ml

+ 46 - 18
codegen.ml

@@ -50,6 +50,23 @@ let concat e1 e2 =
 	) in
 	) in
 	mk e e2.etype (punion e1.epos e2.epos)
 	mk e e2.etype (punion e1.epos e2.epos)
 
 
+let type_constant com c p =
+	let t = com.basic in
+	match c with
+	| Int s ->
+		if String.length s > 10 && String.sub s 0 2 = "0x" then error "Invalid hexadecimal integer" p;
+		(try
+			mk (TConst (TInt (Int32.of_string s))) t.tint p
+		with
+			_ -> mk (TConst (TFloat s)) t.tfloat p)
+	| Float f -> mk (TConst (TFloat f)) t.tfloat p
+	| String s -> mk (TConst (TString s)) t.tstring p
+	| Ident "true" -> mk (TConst (TBool true)) t.tbool p
+	| Ident "false" -> mk (TConst (TBool false)) t.tbool p
+	| Ident "null" -> mk (TConst TNull) (t.tnull (mk_mono())) p
+	| Ident t | Type t -> error ("Invalid constant :  " ^ t) p
+	| Regexp _ -> error "Invalid constant" p
+
 (* -------------------------------------------------------------------------- *)
 (* -------------------------------------------------------------------------- *)
 (* REMOTING PROXYS *)
 (* REMOTING PROXYS *)
 
 
@@ -265,22 +282,35 @@ let build_metadata com t =
 	let api = com.basic in
 	let api = com.basic in
 	let p, meta, fields, statics = (match t with
 	let p, meta, fields, statics = (match t with
 		| TClassDecl c ->
 		| TClassDecl c ->
-			let fields = List.map (fun f -> f.cf_name,f.cf_meta()) (c.cl_ordered_fields @ (match c.cl_constructor with None -> [] | Some f -> [{ f with cf_name = "_" }])) in
-			let statics =  List.map (fun f -> f.cf_name,f.cf_meta()) c.cl_ordered_statics in
-			(c.cl_pos, ["",c.cl_meta()],fields,statics)
+			let fields = List.map (fun f -> f.cf_name,f.cf_meta) (c.cl_ordered_fields @ (match c.cl_constructor with None -> [] | Some f -> [{ f with cf_name = "_" }])) in
+			let statics =  List.map (fun f -> f.cf_name,f.cf_meta) c.cl_ordered_statics in
+			(c.cl_pos, ["",c.cl_meta],fields,statics)
 		| TEnumDecl e ->
 		| TEnumDecl e ->
-			(e.e_pos, ["",e.e_meta()],List.map (fun n -> n, (PMap.find n e.e_constrs).ef_meta()) e.e_names, [])
+			(e.e_pos, ["",e.e_meta],List.map (fun n -> n, (PMap.find n e.e_constrs).ef_meta) e.e_names, [])
 		| TTypeDecl t ->
 		| TTypeDecl t ->
-			(t.t_pos, ["",t.t_meta()],(match follow t.t_type with TAnon a -> PMap.fold (fun f acc -> (f.cf_name,f.cf_meta()) :: acc) a.a_fields [] | _ -> []),[])
+			(t.t_pos, ["",t.t_meta],(match follow t.t_type with TAnon a -> PMap.fold (fun f acc -> (f.cf_name,f.cf_meta) :: acc) a.a_fields [] | _ -> []),[])
 	) in
 	) in
-	let filter l = 
+	let filter l =
 		let l = List.map (fun (n,ml) -> n, List.filter (fun (m,_) -> m.[0] <> ':') ml) l in
 		let l = List.map (fun (n,ml) -> n, List.filter (fun (m,_) -> m.[0] <> ':') ml) l in
 		List.filter (fun (_,ml) -> ml <> []) l
 		List.filter (fun (_,ml) -> ml <> []) l
 	in
 	in
 	let meta, fields, statics = filter meta, filter fields, filter statics in
 	let meta, fields, statics = filter meta, filter fields, filter statics in
+	let rec loop (e,p) =
+		match e with
+		| EConst c ->
+			type_constant com c p
+		| EParenthesis e ->
+			loop e
+		| EObjectDecl el ->
+			mk (TObjectDecl (List.map (fun (n,e) -> n, loop e) el)) (TAnon { a_fields = PMap.empty; a_status = ref Closed }) p
+		| EArrayDecl el ->
+			mk (TArrayDecl (List.map loop el)) (com.basic.tarray t_dynamic) p
+		| _ ->
+			error "Metadata should be constant" p
+	in
 	let make_meta_field ml =
 	let make_meta_field ml =
-		mk (TObjectDecl (List.map (fun (f,l) -> 
-			f, mk (match l with [] -> TConst TNull | _ -> TArrayDecl l) (api.tarray t_dynamic) p
+		mk (TObjectDecl (List.map (fun (f,el) ->
+			f, mk (match el with [] -> TConst TNull | _ -> TArrayDecl (List.map loop el)) (api.tarray t_dynamic) p
 		) ml)) (api.tarray t_dynamic) p
 		) ml)) (api.tarray t_dynamic) p
 	in
 	in
 	let make_meta l =
 	let make_meta l =
@@ -290,10 +320,10 @@ let build_metadata com t =
 		None
 		None
 	else
 	else
 		let meta_obj = [] in
 		let meta_obj = [] in
-		let meta_obj = (if fields = [] then meta_obj else ("fields",make_meta fields) :: meta_obj) in		
+		let meta_obj = (if fields = [] then meta_obj else ("fields",make_meta fields) :: meta_obj) in
 		let meta_obj = (if statics = [] then meta_obj else ("statics",make_meta statics) :: meta_obj) in
 		let meta_obj = (if statics = [] then meta_obj else ("statics",make_meta statics) :: meta_obj) in
 		let meta_obj = (try ("obj", make_meta_field (List.assoc "" meta)) :: meta_obj with Not_found -> meta_obj) in
 		let meta_obj = (try ("obj", make_meta_field (List.assoc "" meta)) :: meta_obj with Not_found -> meta_obj) in
-		Some (mk (TObjectDecl meta_obj) t_dynamic p)		
+		Some (mk (TObjectDecl meta_obj) t_dynamic p)
 
 
 (* -------------------------------------------------------------------------- *)
 (* -------------------------------------------------------------------------- *)
 (* API EVENTS *)
 (* API EVENTS *)
@@ -351,15 +381,13 @@ let rec has_rtti c =
 let on_generate ctx t =
 let on_generate ctx t =
 	match t with
 	match t with
 	| TClassDecl c ->
 	| TClassDecl c ->
-		let meta = ref (c.cl_meta()) in
 		List.iter (fun m ->
 		List.iter (fun m ->
 			match m with
 			match m with
-			| ":native",[{ eexpr = TConst (TString name) } as e] ->				
-				meta := (":real",[{ e with eexpr = TConst (TString (s_type_path c.cl_path)) }]) :: !meta;
-				c.cl_meta <- (fun() -> !meta);
+			| ":native",[Ast.EConst (Ast.String name),p] ->
+				c.cl_meta <- (":real",[Ast.EConst (Ast.String (s_type_path c.cl_path)),p]) :: c.cl_meta;
 				c.cl_path <- parse_path name;
 				c.cl_path <- parse_path name;
 			| _ -> ()
 			| _ -> ()
-		) (!meta);
+		) c.cl_meta;
 		if has_rtti c && not (PMap.mem "__rtti" c.cl_statics) then begin
 		if has_rtti c && not (PMap.mem "__rtti" c.cl_statics) then begin
 			let f = mk_field "__rtti" ctx.t.tstring in
 			let f = mk_field "__rtti" ctx.t.tstring in
 			let str = Genxml.gen_type_string ctx.com t in
 			let str = Genxml.gen_type_string ctx.com t in
@@ -369,14 +397,14 @@ let on_generate ctx t =
 		end;
 		end;
 		if not ctx.in_macro then List.iter (fun f ->
 		if not ctx.in_macro then List.iter (fun f ->
 			match f.cf_kind with
 			match f.cf_kind with
-			| Method MethMacro -> 
+			| Method MethMacro ->
 				c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
 				c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
 				c.cl_ordered_statics <- List.filter (fun f2 -> f != f2) c.cl_ordered_statics;
 				c.cl_ordered_statics <- List.filter (fun f2 -> f != f2) c.cl_ordered_statics;
 			| _ -> ()
 			| _ -> ()
 		) c.cl_ordered_statics;
 		) c.cl_ordered_statics;
 		(match build_metadata ctx.com t with
 		(match build_metadata ctx.com t with
 		| None -> ()
 		| None -> ()
-		| Some e -> 
+		| Some e ->
 			let f = mk_field "__meta__" t_dynamic in
 			let f = mk_field "__meta__" t_dynamic in
 			f.cf_expr <- Some e;
 			f.cf_expr <- Some e;
 			c.cl_ordered_statics <- f :: c.cl_ordered_statics;
 			c.cl_ordered_statics <- f :: c.cl_ordered_statics;
@@ -1113,7 +1141,7 @@ let default_cast ?(vtmp="$t") com e texpr t p =
 		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
 		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
 		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
 		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
 		| TTypeDecl _ -> assert false
 		| TTypeDecl _ -> assert false
-	in	
+	in
 	let var = mk (TVars [(vtmp,e.etype,Some e)]) api.tvoid p in
 	let var = mk (TVars [(vtmp,e.etype,Some e)]) api.tvoid p in
 	let vexpr = mk (TLocal vtmp) e.etype p in
 	let vexpr = mk (TLocal vtmp) e.etype p in
 	let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in
 	let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in

+ 1 - 0
doc/CHANGES.txt

@@ -17,6 +17,7 @@
 	all : added haxe.Timer.measure
 	all : added haxe.Timer.measure
 	all : added Lambda.indexOf and Lambda.concat
 	all : added Lambda.indexOf and Lambda.concat
 	js, flash8: changed behavior when explicitely using 'null' for optional param with default value
 	js, flash8: changed behavior when explicitely using 'null' for optional param with default value
+	all : no longer allow inline vars as metadata values
 
 
 2010-08-14: 2.06
 2010-08-14: 2.06
 	neko : change serializer to be able to handle instances of basic classes from other modules
 	neko : change serializer to be able to handle instances of basic classes from other modules

+ 3 - 3
genswf9.ml

@@ -768,7 +768,7 @@ let gen_access ctx e (forset : 'a) : 'a access =
 		let id, k, closure = property ctx f e1.etype in
 		let id, k, closure = property ctx f e1.etype in
 		if closure && not ctx.for_call then error "In Flash9, this method cannot be accessed this way : please define a local function" e1.epos;
 		if closure && not ctx.for_call then error "In Flash9, this method cannot be accessed this way : please define a local function" e1.epos;
 		(match e1.eexpr with
 		(match e1.eexpr with
-		| TConst TThis when not ctx.in_static -> 
+		| TConst TThis when not ctx.in_static ->
 			use_var ctx f e.epos;
 			use_var ctx f e.epos;
 			write ctx (HFindProp id)
 			write ctx (HFindProp id)
 		| _ -> gen_expr ctx true e1);
 		| _ -> gen_expr ctx true e1);
@@ -1825,7 +1825,7 @@ let generate_class ctx c =
 					try
 					try
 						let f = PMap.find f.cf_name c.cl_fields in
 						let f = PMap.find f.cf_name c.cl_fields in
 						if List.mem f.cf_name c.cl_overrides then raise Not_found;
 						if List.mem f.cf_name c.cl_overrides then raise Not_found;
-						f.cf_meta()
+						f.cf_meta
 					with Not_found ->
 					with Not_found ->
 						find_meta c
 						find_meta c
 			in
 			in
@@ -1833,7 +1833,7 @@ let generate_class ctx c =
 				| [] -> ident f.cf_name
 				| [] -> ident f.cf_name
 				| x :: l ->
 				| x :: l ->
 					match x with
 					match x with
-					| (":ns",[{ eexpr = TConst (TString ns) }]) -> HMName (f.cf_name,HNNamespace ns)
+					| (":ns",[Ast.EConst (Ast.String ns),_]) -> HMName (f.cf_name,HNNamespace ns)
 					| (":protected",[]) ->
 					| (":protected",[]) ->
 						let p = (match c.cl_path with [], n -> n | p, n -> String.concat "." p ^ ":" ^ n) in
 						let p = (match c.cl_path with [], n -> n | p, n -> String.concat "." p ^ ":" ^ n) in
 						has_protected := Some p;
 						has_protected := Some p;

+ 2 - 2
genxml.ml

@@ -52,10 +52,10 @@ let gen_arg_name (name,opt,_) =
 let cpath c =
 let cpath c =
 	let rec loop = function
 	let rec loop = function
 		| [] -> c.cl_path
 		| [] -> c.cl_path
-		| (":real",[{ eexpr = TConst (TString s) }]) :: _ -> parse_path s
+		| (":real",[(Ast.EConst (Ast.String s),_)]) :: _ -> parse_path s
 		| _ :: l -> loop l
 		| _ :: l -> loop l
 	in
 	in
-	loop (c.cl_meta())
+	loop c.cl_meta
 
 
 let rec follow_param t =
 let rec follow_param t =
 	match t with
 	match t with

+ 168 - 128
interp.ml

@@ -87,6 +87,7 @@ type extern_api = {
 	pos : Ast.pos;
 	pos : Ast.pos;
 	get_type : string -> Type.t option;
 	get_type : string -> Type.t option;
 	parse_string : string -> Ast.pos -> Ast.expr;
 	parse_string : string -> Ast.pos -> Ast.expr;
+	eval : Ast.expr -> Type.t;
 }
 }
 
 
 type context = {
 type context = {
@@ -131,9 +132,11 @@ exception Return of value
 let get_ctx_ref = ref (fun() -> assert false)
 let get_ctx_ref = ref (fun() -> assert false)
 let encode_type_ref = ref (fun t -> assert false)
 let encode_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 get_ctx() = (!get_ctx_ref)()
 let get_ctx() = (!get_ctx_ref)()
 let encode_type (t:Type.t) : value = (!encode_type_ref) t
 let encode_type (t:Type.t) : value = (!encode_type_ref) t
 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 to_int f = int_of_float (mod_float f 2147483648.0)
 let to_int f = int_of_float (mod_float f 2147483648.0)
 
 
@@ -600,7 +603,7 @@ let std_lib =
 		| VString s -> s
 		| VString s -> s
 		| _ -> error()
 		| _ -> error()
 	in
 	in
-	let int32_addr h = 
+	let int32_addr h =
 		let base = Int32.to_int (Int32.logand h 0xFFFFFFl) in
 		let base = Int32.to_int (Int32.logand h 0xFFFFFFl) in
 		let str = Printf.sprintf "%ld.%d.%d.%d" (Int32.shift_right_logical h 24) (base lsr 16) ((base lsr 8) land 0xFF) (base land 0xFF) in
 		let str = Printf.sprintf "%ld.%d.%d.%d" (Int32.shift_right_logical h 24) (base lsr 16) ((base lsr 8) land 0xFF) (base land 0xFF) in
 		Unix.inet_addr_of_string str
 		Unix.inet_addr_of_string str
@@ -1027,15 +1030,15 @@ let std_lib =
 		);
 		);
 		"socket_recv_char", Fun1 (fun s ->
 		"socket_recv_char", Fun1 (fun s ->
 			match s with
 			match s with
-			| VAbstract (ASocket s) -> 
+			| VAbstract (ASocket s) ->
 				let buf = String.make 1 '\000' in
 				let buf = String.make 1 '\000' in
-				ignore(Unix.recv s buf 0 1 []);	
+				ignore(Unix.recv s buf 0 1 []);
 				VInt (int_of_char (String.unsafe_get buf 0))
 				VInt (int_of_char (String.unsafe_get buf 0))
 			| _ -> error()
 			| _ -> error()
 		);
 		);
 		"socket_write", Fun2 (fun s str ->
 		"socket_write", Fun2 (fun s str ->
 			match s, str with
 			match s, str with
-			| VAbstract (ASocket s), VString str -> 
+			| VAbstract (ASocket s), VString str ->
 				let pos = ref 0 in
 				let pos = ref 0 in
 				let len = ref (String.length str) in
 				let len = ref (String.length str) in
 				while !len > 0 do
 				while !len > 0 do
@@ -1048,7 +1051,7 @@ let std_lib =
 		);
 		);
 		"socket_read", Fun1 (fun s ->
 		"socket_read", Fun1 (fun s ->
 			match s with
 			match s with
-			| VAbstract (ASocket s) -> 
+			| VAbstract (ASocket s) ->
 				let tmp = String.make 1024 '\000' in
 				let tmp = String.make 1024 '\000' in
 				let buf = Buffer.create 0 in
 				let buf = Buffer.create 0 in
 				let rec loop() =
 				let rec loop() =
@@ -1106,7 +1109,7 @@ let std_lib =
 		);
 		);
 		"socket_shutdown", Fun3 (fun s r w ->
 		"socket_shutdown", Fun3 (fun s r w ->
 			match s, r, w with
 			match s, r, w with
-			| VAbstract (ASocket s), VBool r, VBool w ->				
+			| VAbstract (ASocket s), VBool r, VBool w ->
 				Unix.shutdown s (match r, w with true, true -> SHUTDOWN_ALL | true, false -> SHUTDOWN_RECEIVE | false, true -> SHUTDOWN_SEND | _ -> error());
 				Unix.shutdown s (match r, w with true, true -> SHUTDOWN_ALL | true, false -> SHUTDOWN_RECEIVE | false, true -> SHUTDOWN_SEND | _ -> error());
 				VNull
 				VNull
 			| _ -> error()
 			| _ -> error()
@@ -1540,7 +1543,7 @@ let macro_lib =
 		);
 		);
 		"signature", Fun1 (fun v ->
 		"signature", Fun1 (fun v ->
 			let cache = ref [] in
 			let cache = ref [] in
-			let rec loop v = 
+			let rec loop v =
 				match v with
 				match v with
 				| VNull | VBool _ | VInt _ | VFloat _ | VString _ | VAbstract _ -> v
 				| VNull | VBool _ | VInt _ | VFloat _ | VString _ | VAbstract _ -> v
 				| _ ->
 				| _ ->
@@ -1578,6 +1581,9 @@ let macro_lib =
 			let v = loop v in
 			let v = loop v in
 			VString (Digest.to_hex (Digest.string (Marshal.to_string v [Marshal.Closures])))
 			VString (Digest.to_hex (Digest.string (Marshal.to_string v [Marshal.Closures])))
 		);
 		);
+		"eval", Fun1 (fun v ->
+			encode_type ((get_ctx()).curapi.eval (decode_expr v))
+		);
 	]
 	]
 
 
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
@@ -2502,126 +2508,6 @@ let encode_expr e =
 	in
 	in
 	loop e
 	loop e
 
 
-(* ---------------------------------------------------------------------- *)
-(* TYPE ENCODING *)
-
-let encode_ref v convert tostr =
-	enc_obj [
-		"get", VFunction (Fun0 (fun() -> convert v));
-		"__string", VFunction (Fun0 (fun() -> VString (tostr())));
-		"toString", VFunction (Fun0 (fun() -> enc_string (tostr())));
-	]
-
-let encode_pmap convert m =
-	let h = Hashtbl.create 0 in
-	PMap.iter (fun k v -> Hashtbl.add h (VString k) (convert v)) m;
-	enc_hash h
-
-let rec encode_tenum e =
-	enc_obj [
-		"pack", enc_array (List.map enc_string (fst e.e_path));
-		"name", enc_string (snd e.e_path);
-		"pos", encode_pos e.e_pos;
-		"isPrivate", VBool e.e_private;
-		"isExtern", VBool e.e_extern;
-		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) e.e_types);
-		"contructs", encode_pmap encode_efield e.e_constrs;
-		"names", enc_array (List.map enc_string e.e_names);
-	]
-
-and encode_efield f =
-	enc_obj [
-		"name", enc_string f.ef_name;
-		"type", encode_type f.ef_type;
-		"pos", encode_pos f.ef_pos;
-		"index", VInt f.ef_index;
-	]
-
-and encode_cfield f =
-	enc_obj [
-		"name", enc_string f.cf_name;
-		"type", encode_type f.cf_type;
-		"isPublic", VBool f.cf_public;
-		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) f.cf_params);
-	]
-
-and encode_tclass c =
-	enc_obj [
-		"pack", enc_array (List.map enc_string (fst c.cl_path));
-		"name", enc_string (snd c.cl_path);
-		"pos", encode_pos c.cl_pos;
-		"isPrivate", VBool c.cl_private;
-		"isExtern", VBool c.cl_extern;
-		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) c.cl_types);
-		"isInterface", VBool c.cl_interface;
-		"superClass", (match c.cl_super with
-			| None -> VNull
-			| Some (c,pl) -> enc_obj ["t",encode_clref c;"params",encode_tparams pl]
-		);
-		"interfaces", enc_array (List.map (fun (c,pl) -> enc_obj ["t",encode_clref c;"params",encode_tparams pl]) c.cl_implements);
-		"fields", encode_ref c.cl_fields (encode_pmap encode_cfield) (fun() -> "class fields");
-		"statics", encode_ref c.cl_statics (encode_pmap encode_cfield) (fun() -> "class fields");
-		"constructor", (match c.cl_constructor with None -> VNull | Some c -> encode_ref c encode_cfield (fun() -> "constructor"));
-	]
-
-and encode_ttype t =
-	enc_obj [
-		"pack", enc_array (List.map enc_string (fst t.t_path));
-		"name", enc_string (snd t.t_path);
-		"pos", encode_pos t.t_pos;
-		"isPrivate", VBool t.t_private;
-		"isExtern", VBool false;
-		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) t.t_types);
-		"type", encode_type t.t_type;
-	]
-
-and encode_tanon a =
-	enc_obj [
-		"fields", encode_pmap encode_cfield a.a_fields;
-	]
-
-and encode_tparams pl =
-	enc_array (List.map encode_type pl)
-
-and encode_clref c =
-	encode_ref c encode_tclass (fun() -> s_type_path c.cl_path)
-
-and encode_type t =
-	let rec loop = function
-		| TMono r ->
-			(match !r with
-			| None -> 0, []
-			| Some t -> loop t)
-		| TEnum (e, pl) ->
-			1 , [encode_ref e encode_tenum (fun() -> s_type_path e.e_path); encode_tparams pl]
-		| TInst (c, pl) ->
-			2 , [encode_clref c; encode_tparams pl]
-		| TType (t,pl) ->
-			3 , [encode_ref t encode_ttype (fun() -> s_type_path t.t_path); encode_tparams pl]
-		| TFun (pl,ret) ->
-			let pl = List.map (fun (n,o,t) ->
-				enc_obj [
-					"name",enc_string n;
-					"opt",VBool o;
-					"t",encode_type t
-				]
-			) pl in
-			4 , [enc_array pl; encode_type ret]
-		| TAnon a ->
-			5, [encode_ref a encode_tanon (fun() -> "<anonymous>")]
-		| TDynamic tsub as t ->
-			if t == t_dynamic then
-				6, [VNull]
-			else
-				6, [encode_type tsub]
-		| TLazy f ->
-			loop ((!f)())
-	in
-	let tag, pl = loop t in
-	enc_enum IType tag pl
-
-;;encode_type_ref := encode_type;;
-
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
 (* EXPR DECODING *)
 (* EXPR DECODING *)
 
 
@@ -2839,4 +2725,158 @@ let decode_expr v =
 	in
 	in
 	loop v
 	loop v
 
 
-;;encode_expr_ref := encode_expr;;
+(* ---------------------------------------------------------------------- *)
+(* TYPE ENCODING *)
+
+let encode_ref v convert tostr =
+	enc_obj [
+		"get", VFunction (Fun0 (fun() -> convert v));
+		"__string", VFunction (Fun0 (fun() -> VString (tostr())));
+		"toString", VFunction (Fun0 (fun() -> enc_string (tostr())));
+	]
+
+let encode_pmap convert m =
+	let h = Hashtbl.create 0 in
+	PMap.iter (fun k v -> Hashtbl.add h (VString k) (convert v)) m;
+	enc_hash h
+
+let encode_meta m set =
+	let meta = ref m in
+	enc_obj [
+		"get", VFunction (Fun0 (fun() ->
+			enc_array (List.map (fun (m,ml) ->
+				enc_obj [
+					"name", enc_string m;
+					"params", enc_array (List.map encode_expr ml);
+				]
+			) (!meta))
+		));
+		"add", VFunction (Fun2 (fun k vl ->
+			(try
+				let el = List.map decode_expr (dec_array vl) in
+				meta := (dec_string k, el) :: !meta;
+				set (!meta)
+			with Invalid_expr ->
+				failwith "Invalid expression");
+			VNull
+		));
+		"remove", VFunction (Fun1 (fun k ->
+			let k = (try dec_string k with Invalid_expr -> raise Builtin_error) in
+			meta := List.filter (fun (m,_) -> m <> k) (!meta);
+			set (!meta);
+			VNull
+		));
+	]
+
+let rec encode_tenum e =
+	enc_obj [
+		"pack", enc_array (List.map enc_string (fst e.e_path));
+		"name", enc_string (snd e.e_path);
+		"pos", encode_pos e.e_pos;
+		"isPrivate", VBool e.e_private;
+		"isExtern", VBool e.e_extern;
+		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) e.e_types);
+		"contructs", encode_pmap encode_efield e.e_constrs;
+		"names", enc_array (List.map enc_string e.e_names);
+		"meta", encode_meta e.e_meta (fun m -> e.e_meta <- m);
+	]
+
+and encode_efield f =
+	enc_obj [
+		"name", enc_string f.ef_name;
+		"type", encode_type f.ef_type;
+		"pos", encode_pos f.ef_pos;
+		"index", VInt f.ef_index;
+		"meta", encode_meta f.ef_meta (fun m -> f.ef_meta <- m);
+	]
+
+and encode_cfield f =
+	enc_obj [
+		"name", enc_string f.cf_name;
+		"type", encode_type f.cf_type;
+		"isPublic", VBool f.cf_public;
+		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) f.cf_params);
+		"meta", encode_meta f.cf_meta (fun m -> f.cf_meta <- m);
+	]
+
+and encode_tclass c =
+	enc_obj [
+		"pack", enc_array (List.map enc_string (fst c.cl_path));
+		"name", enc_string (snd c.cl_path);
+		"pos", encode_pos c.cl_pos;
+		"isPrivate", VBool c.cl_private;
+		"isExtern", VBool c.cl_extern;
+		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) c.cl_types);
+		"isInterface", VBool c.cl_interface;
+		"superClass", (match c.cl_super with
+			| None -> VNull
+			| Some (c,pl) -> enc_obj ["t",encode_clref c;"params",encode_tparams pl]
+		);
+		"interfaces", enc_array (List.map (fun (c,pl) -> enc_obj ["t",encode_clref c;"params",encode_tparams pl]) c.cl_implements);
+		"fields", encode_ref c.cl_fields (encode_pmap encode_cfield) (fun() -> "class fields");
+		"statics", encode_ref c.cl_statics (encode_pmap encode_cfield) (fun() -> "class fields");
+		"constructor", (match c.cl_constructor with None -> VNull | Some c -> encode_ref c encode_cfield (fun() -> "constructor"));
+		"meta", encode_meta c.cl_meta (fun m -> c.cl_meta <- m);
+	]
+
+and encode_ttype t =
+	enc_obj [
+		"pack", enc_array (List.map enc_string (fst t.t_path));
+		"name", enc_string (snd t.t_path);
+		"pos", encode_pos t.t_pos;
+		"isPrivate", VBool t.t_private;
+		"isExtern", VBool false;
+		"params", enc_array (List.map (fun (n,t) -> enc_obj ["name",enc_string n;"t",encode_type t]) t.t_types);
+		"type", encode_type t.t_type;
+		"meta", encode_meta t.t_meta (fun m -> t.t_meta <- m);
+	]
+
+and encode_tanon a =
+	enc_obj [
+		"fields", encode_pmap encode_cfield a.a_fields;
+	]
+
+and encode_tparams pl =
+	enc_array (List.map encode_type pl)
+
+and encode_clref c =
+	encode_ref c encode_tclass (fun() -> s_type_path c.cl_path)
+
+and encode_type t =
+	let rec loop = function
+		| TMono r ->
+			(match !r with
+			| None -> 0, []
+			| Some t -> loop t)
+		| TEnum (e, pl) ->
+			1 , [encode_ref e encode_tenum (fun() -> s_type_path e.e_path); encode_tparams pl]
+		| TInst (c, pl) ->
+			2 , [encode_clref c; encode_tparams pl]
+		| TType (t,pl) ->
+			3 , [encode_ref t encode_ttype (fun() -> s_type_path t.t_path); encode_tparams pl]
+		| TFun (pl,ret) ->
+			let pl = List.map (fun (n,o,t) ->
+				enc_obj [
+					"name",enc_string n;
+					"opt",VBool o;
+					"t",encode_type t
+				]
+			) pl in
+			4 , [enc_array pl; encode_type ret]
+		| TAnon a ->
+			5, [encode_ref a encode_tanon (fun() -> "<anonymous>")]
+		| TDynamic tsub as t ->
+			if t == t_dynamic then
+				6, [VNull]
+			else
+				6, [encode_type tsub]
+		| TLazy f ->
+			loop ((!f)())
+	in
+	let tag, pl = loop t in
+	enc_enum IType tag pl
+
+;;
+encode_type_ref := encode_type;
+encode_expr_ref := encode_expr;
+decode_expr_ref := decode_expr

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

@@ -98,6 +98,13 @@ class Context {
 		return new String(load("signature", 1)(v));
 		return new String(load("signature", 1)(v));
 	}
 	}
 	
 	
+	/**
+		Evaluate the type a given expression would have in the context of the current macro call.
+	**/
+	public static function eval( e : Expr ) : Type {
+		return load("eval", 1)(e);
+	}
+	
 	static function load( f, nargs ) : Dynamic {
 	static function load( f, nargs ) : Dynamic {
 		#if macro
 		#if macro
 		return neko.Lib.load("macro", f, nargs);
 		return neko.Lib.load("macro", f, nargs);

+ 9 - 3
std/haxe/macro/Type.hx

@@ -51,7 +51,7 @@ typedef BaseType = {
 	var isPrivate : Bool;
 	var isPrivate : Bool;
 	var isExtern : Bool;
 	var isExtern : Bool;
 	var params : Array<{ name : String, t : Type }>;
 	var params : Array<{ name : String, t : Type }>;
-	//var meta : Metadata;
+	var meta : Metadata;
 }
 }
 
 
 typedef ClassField = {
 typedef ClassField = {
@@ -59,7 +59,7 @@ typedef ClassField = {
 	var type : Type;
 	var type : Type;
 	var isPublic : Bool;
 	var isPublic : Bool;
 	var params : Array<{ name : String, t : Type }>;
 	var params : Array<{ name : String, t : Type }>;
-	//var meta : Metadata;
+	var meta : Metadata;
 	//var kind : FieldKind;
 	//var kind : FieldKind;
 }
 }
 
 
@@ -79,7 +79,7 @@ typedef EnumField = {
 	var name : String;
 	var name : String;
 	var type : Type;
 	var type : Type;
 	var pos : Expr.Position;
 	var pos : Expr.Position;
-	//var meta : Metadata;
+	var meta : Metadata;
 	var index : Int;
 	var index : Int;
 }
 }
 
 
@@ -91,3 +91,9 @@ typedef EnumType = {> BaseType,
 typedef DefType = {> BaseType,
 typedef DefType = {> BaseType,
 	var type : Type;
 	var type : Type;
 }
 }
+
+typedef Metadata = {
+	function get() : Array<{ name : String, params : Array<Expr> }>;
+	function add( name : String, params : Array<Expr> ) : Void;
+	function remove( name : String ) : Void;
+}

+ 12 - 12
type.ml

@@ -110,7 +110,7 @@ and texpr_expr =
 	| TBreak
 	| TBreak
 	| TContinue
 	| TContinue
 	| TThrow of texpr
 	| TThrow of texpr
-	| TCast of texpr * module_type option	
+	| TCast of texpr * module_type option
 
 
 and texpr = {
 and texpr = {
 	eexpr : texpr_expr;
 	eexpr : texpr_expr;
@@ -123,7 +123,7 @@ and tclass_field = {
 	mutable cf_type : t;
 	mutable cf_type : t;
 	cf_public : bool;
 	cf_public : bool;
 	mutable cf_doc : Ast.documentation;
 	mutable cf_doc : Ast.documentation;
-	cf_meta : metadata;
+	mutable cf_meta : metadata;
 	cf_kind : field_kind;
 	cf_kind : field_kind;
 	cf_params : (string * t) list;
 	cf_params : (string * t) list;
 	mutable cf_expr : texpr option;
 	mutable cf_expr : texpr option;
@@ -137,7 +137,7 @@ and tclass_kind =
 	| KGeneric
 	| KGeneric
 	| KGenericInstance of tclass * tparams
 	| KGenericInstance of tclass * tparams
 
 
-and metadata = unit -> (string * texpr list) list
+and metadata = (string * Ast.expr list) list
 
 
 and tclass = {
 and tclass = {
 	mutable cl_path : path;
 	mutable cl_path : path;
@@ -167,16 +167,16 @@ and tenum_field = {
 	ef_type : t;
 	ef_type : t;
 	ef_pos : Ast.pos;
 	ef_pos : Ast.pos;
 	ef_doc : Ast.documentation;
 	ef_doc : Ast.documentation;
-	ef_meta : metadata;
 	ef_index : int;
 	ef_index : int;
+	mutable ef_meta : metadata;
 }
 }
 
 
 and tenum = {
 and tenum = {
 	e_path : path;
 	e_path : path;
 	e_pos : Ast.pos;
 	e_pos : Ast.pos;
 	e_doc : Ast.documentation;
 	e_doc : Ast.documentation;
-	e_meta : metadata;
 	e_private : bool;
 	e_private : bool;
+	mutable e_meta : metadata;
 	mutable e_extern : bool;
 	mutable e_extern : bool;
 	mutable e_types : (string * t) list;
 	mutable e_types : (string * t) list;
 	mutable e_constrs : (string , tenum_field) PMap.t;
 	mutable e_constrs : (string , tenum_field) PMap.t;
@@ -187,8 +187,8 @@ and tdef = {
 	t_path : path;
 	t_path : path;
 	t_pos : Ast.pos;
 	t_pos : Ast.pos;
 	t_doc : Ast.documentation;
 	t_doc : Ast.documentation;
-	t_meta : metadata;
 	t_private : bool;
 	t_private : bool;
+	mutable t_meta : metadata;
 	mutable t_types : (string * t) list;
 	mutable t_types : (string * t) list;
 	mutable t_type : t;
 	mutable t_type : t;
 }
 }
@@ -225,7 +225,7 @@ let mk_class path pos =
 		cl_path = path;
 		cl_path = path;
 		cl_pos = pos;
 		cl_pos = pos;
 		cl_doc = None;
 		cl_doc = None;
-		cl_meta = (fun() -> []);
+		cl_meta = [];
 		cl_private = false;
 		cl_private = false;
 		cl_kind = KNormal;
 		cl_kind = KNormal;
 		cl_extern = false;
 		cl_extern = false;
@@ -244,7 +244,7 @@ let mk_class path pos =
 		cl_overrides = [];
 		cl_overrides = [];
 	}
 	}
 
 
-let null_class = 
+let null_class =
 	let c = mk_class ([],"") Ast.null_pos in
 	let c = mk_class ([],"") Ast.null_pos in
 	c.cl_private <- true;
 	c.cl_private <- true;
 	c
 	c
@@ -528,8 +528,8 @@ let invalid_visibility n = Invalid_visibility n
 let has_no_field t n = Has_no_field (t,n)
 let has_no_field t n = Has_no_field (t,n)
 let has_extra_field t n = Has_extra_field (t,n)
 let has_extra_field t n = Has_extra_field (t,n)
 let error l = raise (Unify_error l)
 let error l = raise (Unify_error l)
-let has_meta m ml = List.mem (m,[]) (ml())
-let no_meta() = []
+let has_meta m ml = List.exists (fun (m2,_) -> m = m2) ml
+let no_meta = []
 
 
 (*
 (*
 	we can restrict access as soon as both are runtime-compatible
 	we can restrict access as soon as both are runtime-compatible
@@ -552,7 +552,7 @@ let unify_kind k1 k2 =
 			| AccNormal, _, MethNormal -> true
 			| AccNormal, _, MethNormal -> true
 			| AccNormal, AccNormal, MethDynamic -> true
 			| AccNormal, AccNormal, MethDynamic -> true
 			| _ -> false)
 			| _ -> false)
-		| Method m, Var v -> 
+		| Method m, Var v ->
 			(match m with
 			(match m with
 			| MethDynamic -> direct_access v.v_read && direct_access v.v_write
 			| MethDynamic -> direct_access v.v_read && direct_access v.v_write
 			| MethMacro -> false
 			| MethMacro -> false
@@ -590,7 +590,7 @@ let rec type_eq param a b =
 		| Some t -> type_eq param a t)
 		| Some t -> type_eq param a t)
 	| TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 ->
 	| TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 ->
 		List.iter2 (type_eq param) tl1 tl2
 		List.iter2 (type_eq param) tl1 tl2
-	| TType (t,tl) , _ when param <> EqCoreType ->		
+	| TType (t,tl) , _ when param <> EqCoreType ->
 		type_eq param (apply_params t.t_types tl t.t_type) b
 		type_eq param (apply_params t.t_types tl t.t_type) b
 	| _ , TType (t,tl) when param <> EqCoreType ->
 	| _ , TType (t,tl) when param <> EqCoreType ->
 		if List.exists (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) (!eq_stack) then
 		if List.exists (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) (!eq_stack) then

+ 12 - 51
typeload.ml

@@ -25,21 +25,6 @@ open Typecore
 let has_meta m (ml:Ast.metadata) =
 let has_meta m (ml:Ast.metadata) =
 	List.exists (fun(m2,_) -> m = m2) ml
 	List.exists (fun(m2,_) -> m = m2) ml
 
 
-let type_constant ctx c p =
-	match c with
-	| Int s ->
-		if String.length s > 10 && String.sub s 0 2 = "0x" then error "Invalid hexadecimal integer" p;
-		(try
-			mk (TConst (TInt (Int32.of_string s))) ctx.t.tint p
-		with
-			_ -> mk (TConst (TFloat s)) ctx.t.tfloat p)
-	| Float f -> mk (TConst (TFloat f)) ctx.t.tfloat p
-	| String s -> mk (TConst (TString s)) ctx.t.tstring p
-	| Ident "true" -> mk (TConst (TBool true)) ctx.t.tbool p
-	| Ident "false" -> mk (TConst (TBool false)) ctx.t.tbool p
-	| Ident "null" -> mk (TConst TNull) (ctx.t.tnull (mk_mono())) p
-	| _ -> assert false
-
 let type_function_param ctx t e opt p =
 let type_function_param ctx t e opt p =
 	match e with
 	match e with
 	| None ->
 	| None ->
@@ -119,10 +104,10 @@ let rec load_instance ctx t p allow_no_params =
 				match follow t with
 				match follow t with
 				| TInst (c,_) ->
 				| TInst (c,_) ->
 					let t = mk_mono() in
 					let t = mk_mono() in
-					if c.cl_implements <> [] then delay ctx (fun() -> 
+					if c.cl_implements <> [] then delay ctx (fun() ->
 						List.iter (fun (i,tl) -> unify ctx t (TInst(i,tl)) p) c.cl_implements
 						List.iter (fun (i,tl) -> unify ctx t (TInst(i,tl)) p) c.cl_implements
 					);
 					);
-					t;					
+					t;
 				| _ -> assert false
 				| _ -> assert false
 			) types)
 			) types)
 		else if path = ([],"Dynamic") then
 		else if path = ([],"Dynamic") then
@@ -544,39 +529,8 @@ let type_function ctx args ret static constr f p =
 	ctx.opened <- old_opened;
 	ctx.opened <- old_opened;
 	e , fargs
 	e , fargs
 
 
-let type_meta ctx meta =
-	let mcache = ref None in
-	let notconst e = error "Metadata should be constant" e.epos in
-	let rec chk_const e =
-		match e.eexpr with
-		| TConst c ->
-			(match c with
-			| TInt _ | TFloat _ | TString _ | TBool _ | TNull -> ()
-			| _ -> notconst e)
-		| TParenthesis e ->
-			chk_const e
-		| TObjectDecl el ->
-			List.iter (fun (_,e) -> chk_const e) el
-		| TArrayDecl el ->
-			List.iter chk_const el
-		| _ ->
-			notconst e
-	in
-	let mk_meta (m,el) =
-		let el = List.map (fun e -> type_expr ctx e true) el in
-		List.iter chk_const el;
-		m, el
-	in
-	let get_meta() =
-		match !mcache with
-		| None ->
-			let ml = List.map mk_meta meta in
-			mcache := Some ml;
-			ml
-		| Some ml -> ml
-	in
-	delay ctx (fun() -> ignore(get_meta()));
-	get_meta
+(* nothing *)
+let type_meta ctx meta = meta
 
 
 let init_core_api ctx c =
 let init_core_api ctx c =
 	let ctx2 = (match ctx.g.core_api with
 	let ctx2 = (match ctx.g.core_api with
@@ -1111,7 +1065,14 @@ let type_module ctx m tdecls loadp =
 			let names = ref [] in
 			let names = ref [] in
 			let index = ref 0 in
 			let index = ref 0 in
 			let rec loop = function
 			let rec loop = function
-				| (":build",(EConst (String s),p) :: el) :: _ ->
+				| (":build",[ECall (epath,el),p]) :: _ ->
+					let rec loop (e,p) =
+						match e with
+						| EConst (Ident i) | EConst (Type i) -> i
+						| EField (e,f) | EType (e,f) -> loop e ^ "." ^ f
+						| _ -> error "Build call parameter must be a class path" p
+					in
+					let s = loop epath in
 					if ctx.in_macro then error "You cannot used :build inside a macro : make sure that your enum is not used in macro" p;
 					if ctx.in_macro then error "You cannot used :build inside a macro : make sure that your enum is not used in macro" p;
 					(match apply_macro ctx s el p with
 					(match apply_macro ctx s el p with
 					| None -> error "Enum build failure" p
 					| None -> error "Enum build failure" p

+ 10 - 6
typer.ml

@@ -501,7 +501,7 @@ let rec type_field ctx e i p mode =
 			| Some t ->
 			| Some t ->
 				let t = apply_params c.cl_types params t in
 				let t = apply_params c.cl_types params t in
 				if mode = MGet && PMap.mem "resolve" c.cl_fields then
 				if mode = MGet && PMap.mem "resolve" c.cl_fields then
-					AKExpr (make_call ctx (mk (TField (e,"resolve")) (tfun [ctx.t.tstring] t) p) [Typeload.type_constant ctx (String i) p] t p)
+					AKExpr (make_call ctx (mk (TField (e,"resolve")) (tfun [ctx.t.tstring] t) p) [Codegen.type_constant ctx.com (String i) p] t p)
 				else
 				else
 					AKExpr (mk (TField (e,i)) t p)
 					AKExpr (mk (TField (e,i)) t p)
 			| None ->
 			| None ->
@@ -1168,7 +1168,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let t = Typeload.load_core_type ctx "EReg" in
 		let t = Typeload.load_core_type ctx "EReg" in
 		mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[str;opt])) t p
 		mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[str;opt])) t p
 	| EConst c ->
 	| EConst c ->
-		Typeload.type_constant ctx c p
+		Codegen.type_constant ctx.com c p
     | EBinop (op,e1,e2) ->
     | EBinop (op,e1,e2) ->
 		type_binop ctx op e1 e2 p
 		type_binop ctx op e1 e2 p
 	| EBlock [] when need_val ->
 	| EBlock [] when need_val ->
@@ -1817,12 +1817,12 @@ let make_macro_api ctx p =
 				None
 				None
 		);
 		);
 		Interp.parse_string = (fun s p ->
 		Interp.parse_string = (fun s p ->
-			let head = "class X{static function main(){" in
+			let head = "class X{static function main() " in
 			let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in
 			let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in
-			let s = head ^ s ^ "; }}" in
+			let s = head ^ s ^ "}" in
 			let old = Lexer.save() in
 			let old = Lexer.save() in
 			Lexer.init p.pfile;
 			Lexer.init p.pfile;
-			let _, decls = try 
+			let _, decls = try
 				Parser.parse ctx.com (Lexing.from_string s)
 				Parser.parse ctx.com (Lexing.from_string s)
 			with Parser.Error (e,_) ->
 			with Parser.Error (e,_) ->
 				failwith (Parser.error_msg e)
 				failwith (Parser.error_msg e)
@@ -1831,9 +1831,13 @@ let make_macro_api ctx p =
 			in
 			in
 			Lexer.restore old;
 			Lexer.restore old;
 			match decls with
 			match decls with
-			| [EClass { d_data = [FFun ("main",_,_,_,_,{ f_expr = e}),_] },_] -> e
+			| [EClass { d_data = [FFun ("main",_,_,_,_,{ f_expr = e }),_] },_] -> e
 			| _ -> assert false
 			| _ -> assert false
 		);
 		);
+		Interp.eval = (fun e ->
+			let e = (try type_expr ctx ~need_val:true e with Error (msg,_) -> failwith (error_msg msg)) in
+			e.etype
+		);
 	}
 	}
 
 
 let type_macro ctx cpath f el p =
 let type_macro ctx cpath f el p =