-
-
Save gusty/7501726 to your computer and use it in GitHub Desktop.
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
#r @"bin\Debug\FsControl.Core.dll" // from https://github.com/gmpl/FsControl | |
let inline return' x = Inline.instance FsControl.Core.TypeMethods.Applicative.Pure x | |
let inline (>>=) x (f:_->'R) : 'R = Inline.instance (FsControl.Core.TypeMethods.Monad.Bind, x) f | |
let inline mzero () = Inline.instance FsControl.Core.TypeMethods.MonadPlus.Mzero () | |
let inline mplus (x:'a) (y:'a) : 'a = Inline.instance (FsControl.Core.TypeMethods.MonadPlus.Mplus, x) y | |
module Monad = | |
open FsControl.Core.TypeMethods | |
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() | |
module MonadPlus = | |
open Monad | |
open FsControl.Core.TypeMethods.MonadPlus | |
// DoPlus notation (MonadPlus) | |
type DoPlusNotationBuilder() = | |
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 | |
member inline x.Zero() = mzero() | |
member inline x.Combine(a, b) = mplus a b | |
let doPlus = new DoPlusNotationBuilder() | |
module FSharpComputationExpressions = | |
open System | |
open MonadPlus | |
type DefaultImpl = | |
static member inline DelayFromComputationExpression f = f | |
static member inline RunFromComputationExpression f = f | |
static member inline TryWithFromComputationExpression c h = try c() with e -> h e | |
static member inline TryFinallyFromComputationExpression c compensation = try c() finally compensation () | |
static member inline UsingFromComputationExpression (res:#IDisposable) (body:#IDisposable -> _) = DefaultImpl.TryFinallyFromComputationExpression (body res) (fun () -> match res with null -> () | disp -> disp.Dispose()) | |
type Combine = Combine with | |
static member instance (Combine, m:option<'a>,_:option<'a>) = fun (d:unit-> option<'a>) -> if Option.isSome m then m else d ():option<'a> | |
static member instance (Combine, m:list<'a>,_:list<'a>) = fun (d:unit-> list<'a>) -> m @ d() :list<'a> | |
let inline combine m d = Inline.instance (Combine, m) d | |
type TryWith = TryWith with | |
static member instance (TryWith, c:unit->option<'a>,_:option<'a>) = fun (h:exn -> option<'a>) -> DefaultImpl.TryWithFromComputationExpression c h | |
static member instance (TryWith, c:unit->list<'a>,_:list<'a>) = fun (h:exn -> list<'a>)-> DefaultImpl.TryWithFromComputationExpression c h | |
let inline tryWith c h = Inline.instance (TryWith,c) h | |
type TryFinally = TryFinally with | |
static member instance (TryFinally, c:unit->option<'a>,_:option<'a>) = fun f -> DefaultImpl.TryFinallyFromComputationExpression c f | |
static member instance (TryFinally, c:unit->list<'a>,_:list<'a>)= fun f-> DefaultImpl.TryFinallyFromComputationExpression c f | |
let inline tryFinally c (f:unit->unit) = Inline.instance (TryFinally, c) f | |
type Using = Using with | |
static member inline instance (Using, body:#IDisposable-> option<'a>, _:option<'a>) = fun (res:#IDisposable) -> tryFinally (fun () -> body res) (fun () -> match res with null -> () | disp -> disp.Dispose()) | |
static member inline instance (Using, body:#IDisposable-> list<'a>, _:list<'a>) = fun (res:#IDisposable) -> tryFinally (fun () -> body res) (fun () -> match res with null -> () | disp -> disp.Dispose()) | |
let inline using' (res:#IDisposable) body = Inline.instance (Using, body) res | |
// DoFSharp notation | |
type DoFSharpNotationBuilder() = | |
member inline b.Return(a) = doPlus.Return a | |
member inline b.Bind(m,f) = doPlus.Bind (m, f) | |
member inline b.Let (p,rest) = doPlus.Let (p,rest) | |
member inline b.ReturnFrom(m) = doPlus.ReturnFrom m | |
// Other Computation Expressions | |
member inline b.Zero() = doPlus.Zero () | |
member inline b.Combine(x, y) = combine x y | |
member inline b.Delay(f) = f | |
member inline b.Run(f) = f() | |
member inline b.TryWith(d,h) = tryWith d h | |
member inline b.TryFinally(c,f) = tryFinally c f | |
member inline b.Using(res,body) = using' res body | |
// member inline b.While(guard,f) = while' guard f | |
// member inline b.For(sequence,body) = for' sequence body | |
// member inline b.Yield(a) = yield' a | |
// member inline b.YieldFrom(m) = yieldFrom' m | |
let dofs = new DoFSharpNotationBuilder() | |
module Sample = | |
open System | |
open MonadPlus | |
open FSharpComputationExpressions | |
let hoge = | |
doPlus { | |
let! a = Some 10 | |
let! b = Some 100 | |
if a < b then | |
return b - a | |
else | |
return a - b } | |
hoge |> printfn "%A" | |
// Some 90 | |
let createDisposable f = { new IDisposable with member x.Dispose() = f() } | |
let fuga = | |
dofs { | |
let! x = Some "F#" | |
let! y = Some "is fun!" | |
use res = createDisposable (fun () -> printf "%s" "dispose;") | |
try | |
try | |
failwith "fail" | |
return "VB6 is fun!" | |
with | |
| ex -> printf "%s" "error;" | |
return String.Format("{0} {1}", x, y) | |
() | |
finally | |
printf "%s" "finally;" } | |
fuga |> printfn "%A" | |
// error;finally;dispose;Some "F# is fun!" | |
let piyo = | |
dofs { | |
let! a = ["A";"B";] | |
let! b = [1..5] | |
try | |
if b < 4 then | |
return a + string b | |
finally | |
printf "%s" <| String.Format("{0}{1};", a, b) | |
} | |
piyo |> printfn "%A" | |
// A1;A2;A3;A4;A5;B1;B2;B3;B4;B5;["A1"; "A2"; "A3"; "B1"; "B2"; "B3"] | |
Console.ReadKey () |> ignore |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment