palladin

open System

[<AutoOpen>]
module AsyncEx = 
    type private SuccessException<'T>(value : 'T) =
        inherit Exception()
        member self.Value = value

    type Microsoft.FSharp.Control.Async with
        // efficient raise

palladin

type TrampValue<'T> =
    | DelayValue of Delay<'T>
    | ReturnValue of Return<'T>
    | BindValue of IBind<'T>
and ITramp<'T> = 
    abstract member Value : TrampValue<'T>
    abstract member Run : unit -> 'T

and Delay<'T>(f : unit -> ITramp<'T>) =
    member self.Func = f 

palladin

// http://www.madore.org/~david/programs/unlambda/

type C = F -> unit
and F = F of ((F * C) -> unit)

let getReader (source : string) = 
    let pos = ref 0
    (fun () -> let result = source.[!pos] in pos := !pos + 1; result)

let eval (source : string) =

palladin

type HList = interface end
and HNil = HNil with
    static member inline (|*|) (f, HNil) = f $ HNil
    interface HList
and HCons<'a, 'b when 'b :> HList> = HCons of 'a * 'b with
    static member inline (|*|) (f, HCons(x, xs)) = f $ HCons(x, xs) 
    interface HList 

type Peano = interface end
and Zero = Zero with

palladin

let rec Y f x = f (Y f) x 

let rec Y2 f1 f2 =
    let f1' = Y (fun f1' -> f1 f1' (Y (fun f2' -> f2 f1' f2')))
    let f2' = Y (fun f2' -> f2 (Y (fun f1' -> f1 f1' f2')) f2')
    f1', f2'

// Example
let even, odd = 
    Y2 (fun even odd x ->

palladin

// http://homepages.cwi.nl/~ralf/syb3/

let inline gmap f g  (x : ^R) : ^R = (f ? (g) <- x) 

type Data = Data with
    static member inline ($)(f : ^F, x : ^A) = gmap Data f x

    static member inline (?<-)(Data, f, x : int) = x
    static member inline (?<-)(Data, f, x : string) = x
    static member inline (?<-)(Data, f, x : bool) = x

palladin

#r "FSharp.Powerpack.dll"

open System
open System.Xml
open Microsoft.FSharp.Collections

let wiki = "c:\enwiki-20120307-pages-articles\enwiki-20120307-pages-articles.xml"

type name = string
type attributes = (string * string) list 

palladin

open System
open FSharp.Extensions.Joinads

// Init
let n = 5
let chopsticks = [| for i = 1 to n do yield new Channel<unit>() |]
let hungry = [| for i = 1 to n do yield new Channel<unit>() |]
let philosophers = [| "Plato"; "Konfuzius"; "Socrates"; "Voltaire"; "Descartes" |]

let randomDelay (r : Random) = System.Threading.Thread.Sleep(r.Next(1, 10) * 1000)

palladin

// http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.41.125

type ListF<'a, 'b> = Empty | Cons of 'a * 'b
type List<'a> = InL of ListF<'a, List<'a>> with
    member self.Out() = let (InL x) = self in x
type PeanoF<'b> = Zero | Suc of 'b
type Peano = InP of PeanoF<Peano> with
    member self.Out() = let (InP x) = self in x

let inline out x = (^MF : (member Out : unit -> ^F) (x))

palladin

// For more info: ftp://ftp.cs.au.dk/pub/BRICS/RS/01/10/BRICS-RS-01-10.pdf

let (<*>) fs xs = Seq.map2 (fun f x -> f x) fs xs
let succ n fs xs = n (fs <*> xs)
let map n f = n (Seq.initInfinite (fun _ -> f))

// Numerals
let ``1``<'a1, 'r> : seq<('a1 -> 'r)> -> seq<'a1> -> seq<'r> = 
    succ id
let ``2``<'a1, 'a2, 'r> : seq<('a1 -> 'a2 -> 'r)> -> seq<'a1> -> seq<'a2> -> seq<'r> =