// m07b safeio: a stack-safe IO. Same idea as m07's IO, plus one more constructor, so that `flatMap` only builds
// data and no program shape can overflow the stack, however deeply its `flatMap`s are nested.
// {tag:'Pure', value} - done, with a value
// {tag:'Effect', op, k} - perform `op`, then continue with `k(answer)`
// {tag:'FlatMap', io, f} - run `io`, then continue with `f(result)`
// Ops are the same plain data as in m07: {tag:'Draw', shape} (answer undefined), {tag:'RandomSeed'} (answer a number);
// the pure interpreter throws for any other op.
/** @import { Op, SafeIO, Trace } from './types' */
/** @type {(value: A) => SafeIO} */
export const pure = (value) => ({ tag: 'Pure', value })
/** @type {(op: Op) => SafeIO} */
export const effect = (op) => ({ tag: 'Effect', op, k: pure })
// Only builds a node: never calls f, not even when io is Pure.
/** @type {(io: SafeIO, f: (a: A) => SafeIO) => SafeIO} */
export const flatMap = (io, f) => ({ tag: 'FlatMap', io, f })
/** @type {(io: SafeIO, f: (a: A) => B) => SafeIO} */
export const map = (io, f) => flatMap(io, (a) => pure(f(a)))
// A left fold on purpose: with SafeIO the nesting no longer matters.
/** @type {(ios: SafeIO[]) => SafeIO} */
export const sequence = (ios) => ios.reduce((acc, io) => flatMap(acc, () => io), pure(undefined))
// 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, r => FlatMap(k(r), f))
// FlatMap(FlatMap(m, g), f) -> FlatMap(m, x => FlatMap(g(x), f)) (re-association)
// Pure and Effect are already in that shape and come back unchanged.
/** @type {(io: SafeIO) => SafeIO} */
export const step = (io) => {
if (io.tag !== 'FlatMap') return io
const { io: inner, f } = io
if (inner.tag === 'Pure') return f(inner.value)
if (inner.tag === 'Effect') return { tag: 'Effect', op: inner.op, k: (r) => flatMap(inner.k(r), f) }
return flatMap(inner.io, (x) => flatMap(inner.f(x), f))
}
// Given (not an exercise): a trampoline driver without loops or mutation.
// `next(s)` returns `[s2, outs]`. Applies `next` until `isDone(s)`, returns `[last, allOuts]` (outs in order).
// Running `n` moves is running `n/2` moves and then `n/2` more, so the recursion is only log2(n) deep; when the
// budget runs out before the end, the driver doubles it and goes on. The outputs are kept in a balanced tree
// and flattened once at the end, so no array is copied once per move.
const leaf = (items) => ({ tag: 'Leaf', items })
const node = (l, r) => ({ tag: 'Node', l, r })
const toArray = (t) => (t.tag === 'Leaf' ? t.items : toArray(t.l).concat(toArray(t.r)))
const runFor = (s, n, isDone, next) => {
if (isDone(s)) return { state: s, outs: leaf([]) }
if (n === 1) {
const [s2, outs] = next(s)
return { state: s2, outs: leaf(outs) }
}
const half = Math.floor(n / 2)
const first = runFor(s, half, isDone, next)
const second = runFor(first.state, n - half, isDone, next)
return { state: second.state, outs: node(first.outs, second.outs) }
}
/** @type {(start: S, isDone: (s: S) => boolean, next: (s: S) => [S, O[]]) => [S, O[]]} */
export const drive = (start, isDone, next) => {
const go = (s, budget, acc) => {
const r = runFor(s, budget, isDone, next)
const outs = node(acc, r.outs)
return isDone(r.state) ? [r.state, toArray(outs)] : go(r.state, budget * 2, outs)
}
return go(start, 1, leaf([]))
}
const answer = (op, seed) => {
if (op.tag === 'RandomSeed') return seed
if (op.tag === 'Draw') return undefined
throw new Error("SafeIO.trace answers only Module 7's operations")
}
// One move of the pure interpreter: rewrite a FlatMap, or answer an Effect and record its op.
/** @type {(io: SafeIO, seed: number) => [SafeIO, Op[]]} */
export const traceStep = (io, seed) => {
if (io.tag === 'FlatMap') return [step(io), []]
if (io.tag === 'Effect') return [io.k(answer(io.op, seed)), [io.op]]
return [io, []]
}
/** @type {(io: SafeIO, seed: number) => Trace} */
export const trace = (io, seed) => {
const [last, ops] = drive(io, (p) => p.tag === 'Pure', (p) => traceStep(p, seed))
return { result: /** @type {any} */ (last).value, ops } // drive stops only at a Pure
}