summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--css/dthompson.css5
-rw-r--r--embeds/frp-color-picker/hoot/reflect.js738
-rw-r--r--embeds/frp-color-picker/hoot/reflect.wasmbin0 -> 5196 bytes
-rw-r--r--embeds/frp-color-picker/hoot/wtf8.wasmbin0 -> 1071 bytes
-rw-r--r--embeds/frp-color-picker/index.html26
-rw-r--r--embeds/frp-color-picker/propagators.css38
-rw-r--r--embeds/frp-color-picker/propagators.js30
-rw-r--r--embeds/frp-color-picker/propagators.wasmbin0 -> 458030 bytes
-rw-r--r--haunt.scm3
-rw-r--r--images/propagators/rgb-hsv-color-diagram.pngbin0 -> 68181 bytes
-rw-r--r--markdown.scm11
-rw-r--r--posts/2024-07-03-frp-with-propagators.md1147
12 files changed, 1993 insertions, 5 deletions
diff --git a/css/dthompson.css b/css/dthompson.css
index fd6c818..90c8a7a 100644
--- a/css/dthompson.css
+++ b/css/dthompson.css
@@ -209,6 +209,11 @@ footer {
margin-right: 4rem;
}
+iframe {
+ border: none;
+ width: 100%;
+}
+
/* Pagination */
.paginator {
diff --git a/embeds/frp-color-picker/hoot/reflect.js b/embeds/frp-color-picker/hoot/reflect.js
new file mode 100644
index 0000000..b00874c
--- /dev/null
+++ b/embeds/frp-color-picker/hoot/reflect.js
@@ -0,0 +1,738 @@
+// -*- js2-basic-offset: 4 -*-
+class Char {
+ constructor(codepoint) {
+ this.codepoint = codepoint;
+ }
+ toString() {
+ let ch = String.fromCodePoint(this.codepoint);
+ if (ch.match(/[a-zA-Z0-9$[\]().]/)) return `#\\${ch}`;
+ return `#\\x${this.codepoint.toString(16)}`;
+ }
+}
+class Eof { toString() { return "#<eof>"; } }
+class Nil { toString() { return "#nil"; } }
+class Null { toString() { return "()"; } }
+class Unspecified { toString() { return "#<unspecified>"; } }
+
+class Complex {
+ constructor(real, imag) {
+ this.real = real;
+ this.imag = imag;
+ }
+ toString() {
+ const sign = this.imag >= 0 && Number.isFinite(this.imag) ? "+": "";
+ return `${flonum_to_string(this.real)}${sign}${flonum_to_string(this.imag)}i`;
+ }
+}
+class Fraction {
+ constructor(num, denom) {
+ this.num = num;
+ this.denom = denom;
+ }
+ toString() {
+ return `${this.num}/${this.denom}`;
+ }
+}
+
+class HeapObject {
+ constructor(reflector, obj) {
+ this.reflector = reflector;
+ this.obj = obj;
+ }
+ repr() { return this.toString(); } // Default implementation.
+}
+
+class Pair extends HeapObject {
+ toString() { return "#<pair>"; }
+ repr() {
+ let car_repr = repr(this.reflector.car(this));
+ let cdr_repr = repr(this.reflector.cdr(this));
+ if (cdr_repr == '()')
+ return `(${car_repr})`;
+ if (cdr_repr.charAt(0) == '(')
+ return `(${car_repr} ${cdr_repr.substring(1)}`;
+ return `(${car_repr} . ${cdr_repr})`;
+ }
+}
+class MutablePair extends Pair { toString() { return "#<mutable-pair>"; } }
+
+class Vector extends HeapObject {
+ toString() { return "#<vector>"; }
+ repr() {
+ let len = this.reflector.vector_length(this);
+ let out = '#(';
+ for (let i = 0; i < len; i++) {
+ if (i) out += ' ';
+ out += repr(this.reflector.vector_ref(this, i));
+ }
+ out += ')';
+ return out;
+ }
+}
+class MutableVector extends Vector {
+ toString() { return "#<mutable-vector>"; }
+}
+
+class Bytevector extends HeapObject {
+ toString() { return "#<bytevector>"; }
+ repr() {
+ let len = this.reflector.bytevector_length(this);
+ let out = '#vu8(';
+ for (let i = 0; i < len; i++) {
+ if (i) out += ' ';
+ out += this.reflector.bytevector_ref(this, i);
+ }
+ out += ')';
+ return out;
+ }
+}
+class MutableBytevector extends Bytevector {
+ toString() { return "#<mutable-bytevector>"; }
+}
+
+class Bitvector extends HeapObject {
+ toString() { return "#<bitvector>"; }
+ repr() {
+ let len = this.reflector.bitvector_length(this);
+ let out = '#*';
+ for (let i = 0; i < len; i++) {
+ out += this.reflector.bitvector_ref(this, i) ? '1' : '0';
+ }
+ return out;
+ }
+}
+class MutableBitvector extends Bitvector {
+ toString() { return "#<mutable-bitvector>"; }
+}
+
+class MutableString extends HeapObject {
+ toString() { return "#<mutable-string>"; }
+ repr() { return string_repr(this.reflector.string_value(this)); }
+}
+
+class Procedure extends HeapObject {
+ toString() { return "#<procedure>"; }
+ call(...arg) {
+ return this.reflector.call(this, ...arg);
+ }
+ async call_async(...arg) {
+ return await this.reflector.call_async(this, ...arg);
+ }
+}
+
+class Sym extends HeapObject {
+ toString() { return "#<symbol>"; }
+ repr() { return this.reflector.symbol_name(this); }
+}
+
+class Keyword extends HeapObject {
+ toString() { return "#<keyword>"; }
+ repr() { return `#:${this.reflector.keyword_name(this)}`; }
+}
+
+class Variable extends HeapObject { toString() { return "#<variable>"; } }
+class AtomicBox extends HeapObject { toString() { return "#<atomic-box>"; } }
+class HashTable extends HeapObject { toString() { return "#<hash-table>"; } }
+class WeakTable extends HeapObject { toString() { return "#<weak-table>"; } }
+class Fluid extends HeapObject { toString() { return "#<fluid>"; } }
+class DynamicState extends HeapObject { toString() { return "#<dynamic-state>"; } }
+class Syntax extends HeapObject { toString() { return "#<syntax>"; } }
+class Port extends HeapObject { toString() { return "#<port>"; } }
+class Struct extends HeapObject { toString() { return "#<struct>"; } }
+
+function instantiate_streaming(path, imports) {
+ if (typeof fetch !== 'undefined')
+ return WebAssembly.instantiateStreaming(fetch(path), imports);
+ let bytes;
+ if (typeof read !== 'undefined') {
+ bytes = read(path, 'binary');
+ } else if (typeof readFile !== 'undefined') {
+ bytes = readFile(path);
+ } else {
+ let fs = require('fs');
+ bytes = fs.readFileSync(path);
+ }
+ return WebAssembly.instantiate(bytes, imports);
+}
+
+class Scheme {
+ #instance;
+ #abi;
+ constructor(instance, abi) {
+ this.#instance = instance;
+ this.#abi = abi;
+ }
+
+ static async reflect(abi, {reflect_wasm_dir = '.'}) {
+ let debug = {
+ debug_str(x) { console.log(`reflect debug: ${x}`); },
+ debug_str_i32(x, y) { console.log(`reflect debug: ${x}: ${y}`); },
+ debug_str_scm: (x, y) => {
+ console.log(`reflect debug: ${x}: #<scm>`);
+ },
+ };
+ let reflect_wasm = reflect_wasm_dir + '/reflect.wasm';
+ let rt = {
+ die(tag, data) { throw new SchemeTrapError(tag, data); },
+ wtf8_to_string(wtf8) { return wtf8_to_string(wtf8); },
+ string_to_wtf8(str) { return string_to_wtf8(str); },
+ };
+ let { module, instance } =
+ await instantiate_streaming(reflect_wasm, { abi, debug, rt });
+ return new Scheme(instance, abi);
+ }
+
+ #init_module(mod) {
+ mod.set_debug_handler({
+ debug_str(x) { console.log(`debug: ${x}`); },
+ debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
+ debug_str_scm: (x, y) => {
+ console.log(`debug: ${x}: ${repr(this.#to_js(y))}`);
+ },
+ });
+ mod.set_ffi_handler({
+ procedure_to_extern: (obj) => {
+ const proc = this.#to_js(obj);
+ return (...args) => {
+ return proc.call(...args);
+ };
+ }
+ });
+ let proc = new Procedure(this, mod.get_export('$load').value);
+ return proc.call();
+ }
+ static async load_main(path, opts = {}) {
+ let mod = await SchemeModule.fetch_and_instantiate(path, opts);
+ let reflect = await mod.reflect(opts);
+ return reflect.#init_module(mod);
+ }
+ async load_extension(path, opts = {}) {
+ opts = Object.assign({ abi: this.#abi }, opts);
+ let mod = await SchemeModule.fetch_and_instantiate(path, opts);
+ return this.#init_module(mod);
+ }
+
+ #to_scm(js) {
+ let api = this.#instance.exports;
+ if (typeof(js) == 'number') {
+ return api.scm_from_f64(js);
+ } else if (typeof(js) == 'bigint') {
+ if (BigInt(api.scm_most_negative_fixnum()) <= js
+ && js <= BigInt(api.scm_most_positive_fixnum()))
+ return api.scm_from_fixnum(Number(js));
+ return api.scm_from_bignum(js);
+ } else if (typeof(js) == 'boolean') {
+ return js ? api.scm_true() : api.scm_false();
+ } else if (typeof(js) == 'string') {
+ return api.scm_from_string(js);
+ } else if (typeof(js) == 'object') {
+ if (js instanceof Eof) return api.scm_eof();
+ if (js instanceof Nil) return api.scm_nil();
+ if (js instanceof Null) return api.scm_null();
+ if (js instanceof Unspecified) return api.scm_unspecified();
+ if (js instanceof Char) return api.scm_from_char(js.codepoint);
+ if (js instanceof HeapObject) return js.obj;
+ if (js instanceof Fraction)
+ return api.scm_from_fraction(this.#to_scm(js.num),
+ this.#to_scm(js.denom));
+ if (js instanceof Complex)
+ return api.scm_from_complex(js.real, js.imag);
+ return api.scm_from_extern(js);
+ } else if (typeof(js) == 'function') {
+ return api.scm_from_extern(js);
+ } else {
+ throw new Error(`unexpected; ${typeof(js)}`);
+ }
+ }
+
+ #to_js(scm) {
+ let api = this.#instance.exports;
+ let descr = api.describe(scm);
+ let handlers = {
+ fixnum: () => BigInt(api.fixnum_value(scm)),
+ char: () => new Char(api.char_value(scm)),
+ true: () => true,
+ false: () => false,
+ eof: () => new Eof,
+ nil: () => new Nil,
+ null: () => new Null,
+ unspecified: () => new Unspecified,
+ flonum: () => api.flonum_value(scm),
+ bignum: () => api.bignum_value(scm),
+ complex: () => new Complex(api.complex_real(scm),
+ api.complex_imag(scm)),
+ fraction: () => new Fraction(this.#to_js(api.fraction_num(scm)),
+ this.#to_js(api.fraction_denom(scm))),
+ pair: () => new Pair(this, scm),
+ 'mutable-pair': () => new MutablePair(this, scm),
+ vector: () => new Vector(this, scm),
+ 'mutable-vector': () => new MutableVector(this, scm),
+ bytevector: () => new Bytevector(this, scm),
+ 'mutable-bytevector': () => new MutableBytevector(this, scm),
+ bitvector: () => new Bitvector(this, scm),
+ 'mutable-bitvector': () => new MutableBitvector(this, scm),
+ string: () => api.string_value(scm),
+ 'mutable-string': () => new MutableString(this, scm),
+ procedure: () => new Procedure(this, scm),
+ symbol: () => new Sym(this, scm),
+ keyword: () => new Keyword(this, scm),
+ variable: () => new Variable(this, scm),
+ 'atomic-box': () => new AtomicBox(this, scm),
+ 'hash-table': () => new HashTable(this, scm),
+ 'weak-table': () => new WeakTable(this, scm),
+ fluid: () => new Fluid(this, scm),
+ 'dynamic-state': () => new DynamicState(this, scm),
+ syntax: () => new Syntax(this, scm),
+ port: () => new Port(this, scm),
+ struct: () => new Struct(this, scm),
+ 'extern-ref': () => api.extern_value(scm)
+ };
+ let handler = handlers[descr];
+ return handler ? handler() : scm;
+ }
+
+ call(func, ...args) {
+ let api = this.#instance.exports;
+ let argv = api.make_vector(args.length + 1, api.scm_false());
+ func = this.#to_scm(func);
+ api.vector_set(argv, 0, func);
+ for (let [idx, arg] of args.entries())
+ api.vector_set(argv, idx + 1, this.#to_scm(arg));
+ argv = api.call(func, argv);
+ let results = [];
+ for (let idx = 0; idx < api.vector_length(argv); idx++)
+ results.push(this.#to_js(api.vector_ref(argv, idx)))
+ return results;
+ }
+
+ call_async(func, ...args) {
+ return new Promise((resolve, reject) => {
+ this.call(func,
+ val => resolve(this.#to_js(val)),
+ err => reject(this.#to_js(err)),
+ ...args);
+ })
+ }
+
+ car(x) { return this.#to_js(this.#instance.exports.car(x.obj)); }
+ cdr(x) { return this.#to_js(this.#instance.exports.cdr(x.obj)); }
+
+ vector_length(x) { return this.#instance.exports.vector_length(x.obj); }
+ vector_ref(x, i) {
+ return this.#to_js(this.#instance.exports.vector_ref(x.obj, i));
+ }
+
+ bytevector_length(x) {
+ return this.#instance.exports.bytevector_length(x.obj);
+ }
+ bytevector_ref(x, i) {
+ return this.#instance.exports.bytevector_ref(x.obj, i);
+ }
+
+ bitvector_length(x) {
+ return this.#instance.exports.bitvector_length(x.obj);
+ }
+ bitvector_ref(x, i) {
+ return this.#instance.exports.bitvector_ref(x.obj, i) == 1;
+ }
+
+ string_value(x) { return this.#instance.exports.string_value(x.obj); }
+ symbol_name(x) { return this.#instance.exports.symbol_name(x.obj); }
+ keyword_name(x) { return this.#instance.exports.keyword_name(x.obj); }
+}
+
+class SchemeTrapError extends Error {
+ constructor(tag, data) { super(); this.tag = tag; this.data = data; }
+ // FIXME: data is raw Scheme object; would need to be reflected to
+ // have a toString.
+ toString() { return `SchemeTrap(${this.tag}, <data>)`; }
+}
+
+function string_repr(str) {
+ // FIXME: Improve to match Scheme.
+ return '"' + str.replace(/(["\\])/g, '\\$1').replace(/\n/g, '\\n') + '"';
+}
+
+function flonum_to_string(f64) {
+ if (Object.is(f64, -0)) {
+ return '-0.0';
+ } else if (Number.isFinite(f64)) {
+ let repr = f64 + '';
+ return /^-?[0-9]+$/.test(repr) ? repr + '.0' : repr;
+ } else if (Number.isNaN(f64)) {
+ return '+nan.0';
+ } else {
+ return f64 < 0 ? '-inf.0' : '+inf.0';
+ }
+}
+
+let async_invoke = typeof queueMicrotask !== 'undefined'
+ ? queueMicrotask
+ : thunk => setTimeout(thunk, 0);
+function async_invoke_later(thunk, jiffies) {
+ setTimeout(thunk, jiffies / 1000);
+}
+
+let wtf8_helper;
+
+function wtf8_to_string(wtf8) {
+ let { as_iter, iter_next } = wtf8_helper.exports;
+ let codepoints = [];
+ let iter = as_iter(wtf8);
+ for (let cp = iter_next(iter); cp != -1; cp = iter_next(iter))
+ codepoints.push(cp);
+
+ // Passing too many codepoints can overflow the stack.
+ let maxcp = 100000;
+ if (codepoints.length <= maxcp) {
+ return String.fromCodePoint(...codepoints);
+ }
+
+ // For converting large strings, concatenate several smaller
+ // strings.
+ let substrings = [];
+ let end = 0;
+ for (let start = 0; start != codepoints.length; start = end) {
+ end = Math.min(start + maxcp, codepoints.length);
+ substrings.push(String.fromCodePoint(...codepoints.slice(start, end)));
+ }
+ return substrings.join('');
+}
+
+function string_to_wtf8(str) {
+ let { string_builder, builder_push_codepoint, finish_builder } =
+ wtf8_helper.exports;
+ let builder = string_builder()
+ for (let cp of str)
+ builder_push_codepoint(builder, cp.codePointAt(0));
+ return finish_builder(builder);
+}
+
+async function load_wtf8_helper_module(reflect_wasm_dir = '') {
+ if (wtf8_helper) return;
+ let wtf8_wasm = reflect_wasm_dir + "/wtf8.wasm";
+ let { module, instance } = await instantiate_streaming(wtf8_wasm);
+ wtf8_helper = instance;
+}
+
+class SchemeModule {
+ #instance;
+ #io_handler;
+ #debug_handler;
+ #ffi_handler;
+ static #rt = {
+ bignum_from_string(str) { return BigInt(str); },
+ bignum_from_i32(n) { return BigInt(n); },
+ bignum_from_i64(n) { return n; },
+ bignum_from_u64(n) { return n < 0n ? 0xffff_ffff_ffff_ffffn + (n + 1n) : n; },
+ bignum_is_i64(n) {
+ return -0x8000_0000_0000_0000n <= n && n <= 0x7FFF_FFFF_FFFF_FFFFn;
+ },
+ bignum_is_u64(n) {
+ return 0n <= n && n <= 0xFFFF_FFFF_FFFF_FFFFn;
+ },
+ // This truncates; see https://tc39.es/ecma262/#sec-tobigint64.
+ bignum_get_i64(n) { return n; },
+
+ bignum_add(a, b) { return BigInt(a) + BigInt(b) },
+ bignum_sub(a, b) { return BigInt(a) - BigInt(b) },
+ bignum_mul(a, b) { return BigInt(a) * BigInt(b) },
+ bignum_lsh(a, b) { return BigInt(a) << BigInt(b) },
+ bignum_rsh(a, b) { return BigInt(a) >> BigInt(b) },
+ bignum_quo(a, b) { return BigInt(a) / BigInt(b) },
+ bignum_rem(a, b) { return BigInt(a) % BigInt(b) },
+ bignum_mod(a, b) {
+ let r = BigInt(a) % BigInt(b);
+ if ((b > 0n && r < 0n) || (b < 0n && r > 0n)) {
+ return b + r;
+ } else {
+ return r;
+ }
+ },
+ bignum_gcd(a, b) {
+ a = BigInt(a);
+ b = BigInt(b);
+ if (a < 0n) { a = -a; }
+ if (b < 0n) { b = -b; }
+ if (a == 0n) { return b; }
+ if (b == 0n) { return a; }
+
+ let r;
+ while (b != 0n) {
+ r = a % b;
+ a = b;
+ b = r;
+ }
+ return a;
+ },
+
+ bignum_logand(a, b) { return BigInt(a) & BigInt(b); },
+ bignum_logior(a, b) { return BigInt(a) | BigInt(b); },
+ bignum_logxor(a, b) { return BigInt(a) ^ BigInt(b); },
+ bignum_logsub(a, b) { return BigInt(a) & (~ BigInt(b)); },
+
+ bignum_lt(a, b) { return a < b; },
+ bignum_le(a, b) { return a <= b; },
+ bignum_eq(a, b) { return a == b; },
+
+ bignum_to_f64(n) { return Number(n); },
+
+ f64_is_nan(n) { return Number.isNaN(n); },
+ f64_is_infinite(n) { return !Number.isFinite(n); },
+
+ flonum_to_string,
+
+ string_upcase: Function.call.bind(String.prototype.toUpperCase),
+ string_downcase: Function.call.bind(String.prototype.toLowerCase),
+
+ make_weak_map() { return new WeakMap; },
+ weak_map_get(map, k, fail) {
+ const val = map.get(k);
+ return val === undefined ? fail: val;
+ },
+ weak_map_set(map, k, v) { return map.set(k, v); },
+ weak_map_delete(map, k) { return map.delete(k); },
+
+ fsqrt: Math.sqrt,
+ fsin: Math.sin,
+ fcos: Math.cos,
+ ftan: Math.tan,
+ fasin: Math.asin,
+ facos: Math.acos,
+ fatan: Math.atan,
+ fatan2: Math.atan2,
+ flog: Math.log,
+ fexp: Math.exp,
+
+ jiffies_per_second() { return 1000000; },
+ current_jiffy() { return performance.now() * 1000; },
+ current_second() { return Date.now() / 1000; },
+
+ async_invoke,
+ async_invoke_later,
+ promise_on_completed(p, kt, kf) { p.then(kt, kf); },
+ promise_complete(callback, val) { callback(val); },
+
+ // Wrap in functions to allow for lazy loading of the wtf8
+ // module.
+ wtf8_to_string(wtf8) { return wtf8_to_string(wtf8); },
+ string_to_wtf8(str) { return string_to_wtf8(str); },
+
+ die(tag, data) { throw new SchemeTrapError(tag, data); }
+ };
+
+ constructor(instance) {
+ this.#instance = instance;
+ let open_file_error = (filename) => {
+ throw new Error('No file system access');
+ };
+ if (typeof printErr === 'function') { // v8/sm dev console
+ // On the console, try to use 'write' (v8) or 'putstr' (sm),
+ // as these don't add an extraneous newline. Unfortunately
+ // JSC doesn't have a printer that doesn't add a newline.
+ let write_no_newline =
+ typeof write === 'function' ? write
+ : typeof putstr === 'function' ? putstr : print;
+ // Use readline when available. v8 strips newlines so
+ // we need to add them back.
+ let read_stdin =
+ typeof readline == 'function' ? () => {
+ let line = readline();
+ if (line) {
+ return `${line}\n`;
+ } else {
+ return '\n';
+ }
+ }: () => '';
+ this.#io_handler = {
+ write_stdout: write_no_newline,
+ write_stderr: printErr,
+ read_stdin,
+ file_exists: (filename) => false,
+ open_input_file: open_file_error,
+ open_output_file: open_file_error,
+ close_file: () => undefined,
+ read_file: (handle, length) => 0,
+ write_file: (handle, length) => 0,
+ seek_file: (handle, offset, whence) => -1,
+ file_random_access: (handle) => false,
+ file_buffer_size: (handle) => 0,
+ file_buffer_ref: (handle, i) => 0,
+ file_buffer_set: (handle, i, x) => undefined,
+ delete_file: (filename) => undefined
+ };
+ } else if (typeof window !== 'undefined') { // web browser
+ this.#io_handler = {
+ write_stdout: console.log,
+ write_stderr: console.error,
+ read_stdin: () => '',
+ file_exists: (filename) => false,
+ open_input_file: open_file_error,
+ open_output_file: open_file_error,
+ close_file: () => undefined,
+ read_file: (handle, length) => 0,
+ write_file: (handle, length) => 0,
+ seek_file: (handle, offset, whence) => -1,
+ file_random_access: (handle) => false,
+ file_buffer_size: (handle) => 0,
+ file_buffer_ref: (handle, i) => 0,
+ file_buffer_set: (handle, i, x) => undefined,
+ delete_file: (filename) => undefined
+ };
+ } else { // nodejs
+ const fs = require('fs');
+ const process = require('process');
+ const bufLength = 1024;
+ const stdinBuf = Buffer.alloc(bufLength);
+ const SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2;
+ this.#io_handler = {
+ write_stdout: console.log,
+ write_stderr: console.error,
+ read_stdin: () => {
+ let n = fs.readSync(process.stdin.fd, stdinBuf, 0, stdinBuf.length);
+ return stdinBuf.toString('utf8', 0, n);
+ },
+ file_exists: fs.existsSync.bind(fs),
+ open_input_file: (filename) => {
+ let fd = fs.openSync(filename, 'r');
+ return {
+ fd,
+ buf: Buffer.alloc(bufLength),
+ pos: 0
+ };
+ },
+ open_output_file: (filename) => {
+ let fd = fs.openSync(filename, 'w');
+ return {
+ fd,
+ buf: Buffer.alloc(bufLength),
+ pos: 0
+ };
+ },
+ close_file: (handle) => {
+ fs.closeSync(handle.fd);
+ },
+ read_file: (handle, count) => {
+ const n = fs.readSync(handle.fd, handle.buf, 0, count, handle.pos);
+ handle.pos += n;
+ return n;
+ },
+ write_file: (handle, count) => {
+ const n = fs.writeSync(handle.fd, handle.buf, 0, count, handle.pos);
+ handle.pos += n;
+ return n;
+ },
+ seek_file: (handle, offset, whence) => {
+ // There doesn't seem to be a way to ask NodeJS if
+ // a position is valid or not.
+ if (whence == SEEK_SET) {
+ handle.pos = offset;
+ return handle.pos;
+ } else if (whence == SEEK_CUR) {
+ handle.pos += offset;
+ return handle.pos;
+ }
+
+ // SEEK_END not supported.
+ return -1;
+ },
+ file_random_access: (handle) => {
+ return true;
+ },
+ file_buffer_size: (handle) => {
+ return handle.buf.length;
+ },
+ file_buffer_ref: (handle, i) => {
+ return handle.buf[i];
+ },
+ file_buffer_set: (handle, i, x) => {
+ handle.buf[i] = x;
+ },
+ delete_file: fs.rmSync.bind(fs)
+ };
+ }
+ this.#debug_handler = {
+ debug_str(x) { console.log(`debug: ${x}`); },
+ debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
+ debug_str_scm(x, y) { console.log(`debug: ${x}: #<scm>`); },
+ };
+ }
+ static async fetch_and_instantiate(path, { abi, reflect_wasm_dir = '.',
+ user_imports = {} }) {
+ await load_wtf8_helper_module(reflect_wasm_dir);
+ let io = {
+ write_stdout(str) { mod.#io_handler.write_stdout(str); },
+ write_stderr(str) { mod.#io_handler.write_stderr(str); },
+ read_stdin() { return mod.#io_handler.read_stdin(); },
+ file_exists(filename) { return mod.#io_handler.file_exists(filename); },
+ open_input_file(filename) { return mod.#io_handler.open_input_file(filename); },
+ open_output_file(filename) { return mod.#io_handler.open_output_file(filename); },
+ close_file(handle) { mod.#io_handler.close_file(handle); },
+ read_file(handle, length) { return mod.#io_handler.read_file(handle, length); },
+ write_file(handle, length) { return mod.#io_handler.write_file(handle, length); },
+ seek_file(handle, offset, whence) { return mod.#io_handler.seek_file(handle, offset, whence); },
+ file_random_access(handle) { return mod.#io_handler.file_random_access(handle); },
+ file_buffer_size(handle) { return mod.#io_handler.file_buffer_size(handle); },
+ file_buffer_ref(handle, i) { return mod.#io_handler.file_buffer_ref(handle, i); },
+ file_buffer_set(handle, i, x) { return mod.#io_handler.file_buffer_set(handle, i, x); },
+ delete_file(filename) { mod.#io_handler.delete_file(filename); }
+ };
+ let debug = {
+ debug_str(x) { mod.#debug_handler.debug_str(x); },
+ debug_str_i32(x, y) { mod.#debug_handler.debug_str_i32(x, y); },
+ debug_str_scm(x, y) { mod.#debug_handler.debug_str_scm(x, y); },
+ }
+ let ffi = {
+ procedure_to_extern(proc) {
+ return mod.#ffi_handler.procedure_to_extern(proc);
+ }
+ };
+ let imports = {
+ rt: SchemeModule.#rt,
+ abi, debug, io, ffi, ...user_imports
+ };
+ let { module, instance } = await instantiate_streaming(path, imports);
+ let mod = new SchemeModule(instance);
+ return mod;
+ }
+ set_io_handler(h) { this.#io_handler = h; }
+ set_debug_handler(h) { this.#debug_handler = h; }
+ set_ffi_handler(h) { this.#ffi_handler = h; }
+ all_exports() { return this.#instance.exports; }
+ exported_abi() {
+ let abi = {}
+ for (let [k, v] of Object.entries(this.all_exports())) {
+ if (k.startsWith("$"))
+ abi[k] = v;
+ }
+ return abi;
+ }
+ exports() {
+ let ret = {}
+ for (let [k, v] of Object.entries(this.all_exports())) {
+ if (!k.startsWith("$"))
+ ret[k] = v;
+ }
+ return ret;
+ }
+ get_export(name) {
+ if (name in this.all_exports())
+ return this.all_exports()[name];
+ throw new Error(`unknown export: ${name}`)
+ }
+ async reflect(opts = {}) {
+ return await Scheme.reflect(this.exported_abi(), opts);
+ }
+}
+
+function repr(obj) {
+ if (obj instanceof HeapObject)
+ return obj.repr();
+ if (typeof obj === 'boolean')
+ return obj ? '#t' : '#f';
+ if (typeof obj === 'number')
+ return flonum_to_string(obj);
+ if (typeof obj === 'string')
+ return string_repr(obj);
+ return obj + '';
+}
diff --git a/embeds/frp-color-picker/hoot/reflect.wasm b/embeds/frp-color-picker/hoot/reflect.wasm
new file mode 100644
index 0000000..770c94c
--- /dev/null
+++ b/embeds/frp-color-picker/hoot/reflect.wasm
Binary files differ
diff --git a/embeds/frp-color-picker/hoot/wtf8.wasm b/embeds/frp-color-picker/hoot/wtf8.wasm
new file mode 100644
index 0000000..ca1079d
--- /dev/null
+++ b/embeds/frp-color-picker/hoot/wtf8.wasm
Binary files differ
diff --git a/embeds/frp-color-picker/index.html b/embeds/frp-color-picker/index.html
new file mode 100644
index 0000000..e5c4372
--- /dev/null
+++ b/embeds/frp-color-picker/index.html
@@ -0,0 +1,26 @@
+<!DOCTYPE html>
+<html>
+ <head>
+ <title>FRP color picker</title>
+ <link rel="stylesheet" type="text/css" href="propagators.css"/>
+ <script type="text/javascript" src="hoot/reflect.js"></script>
+ <script type="text/javascript" src="propagators.js"></script>
+ </head>
+ <body>
+ <article id="wasm-error" hidden="true">
+ <h1>Uh oh!</h1>
+ <p>
+ A browser with Wasm GC and tail call support is required for
+ this demo.
+ </p>
+ <p>
+ We recommend using either Firefox or Chrome.
+ </p>
+ <p>
+ Safari is currently unsupported. Likewise, <emph>all browsers</emph> on
+ iOS are unsupported, as they are all secretly Safari under the
+ hood.
+ </p>
+ </article>
+ </body>
+</html>
diff --git a/embeds/frp-color-picker/propagators.css b/embeds/frp-color-picker/propagators.css
new file mode 100644
index 0000000..1b803e2
--- /dev/null
+++ b/embeds/frp-color-picker/propagators.css
@@ -0,0 +1,38 @@
+body {
+ font-family: sans;
+ background-color: #fbfbfb;
+ margin: auto;
+ max-width: 20em;
+}
+
+h1 {
+ text-align: center;
+}
+
+.preview {
+ width: 50%;
+ margin-left: auto;
+ margin-right: auto;
+}
+
+.hex {
+ text-align: center;
+ margin-top: 0.5em;
+}
+
+fieldset {
+ margin-bottom: 1em;
+ margin-top: 1em;
+}
+
+.color-block {
+ width: 100%;
+ aspect-ratio: 1;
+ border: 1px black solid;
+}
+
+.slider {
+ display: grid;
+ grid-template-columns: 35% max-content;
+ grip-gap: 1em;
+}
diff --git a/embeds/frp-color-picker/propagators.js b/embeds/frp-color-picker/propagators.js
new file mode 100644
index 0000000..fe0034a
--- /dev/null
+++ b/embeds/frp-color-picker/propagators.js
@@ -0,0 +1,30 @@
+window.addEventListener("load", async () => {
+ try {
+ await Scheme.load_main("propagators.wasm", {
+ reflect_wasm_dir: "hoot",
+ user_imports: {
+ window: {
+ setTimeout: setTimeout
+ },
+ document: {
+ makeTextNode: Document.prototype.createTextNode.bind(document),
+ makeElement: Document.prototype.createElement.bind(document),
+ body: () => document.body,
+ },
+ element: {
+ appendChild: (parent, child) => parent.appendChild(child),
+ setAttribute: (elem, attr, value) => elem.setAttribute(attr, value),
+ getValue: (elem) => elem.value,
+ setValue: (elem, val) => elem.value = val,
+ replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem),
+ addEventListener: (elem, name, f) => elem.addEventListener(name, f)
+ },
+ }
+ });
+ } catch(e) {
+ if(e instanceof WebAssembly.CompileError) {
+ document.getElementById("wasm-error").hidden = false;
+ }
+ throw e;
+ }
+});
diff --git a/embeds/frp-color-picker/propagators.wasm b/embeds/frp-color-picker/propagators.wasm
new file mode 100644
index 0000000..d33412e
--- /dev/null
+++ b/embeds/frp-color-picker/propagators.wasm
Binary files differ
diff --git a/haunt.scm b/haunt.scm
index fc7d311..75ed993 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -61,7 +61,8 @@
(static-directory "fonts")
(static-directory "images")
(static-directory "videos")
- (static-directory "src"))
+ (static-directory "src")
+ (static-directory "embeds"))
#:publishers (list (rsync-publisher #:destination "/var/www/blog"
#:user "publish"
#:host "dthompson.us"))
diff --git a/images/propagators/rgb-hsv-color-diagram.png b/images/propagators/rgb-hsv-color-diagram.png
new file mode 100644
index 0000000..432f1de
--- /dev/null
+++ b/images/propagators/rgb-hsv-color-diagram.png
Binary files differ
diff --git a/markdown.scm b/markdown.scm
index d1a70b4..1fcf721 100644
--- a/markdown.scm
+++ b/markdown.scm
@@ -29,10 +29,13 @@
;; <img> tags with a ".webm" source and substitute a <video> tag.
(define (media-hackery . tree)
(sxml-match tree
- ((img (@ (src ,src) . ,attrs) . ,body)
- (if (string-suffix? ".webm" src)
- `(video (@ (src ,src) (controls "true"),@attrs) ,@body)
- tree))))
+ ((img (@ (src ,src) (alt ,alt) . ,attrs) . ,body)
+ (cond
+ ((string=? src "sxml")
+ (call-with-input-string alt read))
+ ((string-suffix? ".webm" src)
+ `(video (@ (src ,src) (controls "true") ,@attrs) ,@body))
+ (else tree)))))
(define %commonmark-rules
`((code . ,highlight-code)
diff --git a/posts/2024-07-03-frp-with-propagators.md b/posts/2024-07-03-frp-with-propagators.md
new file mode 100644
index 0000000..cfb0e30
--- /dev/null
+++ b/posts/2024-07-03-frp-with-propagators.md
@@ -0,0 +1,1147 @@
+title: Functional reactive user interfaces with propagators
+date: 2024-07-08 08:30:00
+tags: lisp, scheme, guile, frp
+summary: A look at a prototype functional reactive web UI using the propagator paradigm
+---
+
+I’ve been interested in functional reactive programming (FRP) for
+about a decade now. I even wrote a couple of
+[blog](/posts/functional-reactive-programming-in-scheme-with-guile-2d.html)
+[posts](/posts/live-asset-reloading-with-guile-2d.html) back in 2014
+describing my experiments. My initial source of inspiration was
+[Elm](https://elm-lang.org/), the Haskell-like language for the web
+that [once had FRP](https://elm-lang.org/news/farewell-to-frp) as a
+core part of the language. From there, I explored the academic
+literature on the subject.
+
+(Sidenote: The Elm of 10 years ago looks quite different than the Elm
+of today and I don’t know where to find that time-traveling Mario demo
+that sent me down this path in the first place. That demo was really
+cool! I’ll update this post later if I can find an archive of it.)
+
+Ultimately, I created and then abandoned a library that focused on
+[FRP for games](/projects/sly.html). It was a neat idea, but the
+performance was terrible. The overhead of my kinda-sorta FRP system
+was part of the problem, but mostly it was my own inexperience. I
+didn’t know how to optimize effectively and my implementation
+language, [Guile](https://gnu.org/s/guile), did not have as many
+optimization passes as it does now. Also, realtime simulations like
+games require much more careful use of heap allocation.
+
+I found that, overhead aside, FRP is a bad fit for things like
+scripting sequences of actions in a game. I don’t want to give up
+things like coroutines that make it easy. I’ve learned how different
+layers of a program may call for different programming paradigms.
+Functional layers rest upoin imperative foundations. Events are built
+on top of polling. Languages with expression trees run on machines
+that only understand linear sequences. You get the idea. A good
+general-purpose language will allow you to compose many paradigms in
+the same program. I’m still a big fan of functional programming, but
+single paradigm languages do not appeal to me.
+
+Fast forward 10 years, I find myself thinking about FRP again in a new
+context. I now work for the [Spritely
+Institute](https://spritely.institute) where we’re researching and
+building the next generation of [secure, distributed application
+infrastructure](https://spritely.institute/goblins). We want to demo
+our tech through easy-to-use web applications, which means we need to
+do some UI programming. So, the back burner of my brain has been
+mulling over the possibilities. What’s the least painful way to build
+web UIs? Is this FRP thing worth revisiting?
+
+The reason why FRP is so appealing to me (on paper, at least) is that
+it allows for writing interactive programs *declaratively*. With FRP,
+I can simply describe the *relationships* between the various
+time-varying components, and the system wires it all together for me.
+I’m spared from *callback hell*, one of the more frightening layers of
+hell that forces programs to be written in a kind of
+[continuation-passing
+style](https://en.wikipedia.org/wiki/Continuation-passing_style) where
+timing and state bugs consume more development time as the project
+grows.
+
+## What about React?
+
+In the time during and since I last experimented with FRP, a different
+approach to declarative UI programming has swept the web development
+world: [React](https://react.dev/). From React, many other similar
+libraries emerged. On the minimalist side there are things like
+[Mithril](https://mithril.js.org/) (a favorite of mine), and then
+there are bigger players like [Vue](https://vuejs.org/). The term
+“reactive” has become overloaded, but in the mainstream software world
+it is associated with React and friends. FRP is quite different,
+despite sharing the declarative and reactive traits. Both help free
+programmers from callback hell, but they achieve their results
+differently.
+
+The React model describes an application as a tree of “components”.
+Each component represents a subset of the complete UI element tree.
+For each component, there is a template function that takes some
+inputs and returns the new desired state of the UI. This function is
+called whenever an event occurs that might change the state of the UI.
+The template produces a data structure known as a “virtual
+[DOM](https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model)”.
+To realize this new state in the actual DOM, React diffs the previous
+tree with the new one and updates, creates, and deletes elements as
+necessary.
+
+With FRP, you describe your program as an acyclic graph of nodes that
+contain time-varying values. The actual value of any given node is
+determined by a function that maps the current values of some input
+nodes into an output value. The system is bootstrapped by handling a
+UI event and updating the appropriate root node, which kicks off a
+cascade of updates throughout the graph. At the leaf nodes,
+side-effects occur that realize the desired state of the application.
+Racket’s [FrTime](https://docs.racket-lang.org/frtime/) is one example
+of such a system, which is based on Greg Cooper’s 2008 PhD
+dissertation [“Integrating Dataflow Evaluation into a Practical
+Higher-Order Call-by-Value
+Language”](https://cs.brown.edu/people/ghcooper/thesis.pdf). In
+FrTime, time-varying values are called “signals”. Elm borrowed this
+language, too, and there’s currently a [proposal to add signals to
+JavaScript](https://github.com/tc39/proposal-signals). Research into
+FRP goes back quite a bit further. Notably, Conal Elliot and Paul
+Hudak wrote [“Functional Reactive
+Animation”](http://conal.net/papers/icfp97/icfp97.pdf) in 1997.
+
+## On jank
+
+The scope of potential change for any given event is larger in React
+than FRP. An FRP system flows data through an acyclic graph, updating
+only the nodes affected by the event. React requires re-evaluating
+the template for each component that needs refreshing and applying a
+diff algorithm to determine what needs changing in the currently
+rendered UI. The virtual DOM diffing process can be quite wasteful in
+terms of both memory usage and processing time, leading to jank on
+systems with limited resources like phones. Andy Wingo has done some
+interesting analyses of things like [React
+Native](https://wingolog.org/archives/2023/04/21/structure-and-interpretation-of-react-native)
+and
+[Flutter](https://wingolog.org/archives/2023/04/26/structure-and-interpretation-of-flutter)
+and covers the subject of jank well. So, while I appreciate the
+greatly improved developer experience of React-likes (I wrote my fair
+share of frontend code in the jQuery days), I’m less pleased by the
+overhead that it pushes onto each user’s computer. React feels like
+an important step forward on the declarative UI trail, but it’s not
+the destination.
+
+FRP has the potential for less jank because side-effects (the UI
+widget state updates) can be more precise. For example, if a web page
+has a text node that displays the number of times the user has clicked
+a mouse button, an FRP system could produce a program that would do
+the natural thing: Register a click event handler that replaces the
+text node with a new one containing the updated count. We don’t need
+to diff the whole page, nor do we need to create a wrapper component
+to update a subset of the page. The scope is narrow, so we can apply
+smaller updates. No virtual DOM necessary. There is, of course,
+overhead to maintaining the graph of time-varying values. The
+underlying runtime is free to use mutable state, but the user layer
+must take care to use pure functions and persistent, immutable data
+structures. This has a cost, but the per-event cost to refresh the UI
+feels much more reasonable when compared to React. From here on, I
+will stop talking about React and start exploring if FRP might really
+offer a more expressive way to do declarative UI without too much
+overhead. But first, we need to talk about a serious problem.
+
+## FRP is acyclic
+
+FRP is no silver bullet. As mentioned earlier, FRP graphs are
+typically of the acyclic flavor. This limits the set of UIs that are
+possible to create with FRP. Is this the cost of declarativeness? To
+demonstrate the problem, consider a color picker tool that has sliders
+for both the red-green-blue and hue-saturation-value representations
+of color:
+
+![Network diagram of RGB/HSV color picker](/images/propagators/rgb-hsv-color-diagram.png)
+
+In this program, updating the sliders on the RGB side should change
+the values of the sliders on the HSV side, and vice versa. This forms
+a cycle between the two sets of sliders. It’s possible to express
+cycles like this with event callbacks, though it’s messy and
+error-prone to do manually. We’d like a system built on top of event
+callbacks that can do the right thing without strange glitches or
+worse, unbounded loops.
+
+## Propagators to the rescue
+
+Fortunately, I didn’t create that diagram above. It’s from Alexey
+Radul’s 2009 PhD dissertation: [“Propagation Networks: A Flexible and
+Expressive Substrate for
+Computation”](https://dspace.mit.edu/bitstream/handle/1721.1/49525/MIT-CSAIL-TR-2009-053.pdf).
+This paper dedicates a section to explaining how FRP can be built on
+top a more general paradigm called *propagation networks*, or just
+*propagators* for short. The paper is lengthy, naturally, but it is
+written in an approachable style. There isn’t any terse math notation
+and there are plenty of code examples. As far as PhD dissertations
+go, this one is a real page turner!
+
+Here is a quote from section 5.5 about FrTime (with emphasis added by
+me):
+
+> FrTime is built around a custom propagation infrastructure; it
+> nicely achieves both non-recomputation and glitch avoidance, but
+> unfortunately, the propagation system is **nontrivially
+> complicated**, and **specialized for the purpose of supporting
+> functional reactivity**. In particular, the FrTime system **imposes
+> the invariant that the propagation graph be acyclic**, and
+> guarantees that it will **execute the propagators in
+> topological-sort order**. This simplifies the propagators
+> themselves, but greatly complicates the runtime system, especially
+> because it has to **dynamically recompute the sort order** when the
+> structure of some portion of the graph changes (as when the
+> predicate of a conditional changes from true to false, and the other
+> branch must now be computed). That complexity, in turn, makes that
+> runtime system **unsuitable for other kinds of propagation**, and
+> even makes it **difficult for other kinds of propagation to
+> interoperate** with it.
+
+So, the claim is that FRP-on-propagators can remove the acyclic
+restriction, reduce complexity, and improve interoperability. But
+what are propagators? I like how the book [“Software Design for
+Flexibility”](https://mitpress.mit.edu/9780262045490/software-design-for-flexibility/)
+(2021) defines them (again, with emphasis added by me):
+
+> “The propagator model is built on the idea that the basic
+> computational elements are propagators, **autonomous independent
+> machines interconnected by shared cells through which they
+> communicate**. Each propagator machine continuously examines the
+> cells is is connected to, and adds information to some cells based
+> on computations it can make from information it can get from others.
+> **Cells accumulate information and propagators produce
+> information**.”
+
+Research on propagators goes back a long way (you’ll even find a form
+of propagators in the all-time classic [“Structure and Interpretation
+of Computer
+Programs”](https://sarabander.github.io/sicp/html/3_002e3.xhtml#g_t3_002e3_002e5)),
+but it was Alexey Radul that discovered how to unify many different
+types of special-purpose propagation systems so that they could share
+a generic substrate and interoperate.
+
+Perhaps the most exciting application of the propagator model is AI,
+where it can be used to create “explainable AI” that keeps track of
+how a particular output was computed. This type of AI stands in stark
+contrast to the much hyped mainstream machine learning models that
+hoover up our planet’s precious natural resources to produce black
+boxes that generate [impressive
+bullshit](https://link.springer.com/article/10.1007/s10676-024-09775-5).
+But anyway!
+
+The diagram above can also be found in section 5.5 of the
+dissertation. Here’s the description:
+
+> “A network for a widget for RGB and HSV color selection. Traditional
+> functional reactive systems have qualms about the circularity, but
+> general-purpose propagation handles it automatically.”
+
+This color picker felt like a good, achievable target for a prototype.
+The propagator network is small and there are only a handful of UI
+elements, yet it will test if the FRP system is working correctly.
+
+## The prototype
+
+I read Alexey Radul’s dissertation, and then read chapter 7 of
+Software Design for Flexibility, which is all about propagators. Both
+use Scheme as the implementation language. The latter makes no
+mention of FRP, and while the former explains *how* FRP can be
+implemented in terms of propagators, there is (understandably) no code
+included. So, I had to implement it for myself to test my
+understanding. Unsurprisingly, I had misunderstood many things along
+the way and my iterations of broken code let me know that.
+Implementation is the best teacher.
+
+After much code fiddling, I was able to create a working prototype of
+the color picker. Here it is below:
+
+![(iframe (@ (src "/embeds/frp-color-picker/") (height "600px")))](sxml)
+
+This prototype is written in Scheme and uses
+[Hoot](https://spritely.institute/hoot) to compile it to WebAssembly
+so I can embed it right here in my blog. Sure beats a screenshot or
+video! This prototype contains a minimal propagator implementation
+that is sufficient to bootstrap a similarly minimal FRP
+implementation.
+
+## Propagator implementation
+
+Let’s take a look at the code and see how it all works, starting with
+propagation. There are two essential data types: Cells and
+propagators. Cells accumulate information about a value, ranging from
+*nothing*, some form of *partial information*, or a complete value.
+The concept of partial information is Alexey Radul’s major
+contribution to the propagator model. It is through partial
+information structures that general-purpose propagators can be used to
+implement logic programming, probabilistic programming, type
+inference, and FRP, among others. I’m going to keep things as simple
+as possible in this post (it’s a big enough infodump already), but do
+read the propagator literature if phrases like “dependency directed
+backtracking” and “truth maintenance system” sound like a good time to
+you.
+
+Cells start out knowing *nothing*, so we need a special, unique value
+to represent nothing:
+
+```scheme
+(define-record-type <nothing>
+ (make-nothing)
+ %nothing?)
+(define nothing (make-nothing))
+(define (nothing? x) (eq? x nothing))
+```
+
+Any unique (as in `eq?`) object would do, such as `(list ’nothing)`,
+but I chose to use a record type because I like the way it prints.
+
+In addition to nothing, the propagator model also has a notion of
+*contradictions*. If one source of information says there are four
+lights, but another says there are five, then we have a contradiction.
+Propagation networks do not fall apart in the presence of
+contradictory information. There’s a data type that captures
+information about them and they can be resolved in a context-specific
+manner. I mention contradictions only for the sake of completeness,
+as a general-purpose propagator system needs to handle them. This
+prototype does not create any contradictions, so I won’t mention them
+again.
+
+Now we can define a cell type:
+
+```scheme
+(define-record-type <cell>
+ (%make-cell relations neighbors content strongest
+ equivalent? merge find-strongest handle-contradiction)
+ cell?
+ (relations cell-relations)
+ (neighbors cell-neighbors set-cell-neighbors!)
+ (content cell-content set-cell-content!)
+ (strongest cell-strongest set-cell-strongest!)
+ ;; Dispatch table:
+ (equivalent? cell-equivalent?)
+ (merge cell-merge)
+ (find-strongest cell-find-strongest)
+ (handle-contradiction cell-handle-contradiction))
+```
+
+The details of *how* a cell does things like merge old information
+with new information is left intentionally unanswered at this level of
+abstraction. Different systems built on propagators will want to
+handle things in different ways. In the propagator literature, you’ll
+see generic procedures used extensively for this purpose. For the
+sake of simplicity, I use a dispatch table instead. It would be easy
+to layer generic merge on top later, if we wanted.
+
+The constructor for cells sets the default contents to nothing:
+
+```scheme
+(define default-equivalent? equal?)
+;; But what about partial information???
+(define (default-merge old new) new)
+(define (default-find-strongest content) content)
+(define (default-handle-contradiction cell) (values))
+
+(define* (make-cell name #:key
+ (equivalent? default-equivalent?)
+ (merge default-merge)
+ (find-strongest default-find-strongest)
+ (handle-contradiction default-handle-contradiction))
+ (let ((cell (%make-cell (make-relations name) '() nothing nothing
+ equivalent? merge find-strongest
+ handle-contradiction)))
+ (add-child! (current-parent) cell)
+ cell))
+```
+
+The default procedures used for the dispatch table are either no-ops
+or trivial. The default `merge` doesn’t merge at all, it just
+clobbers the old with the new. It’s up to the layers on top to
+provide more useful implementations.
+
+Cells can have neighbors (which will be propagators):
+
+```scheme
+(define (add-cell-neighbor! cell neighbor)
+ (set-cell-neighbors! cell (lset-adjoin eq? (cell-neighbors cell) neighbor)))
+```
+
+Since cells accumulate information, there are procedures for adding
+new content and finding the current strongest value contained within:
+
+```scheme
+(define (add-cell-content! cell new)
+ (match cell
+ (($ <cell> _ neighbors content strongest equivalent? merge
+ find-strongest handle-contradiction)
+ (let ((content* (merge content new)))
+ (set-cell-content! cell content*)
+ (let ((strongest* (find-strongest content*)))
+ (cond
+ ;; New strongest value is equivalent to the old one. No need
+ ;; to alert propagators.
+ ((equivalent? strongest strongest*)
+ (set-cell-strongest! cell strongest*))
+ ;; Uh oh, a contradiction! Call handler.
+ ((contradiction? strongest*)
+ (set-cell-strongest! cell strongest*)
+ (handle-contradiction cell))
+ ;; Strongest value has changed. Alert the propagators!
+ (else
+ (set-cell-strongest! cell strongest*)
+ (for-each alert-propagator! neighbors))))))))
+```
+
+Next up is the propagator type. Propagators can be *activated* to
+create information using content stored in cells and store their
+results in some other cells, forming a graph. Data flow is not forced
+to be directional. Cycles are not only permitted, but very common in
+practice. So, propagators keep track of both their input and output
+cells:
+
+```scheme
+(define-record-type <propagator>
+ (%make-propagator relations inputs outputs activate)
+ propagator?
+ (relations propagator-relations)
+ (inputs propagator-inputs)
+ (outputs propagator-outputs)
+ (activate propagator-activate))
+```
+
+Propagators can be *alerted* to schedule themselves to be re-evaluted:
+
+```scheme
+(define (alert-propagator! propagator)
+ (queue-task! (propagator-activate propagator)))
+```
+
+The constructor for propagators adds the new propagator as a neighbor
+to all input cells and then calls `alert-propagator!` to bootstrap it:
+
+```scheme
+(define (make-propagator name inputs outputs activate)
+ (let ((propagator (%make-propagator (make-relations name)
+ inputs outputs activate)))
+ (add-child! (current-parent) propagator)
+ (for-each (lambda (cell)
+ (add-cell-neighbor! cell propagator))
+ inputs)
+ (alert-propagator! propagator)
+ propagator))
+```
+
+There are two main classes of propagators that will be used:
+**primitive propagators** and **constraint propagators**. Primitive
+propagators are directional; they apply a function to the values of
+some input cells and write the result to an output cell:
+
+```scheme
+(define (unusable-value? x)
+ (or (nothing? x) (contradiction? x)))
+
+(define (primitive-propagator name f)
+ (match-lambda*
+ ((inputs ... output)
+ (define (activate)
+ (let ((args (map cell-strongest inputs)))
+ (unless (any unusable-value? args)
+ (add-cell-content! output (apply f args)))))
+ (make-propagator name inputs (list output) activate))))
+```
+
+We can use `primitive-propagator` to lift standard Scheme procedures
+into the realm of propagators. Here’s how we’d make and use an
+addition propagator:
+
+```scheme
+(define p:+ (primitive-propagator +))
+(define a (make-cell))
+(define b (make-cell))
+(define c (make-cell))
+(p:+ a b c)
+(add-cell-content! a 1)
+(add-cell-content! b 3)
+;; After the scheduler runs…
+(cell-strongest c) ;; => 4
+```
+
+It is from these primitive propagators that we can build more
+complicated, compound propagators. Compound propagators compose
+primitive propagators (or other compound propagators) and lazily
+construct their section of the network upon first activation:
+
+```scheme
+(define (compound-propagator name inputs outputs build)
+ (let ((built? #f))
+ (define (maybe-build)
+ (unless (or built?
+ (and (not (null? inputs))
+ (every unusable-value? (map cell-strongest inputs))))
+ (parameterize ((current-parent (propagator-relations propagator)))
+ (build)
+ (set! built? #t))))
+ (define propagator (make-propagator name inputs outputs maybe-build))
+ propagator))
+```
+
+By this point you may be wondering what all the references to
+`current-parent` are about. It is for tracking the parent/child
+relationships of the cells and propagators in the network. This could
+be helpful for things like visualizing the network, but we aren’t
+going to do anything with it today. I’ve omitted all of the other
+relation code for this reason.
+
+Constraint propagators are compound propagators whose inputs and
+outputs are the same, which results in bidirectional propagation:
+
+```scheme
+(define (constraint-propagator name cells build)
+ (compound-propagator name cells cells build))
+```
+
+Using primitive propagators for addition and subtraction, we can build
+a constraint propagator for the equation `a + b = c`:
+
+```scheme
+(define p:+ (primitive-propagator +))
+(define p:- (primitive-propagator -))
+(define (c:sum a b c)
+ (define (build)
+ (p:+ a b c)
+ (p:- c a b)
+ (p:- c b a))
+ (constraint-propagator 'sum (list a b c) build))
+(define a (make-cell))
+(define b (make-cell))
+(define c (make-cell))
+(c:sum a b c)
+(add-cell-content! a 1)
+(add-cell-content! c 4)
+;; After the scheduler runs…
+(cell-strongest b) ;; => 3
+```
+
+With a constraint, we can populate any two cells and the propagation
+system will figure out the value of the third. Pretty cool!
+
+This is a good enough propagation system for the FRP prototype.
+
+## FRP implementation
+
+If you’re familiar with terminology from other FRP systems like
+“signals” and “behaviors” then set that knowledge aside for now. We
+need some new nouns. But first, a bit about the problems that need
+solving in order to implement FRP on top of general-purpose
+propagators:
+
+* The propagator model does not enforce any ordering of *when*
+ propagators will be re-activated in relation to each other. If
+ we’re not careful, something in the network could compute a value
+ using a mix of fresh and stale data, resulting in a momentary
+ “glitch” that could be noticeable in the UI.
+
+* The presence of cycles introduce a crisis of identity. It’s not
+ sufficient for every time-varying value to be treated as its own
+ self. In the color picker, the RGB values and the HSV values are
+ two representations of *the same thing*. We need a new notion of
+ identity to capture this and prevent unnecessary churn and glitches
+ in the network.
+
+For starters, we will create a “reactive identifier” (needs a better
+name) data type that serves two purposes:
+
+1) To create shared identity between different information sources
+that are *logically* part of the same thing
+
+2) To create localized timestamps for values associated with this identity
+
+```scheme
+(define-record-type <reactive-id>
+ (%make-reactive-id name clock)
+ reactive-id?
+ (name reactive-id-name)
+ (clock reactive-id-clock set-reactive-id-clock!))
+
+(define (make-reactive-id name)
+ (%make-reactive-id name 0))
+
+(define (reactive-id-tick! id)
+ (let ((t (1+ (reactive-id-clock id))))
+ (set-reactive-id-clock! id t)
+ `((,id . ,t))))
+```
+
+Giving each logical identity in the FRP system its own clock
+eliminates the need for a global clock, avoiding a potentially
+troublesome source of centralization. This is kind of like how
+[Lamport timestamps](https://en.wikipedia.org/wiki/Lamport_timestamp)
+are used in distributed systems.
+
+We also need a data type that captures the value of something at a
+particular point in time. Since the cruel march of time is unceasing,
+these are *ephemeral* values:
+
+```scheme
+(define-record-type <ephemeral>
+ (make-ephemeral value timestamps)
+ ephemeral?
+ (value ephemeral-value)
+ ;; Association list mapping identity -> time
+ (timestamps ephemeral-timestamps))
+```
+
+Ephemerals are boxes that contain some arbitrary data with a bunch of
+shipping labels slapped onto the outside explaining from whence they
+came. This is the partial information structure that our propagators
+will manipulate and add to cells.
+
+Here’s how to say “the mouse position was (1, 2) at time 3” in code:
+
+```scheme
+(define mouse-position (make-reactive-id ’mouse-position))
+(make-ephemeral #(1 2) `((,mouse-position . 3)))
+```
+
+We need to perform a few operations with ephemerals:
+
+1) Test if one ephemeral is *fresher* (more recent) than another
+
+2) Compose the timestamps from several inputs to form an aggregate
+timestamp for an output, but only if all timestamps for each distinct
+identifier match (no mixing of fresh and stale values)
+
+3) Merge two ephemerals when cell content is added
+
+```scheme
+(define (ephemeral-fresher? a b)
+ (let ((b-inputs (ephemeral-timestamps b)))
+ (let lp ((a-inputs (ephemeral-timestamps a)))
+ (match a-inputs
+ (() #t)
+ (((key . a-time) . rest)
+ (match (assq-ref b-inputs key)
+ (#f (lp rest))
+ (b-time
+ (and (> a-time b-time)
+ (lp rest)))))))))
+
+(define (merge-ephemerals old new)
+ (cond
+ ((nothing? old) new)
+ ((nothing? new) old)
+ (else (if (ephemeral-fresher? new old) new old))))
+
+(define (merge-ephemeral-timestamps ephemerals)
+ (define (adjoin-keys alist keys)
+ (fold (lambda (key+value keys)
+ (match key+value
+ ((key . _)
+ (lset-adjoin eq? keys key))))
+ keys alist))
+ (define (check-timestamps id)
+ (let lp ((ephemerals ephemerals) (t #f))
+ (match ephemerals
+ (() t)
+ ((($ <ephemeral> _ timestamps) . rest)
+ (match (assq-ref timestamps id)
+ ;; No timestamp for this id in this ephemeral. Continue.
+ (#f (lp rest t))
+ (t*
+ (if t
+ ;; If timestamps don't match then we have a mix of
+ ;; fresh and stale values, so return #f. Otherwise,
+ ;; continue.
+ (and (= t t*) (lp rest t))
+ ;; Initialize timestamp and continue.
+ (lp rest t*))))))))
+ ;; Build a set of all reactive identifiers across all ephemerals.
+ (let ((ids (fold (lambda (ephemeral ids)
+ (adjoin-keys (ephemeral-timestamps ephemeral) ids))
+ '() ephemerals)))
+ (let lp ((ids ids) (timestamps '()))
+ (match ids
+ (() timestamps)
+ ((id . rest)
+ ;; Check for consistent timestamps. If they are consistent
+ ;; then add it to the alist and continue. Otherwise, return
+ ;; #f.
+ (let ((t (check-timestamps id)))
+ (and t (lp rest (cons (cons id t) timestamps)))))))))
+```
+
+Example usage:
+
+```scheme
+(define e1 (make-ephemeral #(3 4) `((,mouse-position . 4))))
+(define e2 (make-ephemeral #(1 2) `((,mouse-position . 3))))
+
+(ephemeral-fresher? e1 e2) ;; => #t
+(merge-ephemerals e1 e2) ;; => e1
+
+(merge-ephemeral-timestamps (list e1 e2)) ;; => #f
+
+(define (mouse-max-coordinate e)
+ (match e
+ (($ <ephemeral> #(x y) timestamps)
+ (make-ephemeral (max x y) timestamps))))
+(define e3 (mouse-max-coordinate e1))
+(merge-ephemeral-timestamps (list e1 e3)) ;; => ((mouse-position . 4))
+```
+
+Now we can build a primitive propagator constructor that lifts
+ordinary Scheme procedures so that they work with ephemerals:
+
+```scheme
+(define (ephemeral-wrap proc)
+ (match-lambda*
+ ((and ephemerals (($ <ephemeral> args) ...))
+ (match (merge-ephemeral-timestamps ephemerals)
+ (#f nothing)
+ (timestamps (make-ephemeral (apply proc args) timestamps))))))
+
+(define* (primitive-reactive-propagator name proc)
+ (primitive-propagator name (ephemeral-wrap proc)))
+```
+
+## Reactive UI implementation
+
+Now we need some propagators that live at the edges of our network
+that know how to interact with the DOM and can do the following:
+
+1) Sync a DOM element attribute with the value of a cell
+
+2) Create a two-way data binding between an element’s `value` attribute
+and a cell
+
+3) Render the markup in a cell and place it into the DOM tree in the
+right location
+
+Syncing an element attribute is a directional operation and the
+easiest to implement:
+
+```scheme
+(define (r:attribute input elem attr)
+ (let ((attr (symbol->string attr)))
+ (define (activate)
+ (match (cell-strongest input)
+ (($ <ephemeral> val)
+ (attribute-set! elem attr (obj->string val)))
+ ;; Ignore unusable values.
+ (_ (values))))
+ (make-propagator 'r:attribute (list input) '() activate)))
+```
+
+Two-way data binding is more involved. First, a new data type is used
+to capture the necessary information:
+
+```scheme
+(define-record-type <binding>
+ (make-binding id cell default group)
+ binding?
+ (id binding-id)
+ (cell binding-cell)
+ (default binding-default)
+ (group binding-group))
+
+(define* (binding id cell #:key (default nothing) (group '()))
+ (make-binding id cell default group))
+```
+
+And then a reactive propagator applies that binding to a specific DOM
+element:
+
+```scheme
+(define* (r:binding binding elem)
+ (match binding
+ (($ <binding> id cell default group)
+ (define (update new)
+ (unless (nothing? new)
+ (let ((timestamp (reactive-id-tick! id)))
+ (add-cell-content! cell (make-ephemeral new timestamp))
+ ;; Freshen timestamps for all cells in the same group.
+ (for-each (lambda (other)
+ (unless (eq? other cell)
+ (match (cell-strongest other)
+ (($ <ephemeral> val)
+ (add-cell-content! other (make-ephemeral val timestamp)))
+ (_ #f))))
+ group))))
+ ;; Sync the element's value with the cell's value.
+ (define (activate)
+ (match (cell-strongest cell)
+ (($ <ephemeral> val)
+ (set-value! elem (obj->string val)))
+ (_ (values))))
+ ;; Initialize element value with the default value.
+ (update default)
+ ;; Sync the cell's value with the element's value.
+ (add-event-listener! elem "input"
+ (procedure->external
+ (lambda (event)
+ (update (string->obj (value elem))))))
+ (make-propagator 'r:binding (list cell) '() activate))))
+```
+
+A simple method for rendering to the DOM is to replace some element
+with a newly created element based on the current ephemeral value of a
+cell:
+
+```scheme
+(define (r:dom input elem)
+ (define (activate)
+ (match (cell-strongest input)
+ (($ <ephemeral> exp)
+ (let ((new (sxml->dom exp)))
+ (replace-with! elem new)
+ (set! elem new)))
+ (_ (values))))
+ (make-propagator 'dom (list input) '() activate))
+```
+
+The `sxml->dom` procedure deserves some further explanation. To
+create a subtree of new elements, we have two options:
+
+1) Use something like the
+[`innerHTML`](https://developer.mozilla.org/en-US/docs/Web/API/Element/innerHTML)
+element property to insert arbitrary HTML as a string and let the
+browser parse and build the elements.
+
+2) Use a Scheme data structure that we can iterate over and make the
+relevant `document.createTextNode`, `document.createElement`,
+etc. calls.
+
+Option 1 might be a shortcut and would be fine for a quick prototype,
+but it would mean that to generate the HTML we’d be stuck using raw
+strings. While string-based templating is commonplace, we can
+certainly [do
+better](https://www.more-magic.net/posts/structurally-fixing-injection-bugs.html)
+in Scheme. Option 2 is actually not too much work and we get to use
+Lisp’s universal templating system,
+[`quasiquote`](https://www.gnu.org/software/guile/manual/r5rs/Quasiquotation.html),
+to write our markup.
+
+Thankfully, [SXML](https://en.wikipedia.org/wiki/SXML) already exists
+for this purpose. SXML is an alternative XML syntax that uses
+s-expressions. Since Scheme uses s-expression syntax, it’s a natural
+fit.
+
+Example:
+
+```scheme
+'(article
+ (h1 "SXML is neat")
+ (img (@ (src "cool.jpg") (alt "cool image")))
+ (p "Yeah, SXML is " (em "pretty neato!")))
+```
+
+Instead of using it to generate HTML text, we’ll instead generate a
+tree of DOM elements. Furthermore, because we’re now in full control
+of how the element tree is built, we can build in support for reactive
+propagators!
+
+Check it out:
+
+```scheme
+(define (sxml->dom exp)
+ (match exp
+ ;; The simple case: a string representing a text node.
+ ((? string? str)
+ (make-text-node str))
+ ((? number? num)
+ (make-text-node (number->string num)))
+ ;; A cell containing SXML (or nothing)
+ ((? cell? cell)
+ (let ((elem (cell->elem cell)))
+ (r:dom cell elem)
+ elem))
+ ;; An element tree. The first item is the HTML tag.
+ (((? symbol? tag) . body)
+ ;; Create a new element with the given tag.
+ (let ((elem (make-element (symbol->string tag))))
+ (define (add-children children)
+ ;; Recursively call sxml->dom for each child node and
+ ;; append it to elem.
+ (for-each (lambda (child)
+ (append-child! elem (sxml->dom child)))
+ children))
+ (match body
+ ((('@ . attrs) . children)
+ (for-each (lambda (attr)
+ (match attr
+ (((? symbol? name) (? string? val))
+ (attribute-set! elem
+ (symbol->string name)
+ val))
+ (((? symbol? name) (? number? val))
+ (attribute-set! elem
+ (symbol->string name)
+ (number->string val)))
+ (((? symbol? name) (? cell? cell))
+ (r:attribute cell elem name))
+ ;; The value attribute is special and can be
+ ;; used to setup a 2-way data binding.
+ (('value (? binding? binding))
+ (r:binding binding elem))))
+ attrs)
+ (add-children children))
+ (children (add-children children)))
+ elem))))
+```
+
+Notice the calls to `r:dom`, `r:attribute`, and `r:binding`. A cell
+can be used in either the context of an element (`r:dom`) or an
+attribute (`r:attribute`). The `value` attribute gets the additional
+superpower of `r:binding`. We will make use of this when it is time
+to render the color picker UI!
+
+## Color picker implementation
+
+Alright, I’ve spent a lot of time explaining how I built a minimal
+propagator and FRP system from first principles on top of
+Hoot-flavored Scheme. Let’s *finally* write the dang color picker!
+
+First we need some data types to represent RGB and HSV colors:
+
+```scheme
+(define-record-type <rgb-color>
+ (rgb-color r g b)
+ rgb-color?
+ (r rgb-color-r)
+ (g rgb-color-g)
+ (b rgb-color-b))
+
+(define-record-type <hsv-color>
+ (hsv-color h s v)
+ hsv-color?
+ (h hsv-color-h)
+ (s hsv-color-s)
+ (v hsv-color-v))
+```
+
+And procedures to convert RGB to HSV and vice versa:
+
+```scheme
+(define (rgb->hsv rgb)
+ (match rgb
+ (($ <rgb-color> r g b)
+ (let* ((cmax (max r g b))
+ (cmin (min r g b))
+ (delta (- cmax cmin)))
+ (hsv-color (cond
+ ((= delta 0.0) 0.0)
+ ((= cmax r)
+ (let ((h (* 60.0 (fmod (/ (- g b) delta) 6.0))))
+ (if (< h 0.0) (+ h 360.0) h)))
+ ((= cmax g) (* 60.0 (+ (/ (- b r) delta) 2.0)))
+ ((= cmax b) (* 60.0 (+ (/ (- r g) delta) 4.0))))
+ (if (= cmax 0.0)
+ 0.0
+ (/ delta cmax))
+ cmax)))))
+
+(define (hsv->rgb hsv)
+ (match hsv
+ (($ <hsv-color> h s v)
+ (let* ((h' (/ h 60.0))
+ (c (* v s))
+ (x (* c (- 1.0 (abs (- (fmod h' 2.0) 1.0)))))
+ (m (- v c)))
+ (define-values (r' g' b')
+ (cond
+ ((<= 0.0 h 60.0) (values c x 0.0))
+ ((<= h 120.0) (values x c 0.0))
+ ((<= h 180.0) (values 0.0 c x))
+ ((<= h 240.0) (values 0.0 x c))
+ ((<= h 300.0) (values x 0.0 c))
+ ((<= h 360.0) (values c 0.0 x))))
+ (rgb-color (+ r' m) (+ g' m) (+ b' m))))))
+```
+
+We also need some procedures to convert colors into the hexadecimal
+representations we’re used to seeing:
+
+```scheme
+(define (uniform->byte x)
+ (inexact->exact (round (* x 255.0))))
+
+(define (rgb->int rgb)
+ (match rgb
+ (($ <rgb-color> r g b)
+ (+ (* (uniform->byte r) (ash 1 16))
+ (* (uniform->byte g) (ash 1 8))
+ (uniform->byte b)))))
+
+(define (rgb->hex-string rgb)
+ (list->string
+ (cons #\#
+ (let lp ((i 0) (n (rgb->int rgb)) (out '()))
+ (if (= i 6)
+ out
+ (lp (1+ i) (ash n -4)
+ (cons (integer->char
+ (let ((digit (logand n 15)))
+ (+ (if (< digit 10)
+ (char->integer #\0)
+ (- (char->integer #\a) 10))
+ digit)))
+ out)))))))
+
+(define (rgb-hex->style hex)
+ (string-append "background-color: " hex ";"))
+```
+
+Now we can lift the color API into primitive reactive propagator
+constructors:
+
+```scheme
+(define-syntax-rule (define-primitive-reactive-propagator name proc)
+ (define name (primitive-reactive-propagator 'name proc)))
+
+(define-primitive-reactive-propagator r:rgb-color rgb-color)
+(define-primitive-reactive-propagator r:rgb-color-r rgb-color-r)
+(define-primitive-reactive-propagator r:rgb-color-g rgb-color-g)
+(define-primitive-reactive-propagator r:rgb-color-b rgb-color-b)
+(define-primitive-reactive-propagator r:hsv-color hsv-color)
+(define-primitive-reactive-propagator r:hsv-color-h hsv-color-h)
+(define-primitive-reactive-propagator r:hsv-color-s hsv-color-s)
+(define-primitive-reactive-propagator r:hsv-color-v hsv-color-v)
+(define-primitive-reactive-propagator r:rgb->hsv rgb->hsv)
+(define-primitive-reactive-propagator r:hsv->rgb hsv->rgb)
+(define-primitive-reactive-propagator r:rgb->hex-string rgb->hex-string)
+(define-primitive-reactive-propagator r:rgb-hex->style rgb-hex->style)
+```
+
+From those primitive propagators, we can build the necessary
+constraint propagators:
+
+```scheme
+(define (r:components<->rgb r g b rgb)
+ (define (build)
+ (r:rgb-color r g b rgb)
+ (r:rgb-color-r rgb r)
+ (r:rgb-color-g rgb g)
+ (r:rgb-color-b rgb b))
+ (constraint-propagator 'r:components<->rgb (list r g b rgb) build))
+
+(define (r:components<->hsv h s v hsv)
+ (define (build)
+ (r:hsv-color h s v hsv)
+ (r:hsv-color-h hsv h)
+ (r:hsv-color-s hsv s)
+ (r:hsv-color-v hsv v))
+ (constraint-propagator 'r:components<->hsv (list h s v hsv) build))
+
+(define (r:rgb<->hsv rgb hsv)
+ (define (build)
+ (r:rgb->hsv rgb hsv)
+ (r:hsv->rgb hsv rgb))
+ (constraint-propagator 'r:components<->hsv (list rgb hsv) build))
+```
+
+At long last, we are ready to define the UI! Here it is:
+
+```scheme
+(define (render exp)
+ (append-child! (document-body) (sxml->dom exp)))
+
+(define* (slider id name min max default #:optional (step "any"))
+ `(div (@ (class "slider"))
+ (label (@ (for ,id)) ,name)
+ (input (@ (id ,id) (type "range")
+ (min ,min) (max ,max) (step ,step)
+ (value ,default)))))
+
+(define (uslider id name default) ; [0,1] slider
+ (slider id name 0 1 default))
+
+(define-syntax-rule (with-cells (name ...) body . body*)
+ (let ((name (make-cell 'name #:merge merge-ephemerals)) ...) body . body*))
+
+(with-cells (r g b rgb h s v hsv hex style)
+ (define color (make-reactive-id 'color))
+ (define rgb-group (list r g b))
+ (define hsv-group (list h s v))
+ (r:components<->rgb r g b rgb)
+ (r:components<->hsv h s v hsv)
+ (r:rgb<->hsv rgb hsv)
+ (r:rgb->hex-string rgb hex)
+ (r:rgb-hex->style hex style)
+ (render
+ `(div
+ (h1 "Color Picker")
+ (div (@ (class "preview"))
+ (div (@ (class "color-block") (style ,style)))
+ (div (@ (class "hex")) ,hex))
+ (fieldset
+ (legend "RGB")
+ ,(uslider "red" "Red"
+ (binding color r #:default 1.0 #:group rgb-group))
+ ,(uslider "green" "Green"
+ (binding color g #:default 0.0 #:group rgb-group))
+ ,(uslider "blue" "Blue"
+ (binding color b #:default 1.0 #:group rgb-group)))
+ (fieldset
+ (legend "HSV")
+ ,(slider "hue" "Hue" 0 360 (binding color h #:group hsv-group))
+ ,(uslider "saturation" "Saturation" (binding color s #:group hsv-group))
+ ,(uslider "value" "Value" (binding color v #:group hsv-group))))))
+```
+
+Each color channel (R, G, B, H, S, and V) has a cell which is bound to
+a slider (`<input type="range">`). All six sliders are identified as
+`color`, so adjusting *any of them* increments `color`’s timestamp.
+The R, G, and B sliders form one input group, and the H, S, and V
+sliders form another. By grouping the related sliders together,
+whenever one of the sliders is moved, *all members* of the group will
+have their ephemeral value refreshed with the latest timestamp. This
+behavior is *crucial* because otherwise the `r:components<->rgb` and
+`r:components<->hsv` propagators would see that one color channel has
+a fresher value than the other two and *do nothing*. Since the
+underlying propagator infrastructure does not enforce activation
+order, reactive propagators *must* wait until their inputs reach a
+consistent state where the timestamps for a given reactive identifier
+are all the same.
+
+With this setup, changing a slider on the RGB side will cause a new
+color value to propagate over to the HSV side. Because the
+relationship is cyclical, the HSV side will then attempt to propagate
+an equivalent color value back to the RGB side! This could be bad
+news, but since the current RGB value is equally fresh (same
+timestamp), the propagation stops right there. Redundant work is
+minimized and an unbounded loop is avoided.
+
+And that’s it! Phew!
+
+Complete source code can be found
+[here](https://git.dthompson.us/software-design-for-flexibility/tree/chapter-7/propagators.scm).
+
+## Reflections
+
+I think the results of this prototype are promising. I’d like to try
+building some larger demos to see what new problems arise. Since
+propagation networks include cycles, they cannot be garbage collected
+until there are no references to any part of the network from the
+outside. Is this acceptable? I didn’t optimize, either. A more
+serious implementation would want to do things like use `case-lambda`
+for all n-ary procedures to avoid consing an argument list in the
+common cases of 1, 2, 3, etc. arguments. There is also a need for a
+more pleasing domain-specific language, using Scheme’s macro system,
+for describing FRP graphs.
+
+Alexey Radul’s dissertation was published in 2009. Has anyone made a
+FRP system based on propagators since then that’s used in real
+software? I don’t know of anything but it’s a big information
+superhighway out there.
+
+I wish I had read Alexey Radul's disseration 10 years ago when I was
+first exploring FRP. It would have saved me a lot of time spent
+running into problems that have already been solved that I was not
+equipped to solve on my own. I have even talked to Gerald Sussman (a
+key figure in propagator research) *in person* about the propagator
+model. That conversation was focused on AI, though, and I didn’t
+realize that propagators could also be used for FRP. It wasn’t until
+more recently that friend and colleague [Christine
+Lemmer-Webber](https://dustycloud.org/), who was present for the
+aforementioned conversation with Sussman, told me about it. There are
+so many interesting things to learn out there, but I am also so tired.
+Better late than never, I guess!
+
+Anyway, if you made it this far then I hope you have enjoyed reading
+about propagators and FRP. ’Til next time!
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-24 00:05:31 +0000