split casts with fields to `a_from_field`/`a_to_field`

codegen.ml

@@ -648,7 +648,7 @@ module AbstractCast = struct
 			r
 		in
 		let find a tl f =
-			let tcf,cfo = f() in
+			let tcf,cf = f() in
 			let mk_cast () =
 				let tcf = apply_params a.a_params tl tcf in
 				if type_iseq tcf tleft then
@@ -658,15 +658,21 @@ module AbstractCast = struct
 					(* let eright = mk (TCast(eright,None)) tleft p in *)
 					do_check_cast ctx tcf eright p
 			in
-			match cfo,a.a_impl with
+			if Meta.has Meta.MultiType a.a_meta then
+				mk_cast()
+			else match a.a_impl with
+				| Some c -> recurse cf (fun () -> make_static_call ctx c cf a tl [eright] tleft p)
+				| None -> assert false
+
+(* 			match cfo,a.a_impl with
 				| None,_ ->
 					mk_cast();
 				| Some cf,_ when Meta.has Meta.MultiType a.a_meta ->
 					mk_cast();
 				| Some cf,Some c ->
-					recurse cf (fun () -> make_static_call ctx c cf a tl [eright] tleft p)
+
 				| _ ->
-					assert false
+					assert false *)
 		in
 		if type_iseq tleft eright.etype then
 			eright
@@ -723,7 +729,7 @@ module AbstractCast = struct
 				end;
 				tl
 		in
-		let _,cfo =
+		let _,cf =
 			try
 				Abstract.find_to a tl m
 			with Not_found ->
@@ -734,9 +740,7 @@ module AbstractCast = struct
 				else
 					error ("Abstract " ^ (s_type_path a.a_path) ^ " has no @:to function that accepts " ^ st) p;
 		in
-		match cfo with
-			| None -> assert false
-			| Some cf -> cf, follow m
+		cf, follow m
 
 	let handle_abstract_casts ctx e =
 		let rec loop ctx e = match e.eexpr with
@@ -1451,7 +1455,7 @@ struct
 				(cacc, rate_tp tlf tla)
 			else
 				let ret = ref None in
