Simon Krajewski 1 rok temu
rodzic
commit
b327ecd409

+ 0 - 2
src/context/typecore.ml

@@ -152,7 +152,6 @@ and typer_expr = {
 	mutable with_type_stack : WithType.t list;
 	mutable call_argument_stack : expr list list;
 	mutable macro_depth : int;
-	mutable is_coroutine : bool;
 }
 
 and typer_field = {
@@ -255,7 +254,6 @@ module TyperManager = struct
 			with_type_stack = [];
 			call_argument_stack = [];
 			macro_depth = 0;
-			is_coroutine = false;
 		}
 
 	let clone_for_module ctx m =

+ 28 - 0
src/core/texpr.ml

@@ -562,6 +562,16 @@ module Builder = struct
 	let index basic e index t p =
 		mk (TArray (e,mk (TConst (TInt (Int32.of_int index))) basic.tint p)) t p
 
+	let default_value t p = match follow_without_null t with
+		| TAbstract({a_path = ([],"Int")},[]) ->
+			mk (TConst (TInt (Int32.zero))) t p
+		| TAbstract({a_path = ([],"Float")},[]) ->
+			mk (TConst (TFloat "0.0")) t p
+		| TAbstract({a_path = ([],"Bool")},[]) ->
+			mk (TConst (TBool false)) t p
+		| _ ->
+			mk (TConst TNull) t p
+
 	let resolve_and_make_static_call c name args p =
 		ignore(c.cl_build());
 		let cf = try
@@ -653,6 +663,24 @@ let for_remap basic v e1 e2 p =
 		mk (TWhile((mk (TParenthesis ehasnext) ehasnext.etype ehasnext.epos),ebody,NormalWhile)) basic.tvoid e1.epos;
 	]) basic.tvoid p
 
+let not_while_true_to_while_true basic e1 e2 flag t p =
+	let e_break = mk TBreak t_dynamic p in
+	let e_not = mk (TUnop(Not,Prefix,Builder.mk_parent e1)) e1.etype e1.epos in
+	let e_if eo = mk (TIf(e_not,e_break,eo)) basic.tvoid p in
+	let rec map_continue e = match e.eexpr with
+		| TContinue ->
+			duplicate_tvars e_identity (e_if (Some e))
+		| TWhile _ | TFor _ ->
+			e
+		| _ ->
+			map_expr map_continue e
+	in
+	let e2 = if flag = NormalWhile then e2 else map_continue e2 in
+	let e_if = e_if None in
+	let e_block = if flag = NormalWhile then concat e_if e2 else concat e2 e_if in
+	let e_true = mk (TConst (TBool true)) basic.tbool p in
+	mk (TWhile(e_true,e_block,NormalWhile)) t p
+
 (* -------------------------------------------------------------------------- *)
 (* BUILD META DATA OBJECT *)
 

+ 24 - 0
src/coro/coro.ml

