// Code from Hansen and Rischel: Functional Programming using F#     16/12 2012
// Chapter 12: Computation Expressions. Just from the sections 12.10

// From the Sections 12.2 - 12.9 
// =============================

// From Section 12.2: Introducing computation expressions using sequence expressions

let pairRecipe = seq {for i in seq [1 .. 3] do
                         for ch in seq ['a' .. 'd'] do
                            yield (i,ch) };;


let f i = seq {for ch in seq ['a' .. 'd'] do
                  yield (i,ch) };;

// From Section 12.3: The basic functions: For and Yield

type mySeq<'a> = seq<'a>;;

type MySeqClass() =
    member bld.Yield a: mySeq<'a> = Seq.singleton a
    member bld.For(sqs:mySeq<'a>, f:'a -> mySeq<'b>):mySeq<'b>
               =  Seq.collect f sqs;;

let mySeq = MySeqClass();;


let cartesian sqx sqy = mySeq {for x in sqx do
                                   for y in sqy do
                                      yield (x,y) };;

let cartesian1 sqx sqy =
   mySeq.For(sqx,
             fun x -> mySeq.For(sqy,
                                fun y -> mySeq.Yield (x,y)));;

// From Section 12.5: Example: Expression evaluation with error handling

type Expr = | Num of int | Var of string
            | Add of Expr*Expr | Div of Expr*Expr;;

let I e env =
    let rec eval = function
        | Num i      -> Some i
        | Var x      -> Map.tryFind x env
        | Add(e1,e2) -> match (eval e1, eval e2) with
                        | (Some v1, Some v2) -> Some(v1+v2)
                        | _                  -> None
        | Div(e1,e2) -> match (eval e1, eval e2) with
                        | (_ , Some 0)       -> None
                        | (Some v1, Some v2) -> Some(v1/v2)
                        | _                  -> None
    eval e;;

let e1 = Add(Div(Num 1, Num 0), Num 2);;
let e2 = Add(Add(Var "x", Var "y"), Num 2);;

let env = Map.ofList [("x",1);("y",2)];;

let v1 = I e1 env;;

let v2 = I e2 env;;


// From Section 12.6: The basic functions: Bind, Return, ReturnFrom and Zero
// The Maybe builder class: version 1 

type maybe1<'a> = option<'a>;;

type MaybeClass1() =
    member bld.Bind(m:maybe1<'a>, f:'a->maybe1<'b>):maybe1<'b> =
        match m with | None   -> None
                     | Some a -> f a
    member bld.Return a:maybe1<'a> = Some a
    member bld.ReturnFrom m:maybe1<'a> = m
    member bld.Zero():maybe1<'a> = None;;

let maybe1 = MaybeClass1();;

let I1 e env =
    let rec eval = function
        | Num i      -> maybe1 {return i}
        | Var x      -> maybe1 {return! Map.tryFind x env}
        | Add(e1,e2) -> maybe1 {let! v1 = eval e1
                                let! v2 = eval e2
                                return v1+v2}
        | Div(e1,e2) -> maybe1 {let! v2 = eval e2
                                if v2<>0 then
                                   let! v1 = eval e1
                                   return v1/v2}
    eval e;;

let v11 = I1 e1 env;;

let v21 = I1 e2 env;;


// From Section 12.7: Controlling the computations: Delay and Start
// The Maybe builder class: version 2

type maybe2<'a> = unit -> option<'a>;;

let delay v = fun () -> v;;

let start m = m();;

type MaybeClass2() =
    member bld.Bind(m:maybe2<'a>, f:'a->maybe2<'b>):maybe2<'b> =
              match start m with
                  | None   -> delay None
                  | Some a -> f a
    member bld.Return a:maybe2<'a> = delay(Some a)
    member bld.ReturnFrom v:maybe2<'a> = delay v
    member bld.Zero():maybe2<'a> = delay None;;

let maybe2 = MaybeClass2();;

let I2 e env =
    let rec eval = function
        | Num i      -> maybe2 {return i}
        | Var x      -> maybe2 {return! Map.tryFind x env}
        | Add(e1,e2) -> maybe2 {let! v1 = eval e1
                                let! v2 = eval e2
                                return (printfn "v1: %i v2: %i" v1 v2 ; v1+v2)}
//        | Add(e1,e2) -> maybe2 {let! v1 = eval e1
//                                let! v2 = eval e2
//                                return v1+v2}
        | Div(e1,e2) -> maybe2 {let! v2 = eval e2
                                if v2<>0 then
                                   let! v1 = eval e1
                                   return v1/v2}
    eval e;;

let v12 = I2 e1 env;;

let v22 = I2 e2 env;;


// From Section 12.8: The basic function: Delay
// The Maybe builder class: version 2

type maybe3<'a> = unit -> option<'a>;;


type MaybeClass3() =
    member bld.Bind(m:maybe3<'a>, f:'a->maybe3<'b>):maybe3<'b> =
              match start m with
                  | None   -> delay None
                  | Some a -> f a
    member bld.Return a:maybe3<'a> = delay(Some a)
    member bld.ReturnFrom v:maybe3<'a> = delay v
    member bld.Zero():maybe3<'a> = delay None
    member bld.Delay f:maybe3<'a> = fun () -> start (f());;

let maybe3 = MaybeClass3();;

let I3 e env =
    let rec eval = function
        | Num i      -> maybe3 {return i}
        | Var x      -> maybe3 {return! Map.tryFind x env}
        | Add(e1,e2) -> maybe3 {let! v1 = eval e1
                                let! v2 = eval e2
                                return (printfn "v1: %i v2: %i" v1 v2 ; v1+v2)}
//        | Add(e1,e2) -> maybe3 {let! v1 = eval e1
//                                let! v2 = eval e2
//                                return v1+v2}
        | Div(e1,e2) -> maybe3 {let! v2 = eval e2
                                if v2<>0 then
                                   let! v1 = eval e1
                                   return v1/v2}
    eval e;;


let v23 = I3 e2 env;;

start v23;;