瀏覽代碼

macro is now a keyword and a field accessor (fixed issue #972)

Nicolas Cannasse 12 年之前
父節點
當前提交
769cacdb95
共有 6 個文件被更改,包括 44 次插入35 次删除
  1. 5 0
      ast.ml
  2. 2 0
      interp.ml
  3. 1 1
      lexer.mll
  4. 23 28
      parser.ml
  5. 1 0
      std/haxe/macro/Expr.hx
  6. 12 6
      typeload.ml

+ 5 - 0
ast.ml

@@ -65,6 +65,7 @@ type keyword =
 	| True
 	| True
 	| False
 	| False
 	| Abstract
 	| Abstract
+	| Macro
 
 
 type binop =
 type binop =
 	| OpAdd
 	| OpAdd
@@ -215,6 +216,7 @@ and access =
 	| AOverride
 	| AOverride
 	| ADynamic
 	| ADynamic
 	| AInline
 	| AInline
+	| AMacro
 
 
 and class_field_kind =
 and class_field_kind =
 	| FVar of complex_type option * expr option
 	| FVar of complex_type option * expr option
@@ -354,6 +356,7 @@ let s_access = function
 	| AOverride -> "override"
 	| AOverride -> "override"
 	| ADynamic -> "dynamic"
 	| ADynamic -> "dynamic"
 	| AInline -> "inline"
 	| AInline -> "inline"
+	| AMacro -> "macro"
 
 
 let s_keyword = function
 let s_keyword = function
 	| Function -> "function"
 	| Function -> "function"
@@ -397,6 +400,7 @@ let s_keyword = function
 	| True -> "true"
 	| True -> "true"
 	| False -> "false"
 	| False -> "false"
 	| Abstract -> "abstract"
 	| Abstract -> "abstract"
+	| Macro -> "macro"
 
 
 let rec s_binop = function
 let rec s_binop = function
 	| OpAdd -> "+"
 	| OpAdd -> "+"
@@ -679,6 +683,7 @@ let reify in_macro =
 			| AOverride -> "AOverride"
 			| AOverride -> "AOverride"
 			| ADynamic -> "ADynamic"
 			| ADynamic -> "ADynamic"
 			| AInline -> "AInline"
 			| AInline -> "AInline"
+			| AMacro -> "AMacro"
 			) in
 			) in
 			mk_enum "Access" n [] p
 			mk_enum "Access" n [] p
 		in
 		in

+ 2 - 0
interp.ml

@@ -3535,6 +3535,7 @@ and encode_access a =
 		| AOverride -> 3
 		| AOverride -> 3
 		| ADynamic -> 4
 		| ADynamic -> 4
 		| AInline -> 5
 		| AInline -> 5
+		| AMacro -> 6
 	in
 	in
 	enc_enum IAccess tag []
 	enc_enum IAccess tag []
 
 
@@ -3820,6 +3821,7 @@ and decode_access v =
 	| 3, [] -> AOverride
 	| 3, [] -> AOverride
 	| 4, [] -> ADynamic
 	| 4, [] -> ADynamic
 	| 5, [] -> AInline
 	| 5, [] -> AInline
+	| 6, [] -> AMacro
 	| _ -> raise Invalid_expr
 	| _ -> raise Invalid_expr
 
 
 and decode_meta_entry v =
 and decode_meta_entry v =

+ 1 - 1
lexer.mll

@@ -77,7 +77,7 @@ let keywords =
 		Switch;Case;Default;Public;Private;Try;Untyped;
 		Switch;Case;Default;Public;Private;Try;Untyped;
 		Catch;New;This;Throw;Extern;Enum;In;Interface;
 		Catch;New;This;Throw;Extern;Enum;In;Interface;
 		Cast;Override;Dynamic;Typedef;Package;
 		Cast;Override;Dynamic;Typedef;Package;
-		Inline;Using;Null;True;False;Abstract];
+		Inline;Using;Null;True;False;Abstract;Macro];
 	h
 	h
 
 
 let init file =
 let init file =

+ 23 - 28
parser.ml

