5 people like it.

IterateeCPS

An iteratee that uses continuation-passing style as an optimization. There is no more discriminated union, and the signature should feel familiar to those using Async.StartWithContinuations.

 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: 
module FSharp.Monad.Iteratee.CPS

open System

type Stream<'a> =
  | Chunk of 'a
  | Empty
  | EOF

type IterateeCPS<'el,'a,'r> = Iteratee of (((Stream<'el> -> IterateeCPS<'el,'a,'r>) -> 'r) -> (exn -> 'r) -> ('a * Stream<'el> -> 'r) -> 'r)

let runIter (Iteratee(i)) onCont onError onDone = i onCont onError onDone
let returnI x = Iteratee(fun _ _ onDone -> onDone(x, Empty))
let rec bind (m: IterateeCPS<'el,'a,'r>) (f: 'a -> IterateeCPS<'el,'b,'r>) : IterateeCPS<'el,'b,'r> =
  Iteratee(fun onCont onError onDone ->
    let mdone (a, s) =
      let fcont k = runIter (k s) onCont onError onDone
      match s with
      | Empty -> runIter (f a) onCont onError onDone
      | _ -> runIter (f a) fcont onError (fun (x, _) -> onDone(x, s))
    in runIter m (fun k -> onCont(k >> (fun m' -> bind m' f))) onError mdone)

type IterateeCPSBuilder() =
  member this.Return(x) = returnI x
  member this.ReturnFrom(m:IterateeCPS<_,_,_>) = m
  member this.Bind(m, k) = bind m k
  member this.Zero() = returnI ()
  member this.Combine(comp1, comp2) = bind comp1 (fun () -> comp2)
  member this.Delay(f) = bind (returnI ()) f
let iterateeCPS = IterateeCPSBuilder()

let throw e = Iteratee(fun _ onError _ -> onError e)
let throwRecoverable e i = Iteratee(fun onCont onError _ -> onError e; onCont i)
let doneI x str = Iteratee(fun _ _ onDone -> onDone(x, str))
let contI k e = Iteratee(fun onCont _ _ -> onCont k)
let liftI k = contI k
let joinI outer = bind outer (fun inner ->
  Iteratee(fun onCont onError onDone ->
    let od (x, _) = onDone(x, Empty)
    let rec oc k = runIter (k EOF) oc' onError od
    and oc' k = onError(Exception("divergent iteratee"))
    runIter inner oc onError od))

let run i =
  let rec onCont k = runIter (k EOF) onCont' onError onDone
  and onCont' k = Choice1Of2 (Exception("divergent iteratee"))
  and onError e = Choice1Of2 e
  and onDone (x,_) = Choice2Of2 x
  runIter i onCont onError onDone

// This matches the run_ implementation from Iteratee
let run_ i =
  match run i with
  | Choice1Of2 e -> raise e
  | x -> x
Multiple items
namespace FSharp

--------------------
namespace Microsoft.FSharp
namespace FSharp.Monad
namespace FSharp.Monad.Iteratee
module CPS

from FSharp.Monad.Iteratee
namespace System
type Stream<'a> =
  | Chunk of 'a
  | Empty
  | EOF

Full name: FSharp.Monad.Iteratee.CPS.Stream<_>
union case Stream.Chunk: 'a -> Stream<'a>
union case Stream.Empty: Stream<'a>
union case Stream.EOF: Stream<'a>
type IterateeCPS<'el,'a,'r> = | Iteratee of (((Stream<'el> -> IterateeCPS<'el,'a,'r>) -> 'r) -> (exn -> 'r) -> ('a * Stream<'el> -> 'r) -> 'r)

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPS<_,_,_>
union case IterateeCPS.Iteratee: (((Stream<'el> -> IterateeCPS<'el,'a,'r>) -> 'r) -> (exn -> 'r) -> ('a * Stream<'el> -> 'r) -> 'r) -> IterateeCPS<'el,'a,'r>
type exn = Exception

Full name: Microsoft.FSharp.Core.exn
val runIter : IterateeCPS<'a,'b,'c> -> onCont:((Stream<'a> -> IterateeCPS<'a,'b,'c>) -> 'c) -> onError:(exn -> 'c) -> onDone:('b * Stream<'a> -> 'c) -> 'c

Full name: FSharp.Monad.Iteratee.CPS.runIter
val i : (((Stream<'a> -> IterateeCPS<'a,'b,'c>) -> 'c) -> (exn -> 'c) -> ('b * Stream<'a> -> 'c) -> 'c)
val onCont : ((Stream<'a> -> IterateeCPS<'a,'b,'c>) -> 'c)
val onError : (exn -> 'c)
val onDone : ('b * Stream<'a> -> 'c)
val returnI : x:'a -> IterateeCPS<'b,'a,'c>

Full name: FSharp.Monad.Iteratee.CPS.returnI
val x : 'a
val onDone : ('a * Stream<'b> -> 'c)
val bind : m:IterateeCPS<'el,'a,'r> -> f:('a -> IterateeCPS<'el,'b,'r>) -> IterateeCPS<'el,'b,'r>

Full name: FSharp.Monad.Iteratee.CPS.bind
val m : IterateeCPS<'el,'a,'r>
val f : ('a -> IterateeCPS<'el,'b,'r>)
val onCont : ((Stream<'el> -> IterateeCPS<'el,'b,'r>) -> 'r)
val onError : (exn -> 'r)
val onDone : ('b * Stream<'el> -> 'r)
val mdone : ('a * Stream<'el> -> 'r)
val a : 'a
val s : Stream<'el>
val fcont : ((Stream<'el> -> IterateeCPS<'el,'b,'r>) -> 'r)
val k : (Stream<'el> -> IterateeCPS<'el,'b,'r>)
val x : 'b
val k : (Stream<'el> -> IterateeCPS<'el,'a,'r>)
val m' : IterateeCPS<'el,'a,'r>
Multiple items
type IterateeCPSBuilder =
  new : unit -> IterateeCPSBuilder
  member Bind : m:IterateeCPS<'i,'j,'k> * k:('j -> IterateeCPS<'i,'l,'k>) -> IterateeCPS<'i,'l,'k>
  member Combine : comp1:IterateeCPS<'d,unit,'e> * comp2:IterateeCPS<'d,'f,'e> -> IterateeCPS<'d,'f,'e>
  member Delay : f:(unit -> IterateeCPS<'a,'b,'c>) -> IterateeCPS<'a,'b,'c>
  member Return : x:'p -> IterateeCPS<'q,'p,'r>
  member ReturnFrom : m:IterateeCPS<'m,'n,'o> -> IterateeCPS<'m,'n,'o>
  member Zero : unit -> IterateeCPS<'g,unit,'h>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder

--------------------
new : unit -> IterateeCPSBuilder
val this : IterateeCPSBuilder
member IterateeCPSBuilder.Return : x:'p -> IterateeCPS<'q,'p,'r>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder.Return
val x : 'p
member IterateeCPSBuilder.ReturnFrom : m:IterateeCPS<'m,'n,'o> -> IterateeCPS<'m,'n,'o>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder.ReturnFrom
val m : IterateeCPS<'m,'n,'o>
member IterateeCPSBuilder.Bind : m:IterateeCPS<'i,'j,'k> * k:('j -> IterateeCPS<'i,'l,'k>) -> IterateeCPS<'i,'l,'k>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder.Bind
val m : IterateeCPS<'i,'j,'k>
val k : ('j -> IterateeCPS<'i,'l,'k>)
member IterateeCPSBuilder.Zero : unit -> IterateeCPS<'g,unit,'h>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder.Zero
member IterateeCPSBuilder.Combine : comp1:IterateeCPS<'d,unit,'e> * comp2:IterateeCPS<'d,'f,'e> -> IterateeCPS<'d,'f,'e>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder.Combine
val comp1 : IterateeCPS<'d,unit,'e>
val comp2 : IterateeCPS<'d,'f,'e>
member IterateeCPSBuilder.Delay : f:(unit -> IterateeCPS<'a,'b,'c>) -> IterateeCPS<'a,'b,'c>

Full name: FSharp.Monad.Iteratee.CPS.IterateeCPSBuilder.Delay
val f : (unit -> IterateeCPS<'a,'b,'c>)
val iterateeCPS : IterateeCPSBuilder

Full name: FSharp.Monad.Iteratee.CPS.iterateeCPS
val throw : e:exn -> IterateeCPS<'a,'b,'c>

Full name: FSharp.Monad.Iteratee.CPS.throw
val e : exn
val throwRecoverable : e:exn -> i:(Stream<'a> -> IterateeCPS<'a,'b,unit>) -> IterateeCPS<'a,'b,unit>

Full name: FSharp.Monad.Iteratee.CPS.throwRecoverable
val i : (Stream<'a> -> IterateeCPS<'a,'b,unit>)
val onCont : ((Stream<'a> -> IterateeCPS<'a,'b,unit>) -> unit)
val onError : (exn -> unit)
val doneI : x:'a -> str:Stream<'b> -> IterateeCPS<'b,'a,'c>

Full name: FSharp.Monad.Iteratee.CPS.doneI
val str : Stream<'b>
val contI : k:(Stream<'a> -> IterateeCPS<'a,'b,'c>) -> e:'d -> IterateeCPS<'a,'b,'c>

Full name: FSharp.Monad.Iteratee.CPS.contI
val k : (Stream<'a> -> IterateeCPS<'a,'b,'c>)
val e : 'd
val liftI : k:(Stream<'a> -> IterateeCPS<'a,'b,'c>) -> ('d -> IterateeCPS<'a,'b,'c>)

Full name: FSharp.Monad.Iteratee.CPS.liftI
val joinI : outer:IterateeCPS<'a,IterateeCPS<'b,'c,'d>,'d> -> IterateeCPS<'a,'c,'d>

Full name: FSharp.Monad.Iteratee.CPS.joinI
val outer : IterateeCPS<'a,IterateeCPS<'b,'c,'d>,'d>
val inner : IterateeCPS<'b,'c,'d>
val onCont : ((Stream<'a> -> IterateeCPS<'a,'c,'d>) -> 'd)
val onError : (exn -> 'd)
val onDone : ('c * Stream<'a> -> 'd)
val od : ('c * 'e -> 'd)
val x : 'c
val oc : ((Stream<'e> -> IterateeCPS<'f,'c,'d>) -> 'd)
val k : (Stream<'e> -> IterateeCPS<'f,'c,'d>)
val oc' : ((Stream<'f> -> IterateeCPS<'f,'c,'d>) -> 'd)
val k : (Stream<'f> -> IterateeCPS<'f,'c,'d>)
Multiple items
type Exception =
  new : unit -> Exception + 2 overloads
  member Data : IDictionary
  member GetBaseException : unit -> Exception
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member GetType : unit -> Type
  member HelpLink : string with get, set
  member InnerException : Exception
  member Message : string
  member Source : string with get, set
  member StackTrace : string
  ...

Full name: System.Exception

--------------------
Exception() : unit
Exception(message: string) : unit
Exception(message: string, innerException: exn) : unit
val run : i:IterateeCPS<'a,'b,Choice<Exception,'b>> -> Choice<Exception,'b>

Full name: FSharp.Monad.Iteratee.CPS.run
val i : IterateeCPS<'a,'b,Choice<Exception,'b>>
val onCont : ((Stream<'c> -> IterateeCPS<'d,'e,Choice<Exception,'e>>) -> Choice<Exception,'e>)
val k : (Stream<'c> -> IterateeCPS<'d,'e,Choice<Exception,'e>>)
val onCont' : ((Stream<'d> -> IterateeCPS<'d,'e,Choice<Exception,'e>>) -> Choice<Exception,'e>)
val onError : (exn -> Choice<Exception,'e>)
val onDone : ('e * Stream<'d> -> Choice<Exception,'e>)
val k : (Stream<'d> -> IterateeCPS<'d,'e,Choice<Exception,'e>>)
union case Choice.Choice1Of2: 'T1 -> Choice<'T1,'T2>
val x : 'e
union case Choice.Choice2Of2: 'T2 -> Choice<'T1,'T2>
val run_ : i:IterateeCPS<'a,'b,Choice<Exception,'b>> -> Choice<Exception,'b>

Full name: FSharp.Monad.Iteratee.CPS.run_
val e : Exception
val raise : exn:Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
val x : Choice<Exception,'b>

More information

Link:http://fssnip.net/79
Posted:13 years ago
Author:Ryan Riley
Tags: iteratee , enumerator , lazy , i/o , cps , continuations , sequences