/// m07b safeio (optional): a stack-safe IO. Same idea as m07's IO, plus one more case, so that `bind` only builds
/// data and no program shape can overflow the stack, however deeply its `bind`s are nested.
///   - `Pure a`            done, with a value
///   - `Effect (op, k)`    perform `op`, then continue with `k result`
///   - `FlatMap (io, f)`   run `io`, then continue with `f result`
/// The ops, their answers and the result of `trace` are m07's `IO.Op`, `IO.OpResult` and `IO.Traced`.
/// (Not `open Snake.IO`: its cases are also called Pure and Effect.)
module Snake.SafeIO

/// `FlatMap`'s inner program produces some type `X` that only its continuation knows. A union case cannot have a
/// type parameter of its own, so `X` is erased to `obj`; only `bind` builds a `FlatMap`, and it keeps the two in step.
type SafeIO<'a> =
    | Pure of 'a
    | Effect of IO.Op * (IO.OpResult -> SafeIO<'a>)
    | FlatMap of SafeIO<obj> * (obj -> SafeIO<'a>)

// Given: the same program, seen as a SafeIO<obj>. Constant work: continuations are wrapped, not called.
let rec private erase (io: SafeIO<'a>) : SafeIO<obj> =
    match io with
    | Pure a -> Pure(box a)
    | Effect(op, k) -> Effect(op, fun r -> erase (k r))
    | FlatMap(m, g) -> FlatMap(m, fun x -> erase (g x))

let pure (a: 'a) : SafeIO<'a> = Pure a

let effect (op: IO.Op) : SafeIO<IO.OpResult> = Effect(op, pure)

// Only builds a node: never calls f, not even when io is Pure. The unbox cannot fail: x is the result of `io`.
let bind (f: 'a -> SafeIO<'b>) (io: SafeIO<'a>) : SafeIO<'b> = FlatMap(erase io, fun x -> f (unbox<'a> x))

let map (f: 'a -> 'b) (io: SafeIO<'a>) : SafeIO<'b> = io |> bind (fun a -> Pure(f a))

// A left fold on purpose: with SafeIO the nesting no longer matters.
let sequence (ios: SafeIO<unit> list) : SafeIO<unit> = List.fold (fun acc io -> acc |> bind (fun () -> io)) (pure ()) ios

// One rewrite towards a program whose top is a Pure or an Effect. Constant work, no recursion.
//   FlatMap(Pure a, f)          -> f a
//   FlatMap(Effect(op, k), f)   -> Effect(op, fun r -> FlatMap(k r, f))
//   FlatMap(FlatMap(m, g), f)   -> FlatMap(m, fun x -> FlatMap(g x, f))     (re-association)
// Pure and Effect are already in that shape and come back unchanged.
let step (io: SafeIO<'a>) : SafeIO<'a> =
    match io with
    | FlatMap(Pure x, f) -> f x
    | FlatMap(Effect(op, k), f) -> Effect(op, fun r -> FlatMap(k r, f))
    | FlatMap(FlatMap(m, g), f) -> FlatMap(m, fun x -> FlatMap(g x, f))
    | other -> other

// Given: the canned answer of the pure interpreter, as in m07. SafeIO keeps Module 7's two operations; the stored
// best score of Module 10 is not part of it, so its operations are refused loudly rather than given a meaning here.
let private answer (seed: uint32) (op: IO.Op) : IO.OpResult =
    match op with
    | IO.RandomSeed -> IO.Seed seed
    | IO.Draw _ -> IO.Done
    | IO.LoadBest
    | IO.SaveBest _ -> failwith "SafeIO.trace answers only Module 7's operations (Draw and RandomSeed)"

// `loop` calls itself only in tail position, so the compiler turns it into a loop: the stack stays flat.
let trace (seed: uint32) (io: SafeIO<'a>) : IO.Traced<'a> =
    let rec loop (current: SafeIO<'a>) (performed: IO.Op list) : IO.Traced<'a> =
        match current with
        | Pure a -> { IO.Result = a; IO.Ops = List.rev performed }
        | Effect(op, k) -> loop (k (answer seed op)) (op :: performed)
        | FlatMap _ -> loop (step current) performed

    loop io []