Răsfoiți Sursa

moved type parameters constraints from cl_implements to cl_kind
allow any type constraint for type parameters
fixed issue #516

Nicolas Cannasse 13 ani în urmă
părinte
comite
dcaf0d610e
17 a modificat fișierele cu 116 adăugiri și 79 ștergeri
  1. 1 1
      codegen.ml
  2. 1 0
      doc/CHANGES.txt
  3. 1 1
      genas3.ml
  4. 10 10
      gencommon.ml
  5. 4 4
      gencpp.ml
  6. 10 10
      gencs.ml
  7. 7 7
      genjava.ml
  8. 1 1
      genphp.ml
  9. 3 3
      genswf9.ml
  10. 1 1
      genxml.ml
  11. 1 1
      interp.ml
  12. 1 1
      std/haxe/macro/Type.hx
  13. 2 0
      tests/unit/MyClass.hx
  14. 4 0
      tests/unit/TestType.hx
  15. 30 13
      type.ml
  16. 20 15
      typeload.ml
  17. 19 11
      typer.ml

+ 1 - 1
codegen.ml

@@ -207,7 +207,7 @@ let rec build_generic ctx c p tl =
 	let rec check_recursive t =
 		match follow t with
 		| TInst (c,tl) ->
-			if c.cl_kind = KTypeParameter then recurse := true;
+			(match c.cl_kind with KTypeParameter _ -> recurse := true | _ -> ());
 			List.iter check_recursive tl;
 		| _ ->
 			()

+ 1 - 0
doc/CHANGES.txt

@@ -3,6 +3,7 @@
 	all : allowed named functions as r-value
 	macro : added $[expr-list] support in reification
 	all : fixed using + overload usage
+	all : allow any type constraint for type parameters
 	
 2012-07-16: 2.10
 	java/cs : added two new targets (beta)

+ 1 - 1
genas3.ml

@@ -230,7 +230,7 @@ let rec type_str ctx t p =
 	| TInst (c,_) ->
 		(match c.cl_kind with
 		| KNormal | KGeneric | KGenericInstance _ -> s_path ctx false c.cl_path p
-		| KTypeParameter | KExtension _ | KExpr _ | KMacroType -> "*")
+		| KTypeParameter _ | KExtension _ | KExpr _ | KMacroType -> "*")
 	| TFun _ ->
 		"Function"
 	| TMono r ->

+ 10 - 10
gencommon.ml

@@ -2648,7 +2648,7 @@ struct
   
   let rec get_type_params acc t = 
     match follow t with
-      | TInst(( { cl_kind = KTypeParameter } as cl), []) -> 
+      | TInst(( { cl_kind = KTypeParameter _ } as cl), []) -> 
         if List.exists (fun c -> c == cl) acc then acc else cl :: acc
       | TFun _
       | TDynamic _
@@ -3559,7 +3559,7 @@ struct
     
     let rec get_arg original applied = 
       match (original, applied) with
-        | TInst( ({ cl_kind = KTypeParameter } as cl ), []), _ ->
+        | TInst( ({ cl_kind = KTypeParameter _ } as cl ), []), _ ->
           Hashtbl.replace params_tbl cl.cl_path applied
         | TInst(cl, params), TInst(cl2, params2) ->
           let rec loop cl2 params2 =
@@ -3667,7 +3667,7 @@ struct
     
     let rec has_type_params t =
       match follow t with
-        | TInst( { cl_kind = KTypeParameter }, _) -> true
+        | TInst( { cl_kind = KTypeParameter _ }, _) -> true
         | TEnum (_, params)
         | TInst(_, params) -> List.fold_left (fun acc t -> acc || has_type_params t) false params
         | _ -> false
@@ -3733,7 +3733,7 @@ struct
                           | cf :: cfs -> 
                             let t = follow (gen.greal_type cf.cf_type) in
                             match t with