-				if List.exists (fun (t,_) -> try
+				if List.exists (fun t -> try
 					ret := Some (rate_conv (cacc+1) (apply_params af.a_params tlf t) targ);
 					true
 				with | Not_found ->
@@ -1459,7 +1463,7 @@ struct
 				) af.a_from then
 					Option.get !ret
 			else
-				if List.exists (fun (t,_) -> try
+				if List.exists (fun t -> try
 					ret := Some (rate_conv (cacc+1) tfun (apply_params aa.a_params tla t));
 					true
 				with | Not_found ->

gencommon.ml

@@ -70,13 +70,13 @@ let rec like_float t =
 	match follow t with
 		| TAbstract({ a_path = ([], "Float") },[])
 		| TAbstract({ a_path = ([], "Int") },[]) -> true
-		| TAbstract(a, _) -> List.exists (fun (t,_) -> like_float t) a.a_from || List.exists (fun (t,_) -> like_float t) a.a_to
+		| TAbstract(a, _) -> List.exists (fun t -> like_float t) a.a_from || List.exists (fun t -> like_float t) a.a_to
 		| _ -> false
 
 let rec like_int t =
 	match follow t with
 		| TAbstract({ a_path = ([], "Int") },[]) -> true
-		| TAbstract(a, _) -> List.exists (fun (t,_) -> like_int t) a.a_from || List.exists (fun (t,_) -> like_int t) a.a_to
+		| TAbstract(a, _) -> List.exists (fun t -> like_int t) a.a_from || List.exists (fun t -> like_int t) a.a_to
 		| _ -> false
 
 

genxml.ml

@@ -231,7 +231,8 @@ let rec gen_type_decl com pos t =
 	| TAbstractDecl a ->
 		let doc = gen_doc_opt a.a_doc in
 		let meta = gen_meta a.a_meta in
-		let mk_cast (t,cfo) = node "icast" (match cfo with None -> [] | Some cf -> ["field",cf.cf_name]) [gen_type t] in
+		(* let mk_cast (t,cfo) = node "icast" (match cfo with None -> [] | Some cf -> ["field",cf.cf_name]) [gen_type t] in *)
+		let mk_cast t = node "icast" [] [gen_type t] in
 		let sub = (match a.a_from with [] -> [] | l -> [node "from" [] (List.map mk_cast l)]) in
 		let super = (match a.a_to with [] -> [] | l -> [node "to" [] (List.map mk_cast l)]) in
 		let impl = (match a.a_impl with None -> [] | Some c -> [node "impl" [] [gen_type_decl com pos (TClassDecl c)]]) in

interp.ml

@@ -4008,7 +4008,7 @@ let decode_unop op =
 	| 4, [] -> NegBits
 	| _ -> raise Invalid_expr
 
-let decode_import_mode t = 
+let decode_import_mode t =
 	match decode_enum t with
 	| 0, [] -> INormal
 	| 1, [alias] -> IAsName (dec_string alias)
@@ -4285,8 +4285,8 @@ and encode_tabstract a =
 		"impl", (match a.a_impl with None -> VNull | Some c -> encode_clref c);
 		"binops", enc_array (List.map (fun (op,cf) -> enc_obj [ "op",encode_binop op; "field",encode_cfield cf]) a.a_ops);
 		"unops", enc_array (List.map (fun (op,postfix,cf) -> enc_obj [ "op",encode_unop op; "isPostfix",VBool (match postfix with Postfix -> true | Prefix -> false); "field",encode_cfield cf]) a.a_unops);
-		"from", enc_array (List.map (fun (t,cfo) -> enc_obj [ "t",encode_type t; "field",match cfo with None -> VNull | Some cf -> encode_cfield cf]) a.a_from);
-		"to", enc_array (List.map (fun (t,cfo) -> enc_obj [ "t",encode_type t; "field",match cfo with None -> VNull | Some cf -> encode_cfield cf]) a.a_to);
+(* 		"from", enc_array (List.map (fun (t,cfo) -> enc_obj [ "t",encode_type t; "field",match cfo with None -> VNull | Some cf -> encode_cfield cf]) a.a_from);
+		"to", enc_array (List.map (fun (t,cfo) -> enc_obj [ "t",encode_type t; "field",match cfo with None -> VNull | Some cf -> encode_cfield cf]) a.a_to); *)
 		"array", enc_array (List.map encode_cfield a.a_array);
 	]
 

type.ml

@@ -258,9 +258,11 @@ and tabstract = {
 	mutable a_unops : (Ast.unop * unop_flag * tclass_field) list;
 	mutable a_impl : tclass option;
 	mutable a_this : t;
-	mutable a_from : (t * tclass_field option) list;
+	mutable a_from : t list;
+	mutable a_from_field : (t * tclass_field) list;
+	mutable a_to : t list;
+	mutable a_to_field : (t * tclass_field) list;
 	mutable a_array : tclass_field list;
-	mutable a_to : (t * tclass_field option) list;
 }
 
 and module_type =
@@ -1295,8 +1297,8 @@ let rec unify a b =
 	| _ , TAbstract ({a_path=[],"Void"},_) ->
 		error [cannot_unify a b]
 	| TAbstract (a1,tl1) , TAbstract (a2,tl2) ->
-		let f1 = unify_to_field a1 tl1 b in
-		let f2 = unify_from_field a2 tl2 a b in
+		let f1 = unify_to a1 tl1 b in
+		let f2 = unify_from a2 tl2 a b in
 		if not (List.exists (f1 ~allow_transitive_cast:false) a1.a_to) && not (List.exists (f2 ~allow_transitive_cast:false) a2.a_from)
 		    && not (List.exists f1 a1.a_to) && not (List.exists f2 a2.a_from) then error [cannot_unify a b]
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
@@ -1459,24 +1461,50 @@ let rec unify a b =
 		| _ ->
 			error [cannot_unify a b])
 	| TAbstract (aa,tl), _  ->
-		if not (List.exists (unify_to_field aa tl b) aa.a_to) then error [cannot_unify a b];
+		if not (List.exists (unify_to aa tl b) aa.a_to) then error [cannot_unify a b];
 	| TInst ({ cl_kind = KTypeParameter ctl } as c,pl), TAbstract (bb,tl) ->
 		(* one of the constraints must satisfy the abstract *)
 		if not (List.exists (fun t ->
 			let t = apply_params c.cl_params pl t in
 			try unify t b; true with Unify_error _ -> false
-		) ctl) && not (List.exists (unify_from_field bb tl a b) bb.a_from) then error [cannot_unify a b];
+		) ctl) && not (List.exists (unify_from bb tl a b) bb.a_from) then error [cannot_unify a b];
 	| _, TAbstract (bb,tl) ->
