some initial work on exception support, add some major TODOs

Author: nadako

src/optimization/analyzer.ml

@@ -1098,7 +1098,7 @@ module Run = struct
 			(* lose Coroutine<T> type here *)
 			(match cf.cf_type with
 			| TAbstract ({ a_path = [],"Coroutine" }, [TFun (args, ret)]) ->
-				let args = args @ [("",false,tfun [ret] ctx.com.basic.tvoid)] in
+				let args = args @ [("",false,tfun [ret; t_dynamic] ctx.com.basic.tvoid)] in
 				cf.cf_type <- TFun (args, ctx.com.basic.tvoid);
 			| _ -> ())
 		| _ -> ()

src/optimization/analyzerTexprTransformer.ml

@@ -45,7 +45,10 @@ let rec func ctx bb tf t p =
 	let bb_root = create_node (BKFunctionBegin tf) tf.tf_expr.etype tf.tf_expr.epos in
 	let bb_exit = create_node BKFunctionEnd tf.tf_expr.etype tf.tf_expr.epos in
 	let coroutine = match follow t with
-		| TAbstract ({a_path=[],"Coroutine"}, _) -> Some (alloc_var VGenerated "_hx_result" t_dynamic p)
+		| TAbstract ({a_path=[],"Coroutine"}, _) -> Some (
+			alloc_var VGenerated "_hx_result" t_dynamic p,
+			alloc_var VGenerated "_hx_error" t_dynamic p
+		)
 		| _ -> None
 	in
 	add_function g tf t p bb_root coroutine;
@@ -329,7 +332,7 @@ let rec func ctx bb tf t p =
 					| _ -> false
 				in
 				(match coroutine with
-					| Some vresult when is_coroutine efun ->
+					| Some (vresult,_) when is_coroutine efun ->
 						let bb_next = create_node BKNormal e1.etype e1.epos in
 						add_cfg_edge bb bb_next CFGGoto;
 						let syntax_edge = SESuspend (
@@ -745,13 +748,14 @@ and block_to_texpr ctx bb =
 	let e = mk (TBlock el) bb.bb_type bb.bb_pos in
 	e
 
-and block_to_texpr_coroutine ctx bb vcontinuation vresult p =
+and block_to_texpr_coroutine ctx bb vcontinuation vresult verror p =
 	assert(bb.bb_closed);
 
 	let open Texpr.Builder in
 	let com = ctx.com in
 
 	declare_var ctx.graph vresult bb;
+	declare_var ctx.graph verror bb;
 
 	let vstate = alloc_var VGenerated "_hx_state" com.basic.tint p in
 	declare_var ctx.graph vstate bb;
@@ -769,7 +773,11 @@ and block_to_texpr_coroutine ctx bb vcontinuation vresult p =
 
 	let mk_continuation_call eresult p =
 		let econtinuation = make_local vcontinuation p in
-		mk (TCall (econtinuation, [eresult])) com.basic.tvoid p
+		mk (TCall (econtinuation, [eresult; make_null t_dynamic p])) com.basic.tvoid p
+	in
+	let mk_continuation_call_error eerror p =
+		let econtinuation = make_local vcontinuation p in
+		mk (TCall (econtinuation, [make_null t_dynamic p; eerror])) com.basic.tvoid p
 	in
 
 	(* TODO: maybe merge this into block_to_texpr somehow, and only introduce new states when there is a suspension point *)
@@ -832,8 +840,8 @@ and block_to_texpr_coroutine ctx bb vcontinuation vresult p =
 				mk_case (current_el @ el @ [esetstate; ecallcontinuation; ereturn]) :: statecases
 			| TermNone ->
 				mk_case (current_el @ el @ [set_state back_state_id]) :: statecases
-			| TermThrow (_,p) ->
-				Error.error "throw is currently not supported in coroutines" p
+			| TermThrow (e,p) ->
+				mk_case (current_el @ el @ [set_state (-1); mk_continuation_call_error e p; ereturn]) :: statecases
 			| TermCondBranch _ ->
 				die "unexpected TermCondBranch" __LOC__)
 
@@ -982,10 +990,25 @@ and block_to_texpr_coroutine ctx bb vcontinuation vresult p =
 	let eswitch = mk (TSwitch (estate, statecases, Some ethrow)) com.basic.tvoid p in
 	let eloop = mk (TWhile (make_bool com.basic true p, eswitch, DoWhile)) com.basic.tvoid p in
 
+	(* TODO: this has to be much more complicated, unfortunately, we need a try/catch around the state machine to catch errors from
+	   synchronous throws and then we need to propagate properly and then we need to support try/catch inside coroutines etc etc.
+	   maybe while implementing support for all this, we can as well look into adding COROUTINE_SUSPEND markers and separate coroutine
+	   and non-coroutine worlds a bit more *)
+	let eerror = make_local verror p in
+	let eif = mk (TIf (
+		mk (TBinop (
+			OpNotEq,
+			eerror,
+			make_null verror.v_type p (* TODO: throw null should work *)
+		)) com.basic.tbool p,
+		mk_continuation_call_error eerror p,
+		Some eloop
+	)) com.basic.tvoid p in
+
 	let estatemachine_def = mk (TFunction {
-		tf_args = [(vresult,None)];
+		tf_args = [(vresult,None); (verror,None)];
 		tf_type = com.basic.tvoid;
-		tf_expr = eloop;
+		tf_expr = eif;
 	}) tstatemachine p in
 
 	let state_var = mk (TVar (vstate, Some (make_int com.basic 0 p))) com.basic.tvoid p in
@@ -1001,10 +1024,10 @@ and func ctx i =
 	let bb,t,p,tf,coroutine = Hashtbl.find ctx.graph.g_functions i in
 	let e,tf_args,tf_type =
 		match coroutine with
-		| Some vresult ->
+		| Some (vresult,verror) ->
 			let vcontinuation = alloc_var VGenerated "_hx_continuation" (tfun [t_dynamic] ctx.com.basic.tvoid) p in
 			declare_var ctx.graph vcontinuation bb;
-			let e = block_to_texpr_coroutine ctx bb vcontinuation vresult p in
+			let e = block_to_texpr_coroutine ctx bb vcontinuation vresult verror p in
 			let tf_args = tf.tf_args @ [(vcontinuation,None)] in
 			e, tf_args, tf.tf_type
 		| None ->

src/optimization/analyzerTypes.ml

@@ -229,7 +229,7 @@ end
 module Graph = struct
 	open BasicBlock
 
-	type tfunc_info = BasicBlock.t * Type.t * pos * tfunc * tvar option
+	type tfunc_info = BasicBlock.t * Type.t * pos * tfunc * (tvar * tvar) option
 	type texpr_lookup = BasicBlock.t * texpr_lookup_target
 	type var_write = BasicBlock.t list
 	type 'a itbl = (int,'a) Hashtbl.t

