Browse Source

allowed "macro class" reifycation (fixed issue #1399)

Nicolas Cannasse 12 years ago
parent
commit
20bc4c6993
2 changed files with 50 additions and 12 deletions
  1. 28 1
      ast.ml
  2. 22 11
      parser.ml

+ 28 - 1
ast.ml

@@ -1080,5 +1080,32 @@ let reify in_macro =
 				e
 			| _ ->
 				expr "EMeta" [to_obj [("name",to_string (Meta.to_string m) p);("params",to_expr_array ml p);("pos",to_pos p)] p;loop e1]
+	and to_tparam_decl p t =
+		to_obj [
+			"name", to_string t.tp_name p;
+			"params", (EArrayDecl (List.map (to_tparam_decl p) t.tp_params),p);
+			"constraints", (EArrayDecl (List.map (fun t -> to_ctype t p) t.tp_constraints),p)
+		] p
+	and to_type_def (t,p) =
+		match t with
+		| EClass d ->
+			let ext = ref None and impl = ref [] and interf = ref false in
+			List.iter (function
+				| HExtern | HPrivate -> ()
+				| HInterface -> interf := true;
+				| HExtends t -> ext := Some (to_tpath t p)
+				| HImplements i -> impl := (to_tpath i p) :: !impl
+			) d.d_flags;
+			to_obj [
+				"pack", (EArrayDecl [],p);
+				"name", to_string d.d_name p;
+				"pos", to_pos p;
+				"meta", to_meta d.d_meta p;
+				"params", (EArrayDecl (List.map (to_tparam_decl p) d.d_params),p);
+				"isExtern", to_bool (List.mem HExtern d.d_flags) p;
+				"kind", mk_enum "TypeDefKind" "TDClass" [(match !ext with None -> (EConst (Ident "null"),p) | Some t -> t);(EArrayDecl (List.rev !impl),p);to_bool !interf p] p;
+				"fields", (EArrayDecl (List.map (fun f -> to_cfield f p) d.d_data),p)
+			] p
+		| _ -> assert false
 	in
-	(fun e -> to_expr e (snd e)), to_ctype
+	(fun e -> to_expr e (snd e)), to_ctype, to_type_def

+ 22 - 11
parser.ml

@@ -228,15 +228,8 @@ and parse_type_decl s =
 				d_flags = List.map snd c @ n;
 				d_data = l
 			}, punion p1 p2)
-		| [< n , p1 = parse_class_flags; doc = get_doc; name = type_name; tl = parse_constraint_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] ->
-			(EClass {
-				d_name = name;
-				d_doc = doc;
-				d_meta = meta;
-				d_params = tl;
-				d_flags = List.map fst c @ n @ hl;
-				d_data = fl;
-			}, punion p1 p2)
+		| [< d = parse_class meta c true >] ->
+			d
 		| [< '(Kwd Typedef,p1); doc = get_doc; name = type_name; tl = parse_constraint_params; '(Binop OpAssign,p2); t = parse_complex_type; s >] ->
 			(match s with parser
 			| [< '(Semicolon,_) >] -> ()
@@ -260,6 +253,19 @@ and parse_type_decl s =
 				d_flags = flags @ sl;
 				d_data = fl;
 			},punion p1 p2)
+			
+and parse_class meta cflags need_name s =
+	let opt_name = if need_name then type_name else (fun s -> match popt type_name s with None -> "" | Some n -> n) in
+	match s with parser
+	| [< n , p1 = parse_class_flags; doc = get_doc; name = opt_name; tl = parse_constraint_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] ->
+		(EClass {
+			d_name = name;
+			d_doc = doc;
+			d_meta = meta;
+			d_params = tl;
+			d_flags = List.map fst cflags @ n @ hl;
+			d_data = fl;
+		}, punion p1 p2)
 
 and parse_import s p1 =
 	let rec loop acc =
@@ -720,15 +726,20 @@ and inline_function = parser
 	| [< '(Kwd Function,p1) >] -> false, p1
 
 and reify_expr e =
-	let e = fst (reify !in_macro) e in
+	let to_expr,_,_ = reify !in_macro in
+	let e = to_expr e in
 	(ECheckType (e,(CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = None; tparams = [] })),pos e)
 
 and parse_macro_expr p = parser
 	| [< '(DblDot,_); t = parse_complex_type >] ->
-		let t = snd (reify !in_macro) t p in
+		let _, to_type, _  = reify !in_macro in
+		let t = to_type t p in
 		(ECheckType (t,(CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some "ComplexType"; tparams = [] })),p)
 	| [< '(Kwd Var,p1); vl = psep Comma parse_var_decl >] ->
 		reify_expr (EVars vl,p1)
+	| [< d = parse_class [] [] false >] ->
+		let _,_,to_type = reify !in_macro in
+		(ECheckType (to_type d,(CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some "TypeDefinition"; tparams = [] })),p)
 	| [< e = secure_expr >] ->
 		reify_expr e