diff options
-rw-r--r-- | css/dthompson.css | 5 | ||||
-rw-r--r-- | embeds/frp-color-picker/hoot/reflect.js | 738 | ||||
-rw-r--r-- | embeds/frp-color-picker/hoot/reflect.wasm | bin | 0 -> 5196 bytes | |||
-rw-r--r-- | embeds/frp-color-picker/hoot/wtf8.wasm | bin | 0 -> 1071 bytes | |||
-rw-r--r-- | embeds/frp-color-picker/index.html | 26 | ||||
-rw-r--r-- | embeds/frp-color-picker/propagators.css | 38 | ||||
-rw-r--r-- | embeds/frp-color-picker/propagators.js | 30 | ||||
-rw-r--r-- | embeds/frp-color-picker/propagators.wasm | bin | 0 -> 458030 bytes | |||
-rw-r--r-- | haunt.scm | 3 | ||||
-rw-r--r-- | images/propagators/rgb-hsv-color-diagram.png | bin | 0 -> 68181 bytes | |||
-rw-r--r-- | markdown.scm | 11 | ||||
-rw-r--r-- | posts/2024-07-03-frp-with-propagators.md | 1147 |
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 Binary files differnew file mode 100644 index 0000000..770c94c --- /dev/null +++ b/embeds/frp-color-picker/hoot/reflect.wasm diff --git a/embeds/frp-color-picker/hoot/wtf8.wasm b/embeds/frp-color-picker/hoot/wtf8.wasm Binary files differnew file mode 100644 index 0000000..ca1079d --- /dev/null +++ b/embeds/frp-color-picker/hoot/wtf8.wasm 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 Binary files differnew file mode 100644 index 0000000..d33412e --- /dev/null +++ b/embeds/frp-color-picker/propagators.wasm @@ -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 Binary files differnew file mode 100644 index 0000000..432f1de --- /dev/null +++ b/images/propagators/rgb-hsv-color-diagram.png 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! |