Browse Source

allow @:generic abstracts

Simon Krajewski 12 years ago
parent
commit
3ecb209d76
5 changed files with 99 additions and 5 deletions
  1. 31 1
      codegen.ml
  2. 32 0
      tests/unit/MyAbstract.hx
  3. 26 0
      tests/unit/TestType.hx
  4. 9 3
      typeload.ml
  5. 1 1
      typer.ml

+ 31 - 1
codegen.ml

@@ -1369,9 +1369,39 @@ let handle_abstract_casts ctx e =
 		| TVars vl ->
 			let vl = List.map (fun (v,eo) -> match eo with
 				| None -> (v,eo)
-				| Some e -> (v,Some (check_cast v.v_type e e.epos))
+				| Some e ->
+					let is_generic_abstract = match e.etype with TAbstract ({a_impl = Some _} as a,_) -> Meta.has Meta.Generic a.a_meta | _ -> false in
+					let e = check_cast v.v_type e e.epos in
+					(* we can rewrite this for better field inference *)
+					if is_generic_abstract then v.v_type <- e.etype;
+					v, Some e
 			) vl in
 			{ e with eexpr = TVars vl }
+		| TNew({cl_kind = KAbstractImpl a} as c,pl,el) ->
+			(* a TNew of an abstract implementation is only generated if it is a generic abstract *)
+			let at = apply_params a.a_types pl a.a_this in
+			let m = mk_mono() in
+			let _,cfo =
+				try find_to a pl at m
+				with Not_found -> error ("Could not determine type for " ^ (s_type (print_context()) at)) e.epos
+			in
+			begin match cfo with
+			| None -> assert false
+			| Some cf ->
+				let m = follow m in
+				let e = make_cast_call c cf a pl ((mk (TConst TNull) at e.epos) :: el) m e.epos in
+				{e with etype = m}
+			end
+		| TField({etype = TAbstract({a_impl = Some _} as a,pl)} as e1,fa) when Meta.has Meta.Generic a.a_meta ->
+			let at = apply_params a.a_types pl a.a_this in
+			let m = mk_mono() in
+			begin try
+				let _ = find_to a pl at m in
+				(* we could inline this if we had access to Typer.make_call *)
+				{e with eexpr = TField({e1 with etype = m},quick_field m (field_name fa))}
+			with Not_found ->
+				e
+			end
 		| TCall(e1, el) ->
 			begin match follow e1.etype with
 				| TFun(args,_) ->

+ 32 - 0
tests/unit/MyAbstract.hx

@@ -106,4 +106,36 @@ abstract AbstractZ(AbstractBase<T>)<T> from AbstractBase<T> {
 	@:to public static function toString(a:AbstractBase<String>):String {
 		return a.value;
 	}
+}
+
+typedef IMap < K, V > = {
+	public function keys():Iterator<K>;
+	public function set(k:K, v:V):Void;
+	public function get(k:K):V;
+}
+
+class PseudoObjectHash < K: { }, V > {
+	public function new() { }
+	public function get(k:K):V return null
+	public function set(k:K, v:V) { }
+}
+
+@:generic
+abstract MyMap(IMap < K, V > ) < K, V > {
+	public function new();
+	
+	@:to static inline public function toHash(t:IMap < String, V > ):Hash<V> {
+		return new Hash<V>();
+	}
+		
+	@:to static inline public function toObjectHash<K:{}>(t:IMap < K, V > ):PseudoObjectHash<K,V> {
+		return new PseudoObjectHash<K, V>();
+	}
+	
+	@:to static inline public function toIntHash(t:IMap < Int, V > ):IntHash<V> {
+		return new IntHash<V>();
+	}
+	
+	public inline function set(k:K, v:V) this.set(k, v)
+	public inline function get(k:K) return this.get(k)
 }

+ 26 - 0
tests/unit/TestType.hx

@@ -685,4 +685,30 @@ class TestType extends Test {
 			var s:String = z;
 		}));
 	}
