[js] rework exception handling (closes #6458)

src/filters/filters.ml

@@ -81,33 +81,6 @@ let rec add_final_return e =
 			{ e with eexpr = TFunction f }
 		| _ -> e
 
-let rec wrap_js_exceptions com e =
-	let rec is_error t =
-		match follow t with
-		| TInst ({cl_path = (["js"],"Error")},_) -> true
-		| TInst ({cl_super = Some (csup,tl)}, _) -> is_error (TInst (csup,tl))
-		| _ -> false
-	in
-	let rec loop e =
-		match e.eexpr with
-		| TThrow eerr when not (is_error eerr.etype) ->
-			let terr = List.find (fun mt -> match mt with TClassDecl {cl_path = ["js";"_Boot"],"HaxeError"} -> true | _ -> false) com.types in
-			let cerr = match terr with TClassDecl c -> c | _ -> assert false in
-			(match eerr.etype with
-			| TDynamic _ ->
-				let eterr = Texpr.Builder.make_static_this cerr e.epos in
-				let ewrap = Texpr.Builder.fcall eterr "wrap" [eerr] t_dynamic e.epos in
-				{ e with eexpr = TThrow ewrap }
-			| _ ->
-				let ewrap = { eerr with eexpr = TNew (cerr,[],[eerr]); etype = TInst (cerr,[]) } in
-				{ e with eexpr = TThrow ewrap }
-			)
-		| _ ->
-			Type.map_expr loop e
-	in
-
-	loop e
-
 (* -------------------------------------------------------------------------- *)
 (* CHECK LOCAL VARS INIT *)
 
@@ -869,6 +842,8 @@ let run com tctx main =
 			filters @ [
 				TryCatchWrapper.configure_java com
 			]
+		| Js ->
+			filters @ [JsExceptions.init tctx];
 		| _ -> filters
 	in
 	let t = filter_timer detail_times ["expr 1"] in
@@ -897,7 +872,6 @@ let run com tctx main =
 	let filters = [
 		Optimizer.sanitize com;
 		if com.config.pf_add_final_return then add_final_return else (fun e -> e);
-		if com.platform = Js then wrap_js_exceptions com else (fun e -> e);
 		rename_local_vars tctx reserved;
 		mark_switch_break_loops;
 	] in

src/filters/jsExceptions.ml

@@ -0,0 +1,188 @@
+(*
+	The Haxe Compiler
+	Copyright (C) 2005-2017  Haxe Foundation
+
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public License
+	along with this program; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(*
+	This filter handles everything related to expressions for the JavaScript target:
+
+	- wrapping non-js.Error types in HaxeError on throwing
+	- unwrapping HaxeError on catch
+	- transforming series of catches into a single catch with Std.is checks (optimized)
+	- re-throwing caught exception with js.Lib.rethrow
+	- storing caught exception in haxe.CallStack.lastException (if haxe.CallStack is used)
+
+	Basically it translates this:
+
+	 try throw "fail"
+	 catch (e:String) { trace(e); js.Lib.rethrow(); }
+	 catch (e:Bool) {}
+
+	into something like this (JS):
+
+	 try {
+		 throw new HaxeError("fail");
+	 } catch (e) {
+		 haxe.CallStack.lastException = e;
+		 var e1 = (e instanceof HaxeError) e.val : e;
+		 if (typeof e1 == "string") {
+			 trace(e1);
+			 throw e;
+		 } else if (typeof e1 == "boolean") {
+		 } else {
+			 throw e;
+		 }
+	 }
+*)
+
+open Common
+open Type
+open Typecore
+open Texpr.Builder
+
+let follow = Abstract.follow_with_abstracts
+
+let rec is_js_error t =
+	match t with
+	| TInst ({ cl_path = ["js"],"Error" },_) -> true
+	| TInst ({ cl_super = Some (csup,tl) },_) -> is_js_error (TInst (csup,tl))
+	| _ -> false
+
+let find_cl ctx path =
+	ExtList.List.find_map (function
+		| TClassDecl c when c.cl_path = path -> Some c
+		| _ -> None
+	) ctx.com.types
+
+let init ctx =
+	let cJsError = find_cl ctx (["js"],"Error") in
+	let cHaxeError = find_cl ctx (["js";"_Boot"],"HaxeError") in
+	let cStd = find_cl ctx ([],"Std") in
+	let cBoot = find_cl ctx (["js"],"Boot") in
+	let cSyntax = find_cl ctx (["js"],"Syntax") in
+	let cCallStack = try Some (find_cl ctx (["haxe"],"CallStack")) with Not_found -> None in
+
+	let dynamic_wrap e =
+		let eHaxeError = make_static_this cHaxeError e.epos in
+		fcall eHaxeError "wrap" [e] (TInst (cJsError, [])) e.epos
+	in
+
+	let static_wrap e =
+		{ e with eexpr = TNew (cHaxeError,[],[e]); etype = TInst (cHaxeError,[]) }
+	in
+
+	let rec loop vrethrow e =
+		match e.eexpr with
+		| TThrow eexc ->
+			let eexc = loop vrethrow eexc in
+			let eexc =
+				match follow eexc.etype with
+				| TDynamic _ | TMono _ ->
+					(match eexc.eexpr with
+					| TConst (TInt _ | TFloat _ | TString _ | TBool _ | TNull) -> static_wrap eexc
+					| _ -> dynamic_wrap eexc)
+				| t when not (is_js_error t) ->
+					static_wrap eexc
+				| _ ->
+					eexc
+			in
+			{ e with eexpr = TThrow eexc }
+
+		| TCall ({ eexpr = TField (_, FStatic ({ cl_path = ["js"],"Lib" }, { cf_name = "getOriginalException" })) }, _) ->
+			(match vrethrow with
+			| Some erethrowvar -> erethrowvar
+			| None -> abort "js.Lib.getOriginalException can only be called inside a catch block" e.epos)
+
+		| TCall ({ eexpr = TField (_, FStatic ({ cl_path = ["js"],"Lib" }, { cf_name = "rethrow" })) }, _) ->
+			(match vrethrow with
+			| Some erethrowvar -> { e with eexpr = TThrow erethrowvar }
+			| None -> abort "js.Lib.rethrow can only be called inside a catch block" e.epos)
+
+		| TTry (etry, catches) ->
+			let etry = loop vrethrow etry in
+
+			let catchall_name = match catches with [(v,_)] -> v.v_name | _ -> "e" in
+			let vcatchall = alloc_var catchall_name t_dynamic e.epos in
+			let ecatchall = make_local vcatchall e.epos in
+			let erethrow = mk (TThrow ecatchall) t_dynamic e.epos in
+
+			let eSyntax = make_static_this cSyntax e.epos in
+			let eHaxeError = make_static_this cHaxeError e.epos in
+			let eInstanceof = fcall eSyntax "instanceof" [ecatchall;eHaxeError] ctx.com.basic.tbool e.epos in
+			let eVal = field { ecatchall with etype = TInst (cHaxeError,[]) } "val" t_dynamic e.epos in
+			let eunwrap = mk (TIf (eInstanceof, eVal, Some (ecatchall))) t_dynamic e.epos in
+
+			let vunwrapped = alloc_var catchall_name t_dynamic e.epos in
+			let eunwrapped = make_local vunwrapped e.epos in
+
+			let ecatch = List.fold_left (fun acc (v,ecatch) ->
+				let ecatch = loop (Some ecatchall) ecatch in
+
+				match follow v.v_type with
+				| TDynamic _ ->
+					{ ecatch with
+						eexpr = TBlock [
+							mk (TVar (v, Some eunwrapped)) ctx.com.basic.tvoid ecatch.epos;
+							ecatch;
+						]
+					}
+				| t ->
+					let etype = make_typeexpr (module_type_of_type t) e.epos in
+					let args = [eunwrapped;etype] in
+					let echeck =
+						match Optimizer.api_inline ctx cStd "is" args e.epos with
+						| Some e -> e
+						| None ->
+							let eBoot = make_static_this cBoot e.epos in
+							fcall eBoot "__instanceof" [eunwrapped;etype] ctx.com.basic.tbool e.epos
+					in
+					let ecatch = { ecatch with
+						eexpr = TBlock [
+							mk (TVar (v, Some eunwrapped)) ctx.com.basic.tvoid ecatch.epos;
+							ecatch;
+						]
+					} in
+					mk (TIf (echeck, ecatch, Some acc)) e.etype e.epos
+			) erethrow (List.rev catches) in
+
+			let ecatch_block = [
+				mk (TVar (vunwrapped, Some eunwrap)) ctx.com.basic.tvoid e.epos;
+				ecatch;
+			] in
+
+			let ecatch_block =
+				match cCallStack with
+				| None -> ecatch_block
+				| Some c ->
+					(*
+						TODO: we should use `__feature__` here, but analyzer won't like an unbound identifier,
+						so let's wait for some proper way to deal with feature-conditional expressions (@:ifFeature maybe?)
+
+						Alternatively, we could run an additional post-analyzer/dce filter that adds these assignments.
+					*)
+					let eCallStack = make_static_this c ecatch.epos in
+					let elastException = field eCallStack "lastException" t_dynamic ecatch.epos in
+					let estore = mk (TBinop (Ast.OpAssign, elastException, ecatchall)) ecatch.etype ecatch.epos in
+					estore :: ecatch_block
+			in
+
+			let ecatch = { ecatch with eexpr = TBlock ecatch_block } in
+			{ e with eexpr = TTry (etry, [(vcatchall,ecatch)]) }
+		| _ ->
+			Type.map_expr (loop vrethrow) e
+	in
+	loop None

src/generators/genjs.ml

@@ -45,7 +45,6 @@ type ctx = {
 	js_modern : bool;
 	js_flatten : bool;
 	es_version : int;
-	store_exception_stack : bool;
 	mutable current : tclass;
 	mutable statics : (tclass * string * texpr) list;
 	mutable inits : texpr list;
@@ -396,8 +395,6 @@ let rec gen_call ctx e el in_value =
 		else match eelse with
 			| [] -> ()
 			| e :: _ -> gen_value ctx e)
-	| TIdent "__rethrow__", [] ->
-		spr ctx "throw $hx_rethrow";
 	| TIdent "__resources__", [] ->
 		spr ctx "[";
 		concat ctx "," (fun (name,data) ->
@@ -687,110 +684,14 @@ and gen_expr ctx e =
 		newline ctx;
 		spr ctx "}";
 		ctx.in_loop <- old_in_loop
-	| TTry (e,catchs) ->
+	| TTry (etry,[(v,ecatch)]) ->
 		spr ctx "try ";
-		gen_expr ctx e;
-		let vname = (match catchs with [(v,_)] -> check_var_declaration v; v.v_name | _ ->
-			let id = ctx.id_counter in
-			ctx.id_counter <- ctx.id_counter + 1;
-			"$e" ^ string_of_int id
-		) in
-		print ctx " catch( %s ) {" vname;
-		let bend = open_block ctx in
-		let last = ref false in
-		let else_block = ref false in
-
-		if ctx.store_exception_stack then begin
-			newline ctx;
-			print ctx "%s.lastException = %s" (ctx.type_accessor (TClassDecl { null_class with cl_path = ["haxe"],"CallStack" })) vname
-		end;
-
-		if (has_feature ctx "js.Lib.rethrow") then begin
-			let has_rethrow (_,e) =
-				let rec loop e = match e.eexpr with
-				| TCall({eexpr = TIdent "__rethrow__"}, []) -> raise Exit
-				| _ -> Type.iter loop e
-				in
-				try (loop e; false) with Exit -> true
-			in
-			if List.exists has_rethrow catchs then begin
-				newline ctx;
-				print ctx "var $hx_rethrow = %s" vname;
-			end
-		end;
-
-		if (has_feature ctx "js.Boot.HaxeError") then begin
-			let catch_var_used =
-				try
-					List.iter (fun (v,e) ->
-						match follow v.v_type with
-						| TDynamic _ -> (* Dynamic catch - unrap if the catch value is used *)
-							let rec loop e = match e.eexpr with
-							| TLocal v2 when v2 == v -> raise Exit
-							| _ -> Type.iter loop e
-							in
-							loop e
-						| _ -> (* not a Dynamic catch - we need to unwrap the error for type-checking *)
-							raise Exit
-					) catchs;
-					false
-				with Exit ->
-					true
-			in
-			if catch_var_used then begin
-				newline ctx;
-				print ctx "if (%s instanceof %s) %s = %s.val" vname (ctx.type_accessor (TClassDecl { null_class with cl_path = ["js";"_Boot"],"HaxeError" })) vname vname;
-			end;
-		end;
-
-		List.iter (fun (v,e) ->
-			if !last then () else
-			let t = (match follow v.v_type with
-			| TEnum (e,_) -> Some (TEnumDecl e)
-			| TInst (c,_) -> Some (TClassDecl c)
-			| TAbstract (a,_) -> Some (TAbstractDecl a)
-			| TFun _
-			| TLazy _
-			| TType _
-			| TAnon _ ->
-				assert false
-			| TMono _
-			| TDynamic _ ->
-				None
-			) in
-			match t with
-			| None ->
-				last := true;
-				if !else_block then print ctx "{";
-				if vname <> v.v_name then begin
-					newline ctx;
-					print ctx "var %s = %s" v.v_name vname;
-				end;
-				gen_block_element ctx e;
-				if !else_block then begin
-					newline ctx;
-					print ctx "}";
-				end
-			| Some t ->
-				if not !else_block then newline ctx;
-				print ctx "if( %s.__instanceof(%s," (ctx.type_accessor (TClassDecl { null_class with cl_path = ["js"],"Boot" })) vname;
-				gen_value ctx (mk (TTypeExpr t) (mk_mono()) e.epos);
-				spr ctx ") ) {";
-				let bend = open_block ctx in
-				if vname <> v.v_name then begin
-					newline ctx;
-					print ctx "var %s = %s" v.v_name vname;
-				end;
-				gen_block_element ctx e;
-				bend();
-				newline ctx;
-				spr ctx "} else ";
-				else_block := true
-		) catchs;
-		if not !last then print ctx "throw(%s)" vname;
-		bend();
-		newline ctx;
-		spr ctx "}";
+		gen_expr ctx etry;
+		check_var_declaration v;
+		print ctx " catch( %s ) " v.v_name;
+		gen_expr ctx ecatch
+	| TTry _ ->
+		abort "Unhandled try/catch, please report" e.epos
 	| TSwitch (e,cases,def) ->
 		spr ctx "switch";
 		gen_value ctx e;
@@ -1361,7 +1262,6 @@ let alloc_ctx com =
 		js_modern = not (Common.defined com Define.JsClassic);
 		js_flatten = not (Common.defined com Define.JsUnflatten);
 		es_version = (try int_of_string (Common.defined_value com Define.JsEs) with _ -> 0);
-		store_exception_stack = if Common.has_dce com then (Common.has_feature com "haxe.CallStack.exceptionStack") else List.exists (function TClassDecl { cl_path=["haxe"],"CallStack" } -> true | _ -> false) com.types;
 		statics = [];
 		inits = [];
 		current = null_class;