support for abstract type parameters (fixed issue #1400)

codegen.ml

@@ -1301,26 +1301,29 @@ let check_local_vars_init e =
 (* ABSTRACT CASTS *)
 
 let handle_abstract_casts ctx e =
-	let make_cast_call c cf earg t p =
+	let make_cast_call c cf a pl args t p =
 		let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
 		let ethis = mk (TTypeExpr (TClassDecl c)) ta p in
+		let def () =
+			let e = mk (TField (ethis,(FStatic (c,cf)))) cf.cf_type p in
+			mk (TCall(e,args)) t p
+		in
 		(match cf.cf_expr with
-		| Some { eexpr = TFunction fd } ->
-			(match Optimizer.type_inline ctx cf fd ethis earg t p false with
+		| Some { eexpr = TFunction fd } when cf.cf_kind = Method MethInline ->
+			(match Optimizer.type_inline ctx cf fd ethis args t (Some (a.a_types <> [], apply_params a.a_types pl)) p true with
 				| Some e -> e
 				| None ->
-					let e = mk (TField (ethis,(FStatic (c,cf)))) cf.cf_type p in
-					mk (TCall(e,earg)) t p)
+					def())
 		| _ ->
-			assert false)
+			def())
 	in
-	let find_from_cast c a t p =
+	let find_from_cast c a pl t p =
 		let rec loop cfl = match cfl with
 			| [] ->
 				raise Not_found
 			| cf :: cfl when has_meta ":from" cf.cf_meta ->
 				begin match follow cf.cf_type with
-				| TFun([_,_,ta],_) when type_iseq ta t ->
+				| TFun([_,_,ta],_) when type_iseq (apply_params a.a_types pl ta) t ->
 					cf
 				| _ ->
 					loop cfl
@@ -1349,25 +1352,25 @@ let handle_abstract_casts ctx e =
 	let rec check_cast tleft eright p =
 		let eright = loop eright in
 		try (match follow tleft,follow eright.etype with
-			| (TAbstract({a_impl = Some c1} as a1,_) as t1),(TAbstract({a_impl = Some c2} as a2,_) as t2) ->
+			| (TAbstract({a_impl = Some c1} as a1,pl1) as t1),(TAbstract({a_impl = Some c2} as a2,pl2) as t2) ->
 				if a1 == a2 then
 					eright
 				else begin
-					let c,cf = try
-						c1,find_from_cast c1 a1 t2 p
+					let c,cf,a,pl = try
+						c1,find_from_cast c1 a1 pl1 t2 p,a1,pl1
 					with Not_found ->
-						c2,find_to_cast c2 a2 t1 p
+						c2,find_to_cast c2 a2 t1 p,a2,pl2
 					in
-					make_cast_call c cf [eright] tleft p
+					make_cast_call c cf a pl [eright] tleft p
 				end
 			| TDynamic _,_ | _,TDynamic _ ->
 				eright
-			| TAbstract({a_impl = Some c} as a ,_),t ->
-				let cf = find_from_cast c a eright.etype p in
-				make_cast_call c cf [eright] tleft p
-			| t,TAbstract({a_impl = Some c} as a,_) ->
+			| TAbstract({a_impl = Some c} as a,pl),t ->
+				let cf = find_from_cast c a pl eright.etype p in
+				make_cast_call c cf a pl [eright] tleft p
+			| t,TAbstract({a_impl = Some c} as a,pl) ->
 				let cf = find_to_cast c a t p in
-				make_cast_call c cf [eright] tleft p
+				make_cast_call c cf a pl [eright] tleft p
 			| _ ->
 				eright)
 		with Not_found ->

optimizer.ml

@@ -80,7 +80,29 @@ type in_local = {
 	mutable i_read : int;
 }
 