+	
+	function testAbstractGeneric() {
+		var map = new unit.MyAbstract.MyMap();
+		map.set("foo", 1);
+		t(Std.is(map, Hash));
+
+		var map = new unit.MyAbstract.MyMap();
+		_mapMe(map); // infer from function call
+		t(Std.is(map, IntHash));
+
+		var map = new unit.MyAbstract.MyMap();
+		map.set(new haxe.Template("foo"), 99);
+		t(Std.is(map, unit.MyAbstract.PseudoObjectHash));
+		
+		// all these cause a compilation error, but we cannot typeError test that because it happens
+		// during a post-process check
+		//var map = new Map(); // Could not determine type for IMap<Float, Int>
+		//map.set(1.1, 1);
+
+		//var map = new Map(); // Could not determine type for IMap<x : String -> String, Int>
+		//map.set(function(x:String) return x, 1);
+		
+		//var map = new Map(); // Could not determine type for IMap<Unknown<0>, Unknown<1>>
+	}
+	
+	static function _mapMe(map:unit.MyAbstract.MyMap < Int, String > ) { }
 }

+ 9 - 3
typeload.ml

@@ -130,10 +130,14 @@ let make_module ctx mpath file tdecls loadp =
 					| FFun fu when f.cff_name = "new" && not stat ->
 						let init p = (EVars ["this",Some this_t,None],p) in
 						let ret p = (EReturn (Some (EConst (Ident "this"),p)),p) in
+						if Meta.has Meta.Generic a.a_meta then begin
+							if List.mem AInline f.cff_access then error "Generic constructors cannot be inline" f.cff_pos;
+							if fu.f_expr <> None then error "Generic constructors cannot have a body" f.cff_pos;
+						end;
 						let fu = {
 							fu with
 							f_expr = (match fu.f_expr with
-							| None -> None
+							| None -> if Meta.has Meta.Generic a.a_meta then Some (EConst (Ident "null"),p) else None
 							| Some (EBlock [EBinop (OpAssign,(EConst (Ident "this"),_),e),_],_ | EBinop (OpAssign,(EConst (Ident "this"),_),e),_) ->
 								Some (EReturn (Some e), pos e)
 							| Some (EBlock el,p) -> Some (EBlock (init p :: el @ [ret p]),p)
@@ -1335,6 +1339,7 @@ let init_class ctx c p context_init herits fields =
 				cf_params = params;
 				cf_overloads = [];
 			} in
+			let do_bind = ref (not (cf.cf_name <> "__init__" && (c.cl_extern && not inline) || c.cl_interface)) in
 			(match c.cl_kind with
 				| KAbstractImpl a ->
 					let m = mk_mono() in
@@ -1347,7 +1352,8 @@ let init_class ctx c p context_init herits fields =
 						unify ctx t (tfun [ta] m) f.cff_pos;
 						if not (Meta.has Meta.Impl cf.cf_meta) then cf.cf_meta <- (Meta.Impl,[],cf.cf_pos) :: cf.cf_meta;
 						a.a_to <- (follow m, Some cf) :: a.a_to
-					end
+					end else if f.cff_name = "_new" && Meta.has Meta.Generic a.a_meta then
+						do_bind := false
 				| _ ->
 					());
 			init_meta_overloads ctx cf;
@@ -1383,7 +1389,7 @@ let init_class ctx c p context_init herits fields =
 				end;
 				t
 			) "type_fun" in
-			if not (((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__") then bind_type ctx cf r (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) is_macro;
+			if !do_bind then bind_type ctx cf r (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) is_macro;
 			f, constr, cf
 		| FProp (get,set,t,eo) ->
 			let ret = (match t, eo with

+ 1 - 1
typer.ml

@@ -2366,7 +2366,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				error "Constructor is not a function" p
 			) in
 			(match c.cl_kind with
-			| KAbstractImpl _ ->
+			| KAbstractImpl a when not (Meta.has Meta.Generic a.a_meta) ->
 				let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
 				let e = mk (TTypeExpr (TClassDecl c)) ta p in
 				let e = mk (TField (e,(FStatic (c,f)))) ct p in