palladin

open System
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns


// Helper active patters for System.Type
let (|Arrow|_|) (t : Type) = 
    if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<_ -> _> then
        let args = t.GetGenericArguments()
        Some (args.[0], args.[1])

palladin

type Term<'a>() = class end

type Tuples = Tuples with
    static member inline (?<-) (_ : Tuples, _ : Term<_>, _ : Term<_>) = 0
    static member inline (?<-) (_ : Tuples, (_:Term<_>,_:Term<_>),(_:Term<_>, _:Term<_>)) = 2
    static member inline (?<-) (_ : Tuples, a:bool, b:bool) = 3

let inline call_2 (t:^t,a:^a,b:^a) : int = 
    (t ? (a) <- b ) 
    

palladin

type Term<'a>() = class end

type Tuples' = Tuples' with
    static member inline (?<-) (_ : Tuples', _ : (Term<_> * Term<_>), _ : (Term<_> * Term<_>)) = 2    
    static member inline (?<-) (_ : Tuples', a:Term<_>, b : Term<_>) = 4
    static member inline (?<-) (_ : Tuples', a:bool, b:bool) = 3
    static member inline (?<-) (_ : Tuples', a:string, b:string) = 1

let inline call_2 (t:^t,a:^a,b:^b) : int = 
    (t ? (a) <- b ) 

palladin

open MBrace.Core

f : Cloud<Int>
g,h : int -> Cloud<Int>
j,k : int -> int -> Cloud<int>

let spawn c = Cloud.StartAsTask c
let get t = Cloud.AwaitTask t
let (>>=) c f = cloud.Bind(c, f)

palladin

let force (value : Lazy<_>) = value.Force()

let fix : (Lazy<'T> -> 'T) -> Lazy<'T> = fun f -> 
    let rec x = lazy (f x) in x

// Maybe MonadFix
let mfix : (Lazy<'T> -> option<Lazy<'T>>) -> Lazy<option<Lazy<'T>>> = fun f -> 
    let rec x = lazy ( match force x with | Some v -> f v | None -> None ) in x

palladin

open Microsoft.FSharp.Quotations

// <@ fun x -> (% <@ x @> ) @> ~ lambda (fun x -> x)
let lambda (f : Expr<'T> -> Expr<'R>) : Expr<'T -> 'R> =
    let var = new Var("__temp__", typeof<'T>)
    Expr.Cast<_>(Expr.Lambda(var,  f (Expr.Cast<_>(Expr.Var var))))



// encoding of rank-2 polymorphism

palladin

open Microsoft.FSharp.Quotations

// <@ fun x -> (% <@ x @> ) @> ~ lambda (fun x -> x)
let lambda (f : Expr<'T> -> Expr<'R>) : Expr<'T -> 'R> =
    let var = new Var("__temp__", typeof<'T>)
    Expr.Cast<_>(Expr.Lambda(var,  f (Expr.Cast<_>(Expr.Var var))))


// fixed-point combinator
let rec fix : (('Τ -> 'R) -> ('Τ -> 'R)) -> 'Τ -> 'R = fun f x ->

palladin

let partition : CloudFlow<'T> -> ('T -> bool) -> (CloudFlow<'T> * CloudFlow<'T>) = fun flow f ->
  (flow |> CloudFlow.filter f), (flow |> CloudFlow.filter (fun x -> not (f x)))

palladin

type Bool = interface end
and True = True with
    static member inline (|*|) (f, True) = (BoolFold ? (f) <- True)
    interface Bool
and False = False with
    static member inline (|*|) (f, False) = (BoolFold ? (f) <- False)
    interface Bool
and And<'a, 'b when 'a :> Bool and 'b :> Bool> = And of 'a * 'b  with
    static member inline (|*|) (f, x) = (BoolFold ? (f) <- x)
    interface Bool

palladin

// http://lambda-the-ultimate.org/node/4039#comment-61431

open Microsoft.FSharp.Quotations

// <@ fun x -> (% <@ x @> ) @> ~ lambda (fun x -> x)
let lambda (f : Expr<'T> -> Expr<'R>) : Expr<'T -> 'R> =
    let var = new Var("__temp__", typeof<'T>)
    Expr.Cast<_>(Expr.Lambda(var,  f (Expr.Cast<_>(Expr.Var var))))

// Staged fixed-point combinator