open Printf exception Goto of string let label (name: string) = () let goto (name: string) = raise (Goto name) let goto_block (blocks: (string * (unit -> unit)) list): unit = let rec goto_block_impl (name: string option): unit = try let exec (blocks: (string * (unit -> unit)) list): unit = blocks |> List.iter (fun (_, block) -> block ()) in let rec skip (blocks: (string * (unit -> unit)) list) (entry: string) = match blocks with | [] -> () | (name, _) :: rest -> if String.equal name entry then exec blocks else skip rest entry in match name with | None -> exec blocks | (Some entry) -> skip blocks entry with Goto name -> goto_block_impl (Some name) in goto_block_impl None let () = let i = ref 0 in goto_block [("loop", (fun () -> if !i >= 10 then goto "out" else (); printf "%d: Hello, World\n" !i; i := !i + 1; goto "loop")); ("out", (fun () -> printf "Done!\n"))]