@@ -0,0 +1,24 @@
+open Globals
+open Type
+open CoroTypes
+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 cb_root = make_block (Some(e.etype,p)) in
+	ignore(CoroFromTexpr.expr_to_coro ctx (v_result,v_error) cb_root tf.tf_expr);
+	let vcontinuation = alloc_var VGenerated "_hx_continuation" (tfun [tf.tf_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_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 print_endline ("BEFORE:\n" ^ (s_expr_debug e));
+	let e = {e with eexpr = TFunction {tf_args; tf_expr; tf_type}} in
+	if ctx.coro_debug then print_endline ("AFTER:\n" ^ (s_expr_debug e));
+	e
+
+let create_coro_context com meta = {
+	com;
+	coro_debug = Meta.has (Meta.Custom ":coroutine.debug") meta;
+}

+ 271 - 0
src/coro/coroFromTexpr.ml

@@ -0,0 +1,271 @@
+open Globals
+open Type
+open CoroTypes
+open CoroFunctions
+
+let terminate cb kind t p =
+	if cb.cb_next.next_kind = NextUnknown then
+		cb.cb_next <- {next_kind = kind; next_type = t; next_pos = p}
+
+let e_no_value = Texpr.Builder.make_null t_dynamic null_pos
+
+let add_expr cb e =
+	if cb.cb_next.next_kind = NextUnknown && e != e_no_value then
+		DynArray.add cb.cb_el e
+
+type coro_ret =
+	| RLocal of tvar
+	| RTerminate of (coro_block -> texpr -> unit)
+	| RValue
+	| RBlock
+
+let expr_to_coro ctx (vresult,verror) cb_root e =
+	let ordered_value_marker = ref false in
+	let start_ordered_value_list () =
+		let old = !ordered_value_marker in
+		(fun () ->
+			let cur = !ordered_value_marker in
+			ordered_value_marker := old;
+			cur
+		)
+	in
+	let block_from_e e =
+		make_block (Some(e.etype,e.epos))
+	in
+	let cb_unreachable = make_block None in
+	let rec loop cb ret e = match e.eexpr with
+		(* simple values *)
+		| TConst _ | TLocal _ | TTypeExpr _ | TIdent _ ->
+			cb,e
+		(* compound values *)
+		| TBlock [e1] ->
+			loop cb ret e1
+		| TBlock _ ->
+			let cb_sub = block_from_e e in
+			let cb_sub_next,e1 = loop_block cb_sub ret e in
+			let cb_next = make_block None in
+			terminate cb (NextSub(cb_sub,cb_next)) e.etype e.epos;
+			cb_next,e1
+		| TArray(e1,e2) ->
+			let cb,el = ordered_loop cb [e1;e2] in
+			begin match el with
+			| [e1;e2] ->
+				cb,{e with eexpr = TArray(e1,e2)}
+			| _ ->
+				die "" __LOC__
+			end
+		| TArrayDecl el ->
+			let cb,el = ordered_loop cb el in
+			cb,{e with eexpr = TArrayDecl el}
+		| TObjectDecl fl ->
+			let cb,el = ordered_loop cb (List.map snd fl) in
+			let fl = List.map2 (fun (f,_) e -> (f,e)) fl el in
+			cb,{e with eexpr = TObjectDecl fl}
+		| TField(e1,fa) ->
+			(* TODO: this is quite annoying because factoring out field access behaves very creatively on
+			   some targets. This means that (coroCall()).field doesn't work (and isn't tested). *)
+			cb,e
+		| TEnumParameter(e1,ef,i) ->
+			let cb,e1 = loop cb RValue e1 in
+			cb,{e with eexpr = TEnumParameter(e1,ef,i)}
+		| TEnumIndex e1 ->
+			let cb,e1 = loop cb RValue e1 in
+			cb,{e with eexpr = TEnumIndex e1}
+		| TNew(c,tl,el) ->
+			let cb,el = ordered_loop cb el in
+			cb,{e with eexpr = TNew(c,tl,el)}
+		(* rewrites & forwards *)
+		| TWhile(e1,e2,flag) when not (is_true_expr e1) ->
+			loop cb ret (Texpr.not_while_true_to_while_true ctx.com.Common.basic e1 e2 flag e.etype e.epos)
+		| TFor(v,e1,e2) ->
+			loop cb ret (Texpr.for_remap ctx.com.basic v e1 e2 e.epos)
+		| TCast(e1,o) ->
+			let cb,e1 = loop cb ret e1 in
+			cb,{e with eexpr = TCast(e1,o)}
+		| TParenthesis e1 ->
+			let cb,e1 = loop cb ret e1 in
+			cb,{e with eexpr = TParenthesis e1}
+		| TMeta(meta,e1) ->
+			let cb,e1 = loop cb ret e1 in
+			cb,{e with eexpr = TMeta(meta,e1)}
+		| TUnop(op,flag,e1) ->
+			let cb,e1 = loop cb ret (* TODO: is this right? *) e1 in
+			cb,{e with eexpr = TUnop(op,flag,e1)}
+		| TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) ->
+			let cb,e2 = loop_assign cb (RLocal v) e2 in
+			cb,{e with eexpr = TBinop(OpAssign,e1,e2)}
+		(* TODO: OpAssignOp and other OpAssign *)
+		| TBinop(op,e1,e2) ->
+			let cb,e1 = loop cb RValue e1 in
+			let cb,e2 = loop cb RValue e2 in
+			cb,{e with eexpr = TBinop(op,e1,e2)}
+		(* variables *)
+		| TVar(v,None) ->
+			add_expr cb e;
+			cb,e_no_value
+		| TVar(v,Some e1) ->
+			add_expr cb {e with eexpr = TVar(v,None)};
+			let cb,e1 = loop_assign cb (RLocal v) e1 in
+			cb,e_no_value
+		(* calls *)
+		| TCall(e1,el) ->
+			let cb,el = ordered_loop cb (e1 :: el) in
+			begin match el with
+				| e1 :: el ->
+					begin match follow_with_coro e1.etype with
+					| Coro _ ->
+						let cb_next = block_from_e e1 in
+						let suspend = {
+							cs_fun = e1;
+							cs_args = el;
+							cs_pos = e.epos
+						} in
+						terminate cb (NextSuspend(suspend,cb_next)) t_dynamic null_pos;
+						let eresult = Texpr.Builder.make_local vresult e.epos in
+						let eresult = mk_cast eresult e.etype e.epos in
+						cb_next,eresult
+					| _ ->
+						cb,{e with eexpr = TCall(e1,el)}
+					end
+				| [] ->
+					die "" __LOC__
+			end
+		(* terminators *)
+		| TBreak ->
+			terminate cb NextBreak e.etype e.epos;
+			cb,e_no_value
+		| TContinue ->
+			terminate cb NextContinue e.etype e.epos;
+			cb,e_no_value
+		| TReturn None ->
+			terminate cb NextReturnVoid e.etype e.epos;
+			cb_unreachable,e_no_value
+		| TReturn (Some e1) ->
+			let f_terminate cb e1 =
+				terminate cb (NextReturn e1) e.etype e.epos;
+			in
+			let ret = RTerminate f_terminate in
+			let cb_ret,e1 = loop_assign cb ret e1 in
+			terminate cb_ret (NextReturn e1) e.etype e.epos;
+			cb_unreachable,e_no_value
+		| TThrow e1 ->
+			let f_terminate cb e1 =
+				terminate cb (NextThrow e1) e.etype e.epos;
+			in
+			let ret = RTerminate f_terminate in
+			let cb_ret,e1 = loop_assign cb ret e1 in
+			terminate cb_ret (NextThrow e1) e.etype e.epos;
+			cb_unreachable,e_no_value
+		(* branching *)
+		| TIf(e1,e2,None) ->
+			let cb,e1 = loop cb RValue e1 in
+			let cb_then = block_from_e e2 in
+			let _ = loop_block cb_then RBlock e2 in
+			let cb_next = make_block None in
+			terminate cb (NextIfThen(e1,cb_then,cb_next)) e.etype e.epos;
+			cb_next,e_no_value
+		| TIf(e1,e2,Some e3) ->
+			let cb,e1 = loop cb RValue e1 in
+			let cb_then = block_from_e e2 in
+			let _ = loop_block cb_then ret e2 in
+			let cb_else = block_from_e e3 in
+			let _ = loop_block cb_else ret e3 in
+			let cb_next = make_block None in
+			terminate cb (NextIfThenElse(e1,cb_then,cb_else,cb_next)) e.etype e.epos;
+			cb_next,e_no_value
+		| TSwitch switch ->
+			let e1 = switch.switch_subject in
+			let cb,e1 = loop cb RValue e1 in
+			let cases = List.map (fun case ->
+				let cb_case = block_from_e case.case_expr in
+				let _ = loop_block cb_case ret case.case_expr in
+				(case.case_patterns,cb_case)
+			) switch.switch_cases in
+			let def = match switch.switch_default with
+				| None ->
+					None
+				| Some e ->
+					let cb_default = block_from_e e in
+					let _ = loop_block cb_default ret e in
+					Some cb_default
+			in
+			let switch = {
+				cs_subject = e1;
+				cs_cases = cases;
+				cs_default = def;
+				cs_exhaustive = switch.switch_exhaustive
+			} in
+			let cb_next = make_block None in
+			terminate cb (NextSwitch(switch,cb_next)) e.etype e.epos;
+			cb_next,e_no_value
+		| TWhile(e1,e2,flag) (* always while(true) *) ->
+			let cb_body = block_from_e e2 in
+			let _ = loop_block cb_body RBlock e2 in
+			let cb_next = make_block None in
+			terminate cb (NextWhile(e1,cb_body,cb_next)) e.etype e.epos;
+			cb_next,e_no_value
+		| TTry(e1,catches) ->
+			let cb_try = block_from_e e1 in
+			let _ = loop_block cb_try ret e1 in
+			let catches = List.map (fun (v,e) ->
+				let cb_catch = block_from_e e in
+				let _ = loop_block cb_catch ret e in
+				v,cb_catch
+			) catches in
+			let cb_next = make_block None in
+			terminate cb (NextTry(cb_try,catches,cb_next)) e.etype e.epos;
+			cb_next,e_no_value
+		| TFunction tf ->
+			cb,e
+	and ordered_loop cb el =
+		let close = start_ordered_value_list () in
+		let rec aux' cb acc el = match el with
+			| [] ->
+				cb,List.rev acc
+			| e :: el ->
+				let cb,e = loop cb RValue e in
+				aux' cb (e :: acc) el
+		in
+		let cb,el = aux' cb [] el in
+		let _ = close () in
+		cb,el
+	and loop_assign cb ret e =
+		let cb,e = loop cb ret e in
+		match ret with
+			| RBlock ->
+				add_expr cb e;
+				cb,e_no_value
+			| RValue ->
+				cb,e
+			| RLocal v ->
+				let ev = Texpr.Builder.make_local v v.v_pos in
+				let eass = Texpr.Builder.binop OpAssign ev e ev.etype ev.epos in
+				add_expr cb eass;
+				cb,ev
+			| RTerminate f ->
+				f cb e;
+				cb_unreachable,e_no_value
+	and loop_block cb ret e =
+		let el = match e.eexpr with
+			| TBlock el ->
+				el
+			| _ ->
+				[e]
+		in
+		let rec aux' cb el = match el with
+			| [] ->
+				assert false
+			| [e] ->
+				loop_assign cb ret e
+			| e :: el ->
+				let cb,e = loop cb RBlock e in
+				add_expr cb e;
+				aux' cb el
+		in
+		match el with
+			| [] ->
+				cb,e_no_value
+			| _ ->
+				aux' cb el
+	in
+	loop_block cb_root RBlock e

