Effectful F# with Objects

Rea.fsx

// This is a very brief and incomplete sketch of how the technique used in
//
//   Effectful OCaml with Objects and Variants
//   https://github.com/polytypic/rea-ml#effectful-ocaml-with-objects-and-variants
//
// could be translated to F#.  The following F# will likely make more sense after
// reading the introduction that you'll find by following the above link.

[<AutoOpen>]
module Rea =
  type S<'R, 'e, 'a> = private | S of obj

  let unsafe_to_rea<'t, 'R, 'e, 'a> (x: 't) = (S (box x) : S<'R, 'e, 'a>)
  let unsafe_of_rea<'t, 'R, 'e, 'a> (S x: S<'R, 'e, 'a>) = unbox<'t> x

  type ER<'R, 'e, 'a, 'D> = 'D -> S<'R, 'e, 'a>

//

type Bind<'R, 'D> =
  abstract bind<'e, 'a, 'b> :
    ER<'R, 'e, 'a, 'D> -> ('a -> ER<'R, 'e, 'b, 'D>) -> S<'R, 'e, 'b>

let inline bind xE xyE (d: 'D when 'D :> Bind<'R, 'D>) = d.bind xE xyE
let inline (>>=) xE xyE = bind xE xyE

//

type Result<'R, 'D> =
  abstract result<'e, 'a> : 'a -> S<'R, 'e, 'a>

let inline result x (d: 'D when 'D :> Result<'R, 'D>) = d.result x

//

let inline run d xE = xE d

//

type Monad<'R, 'D> =
  inherit Bind<'R, 'D>
  inherit Result<'R, 'D>

//

type ERBuilder() =
  member inline _.Delay(uxE) = fun d -> uxE () d
  member inline _.ReturnFrom xE = xE
  member inline _.Return x = result x
  member inline _.Zero() = result ()
  member inline _.Bind(xE, xyE) = bind xE xyE

let er = new ERBuilder()

//

let rec fib n = er {
  if n < 2 then
    return n
  else
    let! f'2 = fib (n-2)
    let! f'1 = fib (n-1)
    return f'2 + f'1
}

//

module Identity =
  type R = private | R

  let inline to_rea x = unsafe_to_rea<'a, R, 'e, 'a> x
  let inline of_rea x = unsafe_of_rea<'a, R, 'e, 'a> x

  type Identity() =
    interface Monad<R, Identity> with
      member d.bind xO xyO = xyO (of_rea (xO d)) d
      member _.result x = to_rea x

  let monad = new Identity()

do fib 10 |> run Identity.monad |> Identity.of_rea |> printf "%d\n"

//

module Option =
  type R = private | R

  let inline to_rea x = unsafe_to_rea<option<'a>, R, 'e, 'a> x
  let inline of_rea x = unsafe_of_rea<option<'a>, R, 'e, 'a> x