// 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;;