Explorar o código

reverted improved generics

Simon Krajewski %!s(int64=13) %!d(string=hai) anos
pai
achega
a25f8b9f2f
Modificáronse 7 ficheiros con 75 adicións e 187 borrados
  1. 66 98
      codegen.ml
  2. 5 23
      optimizer.ml
  3. 0 13
      tests/unit/MyClass.hx
  4. 0 29
      tests/unit/TestType.hx
  5. 0 12
      type.ml
  6. 3 8
      typeload.ml
  7. 1 4
      typer.ml

+ 66 - 98
codegen.ml

@@ -201,9 +201,47 @@ let extend_remoting ctx c t p async prot =
 (* -------------------------------------------------------------------------- *)
 (* HAXE.RTTI.GENERIC *)
 
-(* updates class ct(arget) from cs(ource) by sustituting types from ps to pt *)
-let rec build_generic ctx cs ct ps pt p =
-	let rec copy_class ctx cs ct ps pt p =
+let rec build_generic ctx c p tl =
+	let pack = fst c.cl_path in
+	let recurse = ref false in
+	let rec check_recursive t =
+		match follow t with
+		| TInst (c,tl) ->
+			(match c.cl_kind with KTypeParameter _ -> recurse := true | _ -> ());
+			List.iter check_recursive tl;
+		| _ ->
+			()
+	in
+	let name = String.concat "_" (snd c.cl_path :: (List.map (fun t ->
+		check_recursive t;
+		let path = (match follow t with
+			| TInst (c,_) -> c.cl_path
+			| TEnum (e,_) -> e.e_path
+			| TMono _ -> error "Type parameter must be explicit when creating a generic instance" p
+			| _ -> error "Type parameter must be a class or enum instance" p
+		) in
+		match path with
+		| [] , name -> name
+		| l , name -> String.concat "_" l ^ "_" ^ name
+	) tl)) in
+	if !recurse then
+		TInst (c,tl) (* build a normal instance *)
+	else try
+		Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
+	with Error(Module_not_found path,_) when path = (pack,name) ->
+		let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
+		let ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
+		let mg = {
+			m_id = alloc_mid();
+			m_path = (pack,name);
+			m_types = [];
+			m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake;
+		} in
+		let cg = mk_class mg (pack,name) c.cl_pos in
+		mg.m_types <- [TClassDecl cg];
+		Hashtbl.add ctx.g.modules mg.m_path mg;
+		add_dependency mg m;
+		add_dependency ctx.current mg;
 		let rec loop l1 l2 =
 			match l1, l2 with
 			| [] , [] -> []
@@ -211,7 +249,7 @@ let rec build_generic ctx cs ct ps pt p =
 			| (_,t1) :: l1 , t2 :: l2 -> (t1,t2) :: loop l1 l2
 			| _ -> assert false
 		in
-		let subst = loop ps pt in
+		let subst = loop c.cl_types tl in
 		let rec build_type t =
 			match t with
 			| TInst ({ cl_kind = KGeneric } as c2,tl2) ->
@@ -235,73 +273,37 @@ let rec build_generic ctx cs ct ps pt p =
 			let t = build_type f.cf_type in
 			{ f with cf_type = t; cf_expr = (match f.cf_expr with None -> None | Some e -> Some (build_expr e)) }
 		in