+ 9 - 0
src/coro/coroFunctions.ml

@@ -0,0 +1,9 @@
+open Globals
+open Type
+open CoroTypes
+
+let make_block typepos = {
+	cb_el = DynArray.create ();
+	cb_typepos = typepos;
+	cb_next = {next_kind = NextUnknown; next_type = t_dynamic; next_pos = null_pos};
+}

+ 351 - 0
src/coro/coroToTexpr.ml

@@ -0,0 +1,351 @@
+open Globals
+open CoroTypes
+open Type
+open Texpr
+
+let block_to_texpr_coroutine ctx bb vcontinuation vresult verror 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 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 vexcstate = alloc_var VGenerated "_hx_exceptionState" com.basic.tint p in
+	let eexcstate = make_local vexcstate p in
+	let set_excstate id = mk_assign eexcstate (mk_int 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 get_next_state_id =
+		let counter = ref 0 in
+		fun () -> (let id = !counter in incr counter; id)
+	in
+
+	let get_rethrow_state_id =
+		let rethrow_state_id = ref (-1) in
+		fun () -> begin
+			if !rethrow_state_id = (-1) then rethrow_state_id := get_next_state_id ();
+			!rethrow_state_id;
+		end
+	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
+	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
+
+	let mk_suspending_call call =
+		let p = call.cs_pos in
+
+		(* lose Coroutine<T> type for the called function not to confuse further filters and generators *)
+		let tcoroutine = tfun [t_dynamic; t_dynamic] com.basic.tvoid in
+		let tfun = match follow_with_coro call.cs_fun.etype with
+			| Coro (args, ret) ->
+				let tcontinuation = tfun [ret; t_dynamic] com.basic.tvoid in
+				let args = args @ [("",false,tcontinuation)] in
+				TFun (args, tcoroutine)
+			| NotCoro _ ->
+				die "Unexpected coroutine type" __LOC__
+		in
+		let efun = { call.cs_fun with etype = tfun } in
+		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
+	in
+
+	let std_is e t =
+		let type_expr = mk (TTypeExpr (module_type_of_type t)) t_dynamic null_pos in
+		Texpr.Builder.resolve_and_make_static_call ctx.com.std "isOfType" [e;type_expr] p
+	in
+
+	let states = ref [] in
+
+	let exc_states = ref [] in
+
+	let debug_endline s =
+		if ctx.coro_debug then
+			print_endline s
+	in
+	debug_endline "---";
+	let rec loop bb state_id back_state_id current_el while_loop exc_state_id_getter =
+		let el = DynArray.to_list bb.cb_el in
+
+		let ereturn = mk (TReturn None) com.basic.tvoid p in
+
+		let add_state extra_el =
+			let el = current_el @ el @ extra_el in
+			states := (state_id,mk (TBlock el) com.basic.tvoid null_pos) :: !states
+		in
+
+		match bb.cb_next.next_kind with
+		| NextSuspend (call, bb_next) ->
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "suspend cur:%d,next:%d,back:%d" state_id next_state_id back_state_id);
+			loop bb_next next_state_id back_state_id [] while_loop exc_state_id_getter;
+			let ecallcoroutine = mk_suspending_call call in
+			let esetstate = set_state next_state_id in
+			add_state [esetstate; ecallcoroutine; ereturn]
+		| NextUnknown when back_state_id = (-1) ->
+			let esetstate = set_state (-1) in
+			let ecallcontinuation = mk_continuation_call (make_null t_dynamic p) p in
+			add_state [esetstate; ecallcontinuation; ereturn]
+		| NextUnknown ->
+			add_state [set_state back_state_id]
+		| NextBreak ->
+			let _,next_state_id = Option.get while_loop in
+			let esetstate = set_state next_state_id in
+			add_state [esetstate]
+		| NextContinue ->
+			let body_state_id,_ = Option.get while_loop in
+			let esetstate = set_state body_state_id in
+			add_state [esetstate]
+		| NextReturnVoid | NextReturn _ as r ->
+			let esetstate = set_state (-1) in
+			let eresult = match r with
+				| NextReturn e -> e
+				| _ -> make_null t_dynamic p
+			in
+			let ecallcontinuation = mk_continuation_call eresult p in
+			add_state [esetstate; ecallcontinuation; ereturn]
+		| NextThrow e1 ->
+			let ethrow = mk (TThrow e1) t_dynamic p in
+			add_state [ethrow]
+		| NextSub (bb_sub,bb_next) ->
+			let sub_state_id = get_next_state_id () in
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "sub cur:%d,sub:%d,next:%d,back:%d" state_id sub_state_id next_state_id back_state_id);
+			loop bb_next next_state_id back_state_id [] while_loop exc_state_id_getter;
+			loop bb_sub sub_state_id next_state_id [] while_loop exc_state_id_getter;
+			add_state [set_state sub_state_id]
+
+		| NextIfThen (econd,bb_then,bb_next) ->
+			let then_state_id = get_next_state_id () in
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "if-then cur:%d,then:%d,next:%d,back:%d" state_id then_state_id next_state_id back_state_id);
+			loop bb_then then_state_id next_state_id [] while_loop exc_state_id_getter;
+			loop bb_next next_state_id back_state_id [] while_loop exc_state_id_getter;
+			let eif = mk (TIf (econd, set_state then_state_id, Some (set_state next_state_id))) com.basic.tint p in
+			add_state [eif]
+
+		| NextIfThenElse (econd,bb_then,bb_else,bb_next) ->
+			let then_state_id = get_next_state_id () in
+			let else_state_id = get_next_state_id () in
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "if-then-else cur:%d,then:%d,else:%d,next:%d,back:%d" state_id then_state_id else_state_id next_state_id back_state_id);
+			loop bb_then then_state_id next_state_id [] while_loop exc_state_id_getter;
+			loop bb_else else_state_id next_state_id [] while_loop exc_state_id_getter;
+			loop bb_next next_state_id back_state_id [] while_loop exc_state_id_getter;
+			let eif = mk (TIf (econd, set_state then_state_id, Some (set_state else_state_id))) com.basic.tint p in
+			add_state [eif]
+
+		| NextSwitch(switch, bb_next) ->
+			let esubj = switch.cs_subject in
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "switch cur:%d,next:%d,back:%d" state_id next_state_id back_state_id);
+			let ecases = List.map (fun (patterns,bb) ->
+				(* TODO: variable capture and other fancy things O_o *)
+				let case_state_id = get_next_state_id () in
+				debug_endline (Printf.sprintf "  case %d" case_state_id);
+				loop bb case_state_id next_state_id [] while_loop exc_state_id_getter;
+				{case_patterns = patterns;case_expr = set_state case_state_id}
+			) switch.cs_cases in
+			let default_state_id = match switch.cs_default with
+				| Some bb ->
+					let default_state_id = get_next_state_id () in
+					loop bb default_state_id next_state_id [] while_loop exc_state_id_getter;
+					default_state_id
+				| None ->
+					next_state_id
+			in
+			debug_endline (Printf.sprintf "  default %d" default_state_id);
+			let eswitch = mk_switch esubj ecases (Some (set_state default_state_id)) true in
+			let eswitch = mk (TSwitch eswitch) com.basic.tvoid p in
+			loop bb_next next_state_id back_state_id [] while_loop exc_state_id_getter;
+			add_state [eswitch]
+
+		| NextWhile (e_cond, bb_body, bb_next) ->
+			let body_state_id = get_next_state_id () in
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "while cur:%d,body:%d,next:%d,back:%d" state_id body_state_id next_state_id back_state_id);
+			let new_while_loop = Some (body_state_id,next_state_id) in
+			(* TODO: next is empty? *)
+			loop bb_body body_state_id body_state_id [] new_while_loop exc_state_id_getter;
+			loop bb_next next_state_id back_state_id [] while_loop exc_state_id_getter;
+			add_state [set_state body_state_id]
+
+		| NextTry (bb_try,catches,bb_next) ->
+			let try_state_id = get_next_state_id () in
+			let new_exc_state_id = get_next_state_id () in
+			let next_state_id = get_next_state_id () in
+			debug_endline (Printf.sprintf "try cur:%d,try:%d,catch:%d,next:%d,back:%d" state_id try_state_id new_exc_state_id next_state_id back_state_id);
+			loop bb_try try_state_id next_state_id [set_excstate new_exc_state_id] while_loop (fun () -> new_exc_state_id); (* TODO: add test for nested try/catch *)
+			let esetexcstate = set_excstate (exc_state_id_getter ()) in
+			let catch_case =
+				let erethrow = mk (TThrow eerror) t_dynamic null_pos in
+				let eif =
+					List.fold_left (fun enext (vcatch,bb_catch) ->
+						let catch_state_id = get_next_state_id () in
+						let ecatchvar = mk (TVar (vcatch, Some eerror)) com.basic.tvoid null_pos in
+						loop bb_catch catch_state_id next_state_id [esetexcstate; ecatchvar] while_loop exc_state_id_getter;
+
+						(* TODO: exceptions filter... *)
+						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
+							mk (TIf (etypecheck, set_state catch_state_id, Some enext)) com.basic.tvoid null_pos
+					) erethrow catches
+				in
+				(new_exc_state_id, eif)
+			in
+			exc_states := catch_case :: !exc_states;
+			loop bb_next next_state_id back_state_id [esetexcstate (* TODO: test propagation after try/catch *)] while_loop exc_state_id_getter;
+			add_state [set_state try_state_id]
+	in
+	loop bb (get_next_state_id ()) (-1) [] None get_rethrow_state_id;
+
+	let states = !states @ !exc_states in
+
+	(* TODO: this (and the coroutine transform in general) should probably be run before captured vars handling *)
+	(* very ugly, but seems to work: extract locals that are used across states *)
+	let var_usages = Hashtbl.create 5 in
+	begin
+		let use v state_id =
+			let m = try
+				Hashtbl.find var_usages v.v_id
+			with Not_found ->
+				let m = Hashtbl.create 1 in
+				Hashtbl.add var_usages v.v_id m;
+				m
+			in
+			Hashtbl.replace m state_id true
+		in
+		List.iter (fun (state_id, expr) ->
+			let rec loop e =
+				match e.eexpr with
+				| TVar (v, eo) ->
+					Option.may loop eo;
+					use v state_id;
+				| TLocal v ->
+					use v state_id;
+				| _ ->
+					Type.iter loop e
+			in
+			loop expr
+		) states;
+	end;
+	let states, decls = begin
+		let is_used_across_states v_id =
+			let m = Hashtbl.find var_usages v_id in
+			(Hashtbl.length m) > 1
+		in
+		let rec loop cases cases_acc decls =
+			match cases with
+			| (id,expr) :: rest ->
+				let decls = ref decls in
+				let expr = begin
+					let rec loop e =
+						match e.eexpr with
+						| TVar (v, eo) when is_used_across_states v.v_id ->
+							decls := v :: !decls;
+							let elocal = make_local v e.epos in
+							(match eo with
+							| None -> elocal
+							| Some einit -> mk (TBinop (OpAssign,elocal,einit)) v.v_type e.epos)
+						| _ ->
+							Type.map_expr loop e
+					in
+					loop expr
+				end in
+				loop rest ((id,expr) :: cases_acc) !decls
+			| [] ->
+				List.rev cases_acc, decls
+		in
+		loop states [] []
+	end in
+
+	(* TODO:
+		we can optimize while and switch in some cases:
+		- if there's only one state (no suspensions) - don't wrap into while/switch, don't introduce state var
+	*)
+
+	let rethrow_state_id = get_rethrow_state_id () in
+	let rethrow_state = (rethrow_state_id, mk (TThrow eerror) com.basic.tvoid null_pos) in
+	let states = states @ [rethrow_state] in
+	let states = List.sort (fun (i1,_) (i2,_) -> i1 - i2) states in
+
+	let ethrow = mk (TBlock [
+		set_state rethrow_state_id;
+		mk (TThrow (make_string com.basic "Invalid coroutine state" p)) com.basic.tvoid p
+	]) com.basic.tvoid null_pos
+	in
+
+	let switch =
+		let cases = List.map (fun (id,e) -> {case_patterns = [mk_int id];case_expr = e}) states in
+		mk_switch estate cases (Some ethrow) true
+	in
+	let eswitch = mk (TSwitch switch) com.basic.tvoid p in
+
+	let etry = mk (TTry (
+		eswitch,
+		[
+			let vcaught = alloc_var VGenerated "e" t_dynamic null_pos in
+			(vcaught, mk (TIf (
+				mk (TBinop (OpEq, estate, mk_int rethrow_state_id)) com.basic.tbool null_pos,
+				mk (TBlock [
+					mk_assign eexcstate (mk_int rethrow_state_id);
+					mk_continuation_call_error (make_local vcaught null_pos) null_pos;
+					mk (TReturn None) com.basic.tvoid null_pos;
+				]) com.basic.tvoid null_pos,
+				Some (mk (TBlock [
+					mk_assign estate eexcstate;
+					mk_assign eerror (make_local vcaught null_pos);
+				]) com.basic.tvoid null_pos)
+			)) com.basic.tvoid null_pos)
+		]
+	)) com.basic.tvoid null_pos in
+
+	let eloop = mk (TWhile (make_bool com.basic true p, etry, DoWhile)) com.basic.tvoid p in
+
+	let eif = mk (TIf (
+		mk (TBinop (
+			OpNotEq,
+			eerror,
+			make_null verror.v_type p
+		)) com.basic.tbool p,
+		mk_assign estate eexcstate,
+		None
+	)) com.basic.tvoid p in
+
+	let estatemachine_def = mk (TFunction {
+		tf_args = [(vresult,None); (verror,None)];
+		tf_type = com.basic.tvoid;
+		tf_expr = mk (TBlock [eif; eloop]) com.basic.tvoid null_pos
+	}) tstatemachine p in
+
+	let state_var = mk (TVar (vstate, Some (make_int com.basic 0 p))) com.basic.tvoid p in
+	let excstate_var = mk (TVar (vexcstate, Some (make_int com.basic rethrow_state_id p))) com.basic.tvoid p in
+	let shared_vars = List.map (fun v -> mk (TVar (v,Some (Texpr.Builder.default_value v.v_type v.v_pos))) com.basic.tvoid null_pos) decls in
+	let shared_vars = List.rev (excstate_var :: state_var :: shared_vars) in
+
+	mk (TBlock (shared_vars @ [
+		mk (TVar (vstatemachine, Some estatemachine_def)) com.basic.tvoid p;
+		mk (TReturn (Some estatemachine)) com.basic.tvoid p;
+	])) com.basic.tvoid p

