added macro <expr> reification

ast.ml

@@ -193,6 +193,7 @@ and expr_def =
 	| EDisplayNew of type_path
 	| ETernary of expr * expr * expr
 	| ECheckType of expr * complex_type
+	| EMacro of expr
 
 and expr = expr_def * pos
 
@@ -516,5 +517,258 @@ 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)
+	| EMacro e -> EMacro (loop e)
 	) in
-	(e,p)
+	(e,p)
+
+let expr_to_value in_macro e =
+	let mk_enum ename n vl p =
+		let constr = (EConst (Ident n),p) in
+		match vl with
+		| [] -> constr
+		| _ -> (ECall (constr,vl),p)
+	in
+	let to_const c p =
+		let cst n v = mk_enum "Constant" n [EConst (String v),p] p in
+		match c with
+		| Int i -> cst "CInt" i
+		| String s -> cst "CString" s
+		| Float s -> cst "CFloat" s
+		| Ident s -> cst "CIdent" s
+		| Regexp (r,o) -> mk_enum "Constant" "CRegexp" [(EConst (String r),p);(EConst (String o),p)] p
+	in
+	let rec to_binop o p =
+		let op n = mk_enum "Binop" n [] p in
+		match o with
+		| OpAdd -> op "OpAdd"
+		| OpMult -> op "OpMult"
+		| OpDiv -> op "OpDiv" 
+		| OpSub -> op "OpSub"
+		| OpAssign -> op "OpAssign"
+		| OpEq -> op "OpEq"
+		| OpNotEq -> op "OpNotEq"
+		| OpGt -> op "OpGt"
+		| OpGte -> op "OpGte"
+		| OpLt -> op "OpLt"
+		| OpLte -> op "OpLte"
+		| OpAnd -> op "OpAnd"
+		| OpOr -> op "OpOr"
+		| OpXor -> op "OpXor"
+		| OpBoolAnd -> op "OpBoolAnd"
+		| OpBoolOr -> op "OpBoolOr"
+		| OpShl -> op "OpShl"
+		| OpShr -> op "OpShr"
+		| OpUShr -> op "OpUShr"
+		| OpMod -> op "OpMod"
+		| OpAssignOp o -> mk_enum "Binop" "OpAssignOp" [to_binop o p] p
+		| OpInterval -> op "OpInterval"
+	in
+	let to_string s p =
+		let len = String.length s in
+		if len > 0 && s.[0] = '$' then
+			(EConst (Ident (String.sub s 1 (len - 1))),p)
+		else
+			(EConst (String s),p)
+	in
+	let to_array f a p =
+		(EArrayDecl (List.map (fun s -> f s p) a),p)
+	in
+	let to_null p =
+		(EConst (Ident "null"),p)
+	in
+	let to_opt f v p =
+		match v with
+		| None -> to_null p
+		| Some v -> f v p
+	in
+	let to_bool o p =
+		(EConst (Ident (if o then "true" else "false")),p)
+	in
+	let to_obj fields p =
+		(EObjectDecl fields,p)
+	in
+	let rec to_tparam t p =
+		let n, v = (match t with
+			| TPType t -> "TPType", to_ctype t p
+			| TPExpr e -> "TPExpr", to_expr e p
+		) in
+		mk_enum "TypeParam" n [v] p
+	and to_tpath t p =
+		let fields = [
+			("pack", to_array to_string t.tpackage p);
+			("name", to_string t.tname p);
+			("params", to_array to_tparam t.tparams p);
+		] in
+		to_obj (match t.tsub with None -> fields | Some s -> fields @ ["sub",to_string s p]) p
+	and to_ctype t p =
+		let ct n vl = mk_enum "ComplexType" n vl p in
+		match t 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 fparam (n,tl) p =
+			let fields = [
+				"name", to_string n p;
+				"constraints", to_array to_ctype tl 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
+				| 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_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
+	and to_meta m p =
+		to_array (fun (m,el,p) _ -> 
+			let fields = [
+				"name", to_string m p;
+				"params", to_array to_expr el p;
+				"pos", to_pos p;
+			] in
+			to_obj fields p
+		) m p
+	and to_pos p =
+		let file = (EConst (String p.pfile),p) in
+		let pmin = (EConst (Int (string_of_int p.pmin)),p) in
+		let pmax = (EConst (Int (string_of_int p.pmax)),p) in
+		if in_macro then
+			(EUntyped (ECall ((EConst (Ident "$mk_pos"),p),[file;pmin;pmax]),p),p)
+		else
+			to_obj [("file",file);("min",pmin);("max",pmax)] p
+	and to_expr e _ =
+		let p = snd e in
+		let expr n vl = 
+			let e = mk_enum "ExprDef" n vl p in
+			to_obj [("expr",e);("pos",to_pos p)] p
+		in
+		let loop e = to_expr e (snd e) in
+		match fst e with
+		| EConst (Ident n) when n.[0] = '$' ->
+			to_string n p
+		| EConst c ->
+			expr "EConst" [to_const c p]
+		| EArray (e1,e2) ->
+			expr "EArray" [loop e1;loop e2]
+		| EBinop (op,e1,e2) ->
+			expr "EBinop" [to_binop op p; loop e1; loop e2]
+		| EField (e,s) ->
+			expr "EField" [loop e; to_string s p]
+		| EParenthesis e ->
+			expr "EParenthesis" [loop e]
+		| EObjectDecl fl -> 
+			expr "EObjectDecl" [to_array (fun (f,e) -> to_obj [("field",to_string f p);("expr",loop e)]) fl p]
+		| EArrayDecl el ->
+			expr "EArrayDecl" [to_array to_expr el p]
+		| ECall (e,el) ->
+			expr "ECall" [loop e;to_array to_expr el p]
+		| ENew (t,el) ->
+			expr "ENew" [to_tpath t p;to_array to_expr el p]
+		| EUnop (op,flag,e) ->
+			let op = mk_enum "Unop" (match op with
+				| Increment -> "OpIncrement"
+				| Decrement -> "OpDecrement"
+				| Not -> "OpNot"
+				| Neg -> "OpNeg"
+				| NegBits -> "OpNegBits"
+			) [] p in
+			expr "EUnop" [op;to_bool (flag = Postfix) p;loop e]
+		| EVars vl ->
+			expr "EVars" [to_array (fun (v,t,e) p ->
+				let fields = [
+					"name", to_string v p;
+					"type", to_opt to_ctype t p;
+					"expr", to_opt to_expr e p;
+				] in
+				to_obj fields p
+			) vl p]
+		| EFunction (name,f) ->
+			expr "EFunction" [to_opt to_string name p; to_fun f p]
+		| EBlock el ->
+			expr "EBlock" [to_array to_expr el p]
+		| EFor (e1,e2) ->
+			expr "EFor" [loop e1;loop e2]
+		| EIn (e1,e2) ->
+			expr "EIn" [loop e1;loop e2]
+		| EIf (e1,e2,eelse) ->
+			expr "EIf" [loop e1;loop e2;to_opt to_expr eelse p]
+		| EWhile (e1,e2,flag) ->
+			expr "EWhile" [loop e1;loop e2;to_bool (flag = NormalWhile) p]
+		| ESwitch (e1,cases,def) ->
+			let scase (el,e) p =
+				to_obj [("values",to_array to_expr el p);"expr",loop e] p
+			in
+			expr "ESwitch" [loop e1;to_array scase cases p;to_opt to_expr def p]
+		| ETry (e1,catches) ->
+			let scatch (n,t,e) p =
+				to_obj [("name",to_string n p);("type",to_ctype t p);("expr",loop e)] p
+			in
+			expr "ETry" [loop e1;to_array scatch catches p]
+		| EReturn eo ->
+			expr "EReturn" [to_opt to_expr eo p]
+		| EBreak ->
+			expr "EBreak" []
+		| EContinue ->
+			expr "EContinue" []
+		| EUntyped e ->
+			expr "EUntyped" [loop e]
+		| EThrow e ->
+			expr "EThrow" [loop e]
+		| ECast (e,ct) ->
+			expr "ECast" [loop e; to_opt to_ctype ct p]
+		| EDisplay (e,flag) ->
+			expr "EDisplay" [loop e; to_bool flag p]
+		| EDisplayNew t ->
+			expr "EDisplayNew" [to_tpath t p]
+		| ETernary (e1,e2,e3) ->
+			expr "ETernary" [loop e1;loop e2;loop e3]
+		| ECheckType (e1,ct) ->
+			expr "ECheckType" [loop e1; to_ctype ct p]
+		| EMacro e ->
+			expr "EMacro" [loop e]
+	in
+	to_expr e (snd e)

interp.ml

@@ -3508,6 +3508,8 @@ and encode_expr e =
 				27, [loop econd;loop e1;loop e2]
 			| ECheckType (e,t) ->
 				28, [loop e; encode_type t]
+			| EMacro e ->
+				29, [loop e]
 		in
 		enc_obj [
 			"pos", encode_pos p;

parser.ml

@@ -612,6 +612,7 @@ and expr = parser
 		(match b with
 		| EObjectDecl _ -> expr_next e s
 		| _ -> e)
+	| [< '(Const (Ident "macro"),p); e = expr >] -> (EMacro e,punion p (pos e))
 	| [< '(Const c,p); s >] -> expr_next (EConst c,p) s
 	| [< '(Kwd This,p); s >] -> expr_next (EConst (Ident "this"),p) s
 	| [< '(Kwd True,p); s >] -> expr_next (EConst (Ident "true"),p) s

std/haxe/macro/Expr.hx

@@ -121,9 +121,10 @@ enum ExprDef {
 	EDisplayNew( t : TypePath );
 	ETernary( econd : Expr, eif : Expr, eelse : Expr );
 	ECheckType( e : Expr, t : ComplexType );
+	EMacro( e : Expr );
 	#if !haxe3
 	EType( e : Expr, field : String );
-	#end	
+	#end
 }
 
 enum ComplexType {

typer.ml

@@ -2113,6 +2113,9 @@ 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
+	| EMacro esub ->
+		let e = Ast.expr_to_value ctx.in_macro esub in
+		type_expr_with_type ctx e (Some (Typeload.load_complex_type ctx p (CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = None; tparams = [] })))
 
 and type_call ctx e el twith p =
 	match e, el with