-		ct.cl_path <- cs.cl_path;
-		ct.cl_module <- cs.cl_module;
-		(* TODO: find a way to deal with this *)
-	(* 	ct.cl_super <- (match cs.cl_super with
+		if c.cl_init <> None || c.cl_dynamic <> None then error "This class can't be generic" p;
+		if c.cl_ordered_statics <> [] then error "A generic class can't have static fields" p;
+		cg.cl_super <- (match c.cl_super with
 			| None -> None
-			| Some (cs,params) ->
-				(match apply_params cs.cl_types pt (TInst (cs,params)) with
-				| TInst ({cl_kind = KGeneric },params) ->
-					build_generic ctx cs ps params p;
-					Some (cs,params)
-				| TInst (cs,params) -> Some (cs,params)
+			| Some (cs,pl) ->
+				(match apply_params c.cl_types tl (TInst (cs,pl)) with
+				| TInst (cs,pl) when cs.cl_kind = KGeneric ->
+					(match build_generic ctx cs p pl with
+					| TInst (cs,pl) -> Some (cs,pl)
+					| _ -> assert false)
+				| TInst (cs,pl) -> Some (cs,pl)
 				| _ -> assert false)
-		); *)
-		ct.cl_interface <- cs.cl_interface;
-		ct.cl_constructor <- (match cs.cl_constructor, cs.cl_super with
+		);
+		cg.cl_kind <- KGenericInstance (c,tl);
+		cg.cl_interface <- c.cl_interface;
+		cg.cl_constructor <- (match c.cl_constructor, c.cl_super with
 			| None, None -> None
-			| Some cs, _ -> Some (build_field cs)
-			| _ -> error "Please define a constructor for this class in order to use it as generic" cs.cl_pos
+			| Some c, _ -> Some (build_field c)
+			| _ -> error "Please define a constructor for this class in order to use it as generic" c.cl_pos
 		);
-		ct.cl_implements <- List.map (fun (i,tl) ->
+		cg.cl_implements <- List.map (fun (i,tl) ->
 			(match follow (build_type (TInst (i, List.map build_type tl))) with
 			| TInst (i,tl) -> i, tl
 			| _ -> assert false)
-		) cs.cl_implements;
-		ct.cl_ordered_fields <- List.map (fun f ->
+		) c.cl_implements;
+		cg.cl_ordered_fields <- List.map (fun f ->
 			let f = build_field f in
-			ct.cl_fields <- PMap.add f.cf_name f ct.cl_fields;
+			cg.cl_fields <- PMap.add f.cf_name f cg.cl_fields;
 			f
-		) cs.cl_ordered_fields;
-		ct.cl_extern <- false;
-		ct.cl_kind <- KNormal;
-		(* this is currently necessary *)
-		ct.cl_meta <- (":keep",[],p) :: ct.cl_meta
-	in
-	let pack = fst ct.cl_path in
-	let name = String.concat "_" (snd ct.cl_path :: (List.map2 (fun (s,_) t ->
-		let path = (match follow t with
-			| TInst({ cl_kind = KGenericInstance _} as c2,[]) ->
-				error ("Generic instance " ^ (s_type_path c2.cl_path) ^ " cannot be used as type parameter") p;			
-			| TInst (ct,_) -> ct.cl_path
-			| TEnum (e,_) -> e.e_path
-			| TMono _ -> error ("Could not determine type for parameter " ^ s) p
-			| _ -> error "Type parameter must be a class or enum instance" p
-		) in
-		match path with
-		| [] , name -> name
-		| l , name -> String.concat "_" l ^ "_" ^ name
-	) ps pt)) in
-	try
-		(match Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false with
-		| TInst(cs,[]) -> copy_class ctx cs ct ps pt p
-		| _ -> assert false)
-	with Error(Module_not_found path,_) when path = (pack,name) ->
-		let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module cs.cl_path) with Not_found -> assert false) in
-		let ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
-		let mg = {
-			m_id = alloc_mid();
-			m_path = (pack,name);
-			m_types = [];
-			m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake;
-		} in
- 		mg.m_types <- [TClassDecl ct];
-		Hashtbl.add ctx.g.modules mg.m_path mg;
-		copy_class ctx cs ct ps pt p;
-		ct.cl_path <- (pack,name);
-		ct.cl_module <- mg;
-		ctx.com.types <- TClassDecl ct :: ctx.com.types
+		) c.cl_ordered_fields;
+		TInst (cg,[])
 
 (* -------------------------------------------------------------------------- *)
 (* HAXE.XML.PROXY *)