+ 48 - 0
src/coro/coroTypes.ml

@@ -0,0 +1,48 @@
+open Common
+open Globals
+open Type
+
+type some_ctx = {
+	com : Common.context;
+	coro_debug : bool;
+}
+
+type coro_block = {
+	cb_el : texpr DynArray.t;
+	cb_typepos : (Type.t * pos) option;
+	mutable cb_next : coro_next;
+}
+
+and coro_next_kind =
+	| NextUnknown
+	| NextSub of coro_block * coro_block
+	| NextBreak
+	| NextContinue
+	| NextReturnVoid
+	| NextReturn of texpr
+	| NextThrow of texpr
+	| NextIfThen of texpr * coro_block * coro_block
+	| NextIfThenElse of texpr * coro_block * coro_block * coro_block
+	| NextSwitch of coro_switch * coro_block
+	| NextWhile of texpr * coro_block * coro_block
+	| NextTry of coro_block * (tvar * coro_block) list * coro_block
+	| NextSuspend of coro_suspend * coro_block
+
+and coro_switch = {
+	cs_subject : texpr;
+	cs_cases : (texpr list * coro_block) list;
+	cs_default : coro_block option;
+	cs_exhaustive : bool;
+}
+
+and coro_suspend = {
+	cs_fun : texpr;
+	cs_args : texpr list;
+	cs_pos : pos;
+}
+
+and coro_next = {
+	next_kind : coro_next_kind;
+	next_type : Type.t;
+	next_pos : pos;
+}

