added TCast

codegen.ml

@@ -159,7 +159,7 @@ let rec build_generic ctx c p tl =
 		let cg = mk_class (pack,name) c.cl_pos None false in
 		let mg = {
 			mpath = cg.cl_path;
-			mtypes = [TClassDecl cg];			
+			mtypes = [TClassDecl cg];
 		} in
 		Hashtbl.add ctx.modules mg.mpath mg;
 		let rec loop l1 l2 =
@@ -186,14 +186,14 @@ let rec build_generic ctx c p tl =
 		in
 		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 
+		cg.cl_super <- (match c.cl_super with
 			| None -> None
 			| 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)					
+					| _ -> assert false)
 				| TInst (cs,pl) -> Some (cs,pl)
 				| _ -> assert false)
 		);
@@ -266,11 +266,11 @@ let build_instance ctx mtype p =
 	match mtype with
 	| TClassDecl c ->
 		let ft = (fun pl ->
-			match c.cl_kind with 
+			match c.cl_kind with
 			| KGeneric ->
 				let r = exc_protect (fun r ->
 					let t = mk_mono() in
-					r := (fun() -> t);	
+					r := (fun() -> t);
 					unify_raise ctx (build_generic ctx c p pl) t p;
 					t
 				) in
@@ -883,6 +883,9 @@ let fix_overrides com t =
 (* -------------------------------------------------------------------------- *)
 (* MISC FEATURES *)
 
+(*
+	Tells if we can find a local var in an expression or inside a sub closure
+*)
 let local_find flag vname e =
 	let rec loop2 e =
 		match e.eexpr with
@@ -970,7 +973,7 @@ let rec constructor_side_effects e =
 	| TBinop _ | TTry _ | TIf _ | TBlock _ | TVars _
 	| TFunction _ | TArrayDecl _ | TObjectDecl _
 	| TParenthesis _ | TTypeExpr _ | TEnumField _ | TLocal _
-	| TConst _ | TContinue | TBreak ->
+	| TConst _ | TContinue | TBreak | TCast _ ->
 		try
 			Type.iter (fun e -> if constructor_side_effects e then raise Exit) e;
 			false;
@@ -1032,3 +1035,27 @@ let dump_types com =
 		output_string ch (Buffer.contents buf);
 		close_out ch
 	) com.types
+
+(*
+	Build a default safe-cast expression :
+	{ var $t = <e>; if( Std.is($t,<t>) ) $t else throw "Class cast error"; }
+*)
+let default_cast com e texpr t p =
+	let api = com.type_api in
+	let mk_texpr = function
+		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
+		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
+		| TTypeDecl _ -> assert false
+	in
+	let vtmp = "$t" in
+	let var = mk (TVars [(vtmp,e.etype,Some e)]) api.tvoid p in
+	let vexpr = mk (TLocal vtmp) e.etype p in
+	let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in
+	let std = (match (api.load_module ([],"Std") p).mtypes with [std] -> std | _ -> assert false) in
+	(*Typeload.load_type_def ctx p { tpackage = []; tname = "Std"; tparams = []; tsub = None } in *)
+	let std = mk (TTypeExpr std) (mk_texpr std) p in
+	let is = mk (TField (std,"is")) (tfun [t_dynamic;t_dynamic] api.tbool) p in
+	let is = mk (TCall (is,[vexpr;texpr])) api.tbool p in
+	let exc = mk (TThrow (mk (TConst (TString "Class cast error")) api.tstring p)) t p in
+	let check = mk (TIf (is,mk (TCast (vexpr,None)) t p,Some exc)) t p in
+	mk (TBlock [var;check;vexpr]) t p

doc/CHANGES.txt

@@ -13,6 +13,7 @@
 	flash : changes in swf handling to work with >16MB swfs
 	flash9 : only init dynamic methods if not already defined (in subclass)
 	std : added haxe.SHA1
+	compiler : added TCast, allow cast optimization on flash9/cpp
 
 2010-01-09: 2.05
 	js : added js.Scroll

genas3.ml

@@ -689,6 +689,12 @@ and gen_expr ctx e =
 			newline ctx;
 		);
 		spr ctx "}"
