Composing Contracts Part 2: Signatures

module Contracts

open System

open ContractDataTypes

val date: String -> Date

val one : Currency -> Contract

val scale : IObservable<double> -> Contract -> Contract

val konst : 'a -> IObservable<'a>

val (==*) : IObservable<'a> -> IObservable<'a> -> IObservable<bool> when 'a : equality

val obsTime : IObservable<Date>

val at: Date -> IObservable<bool>

val cWhen: IObservable<bool> -> Contract -> Contract

// zero-coupon bond

val zcb : Date -> Double -> Currency -> Contract

val eval: Contract -> IObservable<Money>

Composing Contracts Part 1: Data Types

module ContractDataTypes

open System

open System.Linq

type Date = Date of DateTime

type Days = Days of TimeSpan

type Currency = GBP | USD

type Money = Money of float * Currency

    with static member (*) (k, Money (v, c)) = Money (k * v, c)

type Contract = | One of Currency

                | Scale of (IObservable<double> * Contract)

                | When of (IObservable<bool> * Contract)

type RxBuilder() =

    member this.Bind(m:IObservable<'a>, f:'a -> IObservable<'b>) =

        Observable.SelectMany(m, new Func<'a, IObservable<'b>> (f))

    member this.Return x = Observable.Return x

    member this.ReturnFrom x = x

    member this.Zero() = Observable.Empty()

let rx = RxBuilder()

Monad State Transformer

This is an attempt to write a State Monad Transformer.
I haven't been able to make it generic and according to
Brian McNamara "this will never be possible in any .NET language"


 http://cs.hubfs.net/forums/thread/13974.aspx

type StateT<'a, 'b, 'state> = StateT of ('state -> Parser<'a * 'state, 'b>)

type StateTBuilder (p:ParserMonad) =

    // a -> m a

    member this.Return a = StateT (fun s -> p.Return(a, s))

    //  m a -> (a -> m b) -> m b

    member this.Bind (m, f) =  StateT (fun s -> p {  let! (v, s') = let (StateT f) = m in f s

                                                     let (StateT f') = f v

                                                     return! f' s' })

let statefulParser = StateTBuilder(parser)

let getState = StateT (fun s -> parser.Return(s, s))

let setState s = StateT (fun _ -> parser.Return((), s))

let lift c = StateT (fun s -> parser.Bind (c, (fun x -> parser.Return (x, s))))

let Execute m s = let (StateT f) = m in

                  parser { let! (x,_) = f s

                           return x  }

SplitAt (Alternate definition)

let rec splitAt n xs = match (n, xs) with

                       | 0, xs -> ([], xs)

                       | _, [] -> ([], [])

                       | n, x::xs -> let (xs', xs'') = splitAt (n - 1) xs in

                                     (x::xs', xs'')

C# SplitEvery

private static IEnumerable<IEnumerable<T>> SplitEvery<T>(this IEnumerable<T> xs, int n)

{

    return xs.Unfold(ys => ys.Take(n), ys => ys.Any(), ys => ys.Skip(n));

}

private static IEnumerable<T> Unfold<T>(this T x, Func<T, T> h, Func<T, bool> p, Func<T, T> t)

{

    for (var i = x; p(i); i = t(i))

        yield return h(i);

}

SplitEvery (New version, no explicit recursion)

open System.Linq

let repeat x = Seq.initInfinite (fun _ -> x)

let scan = Seq.scan

let iterate f x = scan (fun l _ -> f l) x (repeat x)

let any = Enumerable.Any

let take n = fun xs -> Enumerable.Take (xs, n)

let skip n = fun xs -> Enumerable.Skip (xs, n)

let unfold h p t =  iterate t >> Seq.takeWhile p >> Seq.map h 

let splitAt n = unfold (take n) any (skip n)

C# Permutations (using Rx System.Interactive)

public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> xs)

{

    if (!xs.Any())

        return EnumerableEx.Return(Enumerable.Empty<T>());

    else

        return from zs in Permutations(xs.Skip(1))

               from i in Enumerable.Range(0, zs.Count() + 1)

               select zs.Take(i).Concat(EnumerableEx.Return(xs.First())).Concat(zs.Skip(i));                  

}

Permutations

let length = Seq.length

let take = Seq.take

let skip = Seq.skip

let (++) = Seq.append

let concat = Seq.concat

let map = Seq.map

let (|Empty|Cons|) (xs:seq<'a>) : Choice<Unit, 'a * seq<'a>> =

    if (Seq.isEmpty xs) then Empty else Cons(Seq.head xs, Seq.skip 1 xs)

let interleave x ys =

    seq { for i in [0..length ys] ->

            (take i ys) ++ seq [x] ++ (skip i ys) }

let rec permutations xs =

            match xs with

            | Empty -> seq [seq []]

            | Cons(x,xs) -> concat(map (interleave x) (permutations xs))

Generic Monadic Map and Join using statically resolved type variables

let inline mapM b f m =       

    let unit x    = (^x: (member Return: ^b -> ^n) b, x)  

    let (>>=) m f = (^x: (member Bind: ^m -> (^a -> ^n) -> ^n) b, m, f)

    m >>= (fun x -> unit (f x))

let inline joinM b m =          

    let (>>=) m f = (^x: (member Bind: ^m -> (^n -> ^n) -> ^n) b, m, f)

    m >>= id

SplitEvery (chunk)

open System

open System.Collections.Generic

open System.Linq

//splitEvery :: Int -> [a] -> [[a]]

let splitAt n (xs:IEnumerable<'a>) = (xs.Take n, xs.Skip n)

let rec splitEvery n xs =

    let (ks, vs) = splitAt n xs in

    seq { yield ks

          yield! splitEvery n vs }