F#で楽々breakとcontinue。継続モナドまじパネぇっす！

id:einblickerさんが、「F#で継続モナド - einblickerの日記」というステキな記事を書いてくださいました。グッジョブすぎる！

以前、F#で継続渡し形式(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。ということで継続ワークフロー(簡易版)作った。という記事を書いたのですが、
当時の私には継続モナドはとても難しく、モナドで包む部分とcallCCについて華麗にスルーしていました。
今回、einblickerさんのコードを読んで、継続モナドについて少し理解が深まりました。相変わらずとても難しいんですけど。

で、コードを読んでいて少し気づいたことがあったので、
~~einblickerさんのコードを踏まえつつ、自分ならこんな風に書くかなーというのを書いてみました。~~が、間違えていました。
コメントにてeinblickerさんにご指摘いただいたとおりに修正しました。また、YieldとYieldFromの実装を追加しました。
どうもありがとうございます。もう一度見直してみます。

ContMonad.fs

namespace Monad.ContMonad

[<AutoOpen>]
module ContMonad =
  type Cont<'r, 'a> = Cont of (('a -> 'r) -> 'r)

  let runCont (Cont c) = c
  let callCC f = Cont <| fun k -> runCont (f (fun a -> Cont <| fun _ -> k a)) k
  let creturn a = Cont <| fun k -> k a

  type ContBuilder () = 
    member this.Return(a) = creturn a 
    member this.ReturnFrom(a) = a
    member this.Bind(Cont c, f) = Cont <| fun k -> c (fun a -> runCont (f a) k)
    member this.Zero() = this.Return()
    member this.Combine(c1, c2) = this.Bind(c1, fun _ -> c2)
    member this.For(seq, f) = Seq.fold
                                (fun cc elem -> this.Combine(cc, f elem))
                                (f <| Seq.head seq) <| Seq.skip 1 seq
    member this.Delay (f) = f ()
    member this.Yield (a) = creturn a
    member this.YieldFrom (a) = a

  let cont = new ContBuilder ()

  type ContBuilder with 
    member this.foreach seq f =
      cont {
        do! callCC <| fun break' -> cont {
          for i in seq do
            do! callCC <| fun continue' -> cont {
              do! f i (break'()) (continue'())
            }
        }
      } |> runCont <| ignore

Sample.fs

namespace ConsoleApplication1

module Sample = 
  open Monad.ContMonad
  cont.foreach [1..20] (fun i  break' continue' -> cont {
      if i = 18 then
        do! break'
        printfn "foo"
      else if i % 2 = 0 then
        do! continue'
        printfn "bar"
      else
        printfn "%d" i
  })

  System.Console.WriteLine () |> ignore

  cont.foreach [1..20] (fun i  break' continue' -> cont {
      if i = 18 then
        do! break'
        printfn "foo"
      else
        for x in 1..i do
          printf "%d" x
        printfn ""
  })

  System.Console.ReadLine () |> ignore

実行結果

1
3
5
7
9
11
13
15
17

1
12
123
1234
12345
123456
1234567
12345678
123456789
12345678910
1234567891011
123456789101112
12345678910111213
1234567891011121314
123456789101112131415
12345678910111213141516
1234567891011121314151617

F#で楽々breakとcontinueできちゃってるよ。継続モナドまじパネぇっす！
（よいこは、「C#ならふつうにbreakとcontinueできるじゃん」とかなんとか言わない。）
ちなみに、 break と continue の２つのキーワードは将来利用するために予約されているので、
F#の今後のバージョンでサポートされるかもしれません。

おまけ：モナド則の確認

namespace ContMonad.UT

open System

module Tests = 
  open NUnit.Framework
  open FsUnit
  open Monad.ContMonad
      
  [<TestFixture>]
  type ``ContMonad モナド則`` () =
    let (>>=) m f = cont {let! x = m
                          return! f x}
    let return' x = cont { return x }

    let x = 1
    let m = cont { return 3 }
    let f x = cont { return 4 + x }
    let g x = cont { return 2 * x }

    let assertEqual (left, right) = 
      let result = cont {let! a1 = left
                         let! a2 = right
                         return a1 |> should equal a2} |> runCont <| ignore
      ()

    let (==) left right = assertEqual (left, right)

    [<Test>] 
    // モナド則１： return x >>= f == f x
    member test.``モナド則1`` () =
      return' x >>= f == f x

    [<Test>] 
    // モナド則２: m >>= return == m
    member test.``モナド則2`` () =
      m >>= return' == m

    [<Test>] 
    // モナド則３: (m >>= f) >>= g == m >>= (\x -> f x >>= g)
    member test.``モナド則3`` () =
      (m >>= f) >>= g == (m >>= (fun x -> f x >>= g))

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()