goto.ml

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"))]

I tried porting this to haskell and, as you would expect, it worked just fine.

{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Control.Exception (Exception, throw, try)
import Control.Monad (when)
import Data.Foldable (find, for_)
import Data.IORef (newIORef, readIORef, modifyIORef)

main :: IO ()
main = do
  iRef <- newIORef 0
  runGoTo 
    [ ("loop", do
        i <- readIORef iRef
        when (i >= 10) $ goto "done"
        print i
        modifyIORef iRef (+ 1)
        goto "loop")
    , ("done", putStrLn "DONE")]

newtype GoTo = GoTo String deriving (Show)
instance Exception GoTo

goto :: String -> IO ()
goto label = throw (GoTo label)

runGoTo :: [(String, IO ())] -> IO ()
runGoTo blocks = do
  result :: Either GoTo () <- try $ for_ blocks snd
  case result of
    Left (GoTo label) -> case find ((== label) . fst) blocks of
      Just (_, block) -> runGoTo (dropWhile ((/= label) . fst) blocks)
      Nothing -> error $ "Label not found: " <> label
    Right () -> return ()

Guys, I tested a for loop of an object inside a block, and a normal function with a for loop. Any idea why the loop inside the goto_block mechanism always much faster?