3 people like it.

An approach to MonadFix in ML?

A colleague recently mentioned the problem of not having MonadFix in a strict language. Here is my 2 hour potential approach to implementing it in ML. Let me know if I got something totally wrong!

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
// An approach to MonadFix in ML?
// ------------------------------
//
// A colleague recently mentioned the problem of not having MonadFix in
// a strict language.  Here is my 2 hour potential approach to
// implementing it in ML.

//////////////////////////////////////////////////////////////////////

// First we need a way to tie knots.  This is a partial translation of
// the approach I developed while programming in Standard ML:
//
//  http://mlton.org/Fixpoints
//
// The point of this is to allow tying knots over arbitrary abstract
// products.

type Proxy<'x> = {proxy: 'x; tie: 'x -> unit}
type Fix<'x> = {fix: unit -> Proxy<'x>}

module Fix =
  let fix xF x2x =
    let {proxy=x; tie=xT} = xF.fix ()
    xT (x2x x)
    x
  let (<&>) xF yF =
    {fix = fun () ->
       let {proxy=x; tie=xT} = xF.fix ()
       let {proxy=y; tie=yT} = yF.fix ()
       {proxy = (x, y)
        tie = fun (x', y') -> xT x' ; yT y'}}

//////////////////////////////////////////////////////////////////////

// Here is a minimalistic lazy type.  This is absolutely not a
// production quality implementation as, for simplicity, this does not
// handle issues such as exceptions in any way.

type Lazy<'x> = {mutable delay: Choice<unit -> 'x, 'x>}

module Lazy =
  let delay u2x = {delay = Choice1Of2 u2x}
  let force d =
    match d.delay with
     | Choice2Of2 x -> x
     | Choice1Of2 u2x ->
       let x = u2x ()
       d.delay <- Choice2Of2 x
       x
  let bind x2yD xD =
    delay <| fun () -> force xD |> x2yD |> force
  let Y =
    {fix = fun () ->
       let xD = {delay = Choice1Of2 (fun _ -> failwith "Lazy.Y")}
       {proxy = xD
        tie = fun xD' -> xD.delay <- xD'.delay}}

//////////////////////////////////////////////////////////////////////

// Here is a fixpoint tier for sequences.

module Seq =
  let Y =
    {fix = fun () ->
       let xsR = ref (Seq.delay (fun _ -> failwith "Seq.Y"))
       let xs = Seq.delay (fun () -> !xsR)
       {proxy = xs
        tie = fun xs' -> xsR := xs'}}

//////////////////////////////////////////////////////////////////////

// Here is a lazyish Maybe type and a monad including mfix.  As you
// can see, mfix takes a witness that the parameter type can be tied.

type Maybe<'x> = Lazy<option<'x>>

