限定継続でAmb

#amb
ambは非決定性計算をしてくれるカッコイイオペレータである。
Rosetta CodeにあるAmbの例題を前回の限定継続を利用して解いてみる。

#コード
NotUseAmbをdefineすると今回用意したambの代わりにリストモナドを使う。

open FsControl.Core.Types
open FsControl.Core.TypeMethods
open FsControl.Core.TypeMethods.Applicative
open FsControl.Core.TypeMethods.Monad

//https://github.com/gmpl/FsControl/blob/master/FsControl.Core/Samples/Haskell.fsx
let inline return' x = Inline.instance Pure x
let inline (>>=) x (f:_->'R) : 'R = Inline.instance (Bind, x) f 
type DoNotationBuilder() =
    member inline b.Return(x)    = return' x
    member inline b.Bind(p,rest) = p >>= rest
    member        b.Let (p,rest) = rest p
    member    b.ReturnFrom(expr) = expr
let do' = new DoNotationBuilder()


#if NotUseAmb
#else

let runCont = Cont.run

#endif

let callCC' = Cont.callCC
let inline when'  p s = if p then s else return' ()
let inline unless p s = when' (not p) s

let returnCont :'a->Cont<'b, 'a> = return'

#if NotUseAmb

let amb (lst:List<_>) = lst
let require condition = if condition then [()] else []
let reset k = k
let runCont a b = b(a)

#else

let reset e = returnCont <| runCont e id
let shift e = Cont <| fun k -> e (returnCont << k) |> runCont <| id

let amb lst = shift <| fun k -> do'{
    lst
    |> List.iter (fun x -> ignore <| do'{
        do! (k x)
    })
    return ()
}
let require condition = shift <| fun k -> do'{
    if condition then
        do! k ()
        return ()
    else
        return ()
}

#endif

[<EntryPoint>]
let main argv = 

    let isFollowedBy (a: string) (b: string) =
        a.[a.Length - 1] = b.[0]

    reset <| do'{
        let! first = amb ["the"; "that"; "a"]
        //printfn "a1"
        let! second = amb ["frog"; "elephant"; "thing"]
        //printfn "a2"
        do! require(first |> isFollowedBy <| second)
        //printfn "r1"
        let! third = amb ["walked"; "treaded"; "grows"]
        //printfn "a3"
        do! require(second |> isFollowedBy <| third)
        //printfn "r2"
        let! forth = amb ["slowly"; "quickly"]
        //printfn "a4"
        do! require(third |> isFollowedBy <| forth)
        //printfn "r3"
        printfn "%A" (first, second, third, forth)
        return ()
    }
    |> runCont <|
        fun _ -> printfn "end"

    0

#つか
F#って#define書けないのな^^;