feat(fsharp): m07 io and m08 stream with tests
Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
co-authored by
Claude Opus 5.5
parent
9cbefeb2be
commit
e27372f017
@@ -0,0 +1,68 @@
|
||||
/// m07 io: effects as values. An IO is a plain-data description of a program; nothing runs until interpreted.
|
||||
/// - `Pure a` done, with a value
|
||||
/// - `Effect (op, k)` perform `op`, then continue with `k result`
|
||||
module Snake.IO
|
||||
|
||||
open Snake.View
|
||||
|
||||
/// An operation an IO program can ask the outside world to perform.
|
||||
type Op =
|
||||
| Draw of Shape
|
||||
| RandomSeed
|
||||
|
||||
/// What the outside world answers: `Done` for a `Draw`, `Seed value` for a `RandomSeed`.
|
||||
type OpResult =
|
||||
| Done
|
||||
| Seed of uint32
|
||||
|
||||
type IO<'a> =
|
||||
| Pure of 'a
|
||||
| Effect of Op * (OpResult -> IO<'a>)
|
||||
|
||||
/// The result of `trace`: the final value and the operations performed, in execution order.
|
||||
type Traced<'a> = { Result: 'a; Ops: Op list }
|
||||
|
||||
let pure (a: 'a) : IO<'a> = Pure a
|
||||
|
||||
let effect (op: Op) : IO<OpResult> = Effect(op, pure)
|
||||
|
||||
// Pure: apply f now. Effect: keep the op, and extend the continuation so f runs after k.
|
||||
// Nothing is performed here, we only build a bigger description.
|
||||
let rec bind (f: 'a -> IO<'b>) (io: IO<'a>) : IO<'b> =
|
||||
match io with
|
||||
| Pure a -> f a
|
||||
| Effect(op, k) -> Effect(op, fun result -> bind f (k result))
|
||||
|
||||
let map (f: 'a -> 'b) (io: IO<'a>) : IO<'b> = bind (fun a -> Pure(f a)) io
|
||||
|
||||
let sequence (ios: IO<unit> list) : IO<unit> =
|
||||
List.foldBack (fun io rest -> bind (fun () -> rest) io) ios (pure ())
|
||||
|
||||
let draw (shape: Shape) : IO<unit> = effect (Draw shape) |> map ignore
|
||||
|
||||
// A function of unit: F# evaluates module-level values as soon as the module is used, and a description
|
||||
// is cheap to rebuild. An interpreter that answers a RandomSeed with anything but a Seed is broken; say so loudly.
|
||||
let randomSeed () : IO<uint32> =
|
||||
effect RandomSeed
|
||||
|> map (fun result ->
|
||||
match result with
|
||||
| Seed value -> value
|
||||
| Done -> failwith "RandomSeed must be answered with a Seed")
|
||||
|
||||
let drawScene (scene: Scene) : IO<unit> = sequence (List.map draw scene)
|
||||
|
||||
// Answer each op with a canned result, collecting the ops as we go. Tail recursion: the compiler turns it
|
||||
// into a loop, so long programs cannot overflow the stack, and still nothing is mutated.
|
||||
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> =
|
||||
let rec go io performed =
|
||||
match io with
|
||||
| Pure a -> { Result = a; Ops = List.rev performed }
|
||||
| Effect(op, k) ->
|
||||
let answer =
|
||||
match op with
|
||||
| RandomSeed -> Seed seed
|
||||
| Draw _ -> Done
|
||||
|
||||
go (k answer) (op :: performed)
|
||||
|
||||
go io []
|
||||
@@ -13,5 +13,7 @@
|
||||
<Compile Include="Spawn.fs" />
|
||||
<Compile Include="Game.fs" />
|
||||
<Compile Include="View.fs" />
|
||||
<Compile Include="IO.fs" />
|
||||
<Compile Include="Stream.fs" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
|
||||
@@ -0,0 +1,81 @@
|
||||
/// m08 stream: an event stream is a pure automaton (a Mealy machine).
|
||||
/// There is no hidden state: whatever a stream "remembers" lives in the next stream it returns.
|
||||
module Snake.Stream
|
||||
|
||||
/// Something that happens to the program: time passing (ms since start) or a key going down or up.
|
||||
type Event =
|
||||
| Time of int64
|
||||
| KeyDown of string
|
||||
| KeyUp of string
|
||||
|
||||
type Stream<'a> = Stream of (Event -> 'a list * Stream<'a>)
|
||||
|
||||
let step (e: Event) (Stream f: Stream<'a>) : 'a list * Stream<'a> = f e
|
||||
|
||||
// Sources remember nothing, so the next stream is the same source again.
|
||||
let keyDowns: Stream<string> =
|
||||
let rec source () =
|
||||
Stream(fun e ->
|
||||
match e with
|
||||
| KeyDown key -> [ key ], source ()
|
||||
| _ -> [], source ())
|
||||
|
||||
source ()
|
||||
|
||||
let keyUps: Stream<string> =
|
||||
let rec source () =
|
||||
Stream(fun e ->
|
||||
match e with
|
||||
| KeyUp key -> [ key ], source ()
|
||||
| _ -> [], source ())
|
||||
|
||||
source ()
|
||||
|
||||
// `last` is the time of the previous Time event. Multiples of ms in (last, t] fire, ascending.
|
||||
let rec private intervalFrom (ms: int64) (last: int64) : Stream<int64> =
|
||||
Stream(fun e ->
|
||||
match e with
|
||||
| Time t -> [ for k in last / ms + 1L .. t / ms -> k * ms ], intervalFrom ms t
|
||||
| _ -> [], intervalFrom ms last)
|
||||
|
||||
let interval (ms: int64) : Stream<int64> = intervalFrom ms 0L
|
||||
|
||||
// Each combinator steps the stream and wraps the *next* stream in the same combinator.
|
||||
let rec map (f: 'a -> 'b) (s: Stream<'a>) : Stream<'b> =
|
||||
Stream(fun e ->
|
||||
let out, next = step e s
|
||||
List.map f out, map f next)
|
||||
|
||||
let rec filter (p: 'a -> bool) (s: Stream<'a>) : Stream<'a> =
|
||||
Stream(fun e ->
|
||||
let out, next = step e s
|
||||
List.filter p out, filter p next)
|
||||
|
||||
let rec choose (f: 'a -> 'b option) (s: Stream<'a>) : Stream<'b> =
|
||||
Stream(fun e ->
|
||||
let out, next = step e s
|
||||
List.choose f out, choose f next)
|
||||
|
||||
let rec merge (a: Stream<'a>) (b: Stream<'a>) : Stream<'a> =
|
||||
Stream(fun e ->
|
||||
let outA, nextA = step e a
|
||||
let outB, nextB = step e b
|
||||
outA @ outB, merge nextA nextB)
|
||||
|
||||
// The accumulator travels in the argument of the next scan, not in a variable.
|
||||
// List.scan keeps z as its first element; drop it, we only emit new accumulators.
|
||||
let rec scan (f: 'b -> 'a -> 'b) (z: 'b) (s: Stream<'a>) : Stream<'b> =
|
||||
Stream(fun e ->
|
||||
let out, next = step e s
|
||||
let accs = List.tail (List.scan f z out)
|
||||
accs, scan f (List.fold f z out) next)
|
||||
|
||||
// Only the first step is special; afterwards we are just `next`.
|
||||
let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> =
|
||||
Stream(fun e ->
|
||||
let out, next = step e s
|
||||
v :: out, next)
|
||||
|
||||
// mapFold threads the stream through the events like fold, and keeps each step's outputs.
|
||||
let run (events: Event list) (s: Stream<'a>) : 'a list =
|
||||
List.mapFold (fun stream e -> step e stream) s events |> fst |> List.concat
|
||||
Reference in New Issue
Block a user