module Maybe =
  let result x = Lazy.delay <| fun () -> Some x
  let bind x2yM xM =
    xM
    |> Lazy.bind (fun xO ->
       Lazy.delay <| fun () ->
       xO
       |> Option.bind (x2yM >> Lazy.force))
  let mfix (xF: Fix<'x>) (x2xM: 'x -> Maybe<'x>) : Maybe<'x> =
    Lazy.delay <| fun () ->
      let {proxy=x; tie=xT} = xF.fix ()
      let xM = x2xM x
      match Lazy.force xM with
       | None -> None
       | Some x' -> xT x' ; Some x'

//////////////////////////////////////////////////////////////////////

// Finally here is a simple example.

let someMinusOnes =
  Maybe.mfix Seq.Y (fun xs -> Maybe.result (Seq.append (Seq.singleton 1) xs))
  |> Maybe.bind (fun xs ->
     Maybe.result (Seq.map (~-) xs))
  |> Lazy.force

do printfn "%A" someMinusOnes

// Let me know if I got something totally wrong!
Proxy.proxy: 'x
Proxy.tie: 'x -> unit
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
type Fix<'x> =
  {fix: unit -> Proxy<'x>;}

Full name: Script.Fix<_>
Fix.fix: unit -> Proxy<'x>
type Proxy<'x> =
  {proxy: 'x;
   tie: 'x -> unit;}

Full name: Script.Proxy<_>
val fix : xF:Fix<'a> -> x2x:('a -> 'a) -> 'a

Full name: Script.Fix.fix
val xF : Fix<'a>
val x2x : ('a -> 'a)
val x : 'a
val xT : ('a -> unit)
Fix.fix: unit -> Proxy<'a>
val yF : Fix<'b>
val y : 'b
val yT : ('b -> unit)
Fix.fix: unit -> Proxy<'b>
val x' : 'a
val y' : 'b
Multiple items
active recognizer Lazy: Lazy<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.( |Lazy| )

--------------------
type Lazy<'x> =
  {mutable delay: Choice<(unit -> 'x),'x>;}

Full name: Script.Lazy<_>
Lazy.delay: Choice<(unit -> 'x),'x>
Multiple items
type Choice<'T1,'T2> =
  | Choice1Of2 of 'T1
  | Choice2Of2 of 'T2

Full name: Microsoft.FSharp.Core.Choice<_,_>

--------------------
type Choice<'T1,'T2,'T3> =
  | Choice1Of3 of 'T1
  | Choice2Of3 of 'T2
  | Choice3Of3 of 'T3

Full name: Microsoft.FSharp.Core.Choice<_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4> =
  | Choice1Of4 of 'T1
  | Choice2Of4 of 'T2
  | Choice3Of4 of 'T3
  | Choice4Of4 of 'T4

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5> =
  | Choice1Of5 of 'T1
  | Choice2Of5 of 'T2
  | Choice3Of5 of 'T3
  | Choice4Of5 of 'T4
  | Choice5Of5 of 'T5

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5,'T6> =
  | Choice1Of6 of 'T1
  | Choice2Of6 of 'T2
  | Choice3Of6 of 'T3
  | Choice4Of6 of 'T4
  | Choice5Of6 of 'T5
  | Choice6Of6 of 'T6

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> =
  | Choice1Of7 of 'T1
  | Choice2Of7 of 'T2
  | Choice3Of7 of 'T3
  | Choice4Of7 of 'T4
  | Choice5Of7 of 'T5
  | Choice6Of7 of 'T6
  | Choice7Of7 of 'T7

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_,_,_>
val delay : u2x:(unit -> 'a) -> Lazy<'a>

Full name: Script.Lazy.delay
val u2x : (unit -> 'a)
union case Choice.Choice1Of2: 'T1 -> Choice<'T1,'T2>
val force : d:Lazy<'a> -> 'a

Full name: Script.Lazy.force
val d : Lazy<'a>
Lazy.delay: Choice<(unit -> 'a),'a>
union case Choice.Choice2Of2: 'T2 -> Choice<'T1,'T2>
val bind : x2yD:('a -> Lazy<'b>) -> xD:Lazy<'a> -> Lazy<'b>

Full name: Script.Lazy.bind
val x2yD : ('a -> Lazy<'b>)
val xD : Lazy<'a>
val Y : Fix<Lazy<'a>>

Full name: Script.Lazy.Y
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val xD' : Lazy<'a>
module Seq

from Microsoft.FSharp.Collections
val Y : Fix<seq<'a>>

Full name: Script.Seq.Y
val xsR : seq<'a> ref
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val delay : generator:(unit -> seq<'T>) -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.delay
val xs : seq<'a>
val xs' : seq<'a>
type Maybe<'x> = Lazy<'x option>

Full name: Script.Maybe<_>
Multiple items
active recognizer Lazy: Lazy<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.( |Lazy| )

--------------------
module Lazy

from Script

--------------------
type Lazy<'x> =
  {mutable delay: Choice<(unit -> 'x),'x>;}

Full name: Script.Lazy<_>
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
val result : x:'a -> Lazy<'a option>

Full name: Script.Maybe.result
union case Option.Some: Value: 'T -> Option<'T>
val bind : x2yM:('a -> Lazy<'b option>) -> xM:Lazy<'a option> -> Lazy<'b option>

Full name: Script.Maybe.bind
val x2yM : ('a -> Lazy<'b option>)
val xM : Lazy<'a option>
val xO : 'a option
module Option

from Microsoft.FSharp.Core
val bind : binder:('T -> 'U option) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.bind
val mfix : xF:Fix<'x> -> x2xM:('x -> Maybe<'x>) -> Maybe<'x>

Full name: Script.Maybe.mfix
val xF : Fix<'x>
Multiple items
module Fix

from Script

--------------------
type Fix<'x> =
  {fix: unit -> Proxy<'x>;}

Full name: Script.Fix<_>
val x2xM : ('x -> Maybe<'x>)
val x : 'x
val xT : ('x -> unit)
val xM : Maybe<'x>
union case Option.None: Option<'T>
val x' : 'x
val someMinusOnes : seq<int> option

Full name: Script.someMinusOnes
Multiple items
module Maybe

from Script

--------------------
type Maybe<'x> = Lazy<'x option>

Full name: Script.Maybe<_>
Multiple items
module Seq

from Script

--------------------
module Seq

from Microsoft.FSharp.Collections
val xs : seq<int>
val append : source1:seq<'T> -> source2:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.append
val singleton : value:'T -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.singleton
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
Raw view Test code New version

More information

Link:http://fssnip.net/sv
Posted:8 years ago
Author:Vesa Karvonen
Tags: monad , fixpoint