Procházet zdrojové kódy

[gencommon] cleanup and decouple from gencommon context InterfaceProps and Normalize (also fix normalize checking strict_meta instead of metadata_entry)

Dan Korostelev před 8 roky
rodič
revize
ce7dce2e4a

+ 20 - 27
src/generators/gencommon/interfaceProps.ml

@@ -20,39 +20,32 @@ open Globals
 open Type
 open Type
 open Gencommon
 open Gencommon
 
 
-
-(* ******************************************* *)
-(* InterfaceProps *)
-(* ******************************************* *)
 (*
 (*
 	This module filter will go through all declared properties, and see if they are conforming to a native interface.
 	This module filter will go through all declared properties, and see if they are conforming to a native interface.
 	If they are, it will add Meta.Property to it.
 	If they are, it will add Meta.Property to it.
 *)
 *)
+let run = function
+	| TClassDecl ({ cl_interface = false; cl_extern = false } as cl) ->
+		let vars = List.fold_left (fun acc (iface,_) ->
+			if Meta.has Meta.CsNative iface.cl_meta then
+				let props = List.filter (fun cf -> match cf.cf_kind with Var { v_read = AccCall } | Var { v_write = AccCall } -> true | _ -> false) iface.cl_ordered_fields in
+				props @ acc
+			else
+				acc
+		) [] cl.cl_implements in
+		if vars <> [] then
+			let vars = List.map (fun cf -> cf.cf_name) vars in
+			List.iter (fun cf -> match cf.cf_kind with
+				| Var { v_read = AccCall } | Var { v_write = AccCall } when List.mem cf.cf_name vars ->
+					cf.cf_meta <- (Meta.Property, [], null_pos) :: cf.cf_meta
+				| _ -> ()
+			) cl.cl_ordered_fields
+	| _ ->
+		()
+
 let name = "interface_props"
 let name = "interface_props"
 let priority = solve_deps name []
 let priority = solve_deps name []
 
 
 let configure gen =
 let configure gen =
-	let run md =
-		match md with
-		| TClassDecl ({ cl_interface = false; cl_extern = false } as cl) ->
-			let vars = List.fold_left (fun acc (iface,_) ->
-				if Meta.has Meta.CsNative iface.cl_meta then
-					List.filter (fun cf -> match cf.cf_kind with
-						| Var { v_read = AccCall } | Var { v_write = AccCall } -> true
-						| _ -> false
-					) iface.cl_ordered_fields @ acc
-				else
-					acc
-			) [] cl.cl_implements in
-			let vars = List.map (fun cf -> cf.cf_name) vars in
-			if vars <> [] then
-				List.iter (fun cf -> match cf.cf_kind with
-					| Var { v_read = AccCall } | Var { v_write = AccCall } when List.mem cf.cf_name vars ->
-						cf.cf_meta <- (Meta.Property, [], null_pos) :: cf.cf_meta
-					| _ -> ()
-				) cl.cl_ordered_fields
-		| _ ->
-			()
-	in
-	let map md = Some(run md; md) in
+	let map md = run md; Some md in
 	gen.gmodule_filters#add name (PCustom priority) map
 	gen.gmodule_filters#add name (PCustom priority) map

+ 22 - 21
src/generators/gencommon/normalize.ml

@@ -19,9 +19,6 @@
 open Type
 open Type
 open Gencommon
 open Gencommon
 
 
-(* ******************************************* *)
-(* Normalize *)
-(* ******************************************* *)
 (*
 (*
 	- Filters out enum constructor type parameters from the AST; See Issue #1796
 	- Filters out enum constructor type parameters from the AST; See Issue #1796
 	- Filters out monomorphs
 	- Filters out monomorphs
@@ -31,8 +28,6 @@ open Gencommon
 		No dependencies; but it still should be one of the first filters to run,
 		No dependencies; but it still should be one of the first filters to run,
 		as it will help normalize the AST
 		as it will help normalize the AST
 *)
 *)
-let name = "normalize_type"
-let priority = max_dep
 
 
 let rec filter_param t =
 let rec filter_param t =
 	match t with
 	match t with
@@ -68,29 +63,35 @@ let rec filter_param t =
 	| TLazy f ->
 	| TLazy f ->
 		filter_param (!f())
 		filter_param (!f())
 
 
-let configure gen ~metas =
+let init_expr_filter allowed_metas =
 	let rec run e =
 	let rec run e =
 		match e.eexpr with
 		match e.eexpr with
-		| TMeta (entry, e) when not (Hashtbl.mem metas entry) ->
+		| TMeta ((m,_,_), e) when not (Hashtbl.mem allowed_metas m) ->
 			run e
 			run e
 		| _ ->
 		| _ ->
 			map_expr_type (fun e -> run e) filter_param (fun v -> v.v_type <- filter_param v.v_type; v) e
 			map_expr_type (fun e -> run e) filter_param (fun v -> v.v_type <- filter_param v.v_type; v) e
 	in
 	in
+	run
+
+let type_filter = function
+	| TClassDecl cl ->
+		let rec map cf =
+			cf.cf_type <- filter_param cf.cf_type;
+			List.iter map cf.cf_overloads
+		in
+		List.iter map cl.cl_ordered_fields;
+		List.iter map cl.cl_ordered_statics;
+		Option.may map cl.cl_constructor
+	| _ ->
+		()
+
+let name = "normalize_type"
+let priority = max_dep
+
+let configure gen ~allowed_metas =
+	let run = init_expr_filter allowed_metas in
 	let map e = Some (run e) in
 	let map e = Some (run e) in
 	gen.gexpr_filters#add name (PCustom priority) map;
 	gen.gexpr_filters#add name (PCustom priority) map;
 
 
-	let run md =
-		match md with
-		| TClassDecl cl ->
-			let rec map cf =
-				cf.cf_type <- filter_param cf.cf_type;
-				List.iter map cf.cf_overloads
-			in
-			List.iter map cl.cl_ordered_fields;
-			List.iter map cl.cl_ordered_statics;
-			Option.may map cl.cl_constructor
-		| _ ->
-			()
-	in
-	let map md = Some (run md; md) in
+	let map md = Some (type_filter md; md) in
 	gen.gmodule_filters#add name (PCustom priority) map
 	gen.gmodule_filters#add name (PCustom priority) map

+ 1 - 1
src/generators/gencs.ml

@@ -2717,7 +2717,7 @@ let generate con =
 		in
 		in
 
 
 		FixOverrides.configure ~explicit_fn_name:explicit_fn_name ~get_vmtype:real_type gen;
 		FixOverrides.configure ~explicit_fn_name:explicit_fn_name ~get_vmtype:real_type gen;
-		Normalize.configure gen ~metas:(Hashtbl.create 0);
+		Normalize.configure gen ~allowed_metas:(Hashtbl.create 0);
 
 
 		AbstractImplementationFix.configure gen;
 		AbstractImplementationFix.configure gen;
 
 

+ 1 - 1
src/generators/genjava.ml

@@ -2094,7 +2094,7 @@ let generate con =
 	in
 	in
 
 
 	FixOverrides.configure ~get_vmtype gen;
 	FixOverrides.configure ~get_vmtype gen;
-	Normalize.configure gen ~metas:(Hashtbl.create 0);
+	Normalize.configure gen ~allowed_metas:(Hashtbl.create 0);
 	AbstractImplementationFix.configure gen;
 	AbstractImplementationFix.configure gen;
 
 
 	let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen (get_cl (get_type gen (["haxe";"lang"],"Function"))) 6 in
 	let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen (get_cl (get_type gen (["haxe";"lang"],"Function"))) 6 in