f#monadscomputation-expression
F# too many calls to nested Computation Expression
This questions is an evolution of this question. I am trying to find out why when I run State.exec on the CE that I appear to be getting undesired nesting behavior of the CEs. It seems to be calling them many times. Here is what I have:
type State<'a, 's> = ('s -> 'a * 's)
module State =
// Explicit
// let result x : State<'a, 's> = fun s -> x, s
// Less explicit but works better with other, existing functions:
let result x s =
x, s
let bind (f:'a -> State<'b, 's>) (m:State<'a, 's>) : State<'b, 's> =
// return a function that takes the state
fun s ->
// Get the value and next state from the m parameter
let a, s' = m s
// Get the next state computation by passing a to the f parameter
let m' = f a
// Apply the next state to the next computation
m' s'
/// Evaluates the computation, returning the result value.
let eval (m:State<'a, 's>) (s:'s) =
m s
|> fst
/// Executes the computation, returning the final state.
let exec (m:State<'a, 's>) (s:'s) =
m s
|> snd
/// Returns the state as the value.
let getState (s:'s) =
s, s
/// Ignores the state passed in favor of the provided state value.
let setState (s:'s) =
fun _ ->
(), s
type StateBuilder() =
member __.Return(value) : State<'a, 's> =
State.result value
member __.Bind(m:State<'a, 's>, f:'a -> State<'b, 's>) : State<'b, 's> =
State.bind f m
member __.ReturnFrom(m:State<'a, 's>) =
m
member __.Zero() =
State.result ()
member __.Delay(f) =
State.bind f (State.result ())
let rng = System.Random(123)
type StepId = StepId of int
type Food =
| Chicken
| Rice
type Step =
| GetFood of StepId * Food
| Eat of StepId * Food
| Sleep of StepId * duration:int
type PlanAcc = PlanAcc of lastStepId:StepId * steps:Step list
let state = StateBuilder()
let getFood =
state {
printfn "GetFood"
let randomFood =
if rng.NextDouble() > 0.5 then Food.Chicken
else Food.Rice
let! (PlanAcc (StepId lastStepId, steps)) = State.getState
let nextStepId = StepId (lastStepId + 1)
let newStep = GetFood (nextStepId, randomFood)
let newAcc = PlanAcc (nextStepId, newStep::steps)
do! State.setState newAcc
return randomFood
}
type StateBuilder with
[<CustomOperation("sleep", MaintainsVariableSpaceUsingBind=true)>]
member this.Sleep (st:State<_,PlanAcc>, [<ProjectionParameter>] (duration: 'a -> int)) =
printfn $"Sleep"
let program d =
state {
let! x = st
printfn "Sleep: %A" duration
let! (PlanAcc (StepId lastStepId, steps)) = State.getState
let nextStepId = StepId (lastStepId + 1)
let newStep = Sleep (nextStepId, d)
let newAcc = PlanAcc (nextStepId, newStep::steps)
do! State.setState newAcc
return x
}
State.bind (fun x -> program (duration x)) st
[<CustomOperation("eat", MaintainsVariableSpaceUsingBind=true)>]
member this.Eat (st:State<_,PlanAcc>, [<ProjectionParameter>] (food: 'a -> Food)) =
printfn $"Eat"
let program e =
state {
let! x = st
printfn "Eat: %A" food
let! (PlanAcc (StepId lastStepId, steps)) = State.getState
let nextStepId = StepId (lastStepId + 1)
let newStep = Eat (nextStepId, e)
let newAcc = PlanAcc (nextStepId, newStep::steps)
do! State.setState newAcc
return x
}
State.bind (fun x -> program (food x)) st
let simplePlan =
state {
let! f1 = getFood
sleep 1
eat f1
sleep 2
eat f1
sleep 3
}
let initalAcc = PlanAcc(StepId 0, [])
let x = State.exec simplePlan initalAcc
Here is what I expect to get for x:
> x;;
val it : PlanAcc =
PlanAcc
(StepId 6,
[Sleep (StepId 6, 3); GetFood (StepId 5, Chicken);
Sleep (StepId 4, Chicken); EatFood (StepId 3, Chicken);
Sleep (StepId 2, 1); GetFood (StepId 1, Chicken)])
Here is what I get:
> x;;
val it : PlanAcc =
PlanAcc
(StepId 63,
[Sleep (StepId 63, 3); Eat (StepId 62, Rice); Sleep (StepId 61, 2);
Eat (StepId 60, Rice); Sleep (StepId 59, 1);
GetFood (StepId 58, Chicken); GetFood (StepId 57, Chicken);
Sleep (StepId 56, 1); GetFood (StepId 55, Rice);
GetFood (StepId 54, Chicken); Eat (StepId 53, Chicken);
Sleep (StepId 52, 1); GetFood (StepId 51, Chicken);
GetFood (StepId 50, Chicken); Sleep (StepId 49, 1);
GetFood (StepId 48, Chicken); GetFood (StepId 47, Chicken);
Sleep (StepId 46, 2); Eat (StepId 45, Rice); Sleep (StepId 44, 1);
GetFood (StepId 43, Rice); GetFood (StepId 42, Chicken);
Sleep (StepId 41, 1); GetFood (StepId 40, Rice);
GetFood (StepId 39, Rice); Eat (StepId 38, Rice); Sleep (StepId 37, 1);
GetFood (StepId 36, Chicken); GetFood (StepId 35, Rice);
Sleep (StepId 34, 1); GetFood (StepId 33, Rice);
GetFood (StepId 32, Chicken); Eat (StepId 31, Rice);
Sleep (StepId 30, 2); Eat (StepId 29, Rice); Sleep (StepId 28, 1);
GetFood (StepId 27, Chicken); GetFood (StepId 26, Rice);
Sleep (StepId 25, 1); GetFood (StepId 24, Rice);
GetFood (StepId 23, Rice); Eat (StepId 22, Chicken);
Sleep (StepId 21, 1); GetFood (StepId 20, Rice);
GetFood (StepId 19, Chicken); Sleep (StepId 18, 1);
GetFood (StepId 17, Chicken); GetFood (StepId 16, Rice);
Sleep (StepId 15, 2); Eat (StepId 14, Rice); Sleep (StepId 13, 1);
GetFood (StepId 12, Rice); GetFood (StepId 11, Rice);
Sleep (StepId 10, 1); GetFood (StepId 9, Rice);
GetFood (StepId 8, Chicken); Eat (StepId 7, Chicken);
Sleep (StepId 6, 1); GetFood (StepId 5, Chicken);
GetFood (StepId 4, Chicken); Sleep (StepId 3, 1);
GetFood (StepId 2, Chicken); GetFood (StepId 1, Chicken)])
I'm fairly certain it has to do with how the State is being bound in the program CEs since I don't have a problem if I just call let! f = getFood a bunch of times.
I tried removing the let! x = st and return x calls in the program CEs thinking that was what was causing the issue, but the compiler complained in the simplePlan CE saying, "The expression was expected to have type 'Food' but here has type 'unit'".
Image of error:
Solution
Yes, you're right: it does have to do with binding the incoming computation at let! x = st.
But you're also right that you can't just remove that binding, because you need to tunnel through its return value, as I described in the previous answer.
But this let! x = st is not a problem by itself.
The problem is that you're binding st twice:
[<CustomOperation("eat", MaintainsVariableSpaceUsingBind=true)>]
member this.Eat (st:State<_,PlanAcc>, [<ProjectionParameter>] (food: 'a -> Food)) =
printfn $"Eat"
let program e =
state {
let! x = st <-- here's the first time
printfn "Eat: %A" food
let! (PlanAcc (StepId lastStepId, steps)) = State.getState
let nextStepId = StepId (lastStepId + 1)
let newStep = Eat (nextStepId, e)
let newAcc = PlanAcc (nextStepId, newStep::steps)
do! State.setState newAcc
return x
}
State.bind (fun x -> program (food x)) st
^^
here's the second time
It's absolutely no wonder the resulting values double: you're doing double the computation at every step!
You need to remove one of them, but it's not the one in let! x = st, because you do need that x so that you can return x at the end.
[<CustomOperation("eat", MaintainsVariableSpaceUsingBind=true)>]
member this.Eat (st:State<_,PlanAcc>, [<ProjectionParameter>] (food: 'a -> Food)) =
printfn $"Eat"
state {
let! x = st
let f = food x
printfn "Eat: %A" f
let! (PlanAcc (StepId lastStepId, steps)) = State.getState
let nextStepId = StepId (lastStepId + 1)
let newStep = Eat (nextStepId, f)
let newAcc = PlanAcc (nextStepId, newStep::steps)
do! State.setState newAcc
return x
}