try a different input data design

src/context/common.ml

@@ -830,6 +830,7 @@ let create compilation_step cs version args display_mode =
 			tfloat = mk_mono();
 			tbool = mk_mono();
 			tstring = mk_mono();
+			tcoro_control = mk_mono();
 			tnull = (fun _ -> die "Could use locate abstract Null<T> (was it redefined?)" __LOC__);
 			tarray = (fun _ -> die "Could not locate class Array<T> (was it redefined?)" __LOC__);
 			tcoro = (fun _ -> die "Could not locate abstract Coroutine<T> (was it redefined?)" __LOC__);
@@ -878,6 +879,7 @@ let clone com is_macro_context =
 			tfloat = mk_mono();
 			tbool = mk_mono();
 			tstring = mk_mono();
+			tcoro_control = mk_mono();
 		};
 		main = {
 			main_class = None;
@@ -1224,5 +1226,5 @@ let expand_coro_type basic args ret =
 	let ret_type = if ExtType.is_void (follow ret) then t_dynamic else ret in
 	let tcontinuation = tfun [ret_type; t_dynamic] basic.tvoid in
 	let args = args @ [("_hx_continuation",false,tcontinuation)] in
-	let ret = tfun [t_dynamic; t_dynamic] basic.tvoid in
+	let ret = tfun [t_dynamic; basic.tcoro_control] basic.tvoid in
 	(args,ret)

src/core/tType.ml

@@ -461,6 +461,7 @@ type basic_types = {
 	mutable tstring : t;
 	mutable tarray : t -> t;
 	mutable tcoro : (string * bool * t) list -> t -> t;
+	mutable tcoro_control : t;
 }
 
 type class_field_scope =

src/coro/coro.ml

@@ -6,12 +6,12 @@ open CoroFunctions
 let fun_to_coro ctx e tf =
 	let p = e.epos in
 	let v_result = alloc_var VGenerated "_hx_result" t_dynamic p in
-	let v_error = alloc_var VGenerated "_hx_error" t_dynamic p in
+	let v_control = alloc_var VGenerated "_hx_control" ctx.com.basic.tcoro_control p in
 	let cb_root = make_block ctx (Some(e.etype,p)) in
-	ignore(CoroFromTexpr.expr_to_coro ctx (v_result,v_error) cb_root tf.tf_expr);
+	ignore(CoroFromTexpr.expr_to_coro ctx (v_result,v_control) cb_root tf.tf_expr);
 	let ret_type = if ExtType.is_void (follow tf.tf_type) then t_dynamic else tf.tf_type in
 	let vcontinuation = alloc_var VGenerated "_hx_continuation" (tfun [ret_type; t_dynamic] ctx.com.basic.tvoid) p in
-	let tf_expr = CoroToTexpr.block_to_texpr_coroutine ctx cb_root vcontinuation v_result v_error e.epos in
+	let tf_expr = CoroToTexpr.block_to_texpr_coroutine ctx cb_root vcontinuation v_result v_control e.epos in
 	let tf_args = tf.tf_args @ [(vcontinuation,None)] in
 	let tf_type = tfun [t_dynamic; t_dynamic] ctx.com.basic.tvoid in
 	if ctx.coro_debug then begin

src/coro/coroToTexpr.ml

@@ -8,33 +8,57 @@ type coro_state = {
 	mutable cs_el : texpr list;
 }
 
-let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
+type coro_control =
+	| CoroNormal
+	| CoroError
+	| CoroSuspend
+
+let mk_int com i = Texpr.Builder.make_int com.Common.basic i null_pos
+
+let mk_control com (c : coro_control) = mk_int com (Obj.magic c)
+
+let make_control_switch com e_subject e_normal e_error p =
+	let cases = [{
+		case_patterns = [mk_control com CoroNormal];
+		case_expr = e_normal;
+	}; {
+		case_patterns = [mk_control com CoroError];
+		case_expr = e_error;
+	}] in
+	let switch = {
+		switch_subject = e_subject;
+		switch_cases = cases;
+		switch_default = None;
+		switch_exhaustive = true;
+	} in
+	mk (TSwitch switch) com.basic.tvoid p
+
+let block_to_texpr_coroutine ctx cb vcontinuation vresult vcontrol p =
 	let open Texpr.Builder in
 	let com = ctx.com in
 
-	let eerror = make_local verror null_pos in
-
-	let mk_int i = make_int com.basic i null_pos in
+	let eresult = make_local vresult vresult.v_pos in
+	let econtrol = make_local vcontrol vcontrol.v_pos in
 
 	let mk_assign estate eid =
 		mk (TBinop (OpAssign,estate,eid)) eid.etype null_pos
 	in
 
 	let vstate = alloc_var VGenerated "_hx_state" com.basic.tint p in
 	let estate = make_local vstate p in
-	let set_state id = mk_assign estate (mk_int id) in
+	let set_state id = mk_assign estate (mk_int com id) in
 
 	let tstatemachine = tfun [t_dynamic; t_dynamic] com.basic.tvoid in
 	let vstatemachine = alloc_var VGenerated "_hx_stateMachine" tstatemachine p in
 	let estatemachine = make_local vstatemachine p in
 
 	let mk_continuation_call eresult p =
 		let econtinuation = make_local vcontinuation p in
-		mk (TCall (econtinuation, [eresult; make_null t_dynamic p])) com.basic.tvoid p
+		mk (TCall (econtinuation, [eresult; mk_control com CoroNormal])) 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
+		mk (TCall (econtinuation, [eerror; mk_control com CoroError])) com.basic.tvoid p
 	in
 
 	let cb_uncaught = CoroFunctions.make_block ctx None in
@@ -54,7 +78,7 @@ let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
 		let args = call.cs_args @ [ estatemachine ] in
 		let ecreatecoroutine = mk (TCall (efun, args)) tcoroutine call.cs_pos in
 		let enull = make_null t_dynamic p in
-		mk (TCall (ecreatecoroutine, [enull; enull])) com.basic.tvoid call.cs_pos
+		mk (TCall (ecreatecoroutine, [enull; mk_control com CoroNormal])) com.basic.tvoid call.cs_pos
 	in
 
 	let std_is e t =
@@ -185,13 +209,13 @@ let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
 			]) t_dynamic null_pos in
 			let eif =
 				List.fold_left (fun enext (vcatch,bb_catch) ->
-					let ecatchvar = mk (TVar (vcatch, Some eerror)) com.basic.tvoid null_pos in
+					let ecatchvar = mk (TVar (vcatch, Some eresult)) com.basic.tvoid null_pos in
 					let catch_state_id = loop bb_catch [ecatchvar] in
 					match follow vcatch.v_type with
 					| TDynamic _ ->
 						set_state catch_state_id (* no next *)
 					| t ->
-						let etypecheck = std_is (make_local verror null_pos) vcatch.v_type in
+						let etypecheck = std_is eresult vcatch.v_type in
 						mk (TIf (etypecheck, set_state catch_state_id, Some enext)) com.basic.tvoid null_pos
 				) erethrow (List.rev catch.cc_catches)
 			in
