3 people like it.

Effects and Handlers

Algebraic effects and handlers is a new modular approach for handling effectful computations in functional languages. Inspired from the paper "Handlers in action"

  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: 
106: 
107: 
// http://homepages.inf.ed.ac.uk/slindley/papers/handlers-draft-march2013.pdf
// Quote from the paper
// Effect handler operation clauses generalise exception handler clauses
// by adding a continuation argument, providing support for arbitrary effects. An operation 
// clause is an exception clause if it ignores its continuation argument.

type Cont<'T, 'R> = Cont of ((('T -> 'R) * (exn -> 'R)) -> 'R)

type ContBuilder() = 
    member self.Return x = Cont (fun (k, _) -> k x)
    member self.ReturnFrom c = c
    member self.Bind (c : Cont<_, _>, f : _ -> Cont<_, _>) =
        Cont (fun (k, exk) -> let (Cont contf) = c in contf ((fun v -> let (Cont contf') = f v in contf' (k, exk)), exk))
    member self.TryWith (c : Cont<_, _>, f : exn -> Cont<_, _>) =
        Cont (fun (k, exk) -> 
                let (Cont contf) = c
                contf (k, (fun ex -> 
                    match (try Choice1Of2 (f ex) with ex -> Choice2Of2 ex) with
                    | Choice1Of2 (Cont contf') -> contf' (k, exk)
                    | Choice2Of2 ex -> exk ex)))
     member self.Delay (f : unit -> Cont<'T, 'R>) : Cont<'T, 'R> = 
        Cont (fun (k, exk) -> let (Cont contf) = f () in contf (k, exk))

let eff = new ContBuilder()

let run id (c : Cont<_, _>) = let (Cont contf) = c in contf (id, fun ex -> raise ex)

let shift f  = Cont (fun (k, exk) -> f k) 

// Basic state operations
type Put<'S, 'Ans>(v : 'S, k : unit -> 'Ans) =
    inherit System.Exception()
    member self.Value = v
    member self.K = k

type Get<'S, 'Ans>(k : 'S -> 'Ans) =
    inherit System.Exception()
    member self.K = k

let put (v : int) : Cont<unit, 'Ans> =
    Cont (fun (k, exk) ->  exk <| new Put<int,'Ans>(v, k))

let get () : Cont<int, 'Ans> = 
    Cont (fun (k, exk) ->  exk <| new Get<int,'Ans>(k))

// different ways of handling state
let pureState<'T, 'Ans> (c : Cont<'T, int -> 'Ans>) : Cont<'T, int -> 'Ans> = 
    eff {
        try
            return! c
        with 
            | :? Get<int, int -> 'Ans> as get -> return! Cont (fun _ s -> get.K s s)
            | :? Put<int, int -> 'Ans> as put -> return! Cont (fun _ _ -> put.K () put.Value)
    }
    
let refState<'T, 'Ans> (c : Cont<'T, 'Ans>) : Cont<'T, 'Ans> = 
    eff {
        let stateRef = ref 1
        try
            return! c
        with 
            | :? Get<int, 'Ans> as get -> return! Cont (fun _ -> get.K !stateRef)
            | :? Put<int, 'Ans> as put -> return! Cont (fun _ -> stateRef := put.Value; put.K () )
    }
    
let collectStates<'T, 'Ans> (c : Cont<'T, int -> ('T * int list)>) : Cont<'T, int -> ('T * int list)> = 
    eff {
        try
            return! c
        with 
            | :? Get<int, int -> ('T * int list)> as get -> 
                return! Cont (fun _ -> (fun s -> get.K s s))
            | :? Put<int, int -> ('T * int list)> as put -> 
                return! Cont (fun _ -> (fun _ ->
                                                let x = put.Value 
                                                let (v, xs) = put.K () x
                                                (v, x :: xs)))
    }

let logState<'T, 'Ans> (c : Cont<'T, 'Ans>) : Cont<'T, 'Ans> = 
    eff {
        try
            return! c
        with 
            | :? Put<int, 'Ans> as p -> 
                do printfn "%d" p.Value
                do! put (p.Value) // forward
                return! Cont (fun _ -> p.K ())
    }
 

// example
let test () = 
    eff {
        let! x = get ()
        do! put (x + 1)
        let! y = get ()
        do! put (y + y)
        return! get ()
    } 

    
test () |> logState |> pureState |> run (fun x -> (fun s -> (x, s))) |> (fun f -> f 1) // (4, 4)

test () |> logState |> refState |> run id // 4

test () |> logState |> collectStates |> run (fun x -> (fun s -> (x, []))) |> (fun f -> f 1) // (4, [2; 4])
Multiple items
union case Cont.Cont: (('T -> 'R) * (exn -> 'R) -> 'R) -> Cont<'T,'R>

--------------------
type Cont<'T,'R> = | Cont of (('T -> 'R) * (exn -> 'R) -> 'R)

Full name: Script.Cont<_,_>
type exn = System.Exception

Full name: Microsoft.FSharp.Core.exn
Multiple items
type ContBuilder =
  new : unit -> ContBuilder
  member Bind : c:Cont<'c,'d> * f:('c -> Cont<'e,'d>) -> Cont<'e,'d>
  member Delay : f:(unit -> Cont<'T,'R>) -> Cont<'T,'R>
  member Return : x:'g -> Cont<'g,'h>
  member ReturnFrom : c:'f -> 'f
  member TryWith : c:Cont<'a,'b> * f:(exn -> Cont<'a,'b>) -> Cont<'a,'b>

Full name: Script.ContBuilder

--------------------
new : unit -> ContBuilder
val self : ContBuilder
member ContBuilder.Return : x:'g -> Cont<'g,'h>

Full name: Script.ContBuilder.Return
val x : 'g
val k : ('g -> 'h)
member ContBuilder.ReturnFrom : c:'f -> 'f

Full name: Script.ContBuilder.ReturnFrom
val c : 'f
member ContBuilder.Bind : c:Cont<'c,'d> * f:('c -> Cont<'e,'d>) -> Cont<'e,'d>

Full name: Script.ContBuilder.Bind
val c : Cont<'c,'d>
val f : ('c -> Cont<'e,'d>)
val k : ('e -> 'd)
val exk : (exn -> 'd)
val contf : (('c -> 'd) * (exn -> 'd) -> 'd)
val v : 'c
val contf' : (('e -> 'd) * (exn -> 'd) -> 'd)
member ContBuilder.TryWith : c:Cont<'a,'b> * f:(exn -> Cont<'a,'b>) -> Cont<'a,'b>

Full name: Script.ContBuilder.TryWith
val c : Cont<'a,'b>
val f : (exn -> Cont<'a,'b>)
val k : ('a -> 'b)
val exk : (exn -> 'b)
val contf : (('a -> 'b) * (exn -> 'b) -> 'b)
val ex : exn
union case Choice.Choice1Of2: 'T1 -> Choice<'T1,'T2>
union case Choice.Choice2Of2: 'T2 -> Choice<'T1,'T2>
val contf' : (('a -> 'b) * (exn -> 'b) -> 'b)
member ContBuilder.Delay : f:(unit -> Cont<'T,'R>) -> Cont<'T,'R>

Full name: Script.ContBuilder.Delay
val f : (unit -> Cont<'T,'R>)
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
val k : ('T -> 'R)
val exk : (exn -> 'R)
val contf : (('T -> 'R) * (exn -> 'R) -> 'R)
val eff : ContBuilder

Full name: Script.eff
val run : id:('a -> 'b) -> c:Cont<'a,'b> -> 'b

Full name: Script.run
val id : ('a -> 'b)
val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
val shift : f:(('a -> 'b) -> 'b) -> Cont<'a,'b>

Full name: Script.shift
val f : (('a -> 'b) -> 'b)
Multiple items
type Put<'S,'Ans> =
  inherit Exception
  new : v:'S * k:(unit -> 'Ans) -> Put<'S,'Ans>
  member K : (unit -> 'Ans)
  member Value : 'S

Full name: Script.Put<_,_>

--------------------
new : v:'S * k:(unit -> 'Ans) -> Put<'S,'Ans>
val v : 'S
val k : (unit -> 'Ans)
namespace System
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

--------------------
System.Exception() : unit
System.Exception(message: string) : unit
System.Exception(message: string, innerException: exn) : unit
System.Exception(info: System.Runtime.Serialization.SerializationInfo, context: System.Runtime.Serialization.StreamingContext) : unit
val self : Put<'S,'Ans>
member Put.Value : 'S

Full name: Script.Put`2.Value
member Put.K : (unit -> 'Ans)

Full name: Script.Put`2.K
Multiple items
type Get<'S,'Ans> =
  inherit Exception
  new : k:('S -> 'Ans) -> Get<'S,'Ans>
  member K : ('S -> 'Ans)

Full name: Script.Get<_,_>

--------------------
new : k:('S -> 'Ans) -> Get<'S,'Ans>
val k : ('S -> 'Ans)
val self : Get<'S,'Ans>
member Get.K : ('S -> 'Ans)

Full name: Script.Get`2.K
val put : v:int -> Cont<unit,'Ans>

Full name: Script.put
val v : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val exk : (exn -> 'Ans)
val get : unit -> Cont<int,'Ans>

Full name: Script.get
val k : (int -> 'Ans)
val pureState : c:Cont<'T,(int -> 'Ans)> -> Cont<'T,(int -> 'Ans)>

Full name: Script.pureState
val c : Cont<'T,(int -> 'Ans)>
val get : Get<int,(int -> 'Ans)>
val s : int
property Get.K: int -> int -> 'Ans
val put : Put<int,(int -> 'Ans)>
property Put.K: unit -> int -> 'Ans
property Put.Value: int
val refState : c:Cont<'T,'Ans> -> Cont<'T,'Ans>

Full name: Script.refState
val c : Cont<'T,'Ans>
val stateRef : int 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 get : Get<int,'Ans>
property Get.K: int -> 'Ans
val put : Put<int,'Ans>
property Put.K: unit -> 'Ans
val collectStates<'T,'Ans> : c:Cont<'T,(int -> 'T * int list)> -> Cont<'T,(int -> 'T * int list)>

Full name: Script.collectStates
val c : Cont<'T,(int -> 'T * int list)>
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val get : Get<int,(int -> 'T * int list)>
property Get.K: int -> int -> 'T * int list
val put : Put<int,(int -> 'T * int list)>
val x : int
val v : 'T
val xs : int list
property Put.K: unit -> int -> 'T * int list
val logState : c:Cont<'T,'Ans> -> Cont<'T,'Ans>

Full name: Script.logState
val p : Put<int,'Ans>
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val test : unit -> Cont<int,'a>

Full name: Script.test
val y : int
val f : (int -> int * int)
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val f : (int -> int * int list)
Raw view New version

More information

Link:http://fssnip.net/jl
Posted:4 years ago
Author:Nick Palladinos
Tags: effects , handlers , delimited continuations