Last active
December 12, 2015 03:28
-
-
Save nakamura-to/4706919 to your computer and use it in GitHub Desktop.
MaybeとStateを一緒にしたようなRelayコンピュテーション式
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Relay = | |
type Relay<'a, 's> = 's option -> 'a * 's option | |
let eval m s = m s |> fst | |
let exec m s = m s |> snd | |
type RelayBuilder<'s>(guard: 's -> bool) = | |
member this.Return(a) : Relay<'a,'s> = fun s -> (a,s) | |
member this.Bind(m:Relay<'a,'s>, k:'a -> Relay<'b,'s>) : Relay<'b,'s> = fun s -> | |
let (a, s') = m s | |
match s' with | |
| Some v -> if guard v then (k a) s' else (k a) None | |
| _ -> (k a) None | |
let relay guard = new RelayBuilder<_>(guard) | |
open Relay | |
let landLeft n = function | |
| Some(left, right) -> ((), Some (left + n, right)) | |
| None -> ((), None) | |
let landRight n = function | |
| Some(left, right) -> ((), Some (left, right + n)) | |
| None -> ((), None) | |
let banana = fun _ -> ((), None) | |
let guard n = fun (left, right) -> abs(left - right) < n | |
let tightrope = relay (guard 4) | |
let routine = tightrope { | |
do! landLeft 1 | |
do! landRight 2 | |
do! landLeft 3 } | |
let routine2 = tightrope { | |
do! landLeft 1 | |
do! landRight 2 | |
do! landLeft 5 } | |
let routine3 = tightrope { | |
do! landLeft 1 | |
do! landRight 2 | |
do! banana | |
do! landLeft 3 } | |
let print = function | |
| Some(left, right) -> printfn "成功: %d, %d" left right | |
| _ -> printfn "失敗" | |
do | |
exec routine (Some (0, 0)) |> print (* 成功: 4, 2 *) | |
exec routine2 (Some (0, 0)) |> print (* 失敗 *) | |
exec routine3 (Some (0, 0)) |> print (* 失敗 *) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment