[jvm] factor out some parts for no apparent reason

src/generators/genjvm.ml

@@ -30,6 +30,7 @@ open JvmAttribute
 open JvmSignature
 open JvmMethod
 open JvmBuilder
+open Genshared
 
 (* Note: This module is the bridge between Haxe structures and JVM structures. No module in generators/jvm should reference any
    Haxe-specific type. *)
@@ -56,87 +57,6 @@ let java_hash s =
 	) s;
 	!h
 
-let find_overload map_type c cf el =
-	let matches = ref [] in
-	let rec loop cfl = match cfl with
-		| cf :: cfl ->
-			begin match follow (monomorphs cf.cf_params (map_type cf.cf_type)) with
-				| TFun(tl'',_) as tf ->
-					let rec loop2 acc el tl = match el,tl with
-						| e :: el,(n,o,t) :: tl ->
-							begin try
-								Type.unify e.etype t;
-								loop2 ((e,o) :: acc) el tl
-							with _ ->
-								loop cfl
-							end
-						| [],[] ->
-							matches := ((List.rev acc),tf,(c,cf)) :: !matches;
-							loop cfl
-						| _ ->
-							loop cfl
-					in
-					loop2 [] el tl''
-				| t ->
-					loop cfl
-			end;
-		| [] ->
-			List.rev !matches
-	in
-	loop (cf :: cf.cf_overloads)
-
-let filter_overloads candidates =
-	match Overloads.Resolution.reduce_compatible candidates with
-	| [_,_,(c,cf)] -> Some(c,cf)
-	| [] -> None
-	| ((_,_,(c,cf)) :: _) (* as resolved *) ->
-		(* let st = s_type (print_context()) in
-		print_endline (Printf.sprintf "Ambiguous overload for %s(%s)" name (String.concat ", " (List.map (fun e -> st e.etype) el)));
-		List.iter (fun (_,t,(c,cf)) ->
-			print_endline (Printf.sprintf "\tCandidate: %s.%s(%s)" (s_type_path c.cl_path) cf.cf_name (st t));
-		) resolved; *)
-		Some(c,cf)
-
-let find_overload_rec' is_ctor map_type c name el =
-	let candidates = ref [] in
-	let has_function t1 (_,t2,_) =
-		begin match follow t1,t2 with
-		| TFun(tl1,_),TFun(tl2,_) -> type_iseq (TFun(tl1,t_dynamic)) (TFun(tl2,t_dynamic))
-		| _ -> false
-		end
-	in
-	let rec loop map_type c =
-		begin try
-			let cf = if is_ctor then
-				(match c.cl_constructor with Some cf -> cf | None -> raise Not_found)
-			else
-				PMap.find name c.cl_fields
-			in
-			begin match find_overload map_type c cf el with
-			| [] -> raise Not_found
-			| l ->
-				List.iter (fun ((_,t,_) as ca) ->
-					if not (List.exists (has_function t) !candidates) then candidates := ca :: !candidates
-				) l
-			end;
-			if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then raise Not_found
-		with Not_found ->
-			if c.cl_interface then
-				List.iter (fun (c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c) c.cl_implements
-			else match c.cl_super with
-			| None -> ()
-			| Some(c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c
-		end;
-	in
-	loop map_type c;
-	filter_overloads (List.rev !candidates)
-
-let find_overload_rec is_ctor map_type c cf el =
-	if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then
-		find_overload_rec' is_ctor map_type c cf.cf_name el
-	else
-		Some(c,cf)
-
 let get_construction_mode c cf =
 	if Meta.has Meta.HxGen cf.cf_meta then ConstructInitPlusNew
 	else ConstructInit
@@ -145,26 +65,15 @@ let get_construction_mode c cf =
 
 exception HarderFailure of string
 
-type field_generation_info = {
-	mutable has_this_before_super : bool;
-	(* This is an ordered list of fields that are targets of super() calls which is determined during
-	   pre-processing. The generator can pop from this list assuming that it processes the expression
-	   in the same order (which it should). *)
-	mutable super_call_fields : (tclass * tclass_field) list;
-}
-
 type generation_context = {
 	com : Common.context;
 	jar : Zip.out_file;
 	t_exception : Type.t;
 	t_throwable : Type.t;
-	anon_lut : ((string * jsignature) list,jpath) Hashtbl.t;
-	anon_path_lut : (path,jpath) Hashtbl.t;
-	field_infos : field_generation_info DynArray.t;
-	implicit_ctors : (path,(path * jsignature,tclass * tclass_field) PMap.t) Hashtbl.t;
+	anon_identification : jsignature tanon_identification;
+	preprocessor : jsignature preprocessor;
 	default_export_config : export_config;
 	mutable current_field_info : field_generation_info option;
-	mutable anon_num : int;
 }
 
 type ret =
@@ -172,11 +81,6 @@ type ret =
 	| RVoid
 	| RReturn
 
-type method_type =
-	| MStatic
-	| MInstance
-	| MConstructor
-
 type access_kind =
 	| AKPost
 	| AKPre
@@ -265,36 +169,6 @@ and jtype_argument_of_type stack t =
 let jsignature_of_type t =
 	jsignature_of_type [] t
 
-module TAnonIdentifiaction = struct
-	let convert_fields fields =
-		let l = PMap.fold (fun cf acc -> cf :: acc) fields [] in
-		let l = List.sort (fun cf1 cf2 -> compare cf1.cf_name cf2.cf_name) l in
-		List.map (fun cf -> cf.cf_name,jsignature_of_type cf.cf_type) l
-
-	let identify gctx fields =
-		if PMap.is_empty fields then
-			haxe_dynamic_object_path,[]
-		else begin
-			let l = convert_fields fields in
-			try
-				Hashtbl.find gctx.anon_lut l,l
-			with Not_found ->
-				let id = gctx.anon_num in
-				gctx.anon_num <- gctx.anon_num + 1;
-				let path = (["haxe";"generated"],Printf.sprintf "Anon%i" id) in
-				Hashtbl.add gctx.anon_lut l path;
-				path,l
-		end
-
-	let identify_as gctx path fields =
-		if not (PMap.is_empty fields) && not (Hashtbl.mem gctx.anon_path_lut path) then begin
-			let fields = convert_fields fields in
-			Hashtbl.add gctx.anon_lut fields path;
-			Hashtbl.add gctx.anon_path_lut path path;
-		end
-
-end
-
 module AnnotationHandler = struct
 	let generate_annotations builder meta =
 		let parse_path e =
@@ -406,17 +280,6 @@ let is_interface_var_access c cf =
 let type_unifies a b =
 	try Type.unify a b; true with _ -> false
 
-let get_field_info gctx ml =
-	let rec loop ml = match ml with
-	| (Meta.Custom ":jvm.fieldInfo",[(EConst (Int s),_)],_) :: _ ->
-		Some (DynArray.get gctx.field_infos (int_of_string s))
-	| _ :: ml ->
-		loop ml
-	| [] ->
-		None
-	in
-	loop ml
-
 let follow = Abstract.follow_with_abstracts
 
 class haxe_exception gctx (t : Type.t) = object(self)
@@ -701,7 +564,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			in
 			begin match follow e1.etype with
 			| TAnon an ->
-				let path,_ = TAnonIdentifiaction.identify gctx an.a_fields in
+				let path,_ = gctx.anon_identification#identify an.a_fields in
 				code#dup;
 				code#instanceof path;
 				jm#if_then_else
@@ -1519,7 +1382,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				| _ -> match filter_overloads (find_overload (fun t -> t) c cf el) with
 					| None ->
 						Error.error "Could not find overload" e1.epos
-					| Some(c,cf) ->
+					| Some(c,cf,_) ->
 						c,cf
 			in
 			let tl,tr = self#call_arguments cf.cf_type el in
@@ -1536,7 +1399,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			in
 			begin match find_overload_rec false (apply_params c.cl_params tl) c cf el with
 			| None -> Error.error "Could not find overload" e1.epos
-			| Some(c,cf) ->
+			| Some(c,cf,_) ->
 				let tl,tr = self#call_arguments cf.cf_type el in
 				(if is_super then jm#invokespecial else if c.cl_interface then jm#invokeinterface else jm#invokevirtual) c.cl_path cf.cf_name (self#vtype cf.cf_type);
 				tr
@@ -1965,7 +1828,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			|_,cf ->
 				begin match find_overload_rec true (apply_params c.cl_params tl) c cf el with
 				| None -> Error.error "Could not find overload" e.epos
-				| Some (c',cf) ->
+				| Some (c',cf,_) ->
 					let f () =
 						let tl,_ = self#call_arguments  cf.cf_type el in
 						tl
@@ -2105,7 +1968,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			(* The guard is here because in the case of quoted fields like `"a-b"`, the field is not part of the
 			   type. In this case we have to do full dynamic construction. *)
 			| TAnon an when List.for_all (fun ((name,_,_),_) -> PMap.mem name an.a_fields) fl ->
-				let path,fl' = TAnonIdentifiaction.identify gctx an.a_fields in
+				let path,fl' = gctx.anon_identification#identify an.a_fields in
 				jm#construct ConstructInit path (fun () ->
 					(* We have to respect declaration order, so let's temp var where necessary *)
 					let rec loop fl fl' ok acc = match fl,fl' with
@@ -2351,7 +2214,7 @@ class tclass_to_jvm gctx c = object(self)
 							| _ -> assert false
 						in
 						begin match find_overload_rec' false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
-							| Some(_,cf_impl) -> check true cf cf_impl
+							| Some(_,cf_impl,_) -> check true cf cf_impl
 							| None -> ()
 						end;
 					| _ ->
@@ -2413,7 +2276,7 @@ class tclass_to_jvm gctx c = object(self)
 
 	method private generate_implicit_ctors =
 		try
-			let sm = Hashtbl.find gctx.implicit_ctors c.cl_path in
+			let sm = gctx.preprocessor#get_implicit_ctor c.cl_path in
 			PMap.iter (fun _ (c,cf) ->
 				let cmode = get_construction_mode c cf in
 				let jm = jc#spawn_method (if cmode = ConstructInit then "<init>" else "new") (jsignature_of_type cf.cf_type) [MPublic] in
@@ -2472,7 +2335,7 @@ class tclass_to_jvm gctx c = object(self)
 			handler#texpr RReturn e
 
 	method generate_method gctx jc c mtype cf =
-		gctx.current_field_info <- get_field_info gctx cf.cf_meta;
+		gctx.current_field_info <- gctx.preprocessor#get_field_info cf.cf_meta;
 		let jsig = jsignature_of_type cf.cf_type in
 		let flags = [MPublic] in
 		let flags = if c.cl_interface then MAbstract :: flags else flags in
@@ -2773,12 +2636,6 @@ let debug_path path = match path with
 	| (["haxe";"lang"],_) -> false (* Old Haxe/Java stuff that's weird *)
 	| _ -> true
 
-let is_extern_abstract a = match a.a_impl with
-	| Some {cl_extern = true} -> true
-	| _ -> match a.a_path with
-		| ([],("Void" | "Float" | "Int" | "Single" | "Bool" | "Null")) -> true
-		| _ -> false
-
 let generate_module_type ctx mt =
 	failsafe (t_infos mt).mt_pos (fun () ->
 		match mt with
@@ -2789,210 +2646,6 @@ let generate_module_type ctx mt =
 	)
 
 module Preprocessor = struct
-
-	let is_normal_anon an = match !(an.a_status) with
-		| Closed | Const | Opened -> true
-		| _ -> false
-
-	let check_anon gctx e = match e.etype,follow e.etype with
-		| TType(td,_),TAnon an when is_normal_anon an ->
-			ignore(TAnonIdentifiaction.identify_as gctx td.t_path an.a_fields)
-		| _ ->
-			()
-
-	let add_implicit_ctor gctx c c' cf =
-		let jsig = jsignature_of_type cf.cf_type in
-		try
-			let sm = Hashtbl.find gctx.implicit_ctors c.cl_path in
-			Hashtbl.replace gctx.implicit_ctors c.cl_path (PMap.add (c'.cl_path,jsig) (c',cf) sm);
-		with Not_found ->
-			Hashtbl.add gctx.implicit_ctors c.cl_path (PMap.add (c'.cl_path,jsig) (c',cf) PMap.empty)
-
-	let make_native cf =
-		cf.cf_meta <- (Meta.NativeGen,[],null_pos) :: cf.cf_meta
-
-	let make_haxe cf =
-		cf.cf_meta <- (Meta.HxGen,[],null_pos) :: cf.cf_meta
-
-	let preprocess_constructor_expr gctx c cf e =
-		let used_this = ref false in
-		let this_before_super = ref false in
-		let super_call_fields = DynArray.create () in
-		let is_on_current_class cf = PMap.mem cf.cf_name c.cl_fields in
-		let find_super_ctor el =
-			let csup,map_type = match c.cl_super with
-				| Some(c,tl) -> c,apply_params c.cl_params tl
-				| _ -> assert false
-			in
-			match find_overload_rec' true map_type csup "new" el with
-			| Some(c,cf) ->
-				let rec loop csup =
-					if c != csup then begin
-						match csup.cl_super with
-						| Some(c',_) ->
-							add_implicit_ctor gctx csup c' cf;
-							loop c'
-						| None -> assert false
-					end
-				in
-				loop csup;
-				(c,cf)
-			| None -> Error.error "Could not find overload constructor" e.epos
-		in
-		let rec promote_this_before_super c cf = match get_field_info gctx cf.cf_meta with
-			| None -> jerror "Something went wrong"
-			| Some info ->
-				if not info.has_this_before_super then begin
-					make_haxe cf;
-					(* print_endline (Printf.sprintf "promoted this_before_super to %s.new : %s" (s_type_path c.cl_path) (s_type (print_context()) cf.cf_type)); *)
-					info.has_this_before_super <- true;
-					List.iter (fun (c,cf) -> promote_this_before_super c cf) info.super_call_fields
-				end
-		in
-		let rec loop e =
-			check_anon gctx e;
-			begin match e.eexpr with
-			| TBinop(OpAssign,{eexpr = TField({eexpr = TConst TThis},FInstance(_,_,cf))},e2) when is_on_current_class cf->
-				(* Assigning this.field = value is fine if field is declared on our current class *)
-				loop e2;
-			| TConst TThis ->
-				used_this := true
-			| TCall({eexpr = TConst TSuper},el) ->
-				List.iter loop el;
-				if !used_this then begin
-					this_before_super := true;
-					make_haxe cf;
-					(* print_endline (Printf.sprintf "inferred this_before_super on %s.new : %s" (s_type_path c.cl_path) (s_type (print_context()) cf.cf_type)); *)
-				end;
-				let c,cf = find_super_ctor el in
-				if !this_before_super then promote_this_before_super c cf;
-				DynArray.add super_call_fields (c,cf);
-			| _ ->
-				Type.iter loop e
-			end;
-		in
-		loop e;
-		{
-			has_this_before_super = !this_before_super;
-			super_call_fields = DynArray.to_list super_call_fields;
-		}
-
-	let preprocess_expr gctx e =
-		let rec loop e =
-			check_anon gctx e;
-			Type.iter loop e
-		in
-		loop e
-
-	let check_overrides c = match c.cl_overrides with
-		| []->
-			()
-		| fields ->
-			let csup,map_type = match c.cl_super with
-				| Some(c,tl) -> c,apply_params c.cl_params tl
-				| None -> assert false
-			in
-			let fix_covariant_return cf =
-				let tl = match follow cf.cf_type with
-					| TFun(tl,_) -> tl
-					| _ -> assert false
-				in
-				match find_overload_rec' false map_type csup cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
-				| Some(_,cf') ->
-					let tr = match follow cf'.cf_type with
-						| TFun(_,tr) -> tr
-						| _ -> assert false
-					in
-					cf.cf_type <- TFun(tl,tr);
-					cf.cf_expr <- begin match cf.cf_expr with
-						| Some ({eexpr = TFunction tf} as e) ->
-							Some {e with eexpr = TFunction {tf with tf_type = tr}}
-						| e ->
-							e
-					end;
-				| None ->
-					()
-					(* TODO: this should never happen if we get the unification right *)
-					(* Error.error "Could not find overload" cf.cf_pos *)
-			in
-			List.iter (fun cf ->
-				fix_covariant_return cf;
-				List.iter fix_covariant_return cf.cf_overloads
-			) fields
-
-	let rec get_constructor c =
-		match c.cl_constructor, c.cl_super with
-		| Some cf, _ -> c,cf
-		| None, None -> raise Not_found
-		| None, Some (csup,cparams) -> get_constructor csup
-
-	let preprocess_class gctx c =
-		let field cf = match cf.cf_expr with
-			| None ->
-				()
-			| Some e ->
-				preprocess_expr gctx e
-		in
-		let has_dynamic_instance_method = ref false in
-		let has_field_init = ref false in
-		let field mtype cf =
-			List.iter field (cf :: cf.cf_overloads);
-			match mtype with
-			| MConstructor ->
-				()
-			| MInstance ->
-				begin match cf.cf_kind with
-					| Method MethDynamic -> has_dynamic_instance_method := true
-					| Var _ when cf.cf_expr <> None && not !has_field_init && c.cl_constructor = None && c.cl_super = None ->
-						has_field_init := true;
-						add_implicit_ctor gctx c c (mk_field "new" (tfun [] gctx.com.basic.tvoid) null_pos null_pos)
-					| _ -> ()
-				end;
-			| MStatic ->
-				()
-		in
-		check_overrides c;
-		List.iter (field MStatic) c.cl_ordered_statics;
-		List.iter (field MInstance) c.cl_ordered_fields;
-		match c.cl_constructor with
-		| None ->
-			begin try
-				let csup,cf = get_constructor c in
-				List.iter (fun cf -> add_implicit_ctor gctx c csup cf) (cf :: cf.cf_overloads)
-			with Not_found ->
-				()
-			end;
-		| Some cf ->
-			let field cf =
-				if !has_dynamic_instance_method then make_haxe cf;
-				begin match cf.cf_expr with
-				| None ->
-					()
-				| Some e ->
-					let info = preprocess_constructor_expr gctx c cf e in
-					let index = DynArray.length gctx.field_infos in
-					DynArray.add gctx.field_infos info;
-					cf.cf_meta <- (Meta.Custom ":jvm.fieldInfo",[(EConst (Int (string_of_int index)),null_pos)],null_pos) :: cf.cf_meta;
-					if not (Meta.has Meta.HxGen cf.cf_meta) then begin
-						let rec loop next c =
-							if c.cl_extern then make_native cf
-							else match c.cl_constructor with
-								| Some cf' when Meta.has Meta.HxGen cf'.cf_meta -> make_haxe cf
-								| Some cf' when Meta.has Meta.NativeGen cf'.cf_meta -> make_native cf
-								| _ -> next c
-						in
-						let rec up c = match c.cl_super with
-							| None -> ()
-							| Some(c,_) -> loop up c
-						in
-						let rec down c = List.iter (fun c -> loop down c) c.cl_descendants in
-						loop up c;
-						loop down c
-					end;
-				end
-			in
-			List.iter field (cf :: cf.cf_overloads)
-
 	let make_root path =
 		["haxe";"root"],snd path
 
@@ -3001,7 +2654,7 @@ module Preprocessor = struct
 			match mt with
 			| TClassDecl c ->
 				if fst c.cl_path = [] then c.cl_path <- make_root c.cl_path;
-				if debug_path c.cl_path && not c.cl_interface then preprocess_class gctx c
+				if debug_path c.cl_path && not c.cl_interface then gctx.preprocessor#preprocess_class c
 			| TEnumDecl en ->
 				if fst en.e_path = [] then en.e_path <- make_root en.e_path;
 			| _ -> ()
@@ -3028,16 +2681,14 @@ let generate com =
 	let jar_name = if com.debug then jar_name ^ "-Debug" else jar_name in
 	let jar_dir = add_trailing_slash com.file in
 	let jar_path = Printf.sprintf "%s%s.jar" jar_dir jar_name in
+	let anon_identification = new tanon_identification haxe_dynamic_object_path jsignature_of_type in
 	let gctx = {
 		com = com;
 		jar = Zip.open_out jar_path;
 		t_exception = TInst(resolve_class com (["java";"lang"],"Exception"),[]);
 		t_throwable = TInst(resolve_class com (["java";"lang"],"Throwable"),[]);
-		anon_lut = Hashtbl.create 0;
-		anon_path_lut = Hashtbl.create 0;
-		anon_num = 0;
-		implicit_ctors = Hashtbl.create 0;
-		field_infos = DynArray.create();
+		anon_identification = anon_identification;
+		preprocessor = new preprocessor com.basic anon_identification jsignature_of_type;
 		current_field_info = None;
 		default_export_config = {
 			export_debug = com.debug;
@@ -3106,5 +2757,5 @@ let generate com =
 		end;
 		generate_dynamic_access gctx jc (List.map (fun (name,jsig) -> name,jsig,Var {v_write = AccNormal;v_read = AccNormal}) fields) true;
 		write_class gctx.jar path (jc#export_class gctx.default_export_config)
-	) gctx.anon_lut;
+	) gctx.anon_identification#get_lut;
 	Zip.close_out gctx.jar

src/generators/genshared.ml

@@ -0,0 +1,384 @@
+open Globals
+open Ast
+open TType
+open TFunctions
+open TUnification
+
+type method_type =
+	| MStatic
+	| MInstance
+	| MConstructor
+
+let is_extern_abstract a = match a.a_impl with
+	| Some {cl_extern = true} -> true
+	| _ -> match a.a_path with
+		| ([],("Void" | "Float" | "Int" | "Single" | "Bool" | "Null")) -> true
+		| _ -> false
+
+let unify_cf map_type c cf el =
+	let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+	match follow (apply_params cf.cf_params monos (map_type cf.cf_type)) with
+		| TFun(tl'',_) as tf ->
+			let rec loop2 acc el tl = match el,tl with
+				| e :: el,(n,o,t) :: tl ->
+					begin try
+						Type.unify e.etype t;
+						loop2 ((e,o) :: acc) el tl
+					with _ ->
+						None
+					end
+				| [],[] ->
+					Some ((List.rev acc),tf,(c,cf,monos))
+				| _ ->
+					None
+			in
+			loop2 [] el tl''
+		| t ->
+			None
+
+let unify_cf_with_fallback map_type c cf el =
+	match unify_cf map_type c cf el with
+	| Some(_,_,r) -> r
+	| None -> (c,cf,List.map snd cf.cf_params)
+
+let find_overload map_type c cf el =
+	let matches = ref [] in
+	let rec loop cfl = match cfl with
+		| cf :: cfl ->
+			begin match unify_cf map_type c cf el with
+			| Some r -> matches := r :: !matches;
+			| None -> ()
+			end;
+			loop cfl
+		| [] ->
+			List.rev !matches
+	in
+	loop (cf :: cf.cf_overloads)
+
+let filter_overloads candidates =
+	match Overloads.Resolution.reduce_compatible candidates with
+	| [_,_,(c,cf,tl)] -> Some(c,cf,tl)
+	| [] -> None
+	| ((_,_,(c,cf,tl)) :: _) (* as resolved *) ->
+		(* let st = s_type (print_context()) in
+		print_endline (Printf.sprintf "Ambiguous overload for %s(%s)" name (String.concat ", " (List.map (fun e -> st e.etype) el)));
+		List.iter (fun (_,t,(c,cf)) ->
+			print_endline (Printf.sprintf "\tCandidate: %s.%s(%s)" (s_type_path c.cl_path) cf.cf_name (st t));
+		) resolved; *)
+		Some(c,cf,tl)
+
+let find_overload_rec' is_ctor map_type c name el =
+	let candidates = ref [] in
+	let has_function t1 (_,t2,_) =
+		begin match follow t1,t2 with
+		| TFun(tl1,_),TFun(tl2,_) -> type_iseq (TFun(tl1,t_dynamic)) (TFun(tl2,t_dynamic))
+		| _ -> false
+		end
+	in
+	let rec loop map_type c =
+		begin try
+			let cf = if is_ctor then
+				(match c.cl_constructor with Some cf -> cf | None -> raise Not_found)
+			else
+				PMap.find name c.cl_fields
+			in
+			begin match find_overload map_type c cf el with
+			| [] -> raise Not_found
+			| l ->
+				List.iter (fun ((_,t,_) as ca) ->
+					if not (List.exists (has_function t) !candidates) then candidates := ca :: !candidates
+				) l
+			end;
+			if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then raise Not_found
+		with Not_found ->
+			if c.cl_interface then
+				List.iter (fun (c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c) c.cl_implements
+			else match c.cl_super with
+			| None -> ()
+			| Some(c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c
+		end;
+	in
+	loop map_type c;
+	filter_overloads (List.rev !candidates)
+
+let find_overload_rec is_ctor map_type c cf el =
+	if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then
+		find_overload_rec' is_ctor map_type c cf.cf_name el
+	else match unify_cf map_type c cf el with
+		| Some (_,_,(c,cf,tl)) -> Some (c,cf,tl)
+		| None -> Some(c,cf,List.map snd cf.cf_params)
+
+class ['a] tanon_identification (empty_path : string list * string) (convert : Type.t -> 'a) = object(self)
+	val lut = Hashtbl.create 0
+	val path_lut = Hashtbl.create 0
+	val mutable num = 0
+
+	method get_lut = lut
+
+	method convert_fields (fields : (string,tclass_field) PMap.t) =
+		let l = PMap.fold (fun cf acc -> cf :: acc) fields [] in
+		let l = List.sort (fun cf1 cf2 -> compare cf1.cf_name cf2.cf_name) l in
+		List.map (fun cf -> cf.cf_name,convert cf.cf_type) l
+
+	method identify (fields : (string,tclass_field) PMap.t) =
+		if PMap.is_empty fields then
+			empty_path,[]
+		else begin
+			let l = self#convert_fields fields in
+			try
+				Hashtbl.find lut l,l
+			with Not_found ->
+				let id = num in
+				num <- num + 1;
+				let path = (["haxe";"generated"],Printf.sprintf "Anon%i" id) in
+				Hashtbl.add lut l path;
+				path,l
+		end
+
+	method identify_as path (fields : (string,tclass_field) PMap.t) =
+		if not (PMap.is_empty fields) && not (Hashtbl.mem path_lut path) then begin
+			let fields = self#convert_fields fields in
+			Hashtbl.add lut fields path;
+			Hashtbl.add path_lut path path;
+		end
+end
+
+type field_generation_info = {
+	mutable has_this_before_super : bool;
+	(* This is an ordered list of fields that are targets of super() calls which is determined during
+	   pre-processing. The generator can pop from this list assuming that it processes the expression
+	   in the same order (which it should). *)
+	mutable super_call_fields : (tclass * tclass_field) list;
+}
+
+class ['a] preprocessor (basic : basic_types) (anon_identification : 'a tanon_identification) (convert : Type.t -> 'a) =
+	let is_normal_anon an = match !(an.a_status) with
+		| Closed | Const | Opened -> true
+		| _ -> false
+	in
+	let check_anon e = match e.etype,follow e.etype with
+		| TType(td,_),TAnon an when is_normal_anon an ->
+			ignore(anon_identification#identify_as td.t_path an.a_fields)
+		| _ ->
+			()
+	in
+	let make_native cf =
+		cf.cf_meta <- (Meta.NativeGen,[],null_pos) :: cf.cf_meta
+	in
+	let make_haxe cf =
+		cf.cf_meta <- (Meta.HxGen,[],null_pos) :: cf.cf_meta
+	in
+	let rec get_constructor c =
+		match c.cl_constructor, c.cl_super with
+		| Some cf, _ -> c,cf
+		| None, None -> raise Not_found
+		| None, Some (csup,cparams) -> get_constructor csup
+	in
+	object(self)
+
+	val implicit_ctors : (path,((path * 'a),(tclass * tclass_field)) PMap.t) Hashtbl.t = Hashtbl.create 0
+	val field_infos : field_generation_info DynArray.t = DynArray.create()
+
+	method get_implicit_ctor (path : path) =
+		Hashtbl.find implicit_ctors path
+
+	method get_field_info (ml : metadata) =
+		let rec loop ml = match ml with
+		| (Meta.Custom ":jvm.fieldInfo",[(EConst (Int s),_)],_) :: _ ->
+			Some (DynArray.get field_infos (int_of_string s))
+		| _ :: ml ->
+			loop ml
+		| [] ->
+			None
+		in
+		loop ml
+
+	method add_implicit_ctor (c : tclass) (c' : tclass) (cf : tclass_field) =
+		let jsig = convert cf.cf_type in
+		try
+			let sm = Hashtbl.find implicit_ctors c.cl_path in
+			Hashtbl.replace implicit_ctors c.cl_path (PMap.add (c'.cl_path,jsig) (c',cf) sm);
+		with Not_found ->
+			Hashtbl.add implicit_ctors c.cl_path (PMap.add (c'.cl_path,jsig) (c',cf) PMap.empty)
+
+	method preprocess_constructor_expr (c : tclass) (cf : tclass_field) (e : texpr) =
+		let used_this = ref false in
+		let this_before_super = ref false in
+		let super_call_fields = DynArray.create () in
+		let is_on_current_class cf = PMap.mem cf.cf_name c.cl_fields in
+		let find_super_ctor el =
+			let csup,map_type = match c.cl_super with
+				| Some(c,tl) -> c,apply_params c.cl_params tl
+				| _ -> assert false
+			in
+			match find_overload_rec' true map_type csup "new" el with
+			| Some(c,cf,_) ->
+				let rec loop csup =
+					if c != csup then begin
+						match csup.cl_super with
+						| Some(c',_) ->
+							self#add_implicit_ctor csup c' cf;
+							loop c'
+						| None -> assert false
+					end
+				in
+				loop csup;
+				(c,cf)
+			| None -> Error.error "Could not find overload constructor" e.epos
+		in
+		let find_super_ctor el =
+			let _,cf = find_super_ctor el in
+			(* This is a bit hacky: We always want the direct super class, not the one that actually holds
+			   the ctor. It will be implicitly copied to it anyway. *)
+			match c.cl_super with
+			| None -> assert false
+			| Some(c,_) -> c,cf
+		in
+		let rec promote_this_before_super c cf = match self#get_field_info cf.cf_meta with
+			| None -> failwith "Something went wrong"
+			| Some info ->
+				if not info.has_this_before_super then begin
+					make_haxe cf;
+					(* print_endline (Printf.sprintf "promoted this_before_super to %s.new : %s" (s_type_path c.cl_path) (s_type (print_context()) cf.cf_type)); *)
+					info.has_this_before_super <- true;
+					List.iter (fun (c,cf) -> promote_this_before_super c cf) info.super_call_fields
+				end
+		in
+		let rec loop e =
+			check_anon e;
+			begin match e.eexpr with
+			| TBinop(OpAssign,{eexpr = TField({eexpr = TConst TThis},FInstance(_,_,cf))},e2) when is_on_current_class cf->
+				(* Assigning this.field = value is fine if field is declared on our current class *)
+				loop e2;
+			| TConst TThis ->
+				used_this := true
+			| TCall({eexpr = TConst TSuper},el) ->
+				List.iter loop el;
+				if !used_this then begin
+					this_before_super := true;
+					make_haxe cf;
+					(* print_endline (Printf.sprintf "inferred this_before_super on %s.new : %s" (s_type_path c.cl_path) (s_type (print_context()) cf.cf_type)); *)
+				end;
+				let c,cf = find_super_ctor el in
+				if !this_before_super then promote_this_before_super c cf;
+				DynArray.add super_call_fields (c,cf);
+			| _ ->
+				Type.iter loop e
+			end;
+		in
+		loop e;
+		{
+			has_this_before_super = !this_before_super;
+			super_call_fields = DynArray.to_list super_call_fields;
+		}
+
+	method preprocess_expr e =
+		let rec loop e =
+			check_anon e;
+			Type.iter loop e
+		in
+		loop e
+
+	method check_overrides c = match c.cl_overrides with
+		| []->
+			()
+		| fields ->
+			let csup,map_type = match c.cl_super with
+				| Some(c,tl) -> c,apply_params c.cl_params tl
+				| None -> assert false
+			in
+			let fix_covariant_return cf =
+				let tl = match follow cf.cf_type with
+					| TFun(tl,_) -> tl
+					| _ -> assert false
+				in
+				match find_overload_rec' false map_type csup cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
+				| Some(_,cf',_) ->
+					let tr = match follow cf'.cf_type with
+						| TFun(_,tr) -> tr
+						| _ -> assert false
+					in
+					cf.cf_type <- TFun(tl,tr);
+					cf.cf_expr <- begin match cf.cf_expr with
+						| Some ({eexpr = TFunction tf} as e) ->
+							Some {e with eexpr = TFunction {tf with tf_type = tr}}
+						| e ->
+							e
+					end;
+				| None ->
+					()
+					(* TODO: this should never happen if we get the unification right *)
+					(* Error.error "Could not find overload" cf.cf_pos *)
+			in
+			List.iter (fun cf ->
+				fix_covariant_return cf;
+				List.iter fix_covariant_return cf.cf_overloads
+			) fields
+
+	method preprocess_class (c : tclass) =
+		let field cf = match cf.cf_expr with
+			| None ->
+				()
+			| Some e ->
+				self#preprocess_expr e
+		in
+		let has_dynamic_instance_method = ref false in
+		let has_field_init = ref false in
+		let field mtype cf =
+			List.iter field (cf :: cf.cf_overloads);
+			match mtype with
+			| MConstructor ->
+				()
+			| MInstance ->
+				begin match cf.cf_kind with
+					| Method MethDynamic -> has_dynamic_instance_method := true
+					| Var _ when cf.cf_expr <> None && not !has_field_init && c.cl_constructor = None && c.cl_super = None ->
+						has_field_init := true;
+						self#add_implicit_ctor c c (mk_field "new" (tfun [] basic.tvoid) null_pos null_pos)
+					| _ -> ()
+				end;
+			| MStatic ->
+				()
+		in
+		self#check_overrides c;
+		List.iter (field MStatic) c.cl_ordered_statics;
+		List.iter (field MInstance) c.cl_ordered_fields;
+		match c.cl_constructor with
+		| None ->
+			begin try
+				let csup,cf = get_constructor c in
+				List.iter (fun cf -> self#add_implicit_ctor c csup cf) (cf :: cf.cf_overloads)
+			with Not_found ->
+				()
+			end;
+		| Some cf ->
+			let field cf =
+				if !has_dynamic_instance_method then make_haxe cf;
+				begin match cf.cf_expr with
+				| None ->
+					()
+				| Some e ->
+					let info = self#preprocess_constructor_expr c cf e in
+					let index = DynArray.length field_infos in
+					DynArray.add field_infos info;
+					cf.cf_meta <- (Meta.Custom ":jvm.fieldInfo",[(EConst (Int (string_of_int index)),null_pos)],null_pos) :: cf.cf_meta;
+					if not (Meta.has Meta.HxGen cf.cf_meta) then begin
+						let rec loop next c =
+							if c.cl_extern then make_native cf
+							else match c.cl_constructor with
+								| Some cf' when Meta.has Meta.HxGen cf'.cf_meta -> make_haxe cf
+								| Some cf' when Meta.has Meta.NativeGen cf'.cf_meta -> make_native cf
+								| _ -> next c
+						in
+						let rec up c = match c.cl_super with
+							| None -> ()
+							| Some(c,_) -> loop up c
+						in
+						let rec down c = List.iter (fun c -> loop down c) c.cl_descendants in
+						loop up c;
+						loop down c
+					end;
+				end
+			in
+			List.iter field (cf :: cf.cf_overloads)
+end