@@ -266,7 +290,7 @@ let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
 	*)
 
 	let rethrow_state_id = cb_uncaught.cb_id in
-	let rethrow_state = make_state rethrow_state_id [mk (TThrow eerror) com.basic.tvoid null_pos] in
+	let rethrow_state = make_state rethrow_state_id [mk (TThrow eresult) com.basic.tvoid null_pos] in
 	let states = states @ [rethrow_state] in
 	let states = List.sort (fun state1 state2 -> state1.cs_id - state2.cs_id) states in
 
@@ -278,22 +302,18 @@ let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
 
 	let switch =
 		let cases = List.map (fun state ->
-			{case_patterns = [mk_int state.cs_id];
+			{case_patterns = [mk_int com state.cs_id];
 			case_expr = mk (TBlock state.cs_el) ctx.com.basic.tvoid (punion_el null_pos state.cs_el);
 		}) states in
 		mk_switch estate cases (Some ethrow) true
 	in
 	let eswitch = mk (TSwitch switch) com.basic.tvoid p in
 
-	let eif = mk (TIf (
-		mk (TBinop (
-			OpNotEq,
-			eerror,
-			make_null verror.v_type p
-		)) com.basic.tbool p,
-		set_state cb_uncaught.cb_id,
-		None
-	)) com.basic.tvoid p in
+	let econtrolswitch =
+		let e_normal = mk (TBlock []) ctx.com.basic.tvoid p in
+		let e_error = set_state cb_uncaught.cb_id in
+		make_control_switch com econtrol e_normal e_error p
+	in
 
 	let etry = mk (TTry (
 		eswitch,
@@ -304,10 +324,10 @@ let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
 				| [] ->
 					()
 				| l ->
-					let patterns = List.map mk_int l in
+					let patterns = List.map (mk_int com) l in
 					let expr = mk (TBlock [
 						set_state i;
-						Builder.binop OpAssign eerror (Builder.make_local vcaught null_pos) vcaught.v_type null_pos;
+						Builder.binop OpAssign eresult (Builder.make_local vcaught null_pos) vcaught.v_type null_pos;
 					]) ctx.com.basic.tvoid null_pos in
 					DynArray.add cases {case_patterns = patterns; case_expr = expr};
 			) exc_state_map;
@@ -334,9 +354,9 @@ let block_to_texpr_coroutine ctx cb vcontinuation vresult verror p =
 	let eloop = mk (TWhile (make_bool com.basic true p, etry, DoWhile)) com.basic.tvoid p in
 
 	let estatemachine_def = mk (TFunction {
-		tf_args = [(vresult,None); (verror,None)];
+		tf_args = [(vresult,None); (vcontrol,None)];
 		tf_type = com.basic.tvoid;
-		tf_expr = mk (TBlock [eif;eloop]) com.basic.tvoid null_pos
+		tf_expr = mk (TBlock [econtrolswitch;eloop]) com.basic.tvoid null_pos
 	}) tstatemachine p in
 
 	let state_var = mk (TVar (vstate, Some (make_int com.basic !init_state p))) com.basic.tvoid p in

src/typing/typer.ml

@@ -1735,6 +1735,25 @@ and type_call_builtin ctx e el mode with_type p =
 	let create_coroutine e args ret p =
 		let args,ret = expand_coro_type ctx.t args ret in
 		let el = unify_call_args ctx el args ctx.t.tvoid p false false false in
+		let el = match List.rev el with
+			| e_cb :: el ->
+				let v_result = alloc_var VGenerated "_hx_result" t_dynamic p in
+				let v_control = alloc_var VGenerated "_hx_control" ctx.com.basic.tcoro_control p in
+				let e_result = Texpr.Builder.make_local v_result p in
+				let e_null = Texpr.Builder.make_null t_dynamic p in
+				let e_normal = mk (TCall(e_cb,[e_result;e_null])) ctx.com.basic.tvoid p in
+				let e_error = mk (TCall(e_cb,[e_null;e_result])) ctx.com.basic.tvoid p in
+				let e_controlswitch = CoroToTexpr.make_control_switch ctx.com (Texpr.Builder.make_local v_control p) e_normal e_error p in
+				let tf = {
+					tf_args = [(v_result,None);(v_control,None)];
+					tf_expr = e_controlswitch;
+					tf_type = ctx.com.basic.tvoid;
+				} in
+				let e = mk (TFunction tf) (tfun [t_dynamic;ctx.com.basic.tcoro_control] ctx.com.basic.tvoid) p in
+				List.rev (e :: el)
+			| [] ->
+				die "" __LOC__
+		in
 		let e = mk e.eexpr (TFun(args,ret)) p in
 		mk (TCall (e, el)) ret p
 	in
@@ -1773,7 +1792,7 @@ and type_call_builtin ctx e el mode with_type p =
 			| Coro (args, ret) ->
 				let ecoro = create_coroutine e args ret p in
 				let enull = Builder.make_null t_dynamic p in
-				mk (TCall (ecoro, [enull; enull])) ctx.com.basic.tvoid p
+				mk (TCall (ecoro, [enull; CoroToTexpr.mk_control ctx.com CoroNormal])) ctx.com.basic.tvoid p
 			| _ -> raise Exit)
 	| (EField (e,"create",_),_), args ->
 		let e = type_expr ctx e WithType.value in

src/typing/typerEntry.ml

@@ -157,6 +157,13 @@ let create com macros =
 		| _ ->
 			()
 	) m.m_types;