-let rec type_inline ctx cf f ethis params tret p force =
+let inline_default_config cf t =
+	(* type substitution on both class and function type parameters *)
+	let rec get_params c pl =
+		match c.cl_super with
+		| None -> c.cl_types, pl
+		| Some (csup,spl) ->
+			let spl = (match apply_params c.cl_types pl (TInst (csup,spl)) with
+			| TInst (_,pl) -> pl
+			| _ -> assert false
+			) in
+			let ct, cpl = get_params csup spl in
+			c.cl_types @ ct, pl @ cpl
+	in
+	let tparams = (match follow t with
+		| TInst (c,pl) -> get_params c pl
+		| _ -> ([],[]))
+	in
+	let pmonos = List.map (fun _ -> mk_mono()) cf.cf_params in
+	let tmonos = snd tparams @ pmonos in
+	let tparams = fst tparams @ cf.cf_params in
+	tparams <> [], apply_params tparams tmonos
+
+let rec type_inline ctx cf f ethis params tret config p force =
 	(* perform some specific optimization before we inline the call since it's not possible to detect at final optimization time *)
 	try
 		let cl = (match follow ethis.etype with
@@ -92,25 +114,7 @@ let rec type_inline ctx cf f ethis params tret p force =
 		| None -> raise Exit
 		| Some e -> Some e)
 	with Exit ->
-	(* type substitution on both class and function type parameters *)
-	let has_params, map_type =
-		let rec get_params c pl =
-			match c.cl_super with
-			| None -> c.cl_types, pl
-			| Some (csup,spl) ->
-				let spl = (match apply_params c.cl_types pl (TInst (csup,spl)) with
-				| TInst (_,pl) -> pl
-				| _ -> assert false
-				) in
-				let ct, cpl = get_params csup spl in
-				c.cl_types @ ct, pl @ cpl
-		in
-		let tparams = (match follow ethis.etype with TInst (c,pl) -> get_params c pl | _ -> ([],[])) in
-		let pmonos = List.map (fun _ -> mk_mono()) cf.cf_params in
-		let tmonos = snd tparams @ pmonos in
-		let tparams = fst tparams @ cf.cf_params in
-		tparams <> [], apply_params tparams tmonos
-	in
+	let has_params,map_type = match config with Some config -> config | None -> inline_default_config cf ethis.etype in
 	(* locals substitution *)
 	let locals = Hashtbl.create 0 in
 	let local v =
@@ -332,7 +336,7 @@ let rec type_inline ctx cf f ethis params tret p force =
 		(* force inlining if we modify 'this' *)
 		if i.i_write && i.i_var.v_name = "this" then force := true;
 		(* force inlining of 'this' variable if the expression is writable *)
-		let flag = if not flag && i.i_var.v_name = "this" then begin			
+		let flag = if not flag && i.i_var.v_name = "this" then begin
 			if i.i_write && not (is_writable e) then error "Cannot modify the abstract value, store it into a local first" p;
 			true
 		end else flag in
@@ -387,7 +391,14 @@ let rec type_inline ctx cf f ethis params tret p force =
 			Some e
 		else
 			let mt = map_type cf.cf_type in
-			unify_raise ctx mt (TFun (List.map (fun e -> "",false,e.etype) params,tret)) p;
+			let unify_func () = unify_raise ctx mt (TFun (List.map (fun e -> "",false,e.etype) params,tret)) p in
+			(match follow ethis.etype with
+			| TAnon a -> (match !(a.a_status) with
+				| Statics {cl_kind = KAbstractImpl a } ->
+					(* TODO: we might have to unify something here *)
+					()
+				| _ -> unify_func())
+			| _ -> unify_func());
 			(*
 				this is very expensive since we are building the substitution list for
 				every expression, but hopefully in such cases the expression size is small
@@ -892,7 +903,7 @@ let rec reduce_loop ctx e =
 		let cf = mk_field "" ef.etype e.epos in
 		let ethis = mk (TConst TThis) t_dynamic e.epos in
 		let rt = (match follow ef.etype with TFun (_,rt) -> rt | _ -> assert false) in
-		let inl = (try type_inline ctx cf func ethis el rt e.epos false with Error (Custom _,_) -> None) in
+		let inl = (try type_inline ctx cf func ethis el rt None e.epos false with Error (Custom _,_) -> None) in
 		(match inl with
 		| None -> reduce_expr ctx e
 		| Some e -> reduce_loop ctx e)
@@ -919,7 +930,7 @@ let rec make_constant_expression ctx e =
 		(try
 			let func = match cf.cf_expr with Some ({eexpr = TFunction func}) -> func | _ -> raise Not_found in
 			let ethis = mk (TConst TThis) t_dynamic e.epos in
-			let inl = (try type_inline ctx cf func ethis el ret e.epos false with Error (Custom _,_) -> None) in
+			let inl = (try type_inline ctx cf func ethis el ret None e.epos false with Error (Custom _,_) -> None) in
 			(match inl with
 			| None -> None
 			| Some e -> make_constant_expression ctx e)

typeload.ml

@@ -148,7 +148,7 @@ let make_module ctx mpath file tdecls loadp =
 					| _ ->
 						f
 				) fields in
-				let acc = make_decl acc (EClass { d_name = d.d_name ^ "Impl"; d_flags = [HPrivate]; d_data = fields; d_doc = None; d_params = d.d_params; d_meta = [] },p) in
+				let acc = make_decl acc (EClass { d_name = d.d_name ^ "Impl"; d_flags = [HPrivate]; d_data = fields; d_doc = None; d_params = []; d_meta = [] },p) in
 				(match !decls with
 				| (TClassDecl c,_) :: _ ->
 					a.a_impl <- Some c;
@@ -1302,7 +1302,11 @@ let init_class ctx c p context_init herits fields =
 			let parent = (if not stat then get_parent c name else None) in
 			let dynamic = List.mem ADynamic f.cff_access || (match parent with Some { cf_kind = Method MethDynamic } -> true | _ -> false) in
 			if inline && dynamic then error "You can't have both 'inline' and 'dynamic'" p;
-			ctx.type_params <- if stat then params else params @ ctx.type_params;
+			ctx.type_params <- (match c.cl_kind with
+				| KAbstractImpl a ->
+					params @ a.a_types
+				| _ ->
+					if stat then params else params @ ctx.type_params);
 			let constr = (name = "new") in
 			let ret = if constr then ctx.t.tvoid else type_opt ctx p fd.f_type in
 			let args = List.map (fun (name,opt,t,c) ->

typer.ml

@@ -548,7 +548,7 @@ let get_constructor ctx c params p =
 	| KAbstractImpl a ->
 		let f = (try PMap.find "_new" c.cl_statics with Not_found -> error (s_type_path a.a_path ^ " does not have a constructor") p) in
 		let ct = field_type ctx c params f p in
-		apply_params c.cl_types params ct, f
+		apply_params a.a_types params ct, f
 	| _ ->
 		let ct, f = (try Type.get_constructor (fun f -> field_type ctx c params f p) c with Not_found -> error (s_type_path c.cl_path ^ " does not have a constructor") p) in
 		apply_params c.cl_types params ct, f
@@ -568,11 +568,21 @@ let make_call ctx e params t p =
 			| _ when has_meta ":extern" f.cf_meta -> true
 			| _ -> false
 		) in
+		let config = match cl with
+			| Some ({cl_kind = KAbstractImpl _ }) ->
+				(match if fname = "_new" then t else follow (List.hd params).etype with
+					| TAbstract(a,pl) ->
+						Some (a.a_types <> [], apply_params a.a_types pl)
+					| _ ->
+						None);
+			| _ ->
+				None
+		in
 		ignore(follow f.cf_type); (* force evaluation *)
 		let params = List.map (ctx.g.do_optimize ctx) params in
 		(match f.cf_expr with
 		| Some { eexpr = TFunction fd } ->
-			(match Optimizer.type_inline ctx f fd ethis params t p is_extern with
+			(match Optimizer.type_inline ctx f fd ethis params t config p is_extern with
 			| None ->
 				if is_extern then error "Inline could not be done" p;
 				raise Exit;
@@ -1011,6 +1021,7 @@ and type_field ctx e i p mode =
 			let c = (match a.a_impl with None -> raise Not_found | Some c -> c) in
 			let f = PMap.find i c.cl_statics in
 			let t = field_type ctx c [] f p in
+			let t = apply_params a.a_types pl t in
 			let et = type_module_type ctx (TClassDecl c) None p in
 			AKUsing ((mk (TField (et,FStatic (c,f))) t p),c,f,e)
 		with Not_found -> try
@@ -3206,7 +3217,7 @@ and flush_macro_context mint ctx =
 	(* we should maybe ensure that all filters in Main are applied. Not urgent atm *)
 	Interp.add_types mint types (Codegen.post_process [Codegen.captured_vars mctx.com; Codegen.rename_local_vars mctx.com]);
 	Codegen.post_process_end()
-	
+
 let create_macro_interp ctx mctx =
 	let com2 = mctx.com in
 	let mint, init = (match !macro_interp_cache with
@@ -3227,7 +3238,7 @@ let create_macro_interp ctx mctx =
 	mctx.g.macros <- Some macro;
 	(* mctx.g.core_api <- ctx.g.core_api; // causes some issues because of optional args and Null type in Flash9 *)
 	init()
-	
+
 let get_macro_context ctx p =
 	let api = make_macro_api ctx p in
 	match ctx.g.macros with