src/typing/typer.ml

@@ -1585,10 +1585,10 @@ and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p =
 		build_call ~mode ctx e el with_type p;
 	in
 	let create_coroutine e args ret p =
-		let args = args @ [("_hx_continuation",false,(tfun [ret] ctx.com.basic.tvoid))] in
+		let args = args @ [("_hx_continuation",false,(tfun [ret; t_dynamic] ctx.com.basic.tvoid))] in
 		let ret = ctx.com.basic.tvoid in
 		let el, _ = unify_call_args ctx el args ret p false false false in
-		mk (TCall (e, el)) (tfun [t_dynamic] ctx.com.basic.tvoid) p
+		mk (TCall (e, el)) (tfun [t_dynamic; t_dynamic] ctx.com.basic.tvoid) p
 	in
 	match e, el with
 	| (EConst (Ident "trace"),p) , e :: el ->
@@ -1628,7 +1628,8 @@ and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p =
 		(match follow e.etype with
 			| TAbstract ({ a_path = [],"Coroutine" }, [TFun (args, ret)]) ->
 				let ecoro = create_coroutine e args ret p in
-				mk (TCall (ecoro, [Builder.make_null t_dynamic p])) ctx.com.basic.tvoid p
+				let enull = Builder.make_null t_dynamic p in
+				mk (TCall (ecoro, [enull; enull])) ctx.com.basic.tvoid p
 			| _ -> def ())
 	| (EField (e,"create"),_), args ->
 		let e = type_expr ctx e WithType.value in

std/StdTypes.hx

@@ -182,10 +182,10 @@ abstract Coroutine<T> {
 		for resuming coroutine execution.
 	**/
 	@:coroutine
-	public static extern function suspend<T>(f:(cont:T->Void)->Void):T;
+	public static extern function suspend<T>(f:(cont:(T,Null<Dynamic>)->Void)->Void):T;
 
 	static function __init__():Void {
-		js.Syntax.code("{0} = {1}", Coroutine.suspend, cast function(f, cont) return _ -> f(cont));
+		js.Syntax.code("{0} = {1}", Coroutine.suspend, cast function(f, cont) return (_,_) -> f(cont));
 	}
 	#end
 }

tests/misc/coroutines/src/TestBasic.hx