@@ -149,8 +149,14 @@ let dollar_ident = parser
 	| [< '(Const (Ident i),p) >] -> i,p
 	| [< '(Const (Ident i),p) >] -> i,p
 	| [< '(Dollar i,p) >] -> ("$" ^ i),p
 	| [< '(Dollar i,p) >] -> ("$" ^ i),p
 
 
-let lower_ident = parser
+let dollar_ident_macro pack = parser
+	| [< '(Const (Ident i),p) >] -> i,p
+	| [< '(Dollar i,p) >] -> ("$" ^ i),p
+	| [< '(Kwd Macro,p) when pack <> [] >] -> "macro", p
+
+let lower_ident_or_macro = parser
 	| [< '(Const (Ident i),p) when is_lower_ident i >] -> i
 	| [< '(Const (Ident i),p) when is_lower_ident i >] -> i
+	| [< '(Kwd Macro,_) >] -> "macro"
 
 
 let any_enum_ident = parser
 let any_enum_ident = parser
 	| [< i = ident >] -> i
 	| [< i = ident >] -> i
@@ -260,6 +266,8 @@ and parse_import s p1 =
 			(match s with parser
 			(match s with parser
 			| [< '(Const (Ident k),p) >] ->
 			| [< '(Const (Ident k),p) >] ->
 				loop ((k,p) :: acc)
 				loop ((k,p) :: acc)
+			| [< '(Kwd Macro,p) >] ->
+				loop (("macro",p) :: acc)
 			| [< '(Binop OpMult,_); '(Semicolon,p2) >] ->
 			| [< '(Binop OpMult,_); '(Semicolon,p2) >] ->
 				p2, List.rev acc, IAll
 				p2, List.rev acc, IAll
 			| [< '(Binop OpOr,_) when do_resume() >] ->
 			| [< '(Binop OpOr,_) when do_resume() >] ->
@@ -284,7 +292,7 @@ and parse_abstract_relations s =
 	| [< '(Binop OpLte,_); t = parse_complex_type >] -> ASuperType t
 	| [< '(Binop OpLte,_); t = parse_complex_type >] -> ASuperType t
 	| [< '(Binop OpAssign,p1); '(Binop OpGt,p2) when p1.pmax = p2.pmin; t = parse_complex_type >] -> ASubType t
 	| [< '(Binop OpAssign,p1); '(Binop OpGt,p2) when p1.pmax = p2.pmin; t = parse_complex_type >] -> ASubType t
 
 
-and parse_package s = psep Dot lower_ident s
+and parse_package s = psep Dot lower_ident_or_macro s
 
 
 and parse_class_fields tdecl p1 s =
 and parse_class_fields tdecl p1 s =
 	let l = parse_class_field_resume tdecl s in
 	let l = parse_class_field_resume tdecl s in
@@ -342,7 +350,7 @@ and parse_class_field_resume tdecl s =
 			| Kwd New :: Kwd Function :: _ ->
 			| Kwd New :: Kwd Function :: _ ->
 				junk_tokens (k - 2);
 				junk_tokens (k - 2);
 				parse_class_field_resume tdecl s
 				parse_class_field_resume tdecl s
-			| Kwd Public :: _ | Kwd Static :: _ | Kwd Var :: _ | Kwd Override :: _ | Kwd Dynamic :: _ | Kwd Inline :: _ ->
+			| Kwd Macro :: _ | Kwd Public :: _ | Kwd Static :: _ | Kwd Var :: _ | Kwd Override :: _ | Kwd Dynamic :: _ | Kwd Inline :: _ ->
 				junk_tokens (k - 1);
 				junk_tokens (k - 1);
 				parse_class_field_resume tdecl s
 				parse_class_field_resume tdecl s
 			| BrClose :: _ when tdecl ->
 			| BrClose :: _ when tdecl ->
@@ -416,7 +424,7 @@ and parse_complex_type_inner = parser
 and parse_type_path s = parse_type_path1 [] s
 and parse_type_path s = parse_type_path1 [] s
 
 
 and parse_type_path1 pack = parser
 and parse_type_path1 pack = parser
-	| [< name, p = dollar_ident; s >] ->
+	| [< name, p = dollar_ident_macro pack; s >] ->
 		if is_lower_ident name then
 		if is_lower_ident name then
 			(match s with parser
 			(match s with parser
 			| [< '(Dot,p) >] ->
 			| [< '(Dot,p) >] ->
@@ -584,6 +592,7 @@ and parse_class_field s =
 
 
 and parse_cf_rights allow_static l = parser
 and parse_cf_rights allow_static l = parser
 	| [< '(Kwd Static,_) when allow_static; l = parse_cf_rights false (AStatic :: l) >] -> l
 	| [< '(Kwd Static,_) when allow_static; l = parse_cf_rights false (AStatic :: l) >] -> l
+	| [< '(Kwd Macro,_) when not(List.mem AMacro l); l = parse_cf_rights allow_static (AMacro :: l) >] -> l
 	| [< '(Kwd Public,_) when not(List.mem APublic l || List.mem APrivate l); l = parse_cf_rights allow_static (APublic :: l) >] -> l
 	| [< '(Kwd Public,_) when not(List.mem APublic l || List.mem APrivate l); l = parse_cf_rights allow_static (APublic :: l) >] -> l
 	| [< '(Kwd Private,_) when not(List.mem APublic l || List.mem APrivate l); l = parse_cf_rights allow_static (APrivate :: l) >] -> l
 	| [< '(Kwd Private,_) when not(List.mem APublic l || List.mem APrivate l); l = parse_cf_rights allow_static (APrivate :: l) >] -> l
 	| [< '(Kwd Override,_) when not (List.mem AOverride l); l = parse_cf_rights false (AOverride :: l) >] -> l
 	| [< '(Kwd Override,_) when not (List.mem AOverride l); l = parse_cf_rights false (AOverride :: l) >] -> l
@@ -643,10 +652,6 @@ and block2 name ident p s =
 	match s with parser
 	match s with parser
 	| [< '(DblDot,_); e = expr; l = parse_obj_decl >] -> EObjectDecl ((name,e) :: l)
 	| [< '(DblDot,_); e = expr; l = parse_obj_decl >] -> EObjectDecl ((name,e) :: l)
 	| [< >] ->
 	| [< >] ->
-		match ident with
-		| Ident "macro" ->
-			fst (parse_macro_expr p s)
-		| _ ->
 		let e = expr_next (EConst ident,p) s in
 		let e = expr_next (EConst ident,p) s in
 		try
 		try
 			let _ = semicolon s in
 			let _ = semicolon s in
@@ -703,25 +708,14 @@ and inline_function = parser
 	| [< '(Kwd Inline,_); '(Kwd Function,p1) >] -> true, p1
 	| [< '(Kwd Inline,_); '(Kwd Function,p1) >] -> true, p1
 	| [< '(Kwd Function,p1) >] -> false, p1
 	| [< '(Kwd Function,p1) >] -> false, p1
 
 
-and parse_macro_expr p s =
-	match Stream.npeek 1 s with
-	| [(DblDot,_)] ->
-		(match s with parser
-		| [< '(DblDot,_); t = parse_complex_type >] ->
-			let t = snd (reify !in_macro) t p in
-			(ECheckType (t,(CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some "ComplexType"; tparams = [] })),p)
-		| [< >] -> serror())
-	| [(_,p2)] when p2.pmin > p.pmax ->
-		let reify e =
-			let e = fst (reify !in_macro) e in
-			(ECheckType (e,(CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = None; tparams = [] })),pos e)
-		in
-		(match s with parser
-		| [< '(Kwd Var,p1); vl = psep Comma parse_var_decl >] -> reify (EVars vl,p1)
-		| [< e = expr >] -> reify e
-		| [< >] -> expr_next (EConst (Ident "macro"),p) s)
-	| _ ->
-		expr_next (EConst (Ident "macro"),p) s
+and parse_macro_expr p = parser
+	| [< '(DblDot,_); t = parse_complex_type >] ->
+		let t = snd (reify !in_macro) 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 (EVars vl,p1)
+	| [< e = expr >] ->
+		reify e
 	
 	
 and expr = parser
 and expr = parser
 	| [< (name,params,p) = parse_meta_entry; s >] ->
 	| [< (name,params,p) = parse_meta_entry; s >] ->
@@ -731,7 +725,7 @@ and expr = parser
 		(match b with
 		(match b with
 		| EObjectDecl _ -> expr_next e s
 		| EObjectDecl _ -> expr_next e s
 		| _ -> e)
 		| _ -> e)
-	| [< '(Const (Ident "macro"),p); s >] ->
+	| [< '(Kwd Macro,p); s >] ->
 		parse_macro_expr p s
 		parse_macro_expr p s
 	| [< '(Kwd Var,p1); v = parse_var_decl >] -> (EVars [v],p1)
 	| [< '(Kwd Var,p1); v = parse_var_decl >] -> (EVars [v],p1)
 	| [< '(Const c,p); s >] -> expr_next (EConst c,p) s
 	| [< '(Const c,p); s >] -> expr_next (EConst c,p) s
@@ -835,6 +829,7 @@ and expr_next e1 = parser
 	| [< '(Dot,p); s >] ->
 	| [< '(Dot,p); s >] ->
 		if is_resuming p then display (EDisplay (e1,false),p);
 		if is_resuming p then display (EDisplay (e1,false),p);
 		(match s with parser
 		(match s with parser
+		| [< '(Kwd Macro,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"macro") , punion (pos e1) p2) s
 		| [< '(Const (Ident f),p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,f) , punion (pos e1) p2) s
 		| [< '(Const (Ident f),p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,f) , punion (pos e1) p2) s
 		| [< '(Dollar v,p2); s >] -> expr_next (EField (e1,"$"^v) , punion (pos e1) p2) s
 		| [< '(Dollar v,p2); s >] -> expr_next (EField (e1,"$"^v) , punion (pos e1) p2) s
 		| [< '(Binop OpOr,p2) when do_resume() >] -> display (EDisplay (e1,false),p) (* help for debug display mode *)
 		| [< '(Binop OpOr,p2) when do_resume() >] -> display (EDisplay (e1,false),p) (* help for debug display mode *)

+ 1 - 0
std/haxe/macro/Expr.hx

@@ -207,6 +207,7 @@ enum Access {
 	AOverride;
 	AOverride;
 	ADynamic;
 	ADynamic;
 	AInline;
 	AInline;
+	AMacro;
 }
 }
 
 
 enum FieldType {
 enum FieldType {

+ 12 - 6
typeload.ml

@@ -366,7 +366,7 @@ and load_complex_type ctx p t =
 				| APublic -> ()
 				| APublic -> ()
 				| APrivate -> pub := false;
 				| APrivate -> pub := false;
 				| ADynamic when (match f.cff_kind with FFun _ -> true | _ -> false) -> dyn := true
 				| ADynamic when (match f.cff_kind with FFun _ -> true | _ -> false) -> dyn := true
-				| AStatic | AOverride | AInline | ADynamic -> error ("Invalid access " ^ Ast.s_access a) p
+				| AStatic | AOverride | AInline | ADynamic | AMacro -> error ("Invalid access " ^ Ast.s_access a) p
 			) f.cff_access;
 			) f.cff_access;
 			let t , access = (match f.cff_kind with
 			let t , access = (match f.cff_kind with
 				| FVar (Some (CTPath({tpackage=[];tname="Void"})), _)  | FProp (_,_,Some (CTPath({tpackage=[];tname="Void"})),_) ->
 				| FVar (Some (CTPath({tpackage=[];tname="Void"})), _)  | FProp (_,_,Some (CTPath({tpackage=[];tname="Void"})),_) ->
@@ -1012,8 +1012,8 @@ let init_class ctx c p context_init herits fields =
 	);
 	);
 	let fields = !fields in
 	let fields = !fields in
 	let core_api = has_meta ":coreApi" c.cl_meta in
 	let core_api = has_meta ":coreApi" c.cl_meta in
-	let is_macro = has_meta ":macro" c.cl_meta in
-	let fields, herits = if is_macro && not ctx.in_macro then begin
+	let is_class_macro = has_meta ":macro" c.cl_meta in
+	let fields, herits = if is_class_macro && not ctx.in_macro then begin
 		c.cl_extern <- true;
 		c.cl_extern <- true;
 		List.filter (fun f -> List.mem AStatic f.cff_access) fields, []
 		List.filter (fun f -> List.mem AStatic f.cff_access) fields, []
 	end else fields, herits in
 	end else fields, herits in
@@ -1149,6 +1149,14 @@ let init_class ctx c p context_init herits fields =
 		let extern = has_meta ":extern" f.cff_meta || c.cl_extern in
 		let extern = has_meta ":extern" f.cff_meta || c.cl_extern in
 		let inline = List.mem AInline f.cff_access && (match f.cff_kind with FFun _ -> not ctx.com.display && (ctx.g.doinline || extern) | _ -> true) in
 		let inline = List.mem AInline f.cff_access && (match f.cff_kind with FFun _ -> not ctx.com.display && (ctx.g.doinline || extern) | _ -> true) in
 		let override = List.mem AOverride f.cff_access in
 		let override = List.mem AOverride f.cff_access in
+		let is_macro = List.mem AMacro f.cff_access || has_meta ":macro" f.cff_meta in
+		List.iter (fun acc ->
+			match (acc, f.cff_kind) with
+			| APublic, _ | APrivate, _ | AStatic, _ -> ()
+			| ADynamic, FFun _ | AOverride, FFun _ | AMacro, FFun _ | AInline, FFun _ | AInline, FVar _ -> ()
+			| _, FVar _ -> error ("Invalid accessor '" ^ Ast.s_access acc ^ "' for variable " ^ name) p
+			| _, FProp _ -> error ("Invalid accessor '" ^ Ast.s_access acc ^ "' for property " ^ name) p
+		) f.cff_access;
 		if override then (match c.cl_super with None -> error "Invalid override: class has no super class" p | _ -> ());
 		if override then (match c.cl_super with None -> error "Invalid override: class has no super class" p | _ -> ());
 		(* build the per-field context *)
 		(* build the per-field context *)
 		let ctx = {
 		let ctx = {
@@ -1159,7 +1167,6 @@ let init_class ctx c p context_init herits fields =
 		| FVar (t,e) ->
 		| FVar (t,e) ->
 			if inline && not stat then error "Inline variable must be static" p;
 			if inline && not stat then error "Inline variable must be static" p;
 			if inline && e = None then error "Inline variable must be initialized" p;
 			if inline && e = None then error "Inline variable must be initialized" p;
-			if override then error "You cannot override variables" p;
 
 
 			let t = (match t with
 			let t = (match t with
 				| None when not stat && e = None ->
 				| None when not stat && e = None ->
@@ -1191,7 +1198,7 @@ let init_class ctx c p context_init herits fields =
 		| FFun fd ->
 		| FFun fd ->
 			let params = type_function_params ctx fd f.cff_name p in
 			let params = type_function_params ctx fd f.cff_name p in
 			if inline && c.cl_interface then error "You can't declare inline methods in interfaces" p;
 			if inline && c.cl_interface then error "You can't declare inline methods in interfaces" p;
-			let is_macro = (is_macro && stat) || has_meta ":macro" f.cff_meta in
+			let is_macro = is_macro || (is_class_macro && stat) in
 			let f, stat, fd = if not is_macro || stat then
 			let f, stat, fd = if not is_macro || stat then
 				f, stat, fd
 				f, stat, fd
 			else if ctx.in_macro then
 			else if ctx.in_macro then
@@ -1282,7 +1289,6 @@ let init_class ctx c p context_init herits fields =
 			if not (((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__") then bind_type ctx cf r (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) is_macro;
 			if not (((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__") then bind_type ctx cf r (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) is_macro;
 			f, constr, cf
 			f, constr, cf
 		| FProp (get,set,t,eo) ->
 		| FProp (get,set,t,eo) ->
-			if override then error "You cannot override properties" p;
 			let ret = (match t, eo with
 			let ret = (match t, eo with
 				| None, None -> error "Property must either define a type or a default value" p;
 				| None, None -> error "Property must either define a type or a default value" p;
 				| None, _ -> mk_mono()
 				| None, _ -> mk_mono()