+	let m = TypeloadModule.load_module ctx (["haxe";"coro"],"CoroutineControl") null_pos in
+	List.iter (function
+		| TAbstractDecl({a_path = (["haxe";"coro"],"CoroutineControl")} as a) ->
+			ctx.t.tcoro_control <- TAbstract(a,[])
+		| _ ->
+			()
+	) m.m_types;
 	ignore(TypeloadModule.load_module ctx (["haxe"],"Exception") null_pos);
 	ctx.g.complete <- true;
 	ctx

std/haxe/coro/Continuation.hx

@@ -1,3 +1,3 @@
 package haxe.coro;
 
-typedef Continuation<Result, Error> = (result:Result, error:Error) -> Void;
+typedef Continuation<Result> = (result:Result, control:CoroutineControl) -> Void;

std/haxe/coro/Coroutine.hx

@@ -1,5 +1,7 @@
 package haxe.coro;
 
+import haxe.coro.Continuation;
+
 /**
 	Coroutine function.
 **/
@@ -14,12 +16,12 @@ abstract Coroutine<T:haxe.Constraints.Function> {
 	#if cpp
 	@:native("::hx::Coroutine::suspend")
 	#end
-	public static extern function suspend<T>(f:(cont:Continuation<T, Null<Dynamic>>)->Void):T;
+	public static extern function suspend<T>(f:(cont:Continuation<T>) -> Void):T;
 
 	#if (jvm || eval)
 	@:native("suspend")
 	@:keep
-	static function nativeSuspend<T>(f, cont:Continuation<T, Null<Dynamic>>) {
+	static function nativeSuspend<T>(f, cont:Continuation<T>) {
 		return (_, _) -> f(cont);
 	}
 	#end

std/haxe/coro/CoroutineControl.hx

@@ -0,0 +1,6 @@
+package haxe.coro;
+
+enum abstract CoroutineControl(Int) {
+	final Normal;
+	final Error;
+}

tests/misc/coroutines/src/TestBasic.hx

@@ -11,7 +11,7 @@ class TestBasic extends utest.Test {
 			Assert.equals(42, result);
 			async.done();
 		});
-		cont(null, null);
+		cont(null, Normal);
 	}
 
 	function testErrorDirect(async:Async) {

tests/misc/coroutines/src/TestJsPromise.hx

@@ -3,7 +3,7 @@ import js.lib.Promise;
 
 @:coroutine
 private function await<T>(p:Promise<T>):T {
-	return Coroutine.suspend(cont -> p.then(r -> cont(r, null), e -> cont(null, e)));
+	return Coroutine.suspend(cont -> p.then(r -> cont(r, Normal), e -> cont(e, Error)));
 }
 
 private function promise<T>(c:Coroutine<()->T>):Promise<T> {

tests/misc/coroutines/src/yield/Yield.hx

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