@@ -431,38 +433,7 @@ let build_instance ctx mtype p =
 				let r = exc_protect ctx (fun r ->
 					let t = mk_mono() in
 					r := (fun() -> t);
-	 				if List.exists (fun t -> match t with
-						| TInst({cl_kind = KTypeParameter _},[]) -> true
-						| _ -> false
-					) pl then
-						(* we can't use generic if there's a type parameter involved *)
-						unify_raise ctx (TInst(c,pl)) t p
-					else begin
-						(* create the new generic instance *)
-						let c2 = mk_class c.cl_module c.cl_path p in
-						c2.cl_kind <- KGenericInstance (c,pl);
-						(* apply the class type parameters with all currently known types to all class fields *)
-						(* the remaining monos should be unified through calls, otherwise generic build fails *)
-	 					let apply_field cf =
-							{cf with cf_type = apply_params c.cl_types pl cf.cf_type; cf_expr = None }
-						in
- 						(match c.cl_constructor with None -> () | Some ctor -> c2.cl_constructor <- Some (apply_field ctor));
-						List.iter (fun cf ->
-							let cf = apply_field cf in
-							c2.cl_ordered_statics <- cf :: c2.cl_ordered_statics;
-							c2.cl_statics <- PMap.add cf.cf_name cf c2.cl_statics;
-						) c.cl_ordered_statics;
-						List.iter (fun cf ->
-							let cf = apply_field cf in
-							c2.cl_ordered_fields <- cf :: c2.cl_ordered_fields;
-							c2.cl_fields <- PMap.add cf.cf_name cf c2.cl_fields;
-						) c.cl_ordered_fields;
-						(* at some point in the future the instance will actually be built *)
-						delay_late ctx (fun () ->
-							build_generic ctx c c2 c.cl_types pl p;
-						);
-						unify_raise ctx (TInst(c2,[])) t p;
-					end;
+					unify_raise ctx (build_generic ctx c p pl) t p;
 					t
 				) in
 				delay ctx (fun() -> ignore ((!r)()));
@@ -625,10 +596,7 @@ let on_generate ctx t =
 			let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
 			if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 		end;
-		if c.cl_kind = KGeneric then begin
-			if c.cl_ordered_statics <> [] then error "A generic class can't have static fields" c.cl_pos;
-			c.cl_extern <- true
-		end;
+		if c.cl_kind = KGeneric then c.cl_extern <- true;
 		c.cl_restore <- restore c;
 		List.iter (fun m ->
 			match m with

+ 5 - 23
optimizer.ml

@@ -458,8 +458,7 @@ let optimize_for_loop ctx i e1 e2 p =
 				NormalWhile
 			)) t_void p;
 		]
-		(* disabled for now due to problems with new generic implementation *)
-(* 	| _ , TInst ({ cl_kind = KGenericInstance ({ cl_path = ["haxe"],"FastList" },[t]) } as c,[]) ->
+	| _ , TInst ({ cl_kind = KGenericInstance ({ cl_path = ["haxe"],"FastList" },[t]) } as c,[]) ->
 		let tcell = (try (PMap.find "head" c.cl_fields).cf_type with Not_found -> assert false) in
 		let i = add_local ctx i t in
 		let cell = gen_local ctx tcell in
@@ -478,7 +477,7 @@ let optimize_for_loop ctx i e1 e2 p =
 				block,
 				NormalWhile
 			)) t_void p
-		] *)
+		]
 	| _ ->
 		None
 
@@ -542,8 +541,7 @@ let rec add_final_return e t =
 	| _ ->
 		{ e with eexpr = TBlock [e;def_return e.epos] }
 
-let sanitize_expr ctx e =
-	let com = ctx.com in
+let sanitize_expr com e =
 	let parent e =
 		match e.eexpr with
 		| TParenthesis _ -> e
@@ -628,22 +626,6 @@ let sanitize_expr ctx e =
 			| _ -> { f with tf_expr = block f.tf_expr }
 		) in
 		{ e with eexpr = TFunction f }