+	| TCast (e1,None) ->
+		spr ctx "((";
+		gen_expr ctx e1;
+		print ctx ") as %s)" (type_str ctx e.etype e.epos);
+	| TCast (e1,Some t) ->
+		gen_expr ctx (Codegen.default_cast ctx.inf.com e1 t e.etype e.epos)
 
 and gen_value ctx e =
 	let assign e =
@@ -754,6 +760,8 @@ and gen_value ctx e =
 	| TUnop _
 	| TFunction _ ->
 		gen_expr ctx e
+	| TCast (e1,t) ->
+		gen_value ctx (match t with None -> e1 | Some t -> Codegen.default_cast ctx.inf.com e1 t e.etype e.epos)
 	| TReturn _
 	| TBreak
 	| TContinue ->

gencpp.ml

@@ -130,6 +130,7 @@ let make_base_directory file =
 
 type context =
 {
+	mutable ctx_common : Common.context;
 	mutable ctx_output : string -> unit;
 	mutable ctx_writer : source_writer;
 	mutable ctx_calling : bool;
@@ -152,8 +153,9 @@ type context =
 	mutable ctx_class_member_types : (string,string) Hashtbl.t;
 }
 
-let new_context writer debug = 
+let new_context common_ctx writer debug = 
 	{
+	ctx_common = common_ctx;
 	ctx_writer = writer;
 	ctx_output = (writer#write);
 	ctx_calling = false;
@@ -534,39 +536,7 @@ let get_switch_var ctx =
 
 (* If you put on the "-debug" flag, you get extra comments in the source code *)
 let debug_expression expression type_too =
-	"/* " ^
-	(match expression.eexpr with
-	| TConst _ -> "TConst"
-	| TLocal _ -> "TLocal"
-	| TEnumField _ -> "TEnumField"
-	| TArray (_,_) -> "TArray"
-	| TBinop (_,_,_) -> "TBinop"
-	| TField (_,_) -> "TField"
-	| TClosure _ -> "TClosure"
-	| TTypeExpr _ -> "TTypeExpr"
-	| TParenthesis _ -> "TParenthesis"
-	| TObjectDecl _ -> "TObjectDecl"
-	| TArrayDecl _ -> "TArrayDecl"
-	| TCall (_,_) -> "TCall"
-	| TNew (_,_,_) -> "TNew"
-	| TUnop (_,_,_) -> "TUnop"
-	| TFunction _ -> "TFunction"
-	| TVars _ -> "TVars"
-	| TBlock _ -> "TBlock"
-	| TFor (_,_,_,_) -> "TFor"
-	| TIf (_,_,_) -> "TIf"
-	| TWhile (_,_,_) -> "TWhile"
-	| TSwitch (_,_,_) -> "TSwitch"
-	| TMatch (_,_,_,_) -> "TMatch"
-	| TTry (_,_) -> "TTry"
-	| TReturn _ -> "TReturn"
-	| TBreak -> "TBreak"
-	| TContinue -> "TContinue"
-	| TThrow _ -> "TThrow" ) ^
-	(if (type_too) then " = " ^ (type_string expression.etype) else "") ^
-	" */";;
-
-
+	"/* " ^ Type.s_expr_kind expression ^ (if (type_too) then " = " ^ (type_string expression.etype) else "") ^	" */";;
 
 (* This is like the Type.iter, but also keeps the "retval" flag up to date *)
 let rec iter_retval f retval e =
@@ -632,6 +602,8 @@ let rec iter_retval f retval e =
 		List.iter (fun (_,_,e) -> f false e) catches
 	| TReturn eo ->
 		(match eo with None -> () | Some e -> f true e)
+	| TCast (e,_) ->
+		f retval e
 ;;
 
 
@@ -1497,6 +1469,10 @@ and gen_expression ctx retval expression =
 	| TThrow expression -> output "hx::Throw (";
 			gen_expression ctx true expression;
 			output ")"
+	| TCast (expression,None) ->
+		gen_expression ctx retval expression
+	| TCast (e1,Some t) ->
+		gen_expression ctx retval (Codegen.default_cast ctx.ctx_common e1 t expression.etype expression.epos)		
 	);;
 
 
@@ -1867,7 +1843,7 @@ let generate_main common_ctx member_types super_deps class_def boot_classes init
 		(*make_class_directories base_dir ( "src" :: []);*)
 		let cpp_file = new_cpp_file common_ctx.file ([],filename) in
 		let output_main = (cpp_file#write) in
-		let ctx = new_context cpp_file false in
+		let ctx = new_context common_ctx cpp_file false in
 		ctx.ctx_class_name <- "?";
 		ctx.ctx_class_member_types <- member_types;
 
@@ -1878,7 +1854,7 @@ let generate_main common_ctx member_types super_deps class_def boot_classes init
 		output_main "\n\n";
 
 		output_main ( if is_main then "HX_BEGIN_MAIN\n\n" else "HX_BEGIN_LIB_MAIN\n\n" );
-		gen_expression (new_context cpp_file false) false main_expression;
+		gen_expression (new_context common_ctx cpp_file false) false main_expression;
 		output_main ";\n";
 		output_main ( if is_main then "HX_END_MAIN\n\n" else "HX_END_LIB_MAIN\n\n" );
 		cpp_file#close;
@@ -1935,7 +1911,7 @@ let generate_enum_files common_ctx enum_def super_deps =
 	let cpp_file = new_placed_cpp_file common_ctx class_path in
 	let output_cpp = (cpp_file#write) in
 	let debug = false in
-	let ctx = new_context cpp_file debug in
+	let ctx = new_context common_ctx cpp_file debug in
 
 	if (debug) then
 		print_endline ("Found enum definition:" ^ (join_class_path  class_path "::" ));
@@ -2121,7 +2097,7 @@ let generate_class_files common_ctx member_types super_deps class_def =
 	let cpp_file = new_placed_cpp_file common_ctx class_path in
 	let output_cpp = (cpp_file#write) in
 	let debug = false in
-	let ctx = new_context cpp_file debug in
+	let ctx = new_context common_ctx cpp_file debug in
 	ctx.ctx_class_name <- "::" ^ (join_class_path class_path "::");
 	ctx.ctx_class_member_types <- member_types;
 	if debug then print_endline ("Found class definition:" ^ ctx.ctx_class_name);
@@ -2185,7 +2161,7 @@ let generate_class_files common_ctx member_types super_deps class_def =
 							end else begin
 								gen_expression ctx false function_def.tf_expr;
 								output_cpp ";\n";
-								(*gen_expression (new_context cpp_file debug ) false function_def.tf_expr;*)
+								(*gen_expression (new_context common_ctx cpp_file debug ) false function_def.tf_expr;*)
 							end
 						| _ -> ()
 						)
@@ -2221,7 +2197,7 @@ let generate_class_files common_ctx member_types super_deps class_def =
 	(match class_def.cl_init with
 	| Some expression -> 
 		output_cpp ("void " ^ class_name^ "::__init__()");
-		gen_expression (new_context cpp_file debug) false expression;
+		gen_expression (new_context common_ctx cpp_file debug) false expression;
 		output_cpp "\n\n";
 	| _ -> ());
 

genjs.ml

@@ -465,6 +465,10 @@ and gen_expr ctx e =
 			newline ctx;
 		);
 		spr ctx "}"
+	| TCast (e,None) ->
+		gen_expr ctx e
+	| TCast (e1,Some t) ->
+		gen_expr ctx (Codegen.default_cast ctx.com e1 t e.etype e.epos)
 
 and gen_value ctx e =
 	let assign e =
@@ -522,6 +526,8 @@ and gen_value ctx e =
 	| TBreak
 	| TContinue ->
 		unsupported e.epos
+	| TCast (e1,t) ->
+		gen_value ctx (match t with None -> e1 | Some t -> Codegen.default_cast ctx.com e1 t e.etype e.epos)
 	| TVars _
 	| TFor _
 	| TWhile _

genneko.ml

@@ -389,6 +389,10 @@ and gen_expr ctx e =
 		(EContinue,p)
 	| TThrow e ->
 		call p (builtin p "throw") [gen_expr ctx e]
+	| TCast (e,None) ->
+		gen_expr ctx e
+	| TCast (e1,Some t) ->
+		gen_expr ctx (Codegen.default_cast ctx.com e1 t e.etype e.epos)
 	| TMatch (e,_,cases,eo) ->
 		let etmp = (EVars ["@tmp",Some (gen_expr ctx e)],p) in
 		let eindex = field p (ident p "@tmp") "index" in

genphp.ml

@@ -121,37 +121,7 @@ and type_string haxe_type =
 	type_string_suff "" haxe_type;;
 
 let debug_expression expression type_too =
-	"/* " ^
-	(match expression.eexpr with
-	| TConst _ -> "TConst"
-	| TLocal _ -> "TLocal"
-	| TEnumField _ -> "TEnumField"
-	| TArray (_,_) -> "TArray"
-	| TBinop (_,_,_) -> "TBinop"
-	| TField (_,_) -> "TField"
-	| TClosure _ -> "TClosure"
-	| TTypeExpr _ -> "TTypeExpr"
-	| TParenthesis _ -> "TParenthesis"
-	| TObjectDecl _ -> "TObjectDecl"
-	| TArrayDecl _ -> "TArrayDecl"
-	| TCall (_,_) -> "TCall"
-	| TNew (_,_,_) -> "TNew"
-	| TUnop (_,_,_) -> "TUnop"
-	| TFunction _ -> "TFunction"
-	| TVars _ -> "TVars"
-	| TBlock _ -> "TBlock"
-	| TFor (_,_,_,_) -> "TFor"
-	| TIf (_,_,_) -> "TIf"
-	| TWhile (_,_,_) -> "TWhile"
-	| TSwitch (_,_,_) -> "TSwitch"
-	| TMatch (_,_,_,_) -> "TMatch"
-	| TTry (_,_) -> "TTry"
-	| TReturn _ -> "TReturn"
-	| TBreak -> "TBreak"
-	| TContinue -> "TContinue"
-	| TThrow _ -> "TThrow" ) ^
-	(if (type_too) then " = " ^ (type_string expression.etype) else "") ^
-	" */";;
+	"/* " ^ Type.s_expr_kind expression ^ (if (type_too) then " = " ^ (type_string expression.etype) else "") ^ " */";;
 
 let rec escphp n =
 	if n = 0 then "" else if n = 1 then "\\" else ("\\\\" ^ escphp (n-1))
@@ -160,35 +130,7 @@ let rec register_extern_required_path ctx path =
 	if (List.exists(fun p -> p = path) ctx.extern_classes_with_init) && not (List.exists(fun p -> p = path) ctx.extern_required_paths) then
 		ctx.extern_required_paths <- path :: ctx.extern_required_paths
 		
-let s_expr_expr e =
-	match e.eexpr with
-	| TConst _ -> "TConst"
-	| TLocal _ -> "TLocal"
-	| TEnumField _ -> "TEnumField"
-	| TArray (_,_) -> "TArray"
-	| TBinop (_,_,_) -> "TBinop"
-	| TField (_,_) -> "TField"
-	| TClosure (_,_) -> "TClosure"
-	| TTypeExpr _ -> "TTypeExpr"
-	| TParenthesis _ -> "TParenthesis"
-	| TObjectDecl _ -> "TObjectDecl"
-	| TArrayDecl _ -> "TArrayDecl"
-	| TCall (_,_) -> "TCall"
-	| TNew (_,_,_) -> "TNew"
-	| TUnop (_,_,_) -> "TUnop"
-	| TFunction _ -> "TFunction"
-	| TVars _ -> "TVars"
-	| TBlock _ -> "TBlock"
-	| TFor (_,_,_,_) -> "TFor"
-	| TIf (_,_,_) -> "TIf"
-	| TWhile (_,_,_) -> "TWhile"
-	| TSwitch (_,_,_) -> "TSwitch"
-	| TMatch (_,_,_,_) -> "TMatch"
-	| TTry (_,_) -> "TTry"
-	| TReturn _ -> "TReturn"
-	| TBreak -> "TBreak"
-	| TContinue -> "TContinue"
-	| TThrow _ -> "TThrow"
+let s_expr_expr = Type.s_expr_kind
 
 let s_expr_name e =
 	s_type (print_context()) e.etype
@@ -1541,6 +1483,10 @@ and gen_expr ctx e =
 			newline ctx;
 		);
 		spr ctx "}"
+	| TCast (e,None) ->
+		gen_expr ctx e
+	| TCast (e1,Some t) ->
+		gen_expr ctx (Codegen.default_cast ctx.com e1 t e.etype e.epos)
 
 and gen_value ctx e =
 	let assign e =
@@ -1597,6 +1543,8 @@ and gen_value ctx e =
 	| TNew _
 	| TFunction _ ->
 		gen_expr ctx e
+	| TCast (e1,t) ->
+		gen_value ctx (match t with None -> e1 | Some t -> Codegen.default_cast ctx.com e1 t e.etype e.epos)
 	| TReturn _
 	| TBreak
 	| TContinue ->

genswf8.ml

@@ -1150,6 +1150,10 @@ and gen_expr_2 ctx retval e =
 		gen_binop ctx retval op e1 e2
 	| TUnop (op,flag,e) ->
 		gen_unop ctx retval op flag e
+	| TCast (e,None) ->
+		gen_expr ctx retval e
+	| TCast (e1,Some t) ->
+		gen_expr ctx retval (Codegen.default_cast ctx.com e1 t e.etype e.epos)
 	| TMatch (e,_,cases,def) ->
 		gen_match ctx retval e cases def
 	| TFor (v,_,it,e) ->

genswf9.ml

@@ -104,20 +104,6 @@ let tid (x : 'a index) : int = Obj.magic x
 let ethis = mk (TConst TThis) (mk_mono()) null_pos
 let dynamic_prop = HMMultiNameLate [HNPublic (Some "")]
 
-let t_void = TEnum ({
-		e_path = [],"Void";
-		e_pos = null_pos;
-		e_doc = None;
-		e_private = false;
-		e_extern = false;
-		e_types = [];
-		e_constrs = PMap.empty;
-		e_names = [];
-	},[])
-
-let t_string = TInst (mk_class ([],"String") null_pos None false,[])
-let t_int = TInst (mk_class ([],"Int") null_pos None false,[])
-
 let write ctx op =
 	DynArray.add ctx.code op;
 	ctx.infos.ipos <- ctx.infos.ipos + 1;
@@ -686,7 +672,7 @@ let begin_fun ctx args tret el stat p =
 	)
 
 let empty_method ctx p =
-	let f = begin_fun ctx [] t_void [] true p in
+	let f = begin_fun ctx [] ctx.com.type_api.tvoid [] true p in
 	write ctx HRetVoid;
 	f()
 
@@ -1207,6 +1193,35 @@ let rec gen_expr_content ctx retval e =
 		switch();
 		List.iter (fun j -> j()) jends;
 		free_reg ctx rparams
+	| TCast (e1,t) ->
+		gen_expr ctx retval e1;		
+		if retval then begin
+			match t with
+			| None ->
+				(* no error if cast failure *)
+				let t1 = classify ctx e1.etype in
+				let t = classify ctx e.etype in
+				if t1 <> t then coerce ctx t;
+			| Some t ->
+				(* manual cast *)
+				let tid = (match gen_access ctx (mk (TTypeExpr t) t_dynamic e.epos) Read with
+					| VGlobal id -> id
+					| _ -> assert false
+				) in
+				match classify ctx e.etype with
+				| KType n when (match n with HMPath ([],"String") -> false | _ -> true) ->
+					(* for normal classes, we can use native cast *)
+					write ctx (HCast tid)
+				| _ ->
+					(* we need to check with "is" first *)
+					write ctx HDup;
+					write ctx (HIsType tid);
+					let j = jump ctx J3True in
+					write ctx (HString "Class cast error");
+					write ctx HThrow;
+					j();
+					write ctx (HCast tid)
+		end
 
 and gen_call ctx retval e el r =
 	match e.eexpr , el with
@@ -1732,10 +1747,10 @@ let generate_class ctx c =
 			else
 				generate_construct ctx {
 					tf_args = [];
-					tf_type = t_void;
+					tf_type = ctx.com.type_api.tvoid;
 					tf_expr = {
 						eexpr = TBlock [];
-						etype = t_void;
+						etype = ctx.com.type_api.tvoid;
 						epos = null_pos;
 					}
 				} c
@@ -1794,7 +1809,8 @@ let generate_class ctx c =
 
 let generate_enum ctx e =
 	let name_id = type_path ctx e.e_path in
-	let f = begin_fun ctx [("tag",None,t_string);("index",None,t_int);("params",None,mk_mono())] t_void [ethis] false e.e_pos in
+	let api = ctx.com.type_api in
+	let f = begin_fun ctx [("tag",None,api.tstring);("index",None,api.tint);("params",None,mk_mono())] api.tvoid [ethis] false e.e_pos in
 	let tag_id = ident "tag" in
 	let index_id = ident "index" in
 	let params_id = ident "params" in
@@ -1809,7 +1825,7 @@ let generate_enum ctx e =
 	write ctx (HInitProp params_id);
 	write ctx HRetVoid;
 	let construct = f() in
-	let f = begin_fun ctx [] t_string [] true e.e_pos in
+	let f = begin_fun ctx [] api.tstring [] true e.e_pos in
 	write ctx (HGetLex (type_path ctx (["flash"],"Boot")));
 	write ctx HThis;
 	write ctx (HCallProperty (ident "enum_to_string",1));
@@ -1891,7 +1907,7 @@ let generate_inits ctx =
 	(* define flash.Boot.init method *)
 	write ctx HGetGlobalScope;
 	write ctx (HGetProp (type_path ctx (["flash"],"Boot")));
-	let finit = begin_fun ctx [] t_void [] true null_pos in
+	let finit = begin_fun ctx [] ctx.com.type_api.tvoid [] true null_pos in
 	List.iter (fun t ->
 		match t with
 		| TClassDecl c ->
@@ -1917,7 +1933,7 @@ let generate_type ctx t =
 			None
 		else
 			let hlc = generate_class ctx c in
-			let init = begin_fun ctx [] t_void [ethis] false c.cl_pos in
+			let init = begin_fun ctx [] ctx.com.type_api.tvoid [ethis] false c.cl_pos in
 			generate_class_init ctx c hlc;
 			if c.cl_path = (["flash"],"Boot") then generate_inits ctx;
 			write ctx HRetVoid;
@@ -1932,7 +1948,7 @@ let generate_type ctx t =
 			None
 		else
 			let hlc = generate_enum ctx e in
-			let init = begin_fun ctx [] t_void [ethis] false e.e_pos in
+			let init = begin_fun ctx [] ctx.com.type_api.tvoid [ethis] false e.e_pos in
 			generate_enum_init ctx e hlc;
 			write ctx HRetVoid;
 			Some (init(), {

std/Reflect.hx

@@ -231,6 +231,10 @@ class Reflect {
 	public static function compare<T>( a : T, b : T ) : Int {
 		#if neko
 		return untyped __dollar__compare(a,b);
+		#elseif (flash9 || cpp)
+		var a : Dynamic = a;
+		var b : Dynamic = b;
+		return ( a == b ) ? 0 : ((a > b) ? 1 : -1);
 		#else
 		return ( a == b ) ? 0 : (((cast a) > (cast b)) ? 1 : -1);
 		#end

type.ml

@@ -96,6 +96,7 @@ and texpr_expr =
 	| TBreak
 	| TContinue
 	| TThrow of texpr
+	| TCast of texpr * module_type option	
 
 and texpr = {
 	eexpr : texpr_expr;
@@ -818,6 +819,7 @@ let iter f e =
 	| TField (e,_)
 	| TClosure (e,_)
 	| TParenthesis e
+	| TCast (e,_)
 	| TUnop (_,_,e) ->
 		f e
 	| TArrayDecl el
@@ -902,6 +904,8 @@ let map_expr f e =
 		{ e with eexpr = TTry (f e1, List.map (fun (v,t,e) -> v, t, f e) catches) }
 	| TReturn eo ->
 		{ e with eexpr = TReturn (match eo with None -> None | Some e -> Some (f e)) }
+	| TCast (e1,t) ->
+		{ e with eexpr = TCast (f e1,t) }
 
 let map_expr_type f ft e =
 	match e.eexpr with
@@ -962,6 +966,39 @@ let map_expr_type f ft e =
 		{ e with eexpr = TTry (f e1, List.map (fun (v,t,e) -> v, ft t, f e) catches); etype = ft e.etype }
 	| TReturn eo ->
 		{ e with eexpr = TReturn (match eo with None -> None | Some e -> Some (f e)); etype = ft e.etype }
+	| TCast (e1,t) ->
+		{ e with eexpr = TCast (f e1,t); etype = ft e.etype }
+
+let s_expr_kind e =
+	match e.eexpr with
+	| TConst _ -> "Const"
+	| TLocal _ -> "Local"
+	| TEnumField _ -> "EnumField"
+	| TArray (_,_) -> "Array"
+	| TBinop (_,_,_) -> "Binop"
+	| TField (_,_) -> "Field"
+	| TClosure _ -> "Closure"
+	| TTypeExpr _ -> "TypeExpr"
+	| TParenthesis _ -> "Parenthesis"
+	| TObjectDecl _ -> "ObjectDecl"
+	| TArrayDecl _ -> "ArrayDecl"
+	| TCall (_,_) -> "Call"
+	| TNew (_,_,_) -> "New"
+	| TUnop (_,_,_) -> "Unop"
+	| TFunction _ -> "Function"
+	| TVars _ -> "Vars"
+	| TBlock _ -> "Block"
+	| TFor (_,_,_,_) -> "For"
+	| TIf (_,_,_) -> "If"
+	| TWhile (_,_,_) -> "While"
+	| TSwitch (_,_,_) -> "Switch"
+	| TMatch (_,_,_,_) -> "Match"
+	| TTry (_,_) -> "Try"
+	| TReturn _ -> "Return"
+	| TBreak -> "Break"
+	| TContinue -> "Continue"
+	| TThrow _ -> "Throw"
+	| TCast _ -> "Cast"
 
 let rec s_expr s_type e =
 	let sprintf = Printf.sprintf in
@@ -1040,5 +1077,7 @@ let rec s_expr s_type e =
 		"Continue"
 	| TThrow e ->
 		"Throw " ^ (loop e)
+	| TCast (e,t) ->
+		sprintf "Cast %s%s" (match t with None -> "" | Some t -> s_type_path (t_path t) ^ ": ") (loop e)
 	) in
 	sprintf "(%s : %s)" str (s_type e.etype)

typer.ml

@@ -1432,34 +1432,24 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		}
 	| ECast (e,None) ->
 		let e = type_expr ctx e in
-		{ e with etype = mk_mono() }
+		mk (TCast (e,None)) (mk_mono()) p
 	| ECast (e, Some t) ->
-		(* // if( Std.is(tmp,T) ) tmp else throw "Class cast error" *)
-		let etmp = (EConst (Ident "tmp"),p) in
+		(* force compilation of class "Std" since we might need it *)
+		ignore(Typeload.load_type_def ctx p { tpackage = []; tparams = []; tname = "Std"; tsub = None });
 		let t = Typeload.load_complex_type ctx (pos e) t in
-		let tname = (match follow t with
+		let texpr = (match follow t with
 		| TInst (_,params) | TEnum (_,params) ->
 			List.iter (fun pt ->
 				if follow pt != t_dynamic then error "Cast type parameters must be Dynamic" p;
 			) params;
 			(match follow t with
-			| TInst (c,_) -> c.cl_path
-			| TEnum (e,_) -> e.e_path
+			| TInst (c,_) -> TClassDecl c
+			| TEnum (e,_) -> TEnumDecl e
 			| _ -> assert false);
 		| _ ->
 			error "Cast type must be a class or an enum" p
 		) in
-		let make_type (path,name) =
-			match path with
-			| [] -> (EConst (Type name),p)
-			| x :: path -> (EType (List.fold_left (fun acc x -> (EField (acc,x),p)) (EConst (Ident x),p) path,name),p)
-		in
-		let cond = (ECall ((EField ((EConst (Type "Std"),p),"is"),p),[etmp;make_type tname]),p) in
-		let e = type_expr ctx (EBlock [
-			(EVars [("tmp",None,Some e)],p);
-			(EIf (cond,etmp,Some (EThrow (EConst (String "Class cast error"),p),p)),p);
-		],p) in
-		{ e with etype = t }
+		mk (TCast (type_expr ctx e,Some texpr)) t p
 	| EDisplay e ->
 		let old = ctx.in_display in
 		ctx.in_display <- true;