-		if not (List.exists (unify_from_field bb tl a b) bb.a_from) then error [cannot_unify a b]
+		if not (List.exists (unify_from bb tl a b) bb.a_from) then error [cannot_unify a b]
 	| _ , _ ->
 		error [cannot_unify a b]
 
-and unify_from_field ab tl a b ?(allow_transitive_cast=true) (t,cfo) =
+and unify_from ab tl a b ?(allow_transitive_cast=true) t =
+	let t = apply_params ab.a_params tl t in
+	try
+		begin match follow a with
+			| TAbstract({a_impl = Some _},_) when ab.a_impl <> None || not allow_transitive_cast ->
+				type_eq EqStrict a t
+			| _ ->
+				unify a t
+		end;
+		true
+	with Unify_error _ ->
+		false
+
+and unify_to ab tl b ?(allow_transitive_cast=true) t =
+	let t = apply_params ab.a_params tl t in
+	try
+		begin match follow b with
+			| TAbstract({a_impl = Some _},_) when ab.a_impl <> None || not allow_transitive_cast ->
+				type_eq EqStrict t b
+			| _ ->
+				unify t b
+		end;
+		true
+	with Unify_error _ ->
+		false
+
+and unify_from_field ab tl a b ?(allow_transitive_cast=true) (t,cf) =
 	if (List.exists (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) (!abstract_cast_stack)) then false else begin
 	abstract_cast_stack := (a,b) :: !abstract_cast_stack;
 	let unify_func = match follow a with TAbstract({a_impl = Some _},_) when ab.a_impl <> None || not allow_transitive_cast -> type_eq EqStrict | _ -> unify in
-	let b = try begin match cfo with
-		| Some cf -> (match follow cf.cf_type with
+	let b = try
+		begin match follow cf.cf_type with
 			| TFun(_,r) ->
 				let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
 				let map t = apply_params ab.a_params tl (apply_params cf.cf_params monos t) in
@@ -1487,9 +1515,7 @@ and unify_from_field ab tl a b ?(allow_transitive_cast=true) (t,cfo) =
 					| _ -> ()
 				) monos cf.cf_params;
 				unify (map r) b;
-			| _ -> assert false)
-		| _ ->
-			unify_func a (apply_params ab.a_params tl t)
+			| _ -> assert false
 		end;
 		true
 	with Unify_error _ -> false
@@ -1498,7 +1524,7 @@ and unify_from_field ab tl a b ?(allow_transitive_cast=true) (t,cfo) =
 	b
 	end
 
-and unify_to_field ab tl b ?(allow_transitive_cast=true) (t,cfo) =
+and unify_to_field ab tl b ?(allow_transitive_cast=true) (t,cf) =
 	let a = TAbstract(ab,tl) in
 	if (List.exists (fun (b2,a2) -> fast_eq a a2 && fast_eq b b2) (!abstract_cast_stack)) then false else begin
 	abstract_cast_stack := (b,a) :: !abstract_cast_stack;
@@ -1508,8 +1534,8 @@ and unify_to_field ab tl b ?(allow_transitive_cast=true) (t,cfo) =
 		| _ ->
 			unify
 	in
-	let r = try begin match cfo with
-		| Some cf -> (match follow cf.cf_type with
+	let r = try
+		begin match follow cf.cf_type with
 			| TFun((_,_,ta) :: _,_) ->
 				let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
 				let map t = apply_params ab.a_params tl (apply_params cf.cf_params monos t) in
@@ -1524,9 +1550,7 @@ and unify_to_field ab tl b ?(allow_transitive_cast=true) (t,cfo) =
 					| _ -> ()
 				) monos cf.cf_params;
 				unify_func (map t) b;
-			| _ -> assert false)
-		| _ ->
-			unify_func (apply_params ab.a_params tl t) b;
+			| _ -> assert false
 		end;
 		true
 	with Unify_error _ -> false
@@ -1536,10 +1560,7 @@ and unify_to_field ab tl b ?(allow_transitive_cast=true) (t,cfo) =
 	end
 
 and unify_with_variance f t1 t2 =
-	let allows_variance_to t (tf,cfo) = match cfo with
-		| None -> type_iseq tf t
-		| Some _ -> false
-	in
+	let allows_variance_to t tf = type_iseq tf t in
 	match follow t1,follow t2 with
 	| TInst(c1,tl1),TInst(c2,tl2) when c1 == c2 ->
 		List.iter2 f tl1 tl2
