kitten.sh
1open Wonka_types;
2
3let talkbackPlaceholder = (. _: talkbackT) => ();
4
5let captureTalkback =
6 (
7 source: sourceT('a),
8 sinkWithTalkback: (. signalT('a), (. talkbackT) => unit) => unit,
9 ) => {
10 let talkback = ref(talkbackPlaceholder);
11
12 source((. signal) => {
13 switch (signal) {
14 | Start(x) => talkback := x
15 | _ => ()
16 };
17
18 sinkWithTalkback(. signal, talkback^);
19 });
20};
21
22type trampolineT = {
23 mutable exhausted: bool,
24 mutable inLoop: bool,
25 mutable gotSignal: bool,
26};
27
28let makeTrampoline = (sink: sinkT('a), f: (. unit) => option('a)) => {
29 let state: trampolineT = {
30 exhausted: false,
31 inLoop: false,
32 gotSignal: false,
33 };
34
35 let loop = () => {
36 let rec explode = () =>
37 switch (f(.)) {
38 | Some(x) =>
39 state.gotSignal = false;
40 sink(. Push(x));
41 if (state.gotSignal) {
42 explode();
43 };
44 | None =>
45 state.exhausted = true;
46 sink(. End);
47 };
48
49 state.inLoop = true;
50 explode();
51 state.inLoop = false;
52 };
53
54 sink(.
55 Start(
56 (. signal) =>
57 switch (signal, state.exhausted) {
58 | (Pull, false) =>
59 state.gotSignal = true;
60 if (!state.inLoop) {
61 loop();
62 };
63 | _ => ()
64 },
65 ),
66 );
67};