+ 4 - 3
src/optimization/analyzerTexprTransformer.ml

@@ -44,14 +44,15 @@ let rec func ctx bb tf t p =
 	in
 	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_with_coro t with
-		| Coro _ ->
+	let coroutine =
+
+		(* | Coro _ ->
 			let v_result = alloc_var VGenerated "_hx_result" t_dynamic p in
 			let v_error = alloc_var VGenerated "_hx_error" t_dynamic p in
 			declare_var ctx.graph v_result bb_root;
 			declare_var ctx.graph v_error bb_root;
 			Some (v_result,v_error)
-		| NotCoro _ ->
+		| NotCoro _ -> *)
 			None
 	in
 	add_function g tf t p bb_root coroutine;

+ 3 - 1
src/typing/typeloadFields.ml

@@ -866,7 +866,9 @@ module TypeBinding = struct
 						(match e.eexpr with
 						| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
 						| _ -> TClass.set_cl_init c e);
-					cf.cf_expr <- Some (mk (TFunction tf) t p);
+					let e = mk (TFunction tf) t p in
+					let e = if TyperManager.is_coroutine_context ctx then Coro.fun_to_coro (Coro.create_coro_context ctx.com cf.cf_meta) e tf else e in
+					cf.cf_expr <- Some e;
 					cf.cf_type <- t;
 					check_field_display ctx fctx c cf;
 			end;

