initial EMeta support, no syntax yet (fixed issue #1208)

ast.ml

@@ -194,6 +194,7 @@ and expr_def =
 	| EDisplayNew of type_path
 	| ETernary of expr * expr * expr
 	| ECheckType of expr * complex_type
+	| EMeta of metadata_entry * expr
 
 and expr = expr_def * pos
 
@@ -205,7 +206,8 @@ and type_param = {
 
 and documentation = string option
 
-and metadata = (string * expr list * pos) list
+and metadata_entry = (string * expr list * pos)
+and metadata = metadata_entry list
 
 and access =
 	| APublic
@@ -535,6 +537,7 @@ let map_expr loop (e,p) =
 	| EDisplayNew t -> EDisplayNew (tpath t)
 	| ETernary (e1,e2,e3) -> ETernary (loop e1,loop e2,loop e3)
 	| ECheckType (e,t) -> ECheckType (loop e, ctype t)
+	| EMeta (m,e) -> EMeta(m, loop e)
 	) in
 	(e,p)
 
@@ -622,64 +625,64 @@ let reify in_macro =
 		match t with
 		| CTPath { tpackage = []; tparams = []; tsub = None; tname = n } when n.[0] = '$' ->
 			to_string n p
-		| CTPath t -> ct "TPath" [to_tpath t p]
-		| CTFunction (args,ret) -> ct "TFunction" [to_array to_ctype args p; to_ctype ret p]
-		| CTAnonymous fields -> ct "TAnonymous" [to_array to_cfield fields p]
-		| CTParent t -> ct "TParent" [to_ctype t p]
-		| CTExtend (t,fields) -> ct "TExtend" [to_tpath t p; to_array to_cfield fields p]
-		| CTOptional t -> ct "TOptional" [to_ctype t p]
-	and to_fun f p =
-		let farg (n,o,t,e) p =
-			let fields = [
-				"name", to_string n p;
-				"opt", to_bool o p;
-				"type", to_opt to_ctype t p;					
-			] in
-			to_obj (match e with None -> fields | Some e -> fields @ ["value",to_expr e p]) p
-		in
-		let rec fparam t p =
-			let fields = [
-				"name", to_string t.tp_name p;
-				"constraints", to_array to_ctype t.tp_constraints p;
-				"params", to_array fparam t.tp_params p;
-			] in
-			to_obj fields p
-		in
-		let fields = [
-			("args",to_array farg f.f_args p);
-			("ret",to_opt to_ctype f.f_type p);
-			("expr",to_opt to_expr f.f_expr p);
-			("params",to_array fparam f.f_params p);
-		] in
-		to_obj fields p
-	and to_cfield f p =
-		let p = f.cff_pos in
-		let to_access a p = 
-			let n = (match a with
+		| CTPath t -> ct "TPath" [to_tpath t p]
+		| CTFunction (args,ret) -> ct "TFunction" [to_array to_ctype args p; to_ctype ret p]
+		| CTAnonymous fields -> ct "TAnonymous" [to_array to_cfield fields p]
+		| CTParent t -> ct "TParent" [to_ctype t p]
+		| CTExtend (t,fields) -> ct "TExtend" [to_tpath t p; to_array to_cfield fields p]
+		| CTOptional t -> ct "TOptional" [to_ctype t p]
+	and to_fun f p =
+		let farg (n,o,t,e) p =
+			let fields = [
+				"name", to_string n p;
+				"opt", to_bool o p;
+				"type", to_opt to_ctype t p;					
+			] in
+			to_obj (match e with None -> fields | Some e -> fields @ ["value",to_expr e p]) p
+		in
+		let rec fparam t p =
+			let fields = [
+				"name", to_string t.tp_name p;
+				"constraints", to_array to_ctype t.tp_constraints p;
+				"params", to_array fparam t.tp_params p;
+			] in
+			to_obj fields p
+		in
+		let fields = [
+			("args",to_array farg f.f_args p);
+			("ret",to_opt to_ctype f.f_type p);
+			("expr",to_opt to_expr f.f_expr p);
+			("params",to_array fparam f.f_params p);
+		] in
+		to_obj fields p
+	and to_cfield f p =
+		let p = f.cff_pos in
+		let to_access a p = 
+			let n = (match a with
 			| APublic -> "APublic"
 			| APrivate -> "APrivate"
 			| AStatic -> "AStatic"
 			| AOverride -> "AOverride"
 			| ADynamic -> "ADynamic"
 			| AInline -> "AInline"
-			) in
-			mk_enum "Access" n [] p
-		in
-		let to_kind k =
-			let n, vl = (match k with
+			) in
+			mk_enum "Access" n [] p
+		in
+		let to_kind k =
+			let n, vl = (match k with
 				| FVar (ct,e) -> "FVar", [to_opt to_ctype ct p;to_opt to_expr e p]
 				| FFun f -> "FFun", [to_fun f p]
-				| FProp (get,set,t,e) -> "FProp", [to_string get p; to_string set p; to_opt to_ctype t p; to_opt to_expr e p]
-			) in
-			mk_enum "FieldType" n vl p
-		in
-		let fields = [
-			Some ("name", to_string f.cff_name p);
-			(match f.cff_doc with None -> None | Some s -> Some ("doc", to_string s p));
-			(match f.cff_access with [] -> None | l -> Some ("access", to_array to_access l p));
-			Some ("kind", to_kind f.cff_kind);
-			Some ("pos", to_pos f.cff_pos);
-			(match f.cff_meta with [] -> None | l -> Some ("meta", to_meta f.cff_meta p));
+				| FProp (get,set,t,e) -> "FProp", [to_string get p; to_string set p; to_opt to_ctype t p; to_opt to_expr e p]
+			) in
+			mk_enum "FieldType" n vl p
+		in
+		let fields = [
+			Some ("name", to_string f.cff_name p);
+			(match f.cff_doc with None -> None | Some s -> Some ("doc", to_string s p));
+			(match f.cff_access with [] -> None | l -> Some ("access", to_array to_access l p));
+			Some ("kind", to_kind f.cff_kind);
+			Some ("pos", to_pos f.cff_pos);
+			(match f.cff_meta with [] -> None | l -> Some ("meta", to_meta f.cff_meta p));
 		] in
 		let fields = List.rev (List.fold_left (fun acc v -> match v with None -> acc | Some e -> e :: acc) [] fields) in
 		to_obj fields p
@@ -795,5 +798,7 @@ let reify in_macro =
 			expr "ETernary" [loop e1;loop e2;loop e3]
 		| ECheckType (e1,ct) ->
 			expr "ECheckType" [loop e1; to_ctype ct p]
+		| EMeta ((m,ml,p),e1) ->
+			expr "EMeta" [to_obj [("name",to_string m p);("params",to_expr_array ml p);("pos",to_pos p)] p;loop e1]
 	in
 	(fun e -> to_expr e (snd e)), to_ctype

interp.ml

@@ -3520,14 +3520,15 @@ and encode_access a =
 	in
 	enc_enum IAccess tag []
 
+and encode_meta_entry (m,ml,p) =
+	enc_obj [
+		"name", enc_string m;
+		"params", enc_array (List.map encode_expr ml);
+		"pos", encode_pos p;
+	]
+
 and encode_meta_content m =
-	enc_array (List.map (fun (m,ml,p) ->
-		enc_obj [
-			"name", enc_string m;
-			"params", enc_array (List.map encode_expr ml);
-			"pos", encode_pos p;
-		]
-	) m)
+	enc_array (List.map encode_meta_entry m)
 
 and encode_field (f:class_field) =
 	let tag, pl = match f.cff_kind with
@@ -3664,6 +3665,8 @@ and encode_expr e =
 				27, [loop econd;loop e1;loop e2]
 			| ECheckType (e,t) ->
 				28, [loop e; encode_ctype t]
+			| EMeta (m,e) ->
+				29, [encode_meta_entry m;loop e]
 		in
 		enc_obj [
 			"pos", encode_pos p;
@@ -3800,10 +3803,11 @@ and decode_access v =
 	| 5, [] -> AInline
 	| _ -> raise Invalid_expr
 
+and decode_meta_entry v =
+	(dec_string (field v "name"), List.map decode_expr (dec_array (field v "params")), decode_pos (field v "pos"))
+
 and decode_meta_content v =
-	List.map (fun v ->
-		(dec_string (field v "name"), List.map decode_expr (dec_array (field v "params")), decode_pos (field v "pos"))
-	) (dec_array v)
+	List.map decode_meta_entry (dec_array v)
 
 and decode_field v =
 	let fkind = match decode_enum (field v "kind") with
@@ -3915,7 +3919,9 @@ let decode_expr v =
 			ETernary (loop e1,loop e2,loop e3)
 		| 28, [e;t] ->
 			ECheckType (loop e, decode_ctype t)
-		| 29, [e;f] ->
+		| 29, [m;e] ->
+			EMeta (decode_meta_entry m,loop e)
+		| 30, [e;f] ->
 			EField (loop e, dec_string f) (*** deprecated EType, keep until haxe 3 **)
 		| _ ->
 			raise Invalid_expr

std/haxe/macro/Expr.hx

@@ -118,6 +118,7 @@ enum ExprDef {
 	EDisplayNew( t : TypePath );
 	ETernary( econd : Expr, eif : Expr, eelse : Expr );
 	ECheckType( e : Expr, t : ComplexType );
+	EMeta( s : MetadataEntry, e : Expr );
 	#if !haxe3
 	EType( e : Expr, field : String );
 	#end
@@ -164,7 +165,13 @@ typedef FunctionArg = {
 	@:optional var value : Null<Expr>;
 }
 
-typedef Metadata = Array<{ name : String, params : Array<Expr>, pos : Position }>;
+typedef MetadataEntry = {
+	name : String,
+	params : Array<Expr>,
+	pos : Position
+}
+
+typedef Metadata = Array<MetadataEntry>;
 
 typedef Field = {
 	var name : String;

typecore.ml

@@ -79,6 +79,7 @@ and typer = {
 	com : context;
 	t : basic_types;
 	g : typer_globals;
+	mutable meta : metadata;
 	(* variable *)
 	mutable pass : typer_pass;
 	(* per-module *)

typeload.ml

@@ -1783,6 +1783,7 @@ let type_module ctx m file tdecls p =
 			module_globals = PMap.empty;
 			wildcard_packages = [];
 		};
+		meta = [];
 		pass = PBuildModule;
 		on_error = (fun ctx msg p -> ctx.com.error msg p);
 		macro_depth = ctx.macro_depth;

typer.ml

@@ -191,6 +191,7 @@ let rec can_access ctx c cf stat =
 		| KTypeParameter tl ->
 			List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) tl
 		| _ -> false)
+	|| (has_meta ":privateAccess" ctx.meta)
 
 (* removes the first argument of the class field's function type and all its overloads *)
 let prepare_using_field cf = match cf.cf_type with
@@ -1729,6 +1730,12 @@ and type_expr_with_type_raise ?(print_error=true) ctx e t =
 				type_expr ctx e)
 	| ESwitch (e,cases,def) ->
 		type_switch ctx e cases def true t p
+	| EMeta(m,e) ->
+		let old = ctx.meta in
+		ctx.meta <- m :: ctx.meta;
+		let e = type_expr_with_type_raise ~print_error ctx e t in
+		ctx.meta <- old;
+		e
 	| _ ->
 		type_expr ctx e
 
@@ -2365,6 +2372,8 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let e = type_expr_with_type ctx e (Some t) in
 		unify ctx e.etype t e.epos;
 		if e.etype == t then e else mk (TCast (e,None)) t p
+	| EMeta _ ->
+		type_expr_with_type ctx (e,p) None
 
 and type_call ctx e el twith p =
 	match e, el with
@@ -2453,7 +2462,7 @@ and build_call ctx acc el twith p =
 			(match ctx.g.do_macro ctx MExpr c.cl_path f.cf_name el p with
 			| None -> (fun() -> type_expr ctx (EConst (Ident "null"),p))
 			| Some (EVars vl,p) -> (fun() -> type_vars ctx vl p true)
-			| Some e -> (fun() -> type_expr_with_type ctx e twith))
+			| Some e -> (fun() -> type_expr_with_type ctx (EMeta((":privateAccess",[],snd e),e),snd e) twith))
 		| _ ->
 			(* member-macro call : since we will make a static call, let's found the actual class and not its subclass *)
 			(match follow ethis.etype with
@@ -3250,6 +3259,7 @@ let rec create com =
 			module_globals = PMap.empty;
 			wildcard_packages = [];
 		};
+		meta = [];
 		pass = PBuildModule;
 		macro_depth = 0;
 		untyped = false;