-	(* we skipped inline on generic instances, so let's try to do it now *)
-	| TCall({eexpr = TField(ethis,fname)} as e2,args) ->
-		let def () = if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e in
-		(match follow ethis.etype with
-		| TInst({cl_kind = KGenericInstance _ } as c,[]) ->
-			(try
-				let f = snd (Type.class_field c fname) in
-				(match f.cf_expr with
-					| Some { eexpr = TFunction fd } ->
-						(match type_inline ctx f fd ethis args e.etype e.epos false	with
-						| None -> def()
-						| Some e -> e)
-					| _ -> def())
-			with Not_found ->
-				def())
-		| _ -> def())
 	| TCall (e2,args) ->
 		if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e
 	| TField (e2,f) ->
@@ -694,7 +676,7 @@ let reduce_expr ctx e =
 		e
 
 let rec sanitize ctx e =
-	sanitize_expr ctx (reduce_expr ctx (Type.map_expr (sanitize ctx) e))
+	sanitize_expr ctx.com (reduce_expr ctx (Type.map_expr (sanitize ctx) e))
 
 (* ---------------------------------------------------------------------- *)
 (* REDUCE *)
@@ -716,7 +698,7 @@ let rec reduce_loop ctx e =
 		let fstr = string_of_float f in
 		if (match classify_float f with FP_nan | FP_infinite -> false | _ -> float_of_string fstr = f) then { e with eexpr = TConst (TFloat fstr) } else e
 	in
-	sanitize_expr ctx (match e.eexpr with
+	sanitize_expr ctx.com (match e.eexpr with
 	| TIf ({ eexpr = TConst (TBool t) },e1,e2) ->
 		(if t then e1 else match e2 with None -> { e with eexpr = TBlock [] } | Some e -> e)
 	| TWhile ({ eexpr = TConst (TBool false) },sub,flag) ->

+ 0 - 13
tests/unit/MyClass.hx

@@ -193,17 +193,4 @@ class UsingUnrelated {
 		#end
 		return "foo".pupFunc() + "foo".siblingFunc();
 	}
-}
-
-class ClassWithBar {
-	public function new() { }
-	public var bar:Int;
-}
-
-@:generic class MyGeneric < S, T > {
-	public function new(s:S) { }
-	public function clone() {
-		return new S("foo");
-	}
-	public function bindT(t:T) { }
 }

+ 0 - 29
tests/unit/TestType.hx

@@ -500,33 +500,4 @@ class TestType extends Test {
 	inline function inlineTest2(map:Array<Dynamic>) {
 		map[0];
 	}
-	
-	public function testGeneric() {
-		var l = new haxe.FastList();
-		var l2 = new haxe.FastList<Int>();
-		var l3 = new haxe.FastList();
-		l.add(1);
-		l2 = l;
-		l3.remove("foo");
-		
-		eq(Type.getClassName(Type.getClass(l)), "haxe.FastList_Int");
-		eq(Type.getClassName(Type.getClass(l2)), "haxe.FastList_Int");
-		eq(Type.getClassName(Type.getClass(l3)), "haxe.FastList_String");
-		
-		var mg = new MyGeneric("foo");
-		eq(mg.clone(), "foo");
-		mg.bindT(1);
-		eq(Type.getClassName(Type.getClass(mg)), "unit.MyGeneric_String_Int");
-		
-		var mg2 = new MyGeneric(new haxe.Template("bar"));
-		t(Std.is(mg2.clone(), haxe.Template));
-		mg2.bindT(true);
-		eq(Type.getClassName(Type.getClass(mg2)), "unit.MyGeneric_haxe_Template_Bool");
-		
-		// error cases
-		//var missingT = new MyGeneric("foo"); // Could not determine type for parameter T
-		//var invalidS = new MyGeneric( { foo: 1 } ).bindT("foo"); // Type parameter must be a class or enum instance
-		//var invalidCtor = new MyGeneric(1).bindT("foo"); // Int should be { new : String -> Void }
-		//new MyGenericClass2().bindS(new ClassWithBar()); // unit.ClassWithBar should be { foo : Int }
-	}		
 }

+ 0 - 12
type.ml

@@ -349,14 +349,6 @@ let print_context() = ref []
 
 let is_closed a = !(a.a_status) <> Opened
 
-let pos_t t = match t with
-	| TInst (c,_) -> c.cl_pos
-	| TEnum (e,_) -> e.e_pos
-	| TType (t,_) -> t.t_pos
-	| TAnon a when not (PMap.is_empty a.a_fields) ->
-		PMap.fold (fun cf pu -> if pu = Ast.null_pos then cf.cf_pos else punion pu cf.cf_pos) a.a_fields Ast.null_pos;
-	| _ -> Ast.null_pos
-
 let rec s_type ctx t =
 	match t with
 	| TMono r ->
@@ -899,10 +891,6 @@ let rec unify a b =
 	| TEnum (ea,tl1) , TEnum (eb,tl2) ->
 		if ea != eb then error [cannot_unify a b];
 		unify_types a b tl1 tl2
-	| TInst({cl_kind = KGenericInstance (c1,pl1)},_), TInst({cl_kind = KGenericInstance (c2,pl2)},_) ->
-		(* unify generic instances by unifying their base classes and type parameters *)
-		unify (TInst(c1,[])) (TInst(c2,[]));
-		unify_types (TInst(c1,pl1)) (TInst(c2,pl2)) pl1 pl2
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
 		let rec loop c tl =
 			if c == c2 then begin

+ 3 - 8
typeload.ml

@@ -120,7 +120,7 @@ let rec load_type_def ctx p t =
 let check_param_constraints ctx types t pl c p =
  	match follow t with
 	| TMono _ -> ()
-	| mt ->
+	| _ ->
 		let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in
 		List.iter (fun ti ->
 			(*
@@ -128,12 +128,7 @@ let check_param_constraints ctx types t pl c p =
 				let ti = try snd (List.find (fun (_,t) -> match follow t with TInst(i2,[]) -> i == i2 | _ -> false) types) with Not_found -> TInst (i,tl) in
 			*)
 			let ti = apply_params types pl ti in
-			try
-				unify_raise ctx t ti p
-			with Error (Unify l,p) ->
-				display_error ctx (error_msg (Unify (Constraint_failure (s_type (print_context()) mt) :: l))) p;
-				let pc = pos_t ti in
-				if pc <> Ast.null_pos then display_error ctx "Constraint was defined here" pc;
+			unify ctx t ti p
 		) ctl
 
 (* build an instance from a full type *)
@@ -151,7 +146,7 @@ let rec load_instance ctx t p allow_no_params =
 				match follow t with
 				| TInst (c,_) ->
 					let t = mk_mono() in
-					if c.cl_kind <> KTypeParameter [] then delay_late ctx (fun() -> check_param_constraints ctx types t (!pl) c p);
+					delay_late ctx (fun() -> check_param_constraints ctx types t (!pl) c p);
 					t;
 				| _ -> assert false
 			) types;

+ 1 - 4
typer.ml

@@ -126,8 +126,6 @@ let field_type ctx c pl f p =
 							Type.unify m ct
 						with Unify_error l ->
 							display_error ctx (error_msg (Unify (Constraint_failure (f.cf_name ^ "." ^ name) :: l))) p;
-							let pc = pos_t ct in
-							if pc <> Ast.null_pos then display_error ctx "Constraint was defined here" pc;
 					) constr
 				);
 			| _ -> ()
@@ -440,8 +438,7 @@ let make_call ctx e params t p =
 			| _ when has_meta ":extern" f.cf_meta -> true
 			| _ -> false
 		) in
-		(* can not inline generic instance calls here *)
-		(match cl with Some {cl_kind = KGenericInstance _} -> raise Exit | _ -> ());
+		(* we have to make sure that we mark the field as used here so DCE does not remove it *)
 		if not ctx.g.doinline && not is_extern then raise Exit;
 		ignore(follow f.cf_type); (* force evaluation *)
 		let params = List.map (ctx.g.do_optimize ctx) params in