Skip to content

Instantly share code, notes, and snippets.

@nakamura-to
Last active December 12, 2015 03:28
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save nakamura-to/4706919 to your computer and use it in GitHub Desktop.
Save nakamura-to/4706919 to your computer and use it in GitHub Desktop.
MaybeとStateを一緒にしたようなRelayコンピュテーション式
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