refactored abstract handling into its own module and use cast check early on returns (fixed issue #1557)

codegen.ml

@@ -1304,19 +1304,20 @@ let check_local_vars_init e =
 (* -------------------------------------------------------------------------- *)
 (* ABSTRACT CASTS *)
 
-let find_abstract_to ab pl b = List.find (Type.unify_to_field ab pl b) ab.a_to
-
-let get_underlying_type a pl =
-	if Meta.has Meta.MultiType a.a_meta then begin
-		let m = mk_mono() in
-		let _ = find_abstract_to a pl m in
-		follow m
-	end else
-		apply_params a.a_types pl a.a_this
-
-let handle_abstract_casts ctx e =
-	let find_from ab pl a b = List.find (Type.unify_from_field ab pl a b) ab.a_from in
-	let rec make_static_call c cf a pl args t p =
+module Abstract = struct
+
+	let find_to ab pl b = List.find (Type.unify_to_field ab pl b) ab.a_to
+	let find_from ab pl a b = List.find (Type.unify_from_field ab pl a b) ab.a_from
+
+	let get_underlying_type a pl =
+		if Meta.has Meta.MultiType a.a_meta then begin
+			let m = mk_mono() in
+			let _ = find_to a pl m in
+			follow m
+		end else
+			apply_params a.a_types pl a.a_this
+
+	let rec make_static_call ctx 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 monos = List.map (fun _ -> mk_mono()) cf.cf_params in
@@ -1343,43 +1344,47 @@ let handle_abstract_casts ctx e =
 			def()
 		in
 		(* TODO: can this cause loops? *)
-		loop e
-	and check_cast tleft eright p =
-		let eright = loop eright in
-		try (match follow eright.etype,follow tleft with
+		loop ctx e
+
+	and check_cast ctx tleft eright p =
+		let tright = follow eright.etype in
+		let tleft = follow tleft in
+		if tleft == tright then eright else
+		try (match tright,tleft with
 			| (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,cfo,a,pl = try
 						if Meta.has Meta.MultiType a1.a_meta then raise Not_found;
-						c1,snd (find_abstract_to a1 pl1 t2),a1,pl1
+						c1,snd (find_to a1 pl1 t2),a1,pl1
 					with Not_found ->
 						if Meta.has Meta.MultiType a2.a_meta then raise Not_found;
 						c2,snd (find_from a2 pl2 t1 t2),a2,pl2
 					in
-					match cfo with None -> eright | Some cf -> make_static_call c cf a pl [eright] tleft p
+					match cfo with None -> eright | Some cf -> make_static_call ctx c cf a pl [eright] tleft p
 				end
 			| TDynamic _,_ | _,TDynamic _ ->
 				eright
 			| TAbstract({a_impl = Some c} as a,pl),t2 when not (Meta.has Meta.MultiType a.a_meta) ->
-				begin match snd (find_abstract_to a pl t2) with None -> eright | Some cf -> make_static_call c cf a pl [eright] tleft p end
+				begin match snd (find_to a pl t2) with None -> eright | Some cf -> make_static_call ctx c cf a pl [eright] tleft p end
 			| t1,(TAbstract({a_impl = Some c} as a,pl) as t2) when not (Meta.has Meta.MultiType a.a_meta) ->
-				begin match snd (find_from a pl t1 t2) with None -> eright | Some cf -> make_static_call c cf a pl [eright] tleft p end
+				begin match snd (find_from a pl t1 t2) with None -> eright | Some cf -> make_static_call ctx c cf a pl [eright] tleft p end
 			| _ ->
 				eright)
 		with Not_found ->
 			eright
-	and loop e = match e.eexpr with
+
+	and loop ctx e = match e.eexpr with
 		| TBinop(OpAssign,e1,e2) ->
-			let e2 = check_cast e1.etype e2 e.epos in
-			{ e with eexpr = TBinop(OpAssign,loop e1,e2) }
+			let e2 = check_cast ctx e1.etype (loop ctx e2) e.epos in
+			{ e with eexpr = TBinop(OpAssign,loop ctx e1,e2) }
 		| TVars vl ->
 			let vl = List.map (fun (v,eo) -> match eo with
 				| None -> (v,eo)
 				| Some e ->
 					let is_generic_abstract = match e.etype with TAbstract ({a_impl = Some _} as a,_) -> Meta.has Meta.MultiType a.a_meta | _ -> false in
-					let e = check_cast v.v_type e e.epos in
+					let e = check_cast ctx v.v_type (loop ctx 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
@@ -1390,7 +1395,7 @@ let handle_abstract_casts ctx e =
 			let at = apply_params a.a_types pl a.a_this in
 			let m = mk_mono() in
 			let _,cfo =
-				try find_abstract_to a pl m
+				try find_to a pl m
 				with Not_found ->
 					let st = s_type (print_context()) at in
 					if has_mono at then
@@ -1402,11 +1407,11 @@ let handle_abstract_casts ctx e =
 			| None -> assert false
 			| Some cf ->
 				let m = follow m in
-				let e = make_static_call c cf a pl ((mk (TConst TNull) at e.epos) :: el) m e.epos in
+				let e = make_static_call ctx c cf a pl ((mk (TConst TNull) at e.epos) :: el) m e.epos in
 				{e with etype = m}
 			end
 		| TCall(e1, el) ->
-			let e1 = loop e1 in
+			let e1 = loop ctx e1 in
 			begin try
 				begin match e1.eexpr with
  					| TField(_,FStatic(_,cf)) when Meta.has Meta.To cf.cf_meta ->
@@ -1417,7 +1422,7 @@ let handle_abstract_casts ctx e =
 							| TAbstract(a,pl) when Meta.has Meta.MultiType a.a_meta ->
 								let m = get_underlying_type a pl in
 								let fname = field_name fa in
-								let el = List.map loop el in
+								let el = List.map (loop ctx) el in
 								begin try
 									let ef = mk (TField({e2 with etype = m},quick_field m fname)) e2.etype e2.epos in
 									make_call ctx ef el e.etype e.epos
@@ -1426,7 +1431,7 @@ let handle_abstract_casts ctx e =
 									match follow m with
 									| TAbstract({a_impl = Some c} as a,pl) ->
 										let cf = PMap.find fname c.cl_statics in
-										make_static_call c cf a pl (e2 :: el) e.etype e.epos
+										make_static_call ctx c cf a pl (e2 :: el) e.etype e.epos
 									| _ -> raise Not_found
 								end
 							| _ -> raise Not_found
@@ -1439,23 +1444,23 @@ let handle_abstract_casts ctx e =
 					| TFun(args,_) ->
 						let rec loop2 el tl = match el,tl with
 							| [],_ -> []
-							| e :: el, [] -> (loop e) :: loop2 el []
+							| e :: el, [] -> (loop ctx e) :: loop2 el []
 							| e :: el, (_,_,t) :: tl ->
-								(check_cast t e e.epos) :: loop2 el tl
+								(check_cast ctx t (loop ctx e) e.epos) :: loop2 el tl
 						in
 						let el = loop2 el args in
-						{ e with eexpr = TCall(loop e1,el)}
+						{ e with eexpr = TCall(loop ctx e1,el)}
 					| _ ->
-						Type.map_expr loop e
+						Type.map_expr (loop ctx) e
 				end
 			end
 		| TArrayDecl el ->
 			begin match e.etype with
 				| TInst(_,[t]) ->
-					let el = List.map (fun e -> check_cast t e e.epos) el in
+					let el = List.map (fun e -> check_cast ctx t (loop ctx e) e.epos) el in
 					{ e with eexpr = TArrayDecl el}
 				| _ ->
-					Type.map_expr loop e
+					Type.map_expr (loop ctx) e
 			end
 		| TObjectDecl fl ->
 			begin match follow e.etype with
@@ -1464,19 +1469,21 @@ let handle_abstract_casts ctx e =
 					try
 						let cf = PMap.find n a.a_fields in
 						let e = match e.eexpr with TCast(e1,None) -> e1 | _ -> e in
-						(n,check_cast cf.cf_type e e.epos)
+						(n,check_cast ctx cf.cf_type (loop ctx e) e.epos)
 					with Not_found ->
-						(n,loop e)
+						(n,loop ctx e)
 				) fl in
 				{ e with eexpr = TObjectDecl fl }
 			| _ ->
-				Type.map_expr loop e
+				Type.map_expr (loop ctx) e
 			end
 		| _ ->
-			Type.map_expr loop e
-	in
-	loop e
+			Type.map_expr (loop ctx) e
+
 
+	let handle_abstract_casts ctx e =
+		loop ctx e
+end
 (* -------------------------------------------------------------------------- *)
 (* USAGE *)
 

gencommon.ml

@@ -4955,7 +4955,7 @@ struct
           let arr_etype = match follow arr.etype with
           | (TInst _ as t) -> t
           | TAbstract ({ a_impl = Some _ } as a, pl) ->
-            follow (Codegen.get_underlying_type a pl)
+            follow (Codegen.Abstract.get_underlying_type a pl)
           | t -> t in
           (* get underlying class (if it's a class *)
           (match arr_etype with

gencpp.ml

@@ -452,7 +452,7 @@ and type_string_suff suffix haxe_type =
 	| TDynamic haxe_type -> "Dynamic" ^ suffix
 	| TLazy func -> type_string_suff suffix ((!func)())
 	| TAbstract (abs,pl) when abs.a_impl <> None ->
-		type_string_suff suffix (Codegen.get_underlying_type abs pl)
+		type_string_suff suffix (Codegen.Abstract.get_underlying_type abs pl)
 	| TAbstract (abs,pl) ->
 		"::" ^ (join_class_path abs.a_path "::") ^ suffix
 	)
@@ -2273,7 +2273,7 @@ let find_referenced_types ctx obj super_deps constructor_deps header_only for_de
 		| TFun (args,haxe_type) -> visit_type haxe_type;
 				List.iter (fun (_,_,t) -> visit_type t; ) args;
 		| TAbstract (abs,pl) when abs.a_impl <> None ->
-			visit_type (Codegen.get_underlying_type abs pl)
+			visit_type (Codegen.Abstract.get_underlying_type abs pl)
 		| _ -> ()
 	in
 	let rec visit_types expression =

gencs.ml

@@ -575,7 +575,7 @@ let configure gen =
       | TType ({ t_path = [],"Single" },[])
       | TAbstract ({ a_path = [],"Single" },[]) -> Some t
       | TAbstract ({ a_impl = Some _ } as a, pl) ->
-          Some (gen.gfollow#run_f ( Codegen.get_underlying_type a pl) )
+          Some (gen.gfollow#run_f ( Codegen.Abstract.get_underlying_type a pl) )
       | TAbstract( { a_path = ([], "EnumValue") }, _  )
       | TInst( { cl_path = ([], "EnumValue") }, _  ) -> Some t_dynamic
       | _ -> None);
@@ -596,7 +596,7 @@ let configure gen =
     let t = gen.gfollow#run_f t in
     let ret = match t with
       | TAbstract ({ a_impl = Some _ } as a, pl) ->
-        real_type (Codegen.get_underlying_type a pl)
+        real_type (Codegen.Abstract.get_underlying_type a pl)
       | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
       | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
       | TAbstract( { a_path = [],"Class" }, _ )
@@ -742,7 +742,7 @@ let configure gen =
           | _ -> "object")
       | TDynamic _ -> "object"
       | TAbstract(a,pl) when a.a_impl <> None ->
-        t_s (Codegen.get_underlying_type a pl)
+        t_s (Codegen.Abstract.get_underlying_type a pl)
       (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *)
       | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); assert false end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"
 

genjava.ml

@@ -751,7 +751,7 @@ let configure gen =
       | TAbstract ({ a_path = [],"Single" },[])
       | TType ({ t_path = [],"Null" },[_]) -> Some t
       | TAbstract ({ a_impl = Some _ } as a, pl) ->
-          Some (gen.gfollow#run_f ( Codegen.get_underlying_type a pl) )
+          Some (gen.gfollow#run_f ( Codegen.Abstract.get_underlying_type a pl) )
 	    | TAbstract( { a_path = ([], "EnumValue") }, _ )
       | TInst( { cl_path = ([], "EnumValue") }, _  ) -> Some t_dynamic
       | _ -> None);
@@ -768,7 +768,7 @@ let configure gen =
     let t = gen.gfollow#run_f t in
     match t with
       | TAbstract ({ a_impl = Some _ } as a, pl) ->
-        real_type (Codegen.get_underlying_type a pl)
+        real_type (Codegen.Abstract.get_underlying_type a pl)
       | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
       | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
       | TAbstract( { a_path = ([], "Class") }, p  )
@@ -895,7 +895,7 @@ let configure gen =
         | TDynamic _ ->
             path_s_import pos (["java";"lang"], "Object")
       | TAbstract(a,pl) when a.a_impl <> None ->
-        t_s pos (Codegen.get_underlying_type a pl)
+        t_s pos (Codegen.Abstract.get_underlying_type a pl)
       (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *)
       | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); assert false end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"
 

main.ml

@@ -1161,7 +1161,7 @@ try
 		if Common.defined_value_safe com Define.DisplayMode = "usage" then
 			Codegen.detect_usage com;
 		let filters = [
-			Codegen.handle_abstract_casts tctx;
+			Codegen.Abstract.handle_abstract_casts tctx;
 			if com.foptimize then Optimizer.reduce_expression tctx else Optimizer.sanitize tctx;
 			Codegen.check_local_vars_init;
 			Codegen.captured_vars com;

tests/unit/TestBasetypes.hx

@@ -376,8 +376,15 @@ class TestBasetypes extends Test {
 		var arr:Array<String> = [tpl];
 		eq(arr[0], "Abstract casting really works!");
 		#end
+		
+		// cast to return
+		function returnAbstractCast():String {
+			return new unit.MyAbstract.Meter(12.2);
+		}
+		
+		eq(returnAbstractCast(), "12.2m");
 	}
-
+	
 	function testAbstractToAbstractCast() {
 		var m:unit.MyAbstract.Meter = 122.2;
 		var km:unit.MyAbstract.Kilometer = m;

typer.ml

@@ -2546,6 +2546,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			| Some e ->
 				let e = type_expr ctx e (WithType ctx.ret) in
 				unify ctx e.etype ctx.ret e.epos;
+				let e = Codegen.Abstract.check_cast ctx ctx.ret e p in
 				Some e , e.etype
 		) in
 		mk (TReturn e) t_dynamic p
@@ -3576,7 +3577,7 @@ and flush_macro_context mint ctx =
 		mint
 	end else mint in
 	(* we should maybe ensure that all filters in Main are applied. Not urgent atm *)
-	(try Interp.add_types mint types (Codegen.post_process [Codegen.handle_abstract_casts mctx; Codegen.captured_vars mctx.com; Codegen.rename_local_vars mctx.com])
+	(try Interp.add_types mint types (Codegen.post_process [Codegen.Abstract.handle_abstract_casts mctx; Codegen.captured_vars mctx.com; Codegen.rename_local_vars mctx.com])
 	with Error (e,p) -> display_error ctx (error_msg e) p; raise Fatal_error);
 	Codegen.post_process_end()