diff --git a/fsharp/solutions/IO.fs b/fsharp/solutions/IO.fs new file mode 100644 index 0000000..2d92bd9 --- /dev/null +++ b/fsharp/solutions/IO.fs @@ -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 = 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 list) : IO = + List.foldBack (fun io rest -> bind (fun () -> rest) io) ios (pure ()) + +let draw (shape: Shape) : IO = 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 = + 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 = 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 [] diff --git a/fsharp/solutions/Snake.fsproj b/fsharp/solutions/Snake.fsproj index 5bc1a8e..f444693 100644 --- a/fsharp/solutions/Snake.fsproj +++ b/fsharp/solutions/Snake.fsproj @@ -13,5 +13,7 @@ + + diff --git a/fsharp/solutions/Stream.fs b/fsharp/solutions/Stream.fs new file mode 100644 index 0000000..48c3305 --- /dev/null +++ b/fsharp/solutions/Stream.fs @@ -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 = + let rec source () = + Stream(fun e -> + match e with + | KeyDown key -> [ key ], source () + | _ -> [], source ()) + + source () + +let keyUps: Stream = + 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 = + 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 = 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 diff --git a/fsharp/src/IO.fs b/fsharp/src/IO.fs new file mode 100644 index 0000000..5831d4d --- /dev/null +++ b/fsharp/src/IO.fs @@ -0,0 +1,56 @@ +/// m07 io: effects as values. An `IO<'a>` is a description of a program that, when interpreted, produces an `'a`: +/// - `Pure a` finished, nothing left to do +/// - `Effect (op, k)` perform `op`, then continue with `k result` (which returns another IO) +/// Building an IO never performs anything; only an interpreter (`trace` here, `Runtime.runIO` in m09) does. +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` (an unsigned 32-bit number) 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 } + +/// An IO that does nothing and produces `a`. +let pure (a: 'a) : IO<'a> = failwith "TODO m07" + +/// An IO that performs the single operation `op` and produces its result: `Effect (op, pure)`. +let effect (op: Op) : IO = failwith "TODO m07" + +/// Run `io`, then feed its result to `f` to get the next IO. +/// `Pure a`: `f a`. `Effect (op, k)`: the same op, with the continuation extended by `f`. +let bind (f: 'a -> IO<'b>) (io: IO<'a>) : IO<'b> = failwith "TODO m07" + +/// Transform the result with `f`. Must not call `f` until the IO is interpreted. +let map (f: 'a -> 'b) (io: IO<'a>) : IO<'b> = failwith "TODO m07" + +/// Run the IOs one after another, left to right, producing `()`. `sequence []` performs nothing. +let sequence (ios: IO list) : IO = failwith "TODO m07" + +/// An IO that draws one shape (a `Rect` or `Text` from m06) and produces `()`. +let draw (shape: Shape) : IO = failwith "TODO m07" + +/// An IO that asks the outside world for a random seed and produces it (the `value` of the `Seed` answer). +/// It is a function of `unit` (use it as `randomSeed ()`) because F# evaluates module-level values as soon as +/// the module is used; every call returns the same description. +let randomSeed () : IO = failwith "TODO m07" + +/// Draw every shape of a scene in order: `sequence (List.map draw scene)`. +let drawScene (scene: Scene) : IO = failwith "TODO m07" + +/// A pure interpreter for tests. Answers every `RandomSeed` with `Seed seed` and every `Draw` with `Done`. +/// Returns the final value and the operations in the order they were executed. +/// Implemented by recursion, with no mutation. +let trace (seed: uint32) (io: IO<'a>) : Traced<'a> = failwith "TODO m07" diff --git a/fsharp/src/Snake.fsproj b/fsharp/src/Snake.fsproj index 5bc1a8e..f444693 100644 --- a/fsharp/src/Snake.fsproj +++ b/fsharp/src/Snake.fsproj @@ -13,5 +13,7 @@ + + diff --git a/fsharp/src/Stream.fs b/fsharp/src/Stream.fs new file mode 100644 index 0000000..7e77012 --- /dev/null +++ b/fsharp/src/Stream.fs @@ -0,0 +1,49 @@ +/// m08 stream: an event stream as a pure automaton (a Mealy machine). +/// A step feeds one event and returns the (possibly empty) list of outputs it produced and the stream to use for +/// the next event. Nothing is mutated, so a stream value can be run any number of times with the same results. +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>) + +/// Feed one event to `s`: the outputs it produced and the stream for the next event. +let step (e: Event) (s: Stream<'a>) : 'a list * Stream<'a> = failwith "TODO m08" + +/// Emits the `key` of every KeyDown event; ignores everything else. +/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.) +let keyDowns: Stream = Stream(fun _ -> failwith "TODO m08") + +/// Emits the `key` of every KeyUp event; ignores everything else. +let keyUps: Stream = Stream(fun _ -> failwith "TODO m08") + +/// On `Time t`, emits every multiple `k*ms` with `last < k*ms <= t`, ascending, where `last` starts at 0 +/// and becomes `t` afterwards. A big time jump can emit several values. Ignores key events. +/// Hint: write a private helper that carries `last`. +let interval (ms: int64) : Stream = failwith "TODO m08" + +/// Apply `f` to every output. +let map (f: 'a -> 'b) (s: Stream<'a>) : Stream<'b> = failwith "TODO m08" + +/// Keep only the outputs for which `p` is true. +let filter (p: 'a -> bool) (s: Stream<'a>) : Stream<'a> = failwith "TODO m08" + +/// Apply `f` to every output; `Some b` emits `b`, `None` is dropped (like `List.choose`). +let choose (f: 'a -> 'b option) (s: Stream<'a>) : Stream<'b> = failwith "TODO m08" + +/// Both streams step on every event; the outputs of `a` come before the outputs of `b`. +let merge (a: Stream<'a>) (b: Stream<'a>) : Stream<'a> = failwith "TODO m08" + +/// Fold the outputs into an accumulator, starting from `z`; emits each new accumulator (not `z` itself). +let scan (f: 'b -> 'a -> 'b) (z: 'b) (s: Stream<'a>) : Stream<'b> = failwith "TODO m08" + +/// Emit `v` once, before the outputs of the first step; later steps are unaffected. +/// Note: streams only act when an event arrives, so if no event ever arrives, `v` is never emitted. +let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> = failwith "TODO m08" + +/// Feed all events through the stream and collect every output, in order. A pure fold. +let run (events: Event list) (s: Stream<'a>) : 'a list = failwith "TODO m08" diff --git a/fsharp/tests/M07IO.fs b/fsharp/tests/M07IO.fs new file mode 100644 index 0000000..ad1c174 --- /dev/null +++ b/fsharp/tests/M07IO.fs @@ -0,0 +1,97 @@ +module Snake.Tests.M07IO + +open Expecto +open Snake +open Snake.View +open Snake.IO + +let private rectAt (x: uint32) : Shape = Rect(int x, 0, 1, 1, "#000000") +let private r1 = rectAt 0u +let private t1 = Text(1, 2, "hi", "#ffffff", 16, "left") + +// Monad laws, checked by interpreting both sides and comparing { Result; Ops }. +let private programs: (string * (unit -> IO)) list = + [ "a pure value", (fun () -> IO.pure 4u) + "randomSeed", (fun () -> IO.randomSeed ()) + "a draw followed by reading the seed", (fun () -> IO.draw r1 |> IO.bind (fun () -> IO.randomSeed ())) ] + +let private f (n: uint32) : IO = IO.draw (rectAt n) |> IO.bind (fun () -> IO.pure (n * 2u)) +let private g (n: uint32) : IO = IO.randomSeed () |> IO.map (fun s -> s + n) + +[] +let tests = + testList "M07 IO" [ + yield testCase "trace of pure 3 has result 3 and no ops" (fun () -> + Expect.equal (IO.trace 0u (IO.pure 3)) { Result = 3; Ops = [] } "trace") + + yield testCase "randomSeed is answered with the seed given to trace" (fun () -> + Expect.equal (IO.trace 9u (IO.randomSeed ())).Result 9u "result") + + yield testCase "randomSeed records a RandomSeed op" (fun () -> + Expect.equal (IO.trace 9u (IO.randomSeed ())).Ops [ RandomSeed ] "ops") + + yield testCase "effect op is an Effect whose continuation is pure" (fun () -> + match IO.effect RandomSeed with + | Effect(op, k) -> + Expect.equal op RandomSeed "op" + + match k (Seed 5u) with + | Pure(Seed 5u) -> () + | other -> failtest $"expected Pure (Seed 5u), got %A{other}" + | other -> failtest $"expected an Effect, got %A{other}") + + yield testCase "draw records a Draw op and produces ()" (fun () -> + Expect.equal (IO.trace 0u (IO.draw r1)) { Result = (); Ops = [ Draw r1 ] } "trace") + + yield testCase "drawScene draws the shapes in order" (fun () -> + Expect.equal (IO.trace 0u (IO.drawScene [ r1; t1 ])).Ops [ Draw r1; Draw t1 ] "ops") + + yield testCase "drawScene of an empty scene has no ops" (fun () -> + Expect.equal (IO.trace 0u (IO.drawScene [])).Ops [] "ops") + + yield testCase "sequence of nothing has no ops" (fun () -> + Expect.equal (IO.trace 0u (IO.sequence [])) { Result = (); Ops = [] } "trace") + + yield testCase "sequence runs effects left to right" (fun () -> + Expect.equal + (IO.trace 0u (IO.sequence [ IO.randomSeed () |> IO.map ignore; IO.draw t1; IO.draw r1 ])).Ops + [ RandomSeed; Draw t1; Draw r1 ] + "ops") + + yield testCase "map transforms the result without adding ops" (fun () -> + Expect.equal + (IO.trace 41u (IO.randomSeed () |> IO.map (fun s -> s + 1u))) + { Result = 42u; Ops = [ RandomSeed ] } + "trace") + + yield testCase "bind passes the result of the first IO to the second" (fun () -> + Expect.equal + (IO.trace 7u (IO.randomSeed () |> IO.bind (fun s -> IO.draw (rectAt s)))).Ops + [ RandomSeed; Draw(rectAt 7u) ] + "ops") + + yield testCase "building IO.map throwingF io does not throw" (fun () -> + let boom (_: uint32) : uint32 = failwith "boom" + IO.randomSeed () |> IO.map boom |> ignore) // only builds a description + + yield testCase "tracing IO.map throwingF io runs f and throws" (fun () -> + let boom (_: uint32) : uint32 = failwith "boom" + + Expect.throwsC + (fun () -> IO.randomSeed () |> IO.map boom |> IO.trace 0u |> ignore) + (fun e -> Expect.equal e.Message "boom" "exception message")) + + for name, program in programs do + yield testCase $"left identity holds for {name}" (fun () -> + let a = (IO.trace 5u (program ())).Result + Expect.equal (IO.trace 5u (IO.pure a |> IO.bind f)) (IO.trace 5u (f a)) "left identity") + + yield testCase $"right identity holds for {name}" (fun () -> + Expect.equal (IO.trace 5u (program () |> IO.bind IO.pure)) (IO.trace 5u (program ())) "right identity") + + yield testCase $"associativity holds for {name}" (fun () -> + Expect.equal + (IO.trace 5u (program () |> IO.bind f |> IO.bind g)) + (IO.trace 5u (program () |> IO.bind (fun x -> f x |> IO.bind g))) + "associativity") + ] diff --git a/fsharp/tests/M08Stream.fs b/fsharp/tests/M08Stream.fs new file mode 100644 index 0000000..2a52f04 --- /dev/null +++ b/fsharp/tests/M08Stream.fs @@ -0,0 +1,106 @@ +module Snake.Tests.M08Stream + +open Expecto +open Snake +open Snake.Stream + +[] +let tests = + testList "M08 Stream" [ + testCase "keyDowns emits keys of KeyDown events only" (fun () -> + Expect.equal (Stream.run [ KeyDown "a"; Time 5L; KeyUp "a"; KeyDown "b" ] Stream.keyDowns) [ "a"; "b" ] "keys") + + testCase "keyUps emits keys of KeyUp events only" (fun () -> + Expect.equal + (Stream.run [ KeyDown "a"; Time 5L; KeyUp "a"; KeyDown "b"; KeyUp "b" ] Stream.keyUps) + [ "a"; "b" ] + "keys") + + testCase "run of no events is empty" (fun () -> Expect.equal (Stream.run [] Stream.keyDowns) [] "outputs") + + testCase "interval emits each multiple once as time passes" (fun () -> + Expect.equal (Stream.run [ Time 5L; Time 10L; Time 35L ] (Stream.interval 10L)) [ 10L; 20L; 30L ] "ticks") + + testCase "interval emits several multiples after one big time jump" (fun () -> + Expect.equal (Stream.run [ Time 35L ] (Stream.interval 10L)) [ 10L; 20L; 30L ] "ticks") + + testCase "interval ignores key events" (fun () -> + Expect.equal (Stream.run [ KeyDown "a"; KeyUp "a" ] (Stream.interval 10L)) [] "ticks") + + testCase "map transforms every output" (fun () -> + Expect.equal + (Stream.keyDowns |> Stream.map (fun k -> k + "!") |> Stream.run [ KeyDown "a"; KeyDown "b" ]) + [ "a!"; "b!" ] + "outputs") + + testCase "filter keeps outputs satisfying the predicate" (fun () -> + Expect.equal + (Stream.keyDowns |> Stream.filter (fun k -> k <> "a") |> Stream.run [ KeyDown "a"; KeyDown "b" ]) + [ "b" ] + "outputs") + + testCase "choose transforms outputs and drops Nones" (fun () -> + Expect.equal + (Stream.keyDowns + |> Stream.choose (fun k -> if k = "a" then None else Some(k.ToUpperInvariant())) + |> Stream.run [ KeyDown "a"; KeyDown "b" ]) + [ "B" ] + "outputs") + + testCase "merge puts outputs of the first stream before the second at the same event" (fun () -> + Expect.equal + (Stream.merge (Stream.map (fun k -> "first " + k) Stream.keyDowns) (Stream.map (fun k -> "second " + k) Stream.keyDowns) + |> Stream.run [ KeyDown "x" ]) + [ "first x"; "second x" ] + "outputs") + + testCase "merge interleaves sources by event order" (fun () -> + Expect.equal + (Stream.merge (Stream.interval 10L) (Stream.map (fun _ -> -1L) Stream.keyDowns) + |> Stream.run [ Time 10L; KeyDown "a"; Time 20L ]) + [ 10L; -1L; 20L ] + "outputs") + + testCase "scan emits each new accumulator, not the initial value" (fun () -> + Expect.equal + (Stream.keyDowns + |> Stream.scan (fun n _ -> n + 1) 0 + |> Stream.run [ KeyDown "a"; KeyUp "a"; KeyDown "b"; KeyDown "c" ]) + [ 1; 2; 3 ] + "outputs") + + testCase "scan passes the output to the folding function" (fun () -> + Expect.equal + (Stream.keyDowns |> Stream.scan (+) "" |> Stream.run [ KeyDown "a"; KeyDown "b" ]) + [ "a"; "ab" ] + "outputs") + + testCase "startWith emits the value once, before the outputs of the first step" (fun () -> + Expect.equal + (Stream.keyDowns |> Stream.startWith "init" |> Stream.run [ KeyDown "a"; KeyDown "b" ]) + [ "init"; "a"; "b" ] + "outputs") + + testCase "startWith emits at the first event even if that step has no outputs" (fun () -> + Expect.equal + (Stream.keyDowns |> Stream.startWith "init" |> Stream.run [ Time 1L; KeyDown "a" ]) + [ "init"; "a" ] + "outputs") + + testCase "startWith emits nothing when no event ever arrives" (fun () -> + Expect.equal (Stream.keyDowns |> Stream.startWith "init" |> Stream.run []) [] "outputs") + + testCase "step feeds one event and returns its outputs and the next stream" (fun () -> + let out, next = Stream.step (Time 25L) (Stream.interval 10L) + Expect.equal out [ 10L; 20L ] "first step" + Expect.equal (fst (Stream.step (Time 30L) next)) [ 30L ] "next stream remembers the last time") + + testCase "running the same stream value twice gives the same outputs" (fun () -> + let s = + Stream.merge (Stream.interval 10L) (Stream.map (fun _ -> 100L) Stream.keyDowns) + |> Stream.scan (+) 0L + + let events = [ Time 25L; KeyDown "a"; Time 40L ] + Expect.equal (Stream.run events s) (Stream.run events s) "same outputs" + Expect.equal (Stream.run events s) [ 10L; 30L; 130L; 160L; 200L ] "outputs") + ] diff --git a/fsharp/tests/Snake.Tests.fsproj b/fsharp/tests/Snake.Tests.fsproj index 7282c69..660976a 100644 --- a/fsharp/tests/Snake.Tests.fsproj +++ b/fsharp/tests/Snake.Tests.fsproj @@ -15,6 +15,8 @@ + +