+ 4 - 2
src/typing/typer.ml

@@ -1339,8 +1339,9 @@ and type_local_function ctx_from kind f with_type want_coroutine p =
 	| WithType.NoValue ->
 		if name = None then display_error ctx.com "Unnamed lvalue functions are not supported" p
 	| _ ->
-		());
-		let ft = if is_coroutine then ctx.t.tcoro targs rt else TFun(targs,rt) in
+		()
+	);
+	let ft = if is_coroutine then ctx.t.tcoro targs rt else TFun(targs,rt) in
 	let ft = match with_type with
 		| WithType.NoValue ->
 			ft
@@ -1363,6 +1364,7 @@ and type_local_function ctx_from kind f with_type want_coroutine p =
 		tf_expr = e;
 	} in
 	let e = mk (TFunction tf) ft p in
+	let e = if TyperManager.is_coroutine_context ctx then Coro.fun_to_coro (Coro.create_coro_context ctx.com ctx.f.meta) e tf else e in
 	match v with
 	| None ->
 		e

+ 1 - 0
tests/misc/coroutines/build.hxml

@@ -3,4 +3,5 @@
 --main Main
 --debug
 --js test.js
+-D UTEST-PRINT-TESTS
 --cmd node test.js

+ 2 - 8
tests/misc/coroutines/src/TestBasic.hx

