Jelajahi Sumber

added @:autoBuild support

Nicolas Cannasse 14 tahun lalu
induk
melakukan
7d511da0b6
2 mengubah file dengan 73 tambahan dan 60 penghapusan
  1. 1 1
      doc/CHANGES.txt
  2. 72 59
      typeload.ml

+ 1 - 1
doc/CHANGES.txt

@@ -6,7 +6,7 @@
 	flash9 : fixed issue with @:bind
 	flash9 : added some missing errors
 	flash9 : fixed TypedDictionary.exists
-	all : added @:build for enums and classes
+	all : added @:build and @:autoBuild for enums and classes
 	neko : Std.parseFloat now returns NaN with invalid string
 	php: fixed Array.push must return the current length (issue 219)
 	php: fixed EReg.replace (issue 194)

+ 72 - 59
typeload.ml

@@ -417,6 +417,14 @@ let rec return_flow ctx e =
 (* PASS 1 & 2 : Module and Class Structure *)
 
 let set_heritance ctx c herits p =
+	let process_meta csup =
+		List.iter (fun m ->
+			match m with
+			| ":final", _, _ -> if not (Type.has_meta ":hack" c.cl_meta) then error "Cannot extend a final class" p;
+			| ":autoBuild", el, p -> c.cl_meta <- (":build",el,p) :: m :: c.cl_meta;
+			| _ -> ()
+		) csup.cl_meta
+	in
 	let rec loop = function
 		| HPrivate | HExtern | HInterface ->
 			()
@@ -429,12 +437,12 @@ let set_heritance ctx c herits p =
 			| TInst ({ cl_path = [],"Date" },_)
 			| TInst ({ cl_path = [],"Xml" },_) when ((not (platform ctx.com Cpp)) && (match c.cl_path with "mt" :: _ , _ -> false | _ -> true)) ->
 				error "Cannot extend basic class" p;
-			| TInst (cl,params) ->
-				if is_parent c cl then error "Recursive class" p;
+			| TInst (csup,params) ->
+				if is_parent c csup then error "Recursive class" p;
 				if c.cl_interface then error "Cannot extend an interface" p;
-				if cl.cl_interface then error "Cannot extend by using an interface" p;
-				if Type.has_meta ":final" cl.cl_meta && not (Type.has_meta ":hack" c.cl_meta) then error "Cannot extend a final class" p;
-				c.cl_super <- Some (cl,params)
+				if csup.cl_interface then error "Cannot extend by using an interface" p;
+				process_meta csup;
+				c.cl_super <- Some (csup,params)
 			| _ -> error "Should extend by using a class" p)
 		| HImplements t ->
 			let t = load_instance ctx t p false in
@@ -442,9 +450,10 @@ let set_heritance ctx c herits p =
 			| TInst ({ cl_path = [],"ArrayAccess"; cl_extern = true; },[t]) ->
 				if c.cl_array_access <> None then error "Duplicate array access" p;
 				c.cl_array_access <- Some t
-			| TInst (cl,params) ->
-				if is_parent c cl then error "Recursive class" p;
-				c.cl_implements <- (cl, params) :: c.cl_implements
+			| TInst (intf,params) ->
+				if is_parent c intf then error "Recursive class" p;
+				process_meta intf;
+				c.cl_implements <- (intf, params) :: c.cl_implements
 			| TDynamic t ->
 				if c.cl_dynamic <> None then error "Cannot have several dynamics" p;
 				c.cl_dynamic <- Some t
@@ -632,12 +641,65 @@ let patch_class ctx c fields =
 		in
 		List.rev (loop [] fields)
 
