F# のコンピューテーション式のサンプルを読み解く

理解を進めるためにすべての引数と返り値に型アノテーションをつけていく

code:type.fs

type Eventually<'T> =

| Done of 'T

| NotYetDone of (unit -> Eventually<'T>)

type Delayed<'T> = Eventually<'T> // 理解のために別途型を用意する

code:builder.fs

// まず、bind をつくる

// bind のシグネチャは M<'T> * ('T -> M<'U>) -> M<'U>

let rec (>>=) (m: Eventually<'a>) (f: 'a -> Eventually<'b>) : Eventually<'b> =

match m with

| Done value -> f value

| NotYetDone work -> NotYetDone(fun _ -> work () >>= f)

// 関数としてラップする delay をつくる

// Delayed は任意の型でいいが、通常は M<'T> または unit -> M<'T> が使用される。規定実装では M<'T> が返される

// 今回は型変換をわかりやすくするために、あえて Delayed 型を用意しておく

let delay (f: unit -> Eventually<'T>) : Delayed<'T> = NotYetDone(fun _ -> f ())

// シーケンス処理を行う combine

// M<'T> * Delayed<'T> -> M<'T>

// or

// M<unit> * M<'T> -> M<'T>

let combine (m: Eventually<'a>) (delayed: Delayed<'a>) : Eventually<'a> = m >>= (fun _ -> delayed)

// catch は try系などで利用する

// Delayed<'T> -> M<Result<'T, 'TError>>

let rec catch (delayed: Delayed<'a>) : Eventually<Result<'a, exn>> =

match delayed with

| Done value -> Done (Ok value)

| NotYetDone work ->

NotYetDone(fun _ ->

let res =

try

Ok(work ())

with exn ->

Error exn

match res with

| Ok cont -> catch cont

| Error exn -> Done (Error exn)

)

// try...finaly で呼び出す

// Delayed<'T> * (unit -> unit) -> M<'T>

let tryFinally (delayed: Delayed<'a>) (compensation: unit -> unit) : Eventually<'a> =

catch (delayed) >>= (fun res ->

compensation ()

match res with

| Ok value -> Done value

| Error exn -> raise exn

)

// try...with で呼び出す

// Delayed<'T> * (exn -> M<'T>) -> M<'T>

let tryWith (delayed: Delayed<'a>) (handler: exn -> Eventually<'a>) : Eventually<'a> =

catch (delayed) >>= (function

| Ok value -> Done value

| Error exn -> handler exn

)

// while...do で呼び出す

// (unit -> bool) * Delayed<'T> -> M<'T>

// or

// (unit -> bool) * Delayed<unit> -> M<unit>

let rec whileLoop (pred: unit -> bool) (m: Eventually<'a>) : Eventually<unit> =

if pred () then

m >>= (fun _ -> whileLoop pred m)

else

Done ()

// for...do で呼び出す

// seq<'T> * ('T -> M<'U>) -> M<'U>

// or

// seq<'T> * ('T -> M<'U>) -> seq<M<'U>>

let forLoop (collection: seq<'a>) (f: 'a -> Eventually<'b>) : Eventually<unit> =

let ie = collection.GetEnumerator()

tryFinally

(whileLoop (fun () -> ie.MoveNext()) (delay (fun () -> let value = ie.Current in f value)))

(fun () -> ie.Dispose())

// 実際の使用例

type EventuallyBuilder() =

member _.Bind(m, f) = m >>= f

member _.Return(x) = Done x

member _.ReturnFrom(x) = x

member _.Delay(f) = delay f

member _.Combine(m, delayed) = combine m delayed

member _.Zero() = Done ()

member _.TryWith(delayed, handler) = tryWith delayed handler

member _.TryFinally(delayed, compensation) = tryFinally delayed compensation

member _.For(collection: seq<_>, func) = forLoop collection func

let eventually = EventuallyBuilder()

let step m =

match m with

| Done _ -> m

| NotYetDone f -> f ()

let comp =

eventually {

for x in 1..2 do

printfn $" x = %d{x}"

return ()

}

comp |> step |> step |> step |> step // return Done ()

// x = 1

// x = 2