@@ -1595,15 +1616,15 @@ module Abstract = struct
 
 	let find_to ab pl b =
 		if follow b == t_dynamic then
-			List.find (fun (t,_) -> follow t == t_dynamic) ab.a_to
+			List.find (fun (t,_) -> follow t == t_dynamic) ab.a_to_field
 		else
-			List.find (unify_to_field ab pl b) ab.a_to
+			List.find (unify_to_field ab pl b) ab.a_to_field
 
 	let find_from ab pl a b =
 		if follow a == t_dynamic then
-			List.find (fun (t,_) -> follow t == t_dynamic) ab.a_from
+			List.find (fun (t,_) -> follow t == t_dynamic) ab.a_from_field
 		else
-			List.find (unify_from_field ab pl a b) ab.a_from
+			List.find (unify_from_field ab pl a b) ab.a_from_field
 
 	let underlying_type_stack = ref []
 

typeload.ml

@@ -118,6 +118,8 @@ let make_module ctx mpath file tdecls loadp =
 				a_meta = d.d_meta;
 				a_from = [];
 				a_to = [];
+				a_from_field = [];
+				a_to_field = [];
 				a_ops = [];
 				a_unops = [];
 				a_impl = None;
@@ -1976,7 +1978,7 @@ let init_class ctx c p context_init herits fields =
 									| TFun([_,_,t],_) -> t
 									| _ -> error (f.cff_name ^ ": @:from cast functions must accept exactly one argument") p
 							in
-							a.a_from <- (TLazy (ref r),Some cf) :: a.a_from;
+							a.a_from_field <- (TLazy (ref r),cf) :: a.a_from_field;
 						| (Meta.To,_,_) :: _ ->
 							if is_macro then error (f.cff_name ^ ": Macro cast functions are not supported") p;
 							if not (Meta.has Meta.Impl cf.cf_meta) then cf.cf_meta <- (Meta.Impl,[],cf.cf_pos) :: cf.cf_meta;
@@ -2003,7 +2005,7 @@ let init_class ctx c p context_init herits fields =
 							end else (fun () ->
 								resolve_m []
 							) in
-							a.a_to <- (TLazy (ref r), Some cf) :: a.a_to
+							a.a_to_field <- (TLazy (ref r), cf) :: a.a_to_field
 						| (Meta.ArrayAccess,_,_) :: _ ->
 							if is_macro then error (f.cff_name ^ ": Macro array-access functions are not supported") p;
 							a.a_array <- cf :: a.a_array;
@@ -2611,8 +2613,8 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 			t
 		in
 		List.iter (function
-			| AFromType t -> a.a_from <- (load_type t true, None) :: a.a_from
-			| AToType t -> a.a_to <- (load_type t false, None) :: a.a_to
+			| AFromType t -> a.a_from <- (load_type t true) :: a.a_from
+			| AToType t -> a.a_to <- (load_type t false) :: a.a_to
 			| AIsType t ->
 				if a.a_impl = None then error "Abstracts with underlying type must have an implementation" a.a_pos;
 				if Meta.has Meta.CoreType a.a_meta then error "@:coreType abstracts cannot have an underlying type" p;

typer.ml

@@ -104,7 +104,7 @@ let rec classify t =
 	| TAbstract({a_impl = Some _} as a,tl) -> KAbstract (a,tl)
 	| TAbstract ({ a_path = [],"Int" },[]) -> KInt
 	| TAbstract ({ a_path = [],"Float" },[]) -> KFloat
-	| TAbstract (a,[]) when List.exists (fun (t,_) -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KParam t
+	| TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> 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
@@ -2827,7 +2827,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		| WithType t | WithTypeResume t ->
 			(match follow t with
 			| TAnon a when not (PMap.is_empty a.a_fields) -> Some a
-			| TAbstract (a,tl) when not (Meta.has Meta.CoreType a.a_meta) && List.exists (fun (_,cfo) -> cfo = None) a.a_from ->
+			| TAbstract (a,tl) when not (Meta.has Meta.CoreType a.a_meta) && a.a_from <> [] ->
 				begin match follow (Abstract.get_underlying_type a tl) with
 					| TAnon a when not (PMap.is_empty a.a_fields) -> Some a
 					| _ -> None