track all CFG edges

src/coro/coroDebug.ml

@@ -12,7 +12,7 @@ let create_dotgraph path cb =
 	let rec block cb =
 		let edge_block label cb_target =
 			block cb_target;
-			DynArray.add edges (cb.cb_id,cb_target.cb_id,label);
+			DynArray.add edges (cb.cb_id,cb_target.cb_id,label,true);
 		in
 		let s = String.concat "\n" (DynArray.to_list (DynArray.map se cb.cb_el)) in
 		let snext = match cb.cb_next.next_kind with
@@ -22,9 +22,11 @@ let create_dotgraph path cb =
 				edge_block "next" cb_next;
 				edge_block "sub" cb_sub;
 				None
-			| NextBreak ->
+			| NextBreak cb_break ->
+				DynArray.add edges (cb.cb_id,cb_break.cb_id,"goto",false);
 				Some "break"
-			| NextContinue ->
+			| NextContinue cb_continue ->
+				DynArray.add edges (cb.cb_id,cb_continue.cb_id,"goto",false);
 				Some "continue"
 			| NextReturnVoid ->
 				Some "return"
@@ -63,7 +65,10 @@ let create_dotgraph path cb =
 				edge_block "next" cb_next;
 				Some (Printf.sprintf "%s(%s)" (se suspend.cs_fun) (String.concat ", " (List.map se suspend.cs_args)))
 			| NextFallThrough cb_next ->
-				DynArray.add edges (cb.cb_id,cb_next.cb_id,"fall-through");
+				DynArray.add edges (cb.cb_id,cb_next.cb_id,"fall-through",false);
+				None
+			| NextGoto cb_next ->
+				DynArray.add edges (cb.cb_id,cb_next.cb_id,"goto",false);
 				None
 		in
 		let s = match snext with
@@ -75,7 +80,8 @@ let create_dotgraph path cb =
 		Printf.fprintf ch "n%i [shape=box,label=\"%s\"];\n" cb.cb_id (StringHelper.s_escape s);
 	in
 	ignore(block cb);
-	DynArray.iter (fun (id_from,id_to,label) ->
-		Printf.fprintf ch "n%i -> n%i[label=\"%s\"];\n" id_from id_to label;
+	DynArray.iter (fun (id_from,id_to,label,tree_edge) ->
+		let style = if tree_edge then "style=\"solid\",color=\"black\""  else "style=\"dashed\", color=\"lightgray\"" in
+		Printf.fprintf ch "n%i -> n%i[%s label=\"%s\"];\n" id_from id_to style label;
 	) edges;
 	close();

src/coro/coroFromTexpr.ml

@@ -38,6 +38,9 @@ let expr_to_coro ctx (vresult,verror) cb_root e =
 	let fall_through cb_from cb_to =
 		terminate cb_from (NextFallThrough cb_to) t_dynamic null_pos
 	in
+	let goto cb_from cb_to =
+		terminate cb_from (NextGoto cb_to) t_dynamic null_pos
+	in
 	let replace_this e =
 		let v = match ctx.vthis with
 			| Some v ->
@@ -49,6 +52,7 @@ let expr_to_coro ctx (vresult,verror) cb_root e =
 		in
 		Builder.make_local v e.epos
 	in
+	let loop_stack = ref [] in
 	let rec loop cb ret e = match e.eexpr with
 		(* special cases *)
 		| TConst TThis ->
@@ -159,10 +163,10 @@ let expr_to_coro ctx (vresult,verror) cb_root e =
 			end
 		(* terminators *)
 		| TBreak ->
-			terminate cb NextBreak e.etype e.epos;
+			terminate cb (NextBreak (snd (List.hd !loop_stack))) e.etype e.epos;
 			cb,e_no_value
 		| TContinue ->
-			terminate cb NextContinue e.etype e.epos;
+			terminate cb (NextContinue (fst (List.hd !loop_stack))) e.etype e.epos;
 			cb,e_no_value
 		| TReturn None ->
 			terminate cb NextReturnVoid e.etype e.epos;
@@ -231,9 +235,12 @@ let expr_to_coro ctx (vresult,verror) cb_root e =
 			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
+			let cb_body = block_from_e e2 in
+			loop_stack := (cb_body,cb_next) :: !loop_stack;
+			let cb_body_next,_ = loop_block cb_body RBlock e2 in
+			goto cb_body_next cb_body;
+			loop_stack := List.tl !loop_stack;
 			terminate cb (NextWhile(e1,cb_body,cb_next)) e.etype e.epos;
 			cb_next,e_no_value
 		| TTry(e1,catches) ->

src/coro/coroToTexpr.ml

@@ -118,12 +118,12 @@ let block_to_texpr_coroutine ctx bb vcontinuation vresult verror p =
 		| NextUnknown when back_state_id = (-1) ->
 			let ecallcontinuation = mk_continuation_call (make_null t_dynamic p) p in
 			add_state (Some (-1)) [ecallcontinuation; ereturn]
-		| NextUnknown | NextFallThrough _ ->
+		| NextUnknown | NextFallThrough _ | NextGoto _ ->
 			add_state (Some back_state_id) []
-		| NextBreak ->
+		| NextBreak _ ->
 			let _,next_state_id = Option.get while_loop in
 			add_state (Some next_state_id) []
-		| NextContinue ->
+		| NextContinue _ ->
 			let body_state_id,_ = Option.get while_loop in
 			add_state (Some body_state_id) []
 		| NextReturnVoid | NextReturn _ as r ->

src/coro/coroTypes.ml

@@ -12,8 +12,6 @@ type coro_block = {
 and coro_next_kind =
 	| NextUnknown
 	| NextSub of coro_block * coro_block
-	| NextBreak
-	| NextContinue
 	| NextReturnVoid
 	| NextReturn of texpr
 	| NextThrow of texpr
@@ -24,7 +22,10 @@ and coro_next_kind =
 	| NextTry of coro_block * (tvar * coro_block) list * coro_block
 	| NextSuspend of coro_suspend * coro_block
 	(* graph connections from here on, careful with traversal *)
+	| NextBreak of coro_block
+	| NextContinue of coro_block
 	| NextFallThrough of coro_block
+	| NextGoto of coro_block
 
 and coro_switch = {
 	cs_subject : texpr;