+let build_module_def ctx meta fbuild =
+	let rec loop = function
+		| (":build",args,p) :: l ->
+			let epath, el = (match args with
+				| [ECall (epath,el),p] -> epath, el
+				| _ -> error "Invalid build parameters" p
+			) in
+			let rec getpath (e,p) =
+				match e with
+				| EConst (Ident i) | EConst (Type i) -> [i]
+				| EField (e,f) | EType (e,f) -> f :: getpath e
+				| _ -> error "Build call parameter must be a class path" p
+			in
+			let s = String.concat "." (List.rev (getpath 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;
+			(match apply_macro ctx s el p with
+			| None -> error "Build failure" p
+			| Some e -> fbuild e) @ loop l
+		| _ :: l -> loop l
+		| [] -> []
+	in
+	loop meta
+
 let init_class ctx c p herits fields =
 	let fields = patch_class ctx c fields in
 	let ctx = { ctx with type_params = c.cl_types } in
 	c.cl_extern <- List.mem HExtern herits;
 	c.cl_interface <- List.mem HInterface herits;
 	set_heritance ctx c herits p;
+	let fields = fields @ build_module_def { ctx with curclass = c } c.cl_meta (fun (e,p) ->
+		match e with
+		| EBlock el ->					
+			List.map (fun (e,p) ->
+				let n, k = (match e with
+				| EVars [v,t,e] -> v, FVar (t,e)
+				| EFunction (Some n,f) -> (if n = "__new__" then "new" else n), FFun ([],f)
+				| _ -> error "Class build expression should be a single variable or a named function" p
+				) in
+				let accesses = [APublic; APrivate; AStatic; AOverride; ADynamic; AInline] in
+				let k = ref k in
+				let rec loop acc l =
+					match l with
+					| [] -> error "Missing name" p
+					| "property" :: get :: set :: l ->
+						(match !k with
+						| FVar (Some t,None) -> k := FProp (get,set,t); loop acc l
+						| _ -> error "Invalid property declaration" p)
+					| x :: l ->
+						try
+							let a = List.find (fun a -> Ast.s_access a = x) accesses in
+							loop (a :: acc) l
+						with Not_found ->
+							String.concat "__" (x :: l), acc
+				in
+				let n, access = loop [] (ExtString.String.nsplit n "__") in
+				{ cff_name = n; cff_doc = None; cff_pos = p; cff_meta = []; cff_access = if access = [] then [APublic] else access; cff_kind = !k }
+			) el
+		| _ -> error "Class build macro must return a block" p
+	) in	
 	let core_api = has_meta ":core_api" 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
@@ -1097,25 +1159,6 @@ let resolve_typedef ctx t =
 		| TInst (c,_) -> TClassDecl c
 		| _ -> t
 
-let build_module_def ctx d fbuild =
-	let rec loop = function
-		| (":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) -> f :: loop e
-				| _ -> error "Build call parameter must be a class path" p
-			in
-			let s = String.concat "." (List.rev (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;
-			(match apply_macro ctx s el p with
-			| None -> error "Build failure" p
-			| Some e -> fbuild e)
-		| _ :: l -> loop l
-		| [] -> []
-	in
-	loop d.d_meta
-
 let type_module ctx m tdecls loadp =
 	(* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
 	let decls = ref [] in
@@ -1260,44 +1303,14 @@ let type_module ctx m tdecls loadp =
 		| EClass d ->
 			let c = get_class d.d_name in
 			let checks = if not ctx.com.display then [check_overriding ctx c p; check_interfaces ctx c p] else [] in
-			let extra = build_module_def { ctx with curclass = c } d (fun (e,p) ->
-				match e with
-				| EBlock el ->					
-					List.map (fun (e,p) ->
-						let n, k = (match e with
-						| EVars [v,t,e] -> v, FVar (t,e)
-						| EFunction (Some n,f) -> (if n = "__new__" then "new" else n), FFun ([],f)
-						| _ -> error "Class build expression should be a single variable or a named function" p
-						) in
-						let accesses = [APublic; APrivate; AStatic; AOverride; ADynamic; AInline] in
-						let k = ref k in
-						let rec loop acc l =
-							match l with
-							| [] -> error "Missing name" p
-							| "property" :: get :: set :: l ->
-								(match !k with
-								| FVar (Some t,None) -> k := FProp (get,set,t); loop acc l
-								| _ -> error "Invalid property declaration" p)
-							| x :: l ->
-								try
-									let a = List.find (fun a -> Ast.s_access a = x) accesses in
-									loop (a :: acc) l
-								with Not_found ->
-									String.concat "__" (x :: l), acc
-						in
-						let n, access = loop [] (ExtString.String.nsplit n "__") in
-						{ cff_name = n; cff_doc = None; cff_pos = p; cff_meta = []; cff_access = if access = [] then [APublic] else access; cff_kind = !k }
-					) el
-				| _ -> error "Class build macro must return a block" p
-			) in
-			delays := !delays @ (checks @ init_class ctx c p d.d_flags (d.d_data @ extra))
+			delays := !delays @ (checks @ init_class ctx c p d.d_flags d.d_data)
 		| EEnum d ->
 			let e = get_enum d.d_name in
 			let ctx = { ctx with type_params = e.e_types } in
 			let et = TEnum (e,List.map snd e.e_types) in
 			let names = ref [] in
 			let index = ref 0 in
-			let extra = build_module_def ctx d (fun (e,p) ->
+			let extra = build_module_def ctx e.e_meta (fun (e,p) ->
 				match e with
 				| EArrayDecl el | EBlock el ->
 					List.map (fun (e,p) ->