@@ -16,10 +16,7 @@ class TestBasic extends utest.Test {
 
 	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);
+			Assert.equals("nope", error);
 			async.done();
 		});
 	}
@@ -29,10 +26,7 @@ class TestBasic extends utest.Test {
 			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);
+			Assert.equals("nope", error);
 			async.done();
 		});
 	}

+ 7 - 7
tests/misc/coroutines/src/TestControlFlow.hx

@@ -11,7 +11,7 @@ class TestControlFlow extends utest.Test {
 	}
 
 	function testIfThenReturnNoValue(async:Async) {
-		var v;
+		var v = null;
 		@:coroutine function f(x) {
 			v = 1;
 			if (x) {
@@ -96,12 +96,12 @@ class TestControlFlow extends utest.Test {
 		});
 	}
 
-	function testTryCatchFail(async:Async) {
-		tryCatch.start(new E3(), (result,error) -> {
-			Assert.isOfType(error, E3);
-			async.done();
-		});
-	}
+	// function testTryCatchFail(async:Async) {
+	// 	tryCatch.start(new E3(), (result,error) -> {
+	// 		Assert.isOfType(error, E3);
+	// 		async.done();
+	// 	});
+	// }
 
 	@:coroutine function tryCatch(e:haxe.Exception) {
 		try {