@@ -1,20 +1,47 @@
 class TestBasic extends utest.Test {
 	function testSimpleStart(async:Async) {
-		simple.start(42, result -> {
+		simple.start(42, (result,error) -> {
 			Assert.equals(42, result);
 			async.done();
 		});
 	}
 
 	function testSimpleCreate(async:Async) {
-		var cont = simple.create(42, result -> {
+		var cont = simple.create(42, (result,error) -> {
 			Assert.equals(42, result);
 			async.done();
 		});
-		cont(null);
+		cont(null, null);
+	}
+
+	function testErrorDirect(async:Async) {
+		error.start((result, error) -> {
+			// TODO: Exceptions.filter is currently run before coroutine processor
+			// so we get wrapped exception here... think what we want to do with this
+			var error:haxe.Exception = error;
+			Assert.equals("nope", error.message);
+			async.done();
+		});
+	}
+
+	function testErrorPropagation(async:Async) {
+		@:coroutine function propagate() {
+			error();
+		}
+		propagate.start((result, error) -> {
+			// TODO: Exceptions.filter is currently run before coroutine processor
+			// so we get wrapped exception here... think what we want to do with this
+			var error:haxe.Exception = error;
+			Assert.equals("nope", error.message);
+			async.done();
+		});
 	}
 
 	@:coroutine static function simple(arg:Int):Int {
 		return arg;
 	}
-}
+
+	@:coroutine static function error() {
+		throw "nope";
+	}
+}

tests/misc/coroutines/src/TestControlFlow.hx

@@ -4,7 +4,7 @@ class TestControlFlow extends utest.Test {
 			if (x) return 1;
 			return 2;
 		}
-		mapCalls.start([true, false], f, result -> {
+		mapCalls.start([true, false], f, (result,error) -> {
 			Assert.same([1, 2], result);
 			async.done();
 		});
@@ -20,7 +20,7 @@ class TestControlFlow extends utest.Test {
 			v = 2;
 		}
 		@:coroutine function f2(x) { f(x); return v; }
-		mapCalls.start([true, false], f2, result -> {
+		mapCalls.start([true, false], f2, (result,error) -> {
 			Assert.same([1, 2], result);
 			async.done();
 		});
@@ -30,7 +30,7 @@ class TestControlFlow extends utest.Test {
 		@:coroutine function f(x) {
 			return if (x) 1 else 2;
 		}
-		mapCalls.start([true, false], f, result -> {
+		mapCalls.start([true, false], f, (result,error) -> {
 			Assert.same([1, 2], result);
 			async.done();
 		});
@@ -45,7 +45,7 @@ class TestControlFlow extends utest.Test {
 			}
 			return "d";
 		}
-		mapCalls.start([1, 2, 3, 4], f, result -> {
+		mapCalls.start([1, 2, 3, 4], f, (result,error) -> {
 			Assert.same(["a", "b", "c", "d"], result);
 			async.done();
 		});
@@ -61,7 +61,7 @@ class TestControlFlow extends utest.Test {
 			}
 			return "e";
 		}
-		mapCalls.start([1, 2, 3, 4], f, result -> {
+		mapCalls.start([1, 2, 3, 4], f, (result,error) -> {
 			Assert.same(["a", "b", "c", "d"], result);
 			async.done();
 		});
@@ -79,7 +79,7 @@ class TestControlFlow extends utest.Test {
 			}
 			return results;
 		}
-		mapCalls.start([0, 1, 2], f, result -> {
+		mapCalls.start([0, 1, 2], f, (result,error) -> {
 			Assert.same([
 				[0,1,2,3,4,5,6,7,8,9],
 				[0,1,2,3,4],

tests/misc/coroutines/src/TestGenerator.hx

@@ -44,7 +44,7 @@ private function sequence<T>(f:Coroutine<Yield<T>->Void>):Iterator<T> {
 
 	var nextStep = null;
 
-	function finish(_) {
+	function finish(_, _) {
 		finished = true;
 	}
 
@@ -56,14 +56,14 @@ private function sequence<T>(f:Coroutine<Yield<T>->Void>):Iterator<T> {
 	function hasNext():Bool {
 		if (nextStep == null) {
 			nextStep = f.create(yield, finish);
-			nextStep(null);
+			nextStep(null, null);
 		}
 		return !finished;
 	}
 
 	function next():T {
 		var value = nextValue;
-		nextStep(null);
+		nextStep(null, null);
 		return value;
 	}
 

tests/misc/coroutines/src/TestJsPromise.hx

@@ -2,11 +2,11 @@ import js.lib.Promise;
 
 @:coroutine
 private function await<T>(p:Promise<T>):T {
-	return Coroutine.suspend(cont -> p.then(cont));
+	return Coroutine.suspend(cont -> p.then(r -> cont(r, null), e -> cont(null, e)));
 }
 
 private function promise<T>(c:Coroutine<()->T>):Promise<T> {
-	return new Promise((resolve,_) -> c.start(resolve));
+	return new Promise((resolve,reject) -> c.start((result, error) -> if (error != null) reject(error) else resolve(result)));
 }
 
 class TestJsPromise extends utest.Test {
@@ -18,7 +18,7 @@ class TestJsPromise extends utest.Test {
 			return x + 1;
 		}
 
-		awaiting.start(result -> {
+		awaiting.start((result,error) -> {
 			Assert.equals(42, result);
 			async.done();
 		});