-                              | TInst( { cl_kind = KTypeParameter }, _ ) -> loop cfs
+                              | TInst( { cl_kind = KTypeParameter _ }, _ ) -> loop cfs
                               | TInst(cl,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TClassDecl cl)) ->
                                 if not (Hashtbl.mem gen.gtparam_cast cl.cl_path) then true else loop cfs
                               | TEnum(e,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TEnumDecl e)) ->
@@ -3775,7 +3775,7 @@ struct
                             if List.exists (fun (n,o,t) -> 
                               let t = follow t in
                               match t with
-                                | TInst( { cl_kind = KTypeParameter }, _ ) -> 
+                                | TInst( { cl_kind = KTypeParameter _ }, _ ) -> 
                                   false
                                 | TInst(cl,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TClassDecl cl)) ->
                                   not (Hashtbl.mem gen.gtparam_cast cl.cl_path)
@@ -4279,7 +4279,7 @@ struct
   (* Helpers for cast handling *)
   (* will return true if 'super' is a superclass of 'cl' or if cl implements super or if they are the same class *)
   let can_be_converted gen cl tl super_t super_tl = 
-    map_cls gen (gen.guse_tp_constraints || (not (cl.cl_kind = KTypeParameter || super_t.cl_kind = KTypeParameter))) (fun _ tl ->
+    map_cls gen (gen.guse_tp_constraints || (match cl.cl_kind,super_t.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true)) (fun _ tl ->
       try
         List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) tl super_tl;
         true
@@ -4288,7 +4288,7 @@ struct
   
   (* will return true if both arguments are compatible. If it's not the case, a runtime error is very likely *)
   let is_cl_related gen cl tl super superl =
-    let is_cl_related cl tl super superl = map_cls gen (gen.guse_tp_constraints || (not (cl.cl_kind = KTypeParameter || super.cl_kind = KTypeParameter))) (fun _ _ -> true) super cl tl in
+    let is_cl_related cl tl super superl = map_cls gen (gen.guse_tp_constraints || (match cl.cl_kind,super.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true)) (fun _ _ -> true) super cl tl in
     is_cl_related cl tl super superl || is_cl_related super superl cl tl
   
   
@@ -4377,7 +4377,7 @@ struct
           If a class is found - meaning that the cl_from can be converted without a cast into cl_to,
           we still need to check their type parameters.
         *)
-        ignore (map_cls gen (gen.guse_tp_constraints || (not (cl_from.cl_kind = KTypeParameter || cl_to.cl_kind = KTypeParameter))) (fun _ tl ->
+        ignore (map_cls gen (gen.guse_tp_constraints || (match cl_from.cl_kind,cl_to.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true)) (fun _ tl ->
           try
             (* type found, checking type parameters *)
             List.iter2 (type_eq gen EqStrict) tl params_to;
@@ -6634,7 +6634,7 @@ struct
         let do_field cf cf_type static = 
           let this = if static then mk_classtype_access cl pos else { eexpr = TConst(TThis); etype = t; epos = pos } in
           match is_float, follow cf_type with
-            | true, TInst( { cl_kind = KTypeParameter }, [] ) -> 
+            | true, TInst( { cl_kind = KTypeParameter _ }, [] ) -> 
               mk_return (mk_cast basic.tfloat (mk_cast t_dynamic (get_field cf cf_type this cf.cf_name)))
             | _ ->
               mk_return (maybe_cast (get_field cf cf_type this cf.cf_name ))
@@ -6649,7 +6649,7 @@ struct
           List.filter (fun (_,cf) -> (* TODO: maybe really apply_params in cf.cf_type. The benefits would be limited, though *)
             match follow (ctx.rcf_gen.greal_type (ctx.rcf_gen.gfollow#run_f cf.cf_type)) with
               | TDynamic _ | TMono _
-              | TInst ({ cl_kind = KTypeParameter }, _)
+              | TInst ({ cl_kind = KTypeParameter _ }, _)
               | TInst ({ cl_path = ([], "Float") }, [])
               | TInst ({ cl_path = ([], "Int") }, []) -> true
               | _ -> false

+ 4 - 4
gencpp.ml

@@ -344,7 +344,7 @@ let rec class_string klass suffix params =
 	(* FastIterator class *)
 	|  (["cpp"],"FastIterator") -> "::cpp::FastIterator" ^ suffix ^ "< " ^ (String.concat ","
 					 (List.map type_string  params) ) ^ " >"
-	| _ when klass.cl_kind=KTypeParameter -> "Dynamic"
+	| _ when (match klass.cl_kind with KTypeParameter _ -> true | _ -> false) -> "Dynamic"
 	|  ([],"#Int") -> "/* # */int"
 	|  (["haxe";"io"],"Unsigned_char__") -> "unsigned char"
 	|  ([],"Class") -> "::Class"
@@ -413,7 +413,7 @@ and is_dynamic_array_param haxe_type =
 	| TInst (klass,params) ->
 			(match klass.cl_path with
          | ([],"Array") | ([],"Class") | (["cpp"],"FastIterator") -> false
-			| _ -> klass.cl_kind = KTypeParameter
+			| _ -> (match klass.cl_kind with KTypeParameter _ -> true | _ -> false)
 			)
    | _ -> false
 	)
@@ -2030,7 +2030,7 @@ let find_referenced_types ctx obj super_deps constructor_deps header_only =
          | ([],"Array") | ([],"Class") | (["cpp"],"FastIterator") -> List.iter visit_type params
          | (["cpp"],"CppInt32__") -> add_type klass.cl_path;
          | _ when klass.cl_extern -> ()
-			| _ -> if (klass.cl_kind <> KTypeParameter ) then add_type klass.cl_path;
+			| _ -> (match klass.cl_kind with KTypeParameter _ -> () | _ -> add_type klass.cl_path);
 			)
 		| TFun (args,haxe_type) -> visit_type haxe_type;
 				List.iter (fun (_,_,t) -> visit_type t; ) args;
@@ -2960,7 +2960,7 @@ let add_class_to_makefile makefile add_obj class_def =
 
 let kind_string = function
 	| KNormal -> "KNormal"
-	| KTypeParameter -> "KTypeParameter"
+	| KTypeParameter _ -> "KTypeParameter"
 	| KExtension _ -> "KExtension"
 	| KExpr _ -> "KExpr"
 	| KGeneric -> "KGeneric"

+ 10 - 10
gencs.ml

@@ -40,7 +40,7 @@ let is_cs_basic_type t =
 
 let is_tparam t = 
   match follow t with
-    | TInst( { cl_kind = KTypeParameter }, [] ) -> true
+    | TInst( { cl_kind = KTypeParameter _ }, [] ) -> true
     | _ -> false
     
 let rec is_int_float t =
@@ -244,7 +244,7 @@ struct
   
   let is_tparam t =
     match follow t with
-      | TInst( { cl_kind = KTypeParameter }, _ ) -> true
+      | TInst( { cl_kind = KTypeParameter _ }, _ ) -> true
       | _ -> false
   
   let traverse gen runtime_cl =
@@ -591,7 +591,7 @@ let configure gen =
           Null<T>, which will then return the type haxe.lang.Null<>
         *)
         (match real_type t with
-          | TInst( { cl_kind = KTypeParameter }, _ ) -> TInst(null_t, [t])
+          | TInst( { cl_kind = KTypeParameter _ }, _ ) -> TInst(null_t, [t])
           | _ when is_cs_basic_type t -> TInst(null_t, [t])
           | _ -> real_type t)
       | TType _ -> t
@@ -620,7 +620,7 @@ let configure gen =
         Null<> type parameters will be transformed into Dynamic.
       *)
       | true, TInst ( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> dynamic_anon
-      | true, TInst ( { cl_kind = KTypeParameter }, _ ) -> t
+      | true, TInst ( { cl_kind = KTypeParameter _ }, _ ) -> t
       | true, TInst _ | true, TEnum _ when is_cs_basic_type t -> t
       | true, TDynamic _ -> t
       | true, _ -> dynamic_anon
@@ -674,7 +674,7 @@ let configure gen =
       | TInst({ cl_path = (["cs"], "Pointer") }, [ t ]) ->
         t_s t ^ "*"
       (* end of basic types *)
-      | TInst ({ cl_kind = KTypeParameter; cl_path=p }, []) -> snd p
+      | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
       | TMono r -> (match !r with | None -> "object" | Some t -> t_s (run_follow gen t))
       | TInst ({ cl_path = [], "String" }, []) -> "string"
       | TEnum ({ e_path = p }, params) -> (path_s p)
@@ -1698,7 +1698,7 @@ let configure gen =
       | TArray(e1, e2) -> 
         ( match follow e1.etype with 
           | TDynamic _ | TAnon _ | TMono _ -> true 
-          | TInst({ cl_kind = KTypeParameter }, _) -> true
+          | TInst({ cl_kind = KTypeParameter _ }, _) -> true
           | _ -> false ) 
       | _ -> assert false
   ) "__get" "__set" );
@@ -1710,7 +1710,7 @@ let configure gen =
   in
   
   let is_type_param e = match follow e with
-    | TInst( { cl_kind = KTypeParameter },[]) -> true
+    | TInst( { cl_kind = KTypeParameter _ },[]) -> true
     | _ -> false
   in
   
@@ -1750,7 +1750,7 @@ let configure gen =
   let should_handle_opeq t = 
     match real_type t with
       | TDynamic _ | TAnon _ | TMono _
-      | TInst( { cl_kind = KTypeParameter }, _ )
+      | TInst( { cl_kind = KTypeParameter _ }, _ )
       | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true
       | _ -> false
   in
@@ -1781,8 +1781,8 @@ let configure gen =
           | _, TDynamic _
           | TInst( { cl_path = ([], "String") }, [] ), _
           | _, TInst( { cl_path = ([], "String") }, [] )
-          | TInst( { cl_kind = KTypeParameter }, [] ), _
-          | _, TInst( { cl_kind = KTypeParameter }, [] ) -> false
+          | TInst( { cl_kind = KTypeParameter _ }, [] ), _
+          | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false
           | _, _ -> true
         in
             

+ 7 - 7
genjava.ml

@@ -46,14 +46,14 @@ let unboxed_type gen t tbyte tshort tchar tfloat = match follow t with
   | _ -> assert false
 
 let rec t_has_type_param t = match follow t with
-  | TInst({ cl_kind = KTypeParameter }, []) -> true
+  | TInst({ cl_kind = KTypeParameter _ }, []) -> true
   | TEnum(_, params)
   | TInst(_, params) -> List.exists t_has_type_param params
   | TFun(f,ret) -> t_has_type_param ret || List.exists (fun (_,_,t) -> t_has_type_param t) f
   | _ -> false
 
 let rec t_has_type_param_shallow last t = match follow t with
-  | TInst({ cl_kind = KTypeParameter }, []) -> true
+  | TInst({ cl_kind = KTypeParameter _ }, []) -> true
   | TEnum(_, params)
   | TInst(_, params) when not last -> List.exists (t_has_type_param_shallow true) params
   | TFun(f,ret) when not last -> t_has_type_param_shallow true ret  || List.exists (fun (_,_,t) -> t_has_type_param_shallow true t) f
@@ -726,7 +726,7 @@ let configure gen =
       | TType({ t_path = ([], "Null") }, [t]) when is_java_basic_type t -> t_dynamic
       | TType({ t_path = ([], "Null") }, [t]) ->
         (match follow t with
-          | TInst( { cl_kind = KTypeParameter }, []) -> t_dynamic
+          | TInst( { cl_kind = KTypeParameter _ }, []) -> t_dynamic
           | _ -> real_type t
         )
       | TType _ -> t
@@ -770,7 +770,7 @@ let configure gen =
         in
         (check_t_s param) ^ "[]"
       (* end of basic types *)
-      | TInst ({ cl_kind = KTypeParameter; cl_path=p }, []) -> snd p
+      | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
       | TMono r -> (match !r with | None -> "java.lang.Object" | Some t -> t_s (run_follow gen t))
       | TInst ({ cl_path = [], "String" }, []) -> "java.lang.String"
       | TInst ({ cl_path = [], "Class" }, _) | TInst ({ cl_path = [], "Enum" }, _) -> assert false (* should have been converted earlier *)
@@ -1607,7 +1607,7 @@ let configure gen =
   in
 
   let is_type_param e = match follow e with
-    | TInst( { cl_kind = KTypeParameter },[]) -> true
+    | TInst( { cl_kind = KTypeParameter _ },[]) -> true
     | _ -> false
   in
 
@@ -1667,8 +1667,8 @@ let configure gen =
           | _, TInst( { cl_path = (["haxe"], "Int32") }, [] )
           | _, TInst( { cl_path = (["haxe"], "Int64") }, [] )
           | _, TEnum({ e_path = ([], "Bool") },[])
-          | TInst( { cl_kind = KTypeParameter }, [] ), _
-          | _, TInst( { cl_kind = KTypeParameter }, [] ) -> false
+          | TInst( { cl_kind = KTypeParameter _ }, [] ), _
+          | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false
           | _, _ -> true
         in
 

+ 1 - 1
genphp.ml

@@ -86,7 +86,7 @@ let rec class_string klass suffix params =
 	(* Array class *)
 	|  ([],"Array") -> (snd klass.cl_path) ^ suffix ^ "<" ^ (String.concat ","
 					 (List.map type_string  params) ) ^ " >"
-	| _ when klass.cl_kind=KTypeParameter -> "Dynamic"
+	| _ when (match klass.cl_kind with KTypeParameter _ -> true | _ -> false) -> "Dynamic"
 	|  ([],"#Int") -> "/* # */int"
 	|  (["haxe";"io"],"Unsigned_char__") -> "unsigned char"
 	|  ([],"Class") -> "Class"

+ 3 - 3
genswf9.ml

@@ -201,9 +201,9 @@ let rec type_id ctx t =
 		HMParams (type_path ctx c.cl_path,List.map (type_id ctx) pl)
 	| TInst (c,_) ->
 		(match c.cl_kind with
-		| KTypeParameter ->
-			(match c.cl_implements with
-			| [csup,_] -> type_path ctx csup.cl_path
+		| KTypeParameter l ->
+			(match l with
+			| [t] -> type_id ctx t
 			| _ -> type_path ctx ([],"Object"))
 		| KExtension (c,params) ->
 			type_id ctx (TInst (c,params))

+ 1 - 1
genxml.ml

@@ -279,7 +279,7 @@ let generate_type com t =
 			(match !r with
 			| None -> "Unknown"
 			| Some t -> stype t)
-		| TInst ({ cl_kind = KTypeParameter } as c,tl) ->
+		| TInst ({ cl_kind = KTypeParameter _ } as c,tl) ->
 			path ([],snd c.cl_path) tl
 		| TInst (c,tl) ->
 			path c.cl_path tl

+ 1 - 1
interp.ml

@@ -3915,7 +3915,7 @@ and encode_method_kind m =
 and encode_class_kind k =
 	let tag, pl = (match k with
 		| KNormal -> 0, []
-		| KTypeParameter -> 1, []
+		| KTypeParameter pl -> 1, [encode_tparams pl]
 		| KExtension (cl, params) -> 2, [encode_clref cl; encode_tparams params]
 		| KExpr e -> 3, [encode_expr e]
 		| KGeneric -> 4, []

+ 1 - 1
std/haxe/macro/Type.hx

@@ -72,7 +72,7 @@ typedef ClassField = {
 
 enum ClassKind {
 	KNormal;
-	KTypeParameter;
+	KTypeParameter(constraints:Array<Type>);
 	KExtension(cl:Ref<ClassType>, params:Array<Type>);
 	KExpr(expr:Expr);
 	KGeneric;

+ 2 - 0
tests/unit/MyClass.hx

@@ -142,6 +142,8 @@ class ParamConstraintsClass {
 	public function memberComplex < A:I1, B:List<A> > (a:A, b:B) { return b; }
 	public function memberBasic < A:String, B:Array<A> > (a:A, b:B) { return b[0]; }
 	
+	public function memberAnon < A:( { x : Int }, { y : Float } ) > (v:A) { return v.x + v.y; }
+	
 #if !(java || cs)  //this is a known bug caused by issue #915
 	@:overload(function< A, B:Array<A> > (a:A, b:B):Void { } )
 	public function memberOverload < A, B > (a:String, b:String) { }

+ 4 - 0
tests/unit/TestType.hx

@@ -443,6 +443,10 @@ class TestType extends Test {
 		
 		eq(pcc.memberBasic("foo", ["bar"]), "bar");
 		
+		eq(pcc.memberAnon( { x : 1, y : 3. } ), 4);
+		//typeError(pcc.memberAnon( { x : 1 } ));
+		//typeError(pcc.memberAnon( { y : 3. } ));
+		
 		#if !(java || cs)
 		pcc.memberOverload("foo", "bar");
 		#end

+ 30 - 13
type.ml

@@ -144,7 +144,7 @@ and tclass_field = {
 
 and tclass_kind =
 	| KNormal
-	| KTypeParameter
+	| KTypeParameter of t list
 	| KExtension of tclass * tparams
 	| KExpr of Ast.expr
 	| KGeneric
@@ -798,17 +798,31 @@ let rec raw_class_field build_type c i =
 			let t , f = raw_class_field build_type c i in
 			apply_params c.cl_types tl t , f
 	with Not_found ->
-		let rec loop = function
-			| [] ->
-				raise Not_found
-			| (c,tl) :: l ->
-				try
-					let t , f = raw_class_field build_type c i in
-					apply_params c.cl_types tl t, f
-				with
-					Not_found -> loop l
-		in
-		loop c.cl_implements
+		match c.cl_kind with
+		| KTypeParameter tl ->
+			let rec loop = function
+				| [] ->
+					raise Not_found
+				| t :: ctl ->
+					match follow t with
+					| TAnon a ->
+						(try
+							let f = PMap.find i a.a_fields in
+							build_type f, f
+						with
+							Not_found -> loop ctl)
+					| TInst (c,pl) ->
+						(try
+							let t , f = raw_class_field build_type c i in
+							apply_params c.cl_types pl t, f
+						with
+							Not_found -> loop ctl)
+					| _ ->
+						loop ctl
+			in
+			loop tl
+		| _ ->
+			raise Not_found
 
 let class_field = raw_class_field field_type
 
@@ -870,7 +884,10 @@ let rec unify a b =
 					loop cs (List.map (apply_params c.cl_types tl) tls)
 			) || List.exists (fun (cs,tls) ->
 				loop cs (List.map (apply_params c.cl_types tl) tls)
-			) c.cl_implements
+			) c.cl_implements 
+			|| (match c.cl_kind with
+			| KTypeParameter pl -> List.exists (fun t -> match follow t with TInst (cs,tls) -> loop cs (List.map (apply_params c.cl_types tl) tls) | _ -> false) pl
+			| _ -> false)
 		in
 		if not (loop c1 tl1) then error [cannot_unify a b]
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->

+ 20 - 15
typeload.ml

@@ -124,11 +124,15 @@ let check_param_constraints ctx types t pl c p =
  	match follow t with
 	| TMono _ -> ()
 	| _ ->
-		List.iter (fun (i,tl) ->
-			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 ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in
+		List.iter (fun ti ->
+			(*
+				what was that used for ?
+				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
 			unify ctx t ti p
-		) c.cl_implements
+		) ctl
 
 (* build an instance from a full type *)
 let rec load_instance ctx t p allow_no_params =
@@ -145,7 +149,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_implements <> [] then delay_late ctx (fun() -> check_param_constraints ctx types t (!pl) c p);
+					if c.cl_kind <> KTypeParameter [] then delay_late ctx (fun() -> check_param_constraints ctx types t (!pl) c p);
 					t;
 				| _ -> assert false
 			) types;
@@ -175,7 +179,7 @@ let rec load_instance ctx t p allow_no_params =
 				let isconst = (match t with TInst ({ cl_kind = KExpr _ },_) -> true | _ -> false) in
 				if isconst <> (name = "Const") && t != t_dynamic then error (if isconst then "Constant value unexpected here" else "Constant value excepted as type parameter") p;
 				match follow t2 with
-				| TInst ({ cl_implements = [] }, []) ->
+				| TInst ({ cl_kind = KTypeParameter [] }, []) ->
 					t
 				| TInst (c,[]) ->
 					let r = exc_protect ctx (fun r ->
@@ -370,19 +374,19 @@ let valid_redefinition ctx f1 t1 f2 t2 =
 		| l1, l2 when List.length l1 = List.length l2 ->
 			let monos = List.map2 (fun (_,p1) (_,p2) -> 
 				match follow p1, follow p2 with
-				| TInst (c1,_), TInst (c2,_) ->
-					(match c1.cl_implements, c2.cl_implements with
+				| TInst ({ cl_kind = KTypeParameter ct1 } as c1,pl1), TInst ({ cl_kind = KTypeParameter ct2 } as c2,pl2) ->
+					(match ct1, ct2 with
 					| [], [] -> 
 						let m = mk_mono() in
 						m,m
-					| l1, l2 when List.length l1 = List.length l2 ->
+					| _, _ when List.length ct1 = List.length ct2 ->
 						(* if same constraints, they are the same type *)
-						List.iter2 (fun (i1,tl1) (i2,tl2) ->
+						List.iter2 (fun t1 t2  ->
 							try 
-								type_eq EqStrict (TInst(i1,tl1)) (TInst(i2,tl2))
+								type_eq EqStrict (apply_params c1.cl_types pl1 t1) (apply_params c2.cl_types pl2 t2)
 							with Unify_error l ->
 								raise (Unify_error (Unify_custom "Constraints differ" :: l))
-						) c1.cl_implements c2.cl_implements;
+						) ct1 ct2;
 						let m = mk_mono() in
 						m,m
 					| _ ->
@@ -562,7 +566,7 @@ let set_heritance ctx c herits p =
 	let process_meta csup =
 		List.iter (fun m ->
 			match m with
-			| ":final", _, _ -> if not (Type.has_meta ":hack" c.cl_meta || c.cl_kind = KTypeParameter) then error "Cannot extend a final class" p;
+			| ":final", _, _ -> if not (Type.has_meta ":hack" c.cl_meta || (match c.cl_kind with KTypeParameter _ -> true | _ -> false)) then error "Cannot extend a final class" p;
 			| ":autoBuild", el, p -> c.cl_meta <- (":build",el,p) :: m :: c.cl_meta;
 			| _ -> ()
 		) csup.cl_meta
@@ -624,15 +628,16 @@ let set_heritance ctx c herits p =
 
 let type_type_params ctx path get_params p (n,flags) =
 	let c = mk_class ctx.current (fst path @ [snd path],n) p in
-	c.cl_kind <- KTypeParameter;
 	let t = TInst (c,[]) in
 	match flags with
-	| [] -> n, t
+	| [] -> 
+		c.cl_kind <- KTypeParameter [];
+		n, t
 	| _ ->
 		let r = exc_protect ctx (fun r ->
 			r := (fun _ -> t);
 			let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
-			set_heritance ctx c (List.map (fun t -> match t with CTPath t -> HImplements t | _ -> error "Unsupported type constraint" p) flags) p;
+			c.cl_kind <- KTypeParameter (List.map (load_complex_type ctx p) flags);
 			t
 		) in
 		delay ctx (fun () -> ignore(!r()));

+ 19 - 11
typer.ml

@@ -86,13 +86,12 @@ type type_class =
 	| KOther
 	| KParam of t
 
-let classify t =
+let rec classify t =
 	match follow t with
 	| TInst ({ cl_path = ([],"Int") },[]) -> KInt
 	| TInst ({ cl_path = ([],"Float") },[]) -> KFloat
 	| TInst ({ cl_path = ([],"String") },[]) -> KString
-	| TInst ({ cl_kind = KTypeParameter; cl_implements = [{ cl_path = ([],"Float")},[]] },[]) -> KParam t
-	| TInst ({ cl_kind = KTypeParameter; cl_implements = [{ cl_path = ([],"Int")},[]] },[]) -> KParam t
+	| TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KParam t
 	| TMono r when !r = None -> KUnk
 	| TDynamic _ -> KDyn
 	| _ -> KOther
@@ -125,11 +124,11 @@ let field_type ctx c pl f p =
 		let monos = List.map (fun _ -> mk_mono()) l in
 		List.iter2 (fun m (name,t) -> 
 			match follow t with
-			| TInst ({ cl_implements = constr },_) when constr <> [] ->
-				let constr = List.map (fun (i,ipl) ->
-					let ipl = if pl = [] then ipl else List.map (apply_params c.cl_types pl) ipl in
-					let ipl = List.map (apply_params f.cf_params monos) ipl in
-					TInst (i,ipl)
+			| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
+				let constr = List.map (fun t -> 
+					let t = apply_params f.cf_params monos t in
+					let t = apply_params c.cl_types pl t in
+					t
 				) constr in
 				delay_late ctx (fun() ->
 					List.iter (fun ct ->
@@ -179,6 +178,9 @@ let rec base_types t =
 	let tl = ref [] in
 	let rec loop t = (match t with
 	| TInst(cl, params) ->
+		(match cl.cl_kind with
+		| KTypeParameter tl -> List.iter loop tl
+		| _ -> ());
 		List.iter (fun (ic, ip) ->
 			let t = apply_params cl.cl_types params (TInst (ic,ip)) in
 			loop t
@@ -2084,7 +2086,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			) params;
 			(match follow t with
 			| TInst (c,_) ->
-				if c.cl_kind = KTypeParameter then error "Can't cast to a type parameter" p;
+				(match c.cl_kind with KTypeParameter _ -> error "Can't cast to a type parameter" p | _ -> ());
 				TClassDecl c
 			| TEnum (e,_) -> TEnumDecl e
 			| _ -> assert false);
@@ -2107,7 +2109,8 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			| _ ->
 				t
 		in
-		let fields = (match follow e.etype with
+		let rec get_fields t = 
+			match follow t with
 			| TInst (c,params) ->
 				let priv = is_parent c ctx.curclass in
 				let merge ?(cond=(fun _ -> true)) a b =
@@ -2122,6 +2125,10 @@ and type_expr ctx ?(need_val=true) (e,p) =
 						| Some (csup,cparams) -> merge m (loop csup cparams)
 					) in
 					let m = merge ~cond:(fun f -> priv || f.cf_public) c.cl_fields m in
+					let m = (match c.cl_kind with
+						| KTypeParameter pl -> List.fold_left (fun acc t -> merge acc (get_fields t)) m pl
+						| _ -> m
+					) in
 					PMap.map (fun f -> { f with cf_type = apply_params c.cl_types params (opt_type f.cf_type); cf_public = true; }) m
 				in
 				loop c params
@@ -2133,7 +2140,8 @@ and type_expr ctx ?(need_val=true) (e,p) =
 					a.a_fields)
 			| _ ->
 				PMap.empty
-		) in
+		in
+		let fields = get_fields e.etype in
 		(*
 			add 'using' methods compatible with this type
 		*)