6 people like it.

Delimited Continuation Monad

Oleg's delimited continuation monad [1] and creating an external iterator from an internal iterator using it. [1] http://okmij.org/ftp/continuations/implementations.html#genuine-shift

delimited continuation monad

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
module ShiftResetGenuine

type DCont<'a,'b,'tau> = ('tau -> 'a) -> 'b

type DContBuilder() =
    member this.Return(x):DCont<_,_,_> =
        fun k -> k x
    member this.Bind(f:DCont<_,_,_>, h:_ -> DCont<_,_,_>):DCont<_,_,_> =
        fun k -> f <| fun s -> h s k

let dcont = DContBuilder()

let ret = dcont.Return
let run (f:DCont<_,_,_>) = f id
let reset (f:DCont<_,_,_>):DCont<_,_,_> =
    fun k -> k (f id)
let shift (f:(_ -> DCont<_,_,_>) -> DCont<_,_,_>):DCont<_,_,_> =
    fun k -> f (fun tau -> ret <| k tau) id

example 1

 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: 
#nowarn "40"

let inversion walker collection =
    let rec c =
        ref <| fun () ->
            reset <| dcont {
                let! _ = walker (fun e -> 
                    shift <| fun k -> 
                    c := fun () -> k e
                    ret e) collection
                return failwith "no more elements"
            }
    fun () -> !c ()

// an internal iterator for lists
let rec map f list = dcont {
    match list with
    | []    -> return []
    | x::xs -> let! x' = f x
               let! xs' = map f xs
               return x'::xs'
}

[1..10]
|> map ((+) 1 >> ret)
|> run
|> printfn "%A"

// creating an external iterator from the internal iterator
let invMap = inversion map

let iterator = invMap [1..10]

for i = 1 to 10 do
    iterator()
    |> run
    |> (+) 1
    |> printfn "%A"

example 2

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
type Tree<'a> = Leaf | Node of 'a * Tree<'a> * Tree<'a>

// an internal iterator for trees
let rec mapTree f tree = dcont {
    match tree with
    | Leaf          -> return Leaf
    | Node(a, l, r) -> let! a' = f a
                       let! l' = mapTree f l
                       let! r' = mapTree f r
                       return Node(a', l', r')
}

let invMapTree = inversion mapTree

let iterator' = invMapTree <| Node(1, Node(2, Node(3, Leaf, Leaf), Leaf), Leaf)

for i = 1 to 3 do
    iterator'()
    |> run
    |> (+) 1
    |> printfn "%A"
module ShiftResetGenuine
type DCont<'a,'b,'tau> = ('tau -> 'a) -> 'b

Full name: ShiftResetGenuine.DCont<_,_,_>
Multiple items
type DContBuilder =
  new : unit -> DContBuilder
  member Bind : f:DCont<'a,'b,'c> * h:('c -> DCont<'d,'a,'e>) -> DCont<'d,'b,'e>
  member Return : x:'f -> DCont<'g,'g,'f>

Full name: ShiftResetGenuine.DContBuilder

--------------------
new : unit -> DContBuilder
val this : DContBuilder
member DContBuilder.Return : x:'f -> DCont<'g,'g,'f>

Full name: ShiftResetGenuine.DContBuilder.Return
val x : 'f
val k : ('f -> 'g)
member DContBuilder.Bind : f:DCont<'a,'b,'c> * h:('c -> DCont<'d,'a,'e>) -> DCont<'d,'b,'e>

Full name: ShiftResetGenuine.DContBuilder.Bind
val f : DCont<'a,'b,'c>
val h : ('c -> DCont<'d,'a,'e>)
val k : ('e -> 'd)
val s : 'c
val dcont : DContBuilder

Full name: ShiftResetGenuine.dcont
val ret : ('a -> DCont<'b,'b,'a>)

Full name: ShiftResetGenuine.ret
member DContBuilder.Return : x:'f -> DCont<'g,'g,'f>
val run : f:DCont<'a,'b,'a> -> 'b

Full name: ShiftResetGenuine.run
val f : DCont<'a,'b,'a>
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val reset : f:DCont<'a,'b,'a> -> k:('b -> 'c) -> 'c

Full name: ShiftResetGenuine.reset
val k : ('b -> 'c)
val shift : f:(('a -> DCont<'b,'b,'c>) -> DCont<'d,'e,'d>) -> k:('a -> 'c) -> 'e

Full name: ShiftResetGenuine.shift
val f : (('a -> DCont<'b,'b,'c>) -> DCont<'d,'e,'d>)
val k : ('a -> 'c)
val tau : 'a
val inversion : walker:(('a -> DCont<'b,'a,'a>) -> 'c -> DCont<'d,'b,'e>) -> collection:'c -> (unit -> DCont<'f,'f,'b>)

Full name: ShiftResetGenuine.inversion
val walker : (('a -> DCont<'b,'a,'a>) -> 'c -> DCont<'d,'b,'e>)
val collection : 'c
val c : (unit -> DCont<'f,'f,'b>) 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 e : 'a
val k : ('a -> DCont<'f,'f,'b>)
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val map : f:('a -> DCont<'b,'b,'c>) -> list:'a list -> DCont<'b,'b,'c list>

Full name: ShiftResetGenuine.map
val f : ('a -> DCont<'b,'b,'c>)
Multiple items
val list : 'a list

--------------------
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val x : 'a
val xs : 'a list
val x' : 'c
val xs' : 'c list
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val invMap : (int list -> unit -> DCont<int,int,int>)

Full name: ShiftResetGenuine.invMap
val iterator : (unit -> DCont<int,int,int>)

Full name: ShiftResetGenuine.iterator
val i : int
type Tree<'a> =
  | Leaf
  | Node of 'a * Tree<'a> * Tree<'a>

Full name: ShiftResetGenuine.Tree<_>
union case Tree.Leaf: Tree<'a>
union case Tree.Node: 'a * Tree<'a> * Tree<'a> -> Tree<'a>
val mapTree : f:('a -> DCont<'b,'b,'c>) -> tree:Tree<'a> -> DCont<'b,'b,Tree<'c>>

Full name: ShiftResetGenuine.mapTree
val tree : Tree<'a>
val a : 'a
val l : Tree<'a>
val r : Tree<'a>
val a' : 'c
val l' : Tree<'c>
val r' : Tree<'c>
val invMapTree : (Tree<int> -> unit -> DCont<int,int,int>)

Full name: ShiftResetGenuine.invMapTree
val iterator' : (unit -> DCont<int,int,int>)

Full name: ShiftResetGenuine.iterator'

More information

Link:http://fssnip.net/7P
Posted:12 years ago
Author:einblicker
Tags: continuations , computation builder , monad