bootstrap.pear

(:
 # "Nil is used whenever we don't actually want to provide a useful value.
  Functions that only have side-effects (aka they may crash or hang) return nil.
  See the assert function for an example."
 nil (&)

 # "Crashing stuff"
 crash (\ (error) (@crash error))
 assert (\ (check) (if check nil (crash "Assert failed.")))

 rec (\ (input function)
  (:
   rec (\ (rec input) (function (\ (new) (rec rec new)) input))
   (rec rec input)))
 rec-2 (\ (a b function)
  (:
   rec (\ (rec a b) (function (\ (a b) (rec rec a b)) a b))
   (rec rec a b)))
 rec-3 (\ (a b c function)
  (:
   rec (\ (rec a b c) (function (\ (a b c) (rec rec a b c)) a b c))
   (rec rec a b c)))
 rec-4 (\ (a b c d function)
  (:
   rec (\ (rec a b c d) (function (\ (a b c d) (rec rec a b c d)) a b c d))
   (rec rec a b c d)))

 true (| true)
 false (| false)

 _ (assert true)

 else true

 not (\ (a) (if a false true))
 and (\ (a b) (if a b false))
 and-3 (\ (a b c) (and (and a b) c))
 and-4 (\ (a b c d) (and (and-3 a b c) d))
 and-5 (\ (a b c d e) (and (and-4 a b c d) e))
 or (\ (a b) (if a true b))
 or-3 (\ (a b c) (or (or a b) c))
 or-4 (\ (a b c d) (or (or-3 a b c) d))
 or-5 (\ (a b c d e) (or (or-4 a b c d) e))

 + (\ (a b) (@add a b))
 - (\ (a b) (@subtract a b))
 * (\ (a b) (@multiply a b))
 / (\ (a b) (@divide a b))
 mod (\ (a b) (@modulo a b))
 << (\ (a b) (@shift-left a b))
 >> (\ (a b) (@shift-right a b))
 bit-and (\ (a b) (@and a b))
 bit-or (\ (a b) (@or a b))
 bit-xor (\ (a b) (@xor a b))

 compare (\ (a b) (@compare a b))
 = (\ (a b) (@equal? a b))
 != (\ (a b) (not (@equal? a b)))
 < (\ (a b) (% (compare a b) less true _ false))
 > (\ (a b) (% (compare a b) greater true _ false))
 <= (\ (a b) (% (compare a b) greater false _ true))
 >= (\ (a b) (% (compare a b) less false _ true))
 max (\ (a b) (if (> a b) a b))
 min (\ (a b) (if (< a b) a b))
 abs (\ (n) (if (< n 0) (- 0 n) n))

 f+ (\ (a b) (@f-add a b))
 f- (\ (a b) (@f-subtract a b))
 f* (\ (a b) (@f-multiply a b))
 f/ (\ (a b) (@f-divide a b))
 f-compare (\ (a b) (@f-compare a b))
 f= (\ (a b) (% (f-compare a b) equal true _ false))
 f!= (\ (a b) (% (f-compare a b) equal false _ true))
 f< (\ (a b) (% (f-compare a b) less true _ false))
 f> (\ (a b) (% (f-compare a b) greater true _ false))
 f<= (\ (a b) (% (f-compare a b) greater false _ true))
 f>= (\ (a b) (% (f-compare a b) less false _ true))
 f-max (\ (a b) (if (f> a b) a b))
 f-min (\ (a b) (if (f< a b) a b))
 int->float (\ (n) (@int->float n))
 float->int (\ (f) (@float->int f))
 f-abs (\ (n) (if (f< n 0.) (f- 0. n) n))

 even? (\ (n) (= (mod n 2) 0))
 odd? (\ (n) (= (mod n 2) 1))

 array-length (\ (array) (@array-length array))
 array-get (\ (array index) (@array-get array index))
 array->list (\ (array) (@array->list array))
 list->array (\ (list) (@list->array list))
 list-length (\ (list)
  (rec list (\ (rec list) (% list empty 0 (more m) (+ (rec (.rest m)) 1)))))

 # "Iterators. An iterator is a function that, when called, returns either
    (| empty) or (| more (& item rest))."
 list->iter (\ (list)
  (rec list (\ (rec list)
   (\ () (% list
    empty (| empty)
    (more m) (| more (& item (.item m) rest (rec (.rest m)))))))))
 array->iter (\ (array)
  (rec 0 (\ (rec i)
   (\ () (if (= i (array-length array))
    (| empty)
    (| more (& item (array-get array i) rest (rec (+ i 1)))))))))
 iter->list (\ (iter)
  (rec iter (\ (rec iter)
   (% (iter)
    empty (| empty)
    (more m) (| more (& item (.item m) rest (rec (.rest m))))))))
 iter->array (\ (iter) (list->array (iter->list iter)))

 map (\ (iter mapper)
  (rec iter (\ (rec iter)
   (\ () (% (iter)
    empty (| empty)
    (more m) (| more (& item (mapper (.item m)) rest (rec (.rest m)))))))))
 map-indexed (\ (iter mapper)
  (rec-2 iter 0 (\ (rec iter index)
   (\ () (% (iter)
    empty (| empty)
    (more m)
     (| more
      (& item (mapper index (.item m)) rest (rec (.rest m) (+ index 1)))))))))
 filter (\ (iter checker)
  (rec iter (\ (next iter)
   (\ () (rec iter (\ (seek iter)
    (% (iter)
     empty (| empty)
     (more m)
      (if (checker (.item m))
       (| more (& item (.item m) rest (next (.rest m))))
       (seek (.rest m))))))))))
 take (\ (iter n)
  (rec-2 iter n (\ (rec iter n)
   (\ () (if (= n 0)
    (| empty)
    (% (iter)
     empty (| empty)
     (more m) (| more (& item (.item m) rest (rec (.rest m) (- n 1))))))))))
 skip (\ (iter n)
  (rec-2 iter n (\ (rec iter n)
   (\ () (if (= n 0)
    (iter)
    (% (iter)
     empty (| empty)
     (more m) ((rec (.rest m) (- n 1)))))))))
 take-while (\ (iter checker)
  (rec iter (\ (rec iter)
   (\ () (% (iter)
    empty (| empty)
    (more m)
     (if (checker (.item m))
      (| more (& item (.item m) rest (rec (.rest m))))
      (| empty)))))))
 skip-while (\ (iter checker)
  (\ () (rec iter (\ (drop iter)
   (% (iter)
    empty (| empty)
    (more m)
     (if (checker (.item m))
      (drop (.rest m))
      (| more (& item (.item m) rest (.rest m)))))))))
 generate (\ (length generator)
  (rec 0 (\ (rec i)
   (\ () (if (= i length)
    (| empty)
    (| more (& item (generator i) rest (rec (+ i 1)))))))))
 fold (\ (iter initial reducer)
  (rec-2 initial iter (\ (rec state iter)
   (% (iter)
    empty state
    (more m) (rec (reducer state (.item m)) (.rest m))))))
 reduce (\ (iter reducer)
  (% (iter)
   empty (crash "called reduce on empty iterator")
   (more m) (fold (.rest m) (.item m) reducer)))
 concat (\ (a b)
  (rec a (\ (rec a)
   (\ () (% (a)
    empty (b)
    (more m) (| more (& item (.item m) rest (rec (.rest m)))))))))
 concat-3 (\ (a b c) (concat a (concat b c)))
 concat-4 (\ (a b c d) (concat a (concat-3 b c d)))
 concat-5 (\ (a b c d e) (concat a (concat-4 b c d e)))
 concat-all (\ (iters)
  (fold iters (array->iter ([])) (\ (acc it) (concat acc it))))
 length (\ (iter) (fold iter 0 (\ (n it) (+ n 1))))
 any (\ (iter checker)
  (rec iter (\ (rec iter)
   (% (iter)
    empty false
    (more m) (if (checker (.item m)) true (rec (.rest m)))))))
 find (\ (iter checker)
  (rec iter (\ (rec iter)
   (% (iter)
    empty (| none)
    (more m) (if (checker (.item m)) (| some (.item m)) (rec (.rest m)))))))
 find-index (\ (iter checker)
  (rec-2 iter 0 (\ (rec iter index)
   (% (iter)
    empty (| none)
    (more m)
     (if (checker (.item m)) (| some index) (rec (.rest m) (+ index 1)))))))
 all (\ (iter checker) (not (any iter (\ (x) (not (checker x))))))

 _ (assert (= (iter->array (array->iter ([] 1 2 3))) ([] 1 2 3)))
 _ (assert (= (iter->array (array->iter ([]))) ([])))
 _ (assert (= (iter->array (take (array->iter ([] 1 2 3 4)) 2)) ([] 1 2)))
 _ (assert (= (iter->array (skip (array->iter ([] 1 2 3 4)) 2)) ([] 3 4)))
 _ (assert (= (iter->array (generate 3 (\ (i) (* i i)))) ([] 0 1 4)))
 _ (assert (= (fold (array->iter ([] 1 2 3)) 0 +) 6))
 _ (assert (= (reduce (array->iter ([] 1 2 3)) +) 6))
 _ (assert (= (length (array->iter ([] 1 2 3))) 3))
 _ (assert (any (array->iter ([] 1 2 3)) (\ (x) (= x 2))))
 _ (assert (not (any (array->iter ([] 1 2 3)) (\ (x) (= x 9)))))
 _ (assert (= (find (array->iter ([] 1 2 3)) (\ (x) (> x 1))) (| some 2)))
 _ (assert (= (find-index (array->iter ([] 1 2 3)) (\ (x) (= x 3))) (| some 2)))
 _ (assert (= (find-index (array->iter ([] 1 2 3)) (\ (x) (= x 9))) (| none)))

 filled-list (\ (length item)
  (:
   _ (assert (< length 100))
   rec (\ (rec i)
    (if (= i length) (| empty) (| more (& item item rest (rec rec (+ i 1))))))
   (rec rec 0)))
 filled-array (\ (length item) (list->array (filled-list length item)))
 list-skip (\ (list n) (iter->list (skip (list->iter list) n)))
 array-skip (\ (array n) (iter->array (skip (array->iter array) n)))
 list-take (\ (list n) (iter->list (take (list->iter list) n)))
 array-take (\ (array n) (iter->array (take (array->iter array) n)))
 list-slice (\ (list from to)
  (iter->list (take (skip (list->iter list) from) (- to from))))
 array-slice (\ (array from to)
  (iter->array (take (skip (array->iter array) from) (- to from))))
 list-update (\ (list index item)
  (iter->list
   (map-indexed (list->iter list) (\ (i it) (if (= i index) item it)))))
 array-update (\ (array index item)
  (iter->array
   (map-indexed (array->iter array) (\ (i it) (if (= i index) item it)))))
 list-remove (\ (list index)
  (iter->list
   (concat
    (take (list->iter list) index)
    (skip (list->iter list) (+ index 1)))))
 array-remove (\ (array index)
  (iter->array
   (concat
    (take (array->iter array) index)
    (skip (array->iter array) (+ index 1)))))
 list-insert (\ (list index item)
  (iter->list
   (concat-3
    (take (list->iter list) index)
    (list->iter (| more (& item item rest (| empty))))
    (skip (list->iter list) index))))
 array-insert (\ (array index item)
  (iter->array
   (concat-3
    (take (array->iter array) index)
    (list->iter (| more (& item item rest (| empty))))
    (skip (array->iter array) index))))
 list-append (\ (list item) (list-insert list (list-length list) item))
 array-append (\ (array item) (array-insert array (array-length array) item))
 list-get (\ (list index)
  (% ((skip (list->iter list) index)) (more m) (.item m)))
 list-swap (\ (list a b)
  (iter->list
   (map-indexed
    (list->iter list)
    (\ (i it)
     (if (= i a) (list-get list b) (if (= i b) (list-get list a) it))))))
 array-swap (\ (array a b)
  (iter->array
   (map-indexed
    (array->iter array)
    (\ (i it)
     (if (= i a) (array-get array b) (if (= i b) (array-get array a) it))))))
 list-reverse (\ (list)
  (rec-2 list (| empty) (\ (rec to-reverse reversed)
   (% to-reverse
    empty reversed
    (more m) (rec (.rest m) (| more (& item (.item m) rest reversed)))))))
 array-reverse (\ (array) (list->array (list-reverse (array->list array))))
 list-take-and-reverse (\ (list n)
  (rec-2 (& list list n n) (| empty) (\ (rec args reversed)
   (:
    list (.list args)
    n (.n args)
    (if (= n 0)
     reversed
     (% list
      (more m)
       (rec
        (& list (.rest m) n (- n 1))
        (| more (& item (.item m) rest reversed)))))))))

 _ (assert (= (list-get (array->list ([] 5 6 7)) 1) 6))
 _ (assert (= (list->array (list-skip (array->list ([] 1 2 3 4)) 2)) ([] 3 4)))
 _ (assert (= (list->array (list-take (array->list ([] 1 2 3 4)) 2)) ([] 1 2)))
 _ (assert (= (list->array (list-slice (array->list ([] 1 2 3 4 5)) 1 4)) ([] 2 3 4)))
 _ (assert (= (list->array (list-update (array->list ([] 1 2 3)) 1 9)) ([] 1 9 3)))
 _ (assert (= (list->array (list-remove (array->list ([] 1 2 3)) 1)) ([] 1 3)))
 _ (assert (= (list->array (list-insert (array->list ([] 1 2 3)) 1 9)) ([] 1 9 2 3)))
 _ (assert (= (list->array (list-swap (array->list ([] 1 2 3)) 0 2)) ([] 3 2 1)))
 _ (assert (= (array-update ([] 1 2 3) 1 9) ([] 1 9 3)))
 _ (assert (= (array-remove ([] 1 2 3) 1) ([] 1 3)))
 _ (assert (= (array-insert ([] 1 2 3) 1 9) ([] 1 9 2 3)))
 _ (assert (= (array-swap ([] 1 2 3) 0 2) ([] 3 2 1)))
 _ (assert (= (array-slice ([] 1 2 3 4 5) 1 4) ([] 2 3 4)))
 _ (assert (= (array-reverse ([] 1 2 3)) ([] 3 2 1)))

 string->bytes (\ (string) (@string->bytes string))
 bytes->string (\ (bytes) (@bytes->string bytes))
 string-length (\ (string) (@array-length (string->bytes string)))
 string-concat (\ (a b)
  (bytes->string
   (iter->array
    (concat
     (array->iter (string->bytes a))
     (array->iter (string->bytes b))))))
 string-concat-3 (\ (a b c) (string-concat a (string-concat b c)))
 string-concat-4 (\ (a b c d) (string-concat a (string-concat-3 b c d)))
 string-concat-5 (\ (a b c d e) (string-concat a (string-concat-4 b c d e)))
 string-slice (\ (string from to)
  (bytes->string (array-slice (string->bytes string) from to)))
 string-replace-range (\ (string range replacement)
  (string-concat-3
   (string-slice string 0 (.start range))
   replacement
   (string-slice string (.end range) (string-length string))))
 string-remove-range (\ (string start end)
  (string-concat
   (string-slice string 0 start)
   (string-slice string end (string-length string))))
 string-remove (\ (string index)
  (string-concat
   (string-slice string 0 index)
   (string-slice string (+ index 1) (string-length string))))
 string-insert (\ (string index text)
  (string-concat-3
   (string-slice string 0 index)
   text
   (string-slice string index (string-length string))))
 string-starts-with (\ (string prefix)
  (if (> (string-length prefix) (string-length string))
   false
   (= (string-slice string 0 (string-length prefix)) prefix)))
 ascii-char (\ (literal) (array-get (string->bytes literal) 0))
 int->string (\ (int)
  (if (= int 0)
   "0"
   (rec-2 int (| empty) (\ (rec int prev)
    (if (= 0 int)
     (bytes->string (list->array prev))
     (rec
      (/ int 10)
      (| more (& item (+ (ascii-char "0") (mod int 10)) rest prev))))))))
 bytes->chars (\ (rec bytes i)
  (if (= i (array-length bytes))
   (| empty)
   (| more (&
    item (@bytes->string ([] (array-get bytes i)))
    rest (rec rec bytes (+ i 1))))))
 bytes->chars-list (\ (bytes) (bytes->chars bytes->chars bytes 0))
 string->chars-list (\ (string) (bytes->chars-list (string->bytes string)))
 string->chars-array (\ (string) (list->array (string->chars-list string)))

 value? (\ (node) (% node value true _ false))
 bind (\ (rec mode input name value)
  (% mode
   expr
    (% input
     value input
     (name n) (if (@equal? name n) value (| name n))
     (let l)
      (| let
       (&
        name (.name l)
        definition (rec rec (| expr) (.definition l) name value)
        body (rec rec (| expr) (.body l) name value)))
     (field f)
      (| field (& of (rec rec (| expr) (.of f) name value) name (.name f)))
     (call c)
      (| call
       (&
        function (rec rec (| expr) (.function c) name value)
        arguments (rec rec (| array) (.arguments c) name value)))
     _ (crash (| todo-bind input))
    )
   array (list->array (rec rec (| list) (array->list input) name value))
   list
    (% input
     empty (| empty)
     (more m)
      (| more
       (&
        item (rec rec (| expr) (.item m) name value)
        rest (rec rec (| list) (.rest m) name value))))
   _ (crash (| unknown-bind-mode mode)))
 )
 bind (\ (input name value) (bind bind (| expr) input name value))
 optimize (\ (rec mode input)
  (% mode
   expr
    (% input
     value input
     (let let)
      (:
       name (.name let)
       definition (rec rec (| expr) (.definition let))
       (% definition
        (value v) (rec rec (| expr) (bind (.body let) name (| value v)))
        _ (:
         body (rec rec (| expr) (.body let))
         (| let (& name name definition definition body body))
        )
       )
      )
     (add args)
      (:
       left (rec rec (| expr) (.left args))
       right (rec rec (| expr) (.right args))
       (% left
        (value l)
         (% right
          (value r) (| value (@add l r))
          _ (| add (& left left right right))
         )
        _ (| add (& left left right right))))
     _ input
    )
   fun
    (@function
     (@arguments input)
     (rec
      rec
      (| expr)
      (| let
       (&
        name "@captured"
        definition (| value (@captured input))
        body (@body input))))
     nil)
  ))
 optimize (\ (function) (optimize optimize (| fun) function))

 ##### "The Render System

  When Pear code is asked to render something for the outside world, it returns
  drawing instructions. These are just normal Pear values.

  DrawingInstruction =
   | nothing
   | fill-path (& path Path color Color)
   | transform (& by TransformationMatrix what DrawingInstruction)
   | all ([] DrawingInstruction)
  Path = ([] PathSegment)
  PathSegment =
   | move-to Point
   | line-to Point
  Point = (& x Float y Float)
  Color = (& r Int g Int b Int)
  TransformationMatrix = (& a Float b Float c Float d Float e Float f Float)

  Initially, I tried to communicate with the outside world using pixel graphics.
  However, I believe that's not the right move as pixels are more difficult to
  handle in code. Having pixels (or some concept of a texture) within Pear
  requires either:
  - mutable values (which Pear doesn't have), or
  - lots of copying on every texture modification (which Pear doesn't have), or
  - a super-smart optimizing compiler (which is useful but it has the sort of
    slow-by-default-and-you-have-to-trust-the-black-box-to-work feeling I don't
    like), or
  - inefficient storage of individual pixels in trees.
  By communicating the intent on a quite high-level, we can instead make use of
  GPUs when turning the high-level drawing instructions into pixels. This is
  also similar to how Flutter works: The Dart VM is decently fast, but not super
  fast, so it just emits drawing instructions that the lower-level C++ engine
  takes and turns into pixels.

  Within Pear, rendering functions usually return structs of the form
  (& draw DrawingInstruction width Int height Int) rather than just raw
  drawing instructions.

  2026-05-10: Added this comment.
 "

 # "All coordinates and sizes are floats."
 point (\ (x y) (& x x y y))

 transform-translate (\ (x y) (& a 1. b 0. c 0. d 1. e x f y))
 transform-scale (\ (factor) (& a factor b 0. c 0. d factor e 0. f 0.))

 parse-hex (\ (string)
  (rec-2 0 (array->list (string->bytes string)) (\ (rec value chars)
   (% chars
    empty value
    (more m) (:
     c (.item m)
     digit
      (cond
       (and (>= c (ascii-char "0")) (<= c (ascii-char "9")))
        (- c (ascii-char "0"))
       (and (>= c (ascii-char "a")) (<= c (ascii-char "f")))
        (+ (- c (ascii-char "a")) 10)
       else (crash "invalid hex char"))
     (rec (+ (* value 16) digit) (.rest m)))))))
 color (\ (hex)
  (:
   _ (assert (= (string-length hex) 7))
   _ (assert (= (string-slice hex 0 1) "#"))
   (&
    r (parse-hex (string-slice hex 1 3))
    g (parse-hex (string-slice hex 3 5))
    b (parse-hex (string-slice hex 5 7)))))

 black (color "#000000")
 white (color "#ffffff")
 red (color "#a02020")
 blue (color "#1099a0")
 green (color "#50a010")
 purple (color "#8e31a3")
 yellow (color "#ffd900")

 # "I try to name the rendering functions in a declarative way
  (e.g. row instead of render-next-to-each-other)."

 empty-box (\ (width height) (& draw (| nothing) width width height height))

 sized-box (\ (width height child)
  (& draw (.draw child) width width height height))

 # "Renders the child at an offset, but still occupies the original position."
 translate (\ (by child)
  (&
    draw
     (| transform
      (& by (transform-translate (.x by) (.y by)) what (.draw child)))
    width (.width child)
    height (.height child)))

 scaled (\ (factor child)
  (&
   draw
    (| transform
     (& by (transform-scale factor) what (.draw child)))
   width (f* factor (.width child))
   height (f* factor (.height child))))

 colored (\ (color child)
  (:
   width (.width child)
   height (.height child)
   (&
    draw
     (| all ([]
      (| fill-path (&
       path ([]
        (| move-to (& x 0. y 0.))
        (| line-to (& x width y 0.))
        (| line-to (& x width y height))
        (| line-to (& x 0. y height)))
       color color))
      (.draw child)))
    width width
    height height)))

 # "padding accepts either a float (uniform on all sides) or a struct
   (& left right top bottom) of floats."
 padding (\ (padding child)
  (if (= (@kind padding) (| float))
   (&
    draw
     (| transform
      (& by (transform-translate padding padding) what (.draw child)))
    width (f+ (.width child) (f* 2. padding))
    height (f+ (.height child) (f* 2. padding)))
   (&
    draw
     (| transform (&
      by (transform-translate (.left padding) (.top padding))
      what (.draw child)))
    width (f+ (.width child) (f+ (.left padding) (.right padding)))
    height (f+ (.height child) (f+ (.top padding) (.bottom padding))))))

 padded-row (\ (padding children)
  (:
   res (rec-2 (array->list children) 0. (\ (rec children x)
    (% children
     empty (& draw (| empty) width 0. height 0.)
     (more m) (:
      child (.item m)
      rest (rec (.rest m) (f+ x (.width child)))
      (&
       draw
        (| more (&
         item
          (| transform (&
           by (transform-translate x 0.)
           what (.draw child)))
         rest (.draw rest)))
       width (f+ (.width child) (f+ padding (.width rest)))
       height (f-max (.height child) (.height rest)))))))
   (&
    draw (| all (list->array (.draw res)))
    width (f- (.width res) padding)
    height (.height res))))
 row (\ (children) (padded-row 0. children))

 column (\ (children)
  (:
   res (rec-2 (array->list children) 0. (\ (rec children y)
    (% children
     empty (& list (| empty) width 0. height 0.)
     (more m) (:
      child (.item m)
      rest (rec (.rest m) (f+ y (.height child)))
      (&
       list
        (| more (&
         item
          (| transform (&
           by (transform-translate 0. y)
           what (.draw child)))
         rest (.list rest)))
       width (f-max (.width child) (.width rest))
       height (f+ (.height child) (.height rest)))))))
   (&
    draw (| all (list->array (.list res)))
    width (.width res)
    height (.height res))))

 stack (\ (children)
  (&
   draw
    (| all (iter->array (map (array->iter children) (\ (child) (.draw child)))))
   width (fold (map (array->iter children) (\ (child) (.width child))) 0. f-max)
   height
    (fold (map (array->iter children) (\ (child) (.height child))) 0. f-max)))

 flow (\ (max-width children)
  (:
   res
    (rec-4 (array->list children) 0. 0. 0. (\ (rec items x y line-height)
     (% items
      empty (& draws (| empty) bottom (f+ y line-height))
      (more m) (:
       child (.item m)
       wrap? (and (f> x 0.) (f> (f+ x (.width child)) max-width))
       x (if wrap? 0. x)
       y (if wrap? (f+ y line-height) y)
       line-height
        (if wrap? (.height child) (f-max line-height (.height child)))
       rest (rec (.rest m) (f+ x (.width child)) y line-height)
       (&
        draws
         (| more (&
          item
           (| transform (&
            by (transform-translate x y)
            what (.draw child)))
          rest (.draws rest)))
        bottom (.bottom rest))))))
   (&
    draw (| all (list->array (.draws res)))
    width max-width
    height (.bottom res))))

 parse-pixels (\ (width string)
  (:
   bytes (string->bytes string)
   row-rec (\ (rec i x)
    (: c (array-get bytes i)
     (if (= c (ascii-char "|"))
      (& cursor (+ i 1) result (filled-list (- width x) 0))
      (if (= x width)
       (crash "Pixel line too long.")
       (: rest (rec rec (+ i 1) (+ x 1))
        (&
         cursor (.cursor rest)
         result
          (| more
           (& item (if (= c (ascii-char " ")) 0 1) rest (.result rest)))))))))
   rec (\ (rec i)
    (if (= i (array-length bytes))
     (| empty)
     (: row (row-rec row-rec i 0)
      (| more
       (& item (list->array (.result row)) rest (rec rec (.cursor row)))))))
   (list->array (rec rec 0))))
 pixel-glyph (\ (char width string)
  (:
   pixels (parse-pixels width string)
   height (array-length pixels)
   paths (rec-2 0 0 (\ (rec x y)
    (if (= x width)
     (if (= (+ y 1) height) (| empty) (rec 0 (+ y 1)))
     (if (= (array-get (array-get pixels y) x) 1)
      (| more (&
       item ([]
        (| move-to (point (int->float x) (int->float y)))
        (| line-to (point (int->float (+ x 1)) (int->float y)))
        (| line-to (point (int->float (+ x 1)) (int->float (+ y 1))))
        (| line-to (point (int->float x) (int->float (+ y 1)))))
       rest (rec (+ x 1) y)))
      (rec (+ x 1) y)))))
   (& char char width (int->float width) paths paths)))
 line-height 13.
 default-glyph
  (pixel-glyph "?" 5 "M M M| M M|M M M| M M|M M M| M M|M M M| M M|M M M| M M|")
 glyphs ([]
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  (pixel-glyph "\n" 2 "|")
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  default-glyph
  (pixel-glyph " " 2 "|")
  (pixel-glyph "!" 2 "|MM|MM|MM|MM|MM|MM||MM|MM|")
  (pixel-glyph "\"" 3 "|M M|M M|M M|")
  (pixel-glyph "#" 6 "|| M  M|MMMMMM| M  M| M  M| M  M|MMMMMM| M  M|")
  (pixel-glyph "$" 5 "  M| MMM|M M M|M M|MMM| MMM|  MMM|  M M|M M M| MMM|  M|")
  (pixel-glyph "%" 9 "| MM   MM|M  M MM|M  M MM| MM MM|   MMM|   MM MM|  MM M  M| MM  M  M| MM   MM|")
  (pixel-glyph "&" 9 "| MMMMM|MM  MM|MM  MM| MMMM| MMM  MM|MM MM MM|MM  MMM|MM  MMMM| MMMM MM|")
  (pixel-glyph "'" 1 "|M|M|M|")
  (pixel-glyph "(" 3 " MM|MM|MM|MM|MM|MM|MM|MM|MM| MM|")
  (pixel-glyph ")" 3 "MM| MM| MM| MM| MM| MM| MM| MM| MM|MM|")
  (pixel-glyph "*" 7 "|||MM   MM| MM MM|  MMM| MM MM|MM   MM|")
  (pixel-glyph "+" 6 "|||  MM|  MM|MMMMMM|  MM|  MM|")
  (pixel-glyph "," 2 "|||||||MM|MM| M|M|")
  (pixel-glyph "-" 5 "|||||MMMMM|")
  (pixel-glyph "." 2 "|||||||MM|MM|")
  (pixel-glyph "/" 5 "   MM|   MM|  MM|  MM|  MM| MM| MM| MM|MM|MM|")
  (pixel-glyph "0" 6 "| MMMM|MM  MM|MM MMM|MM MMM|MMMMMM|MMM MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "1" 2 "| M|MM|MM|MM|MM|MM|MM|MM|MM|")
  (pixel-glyph "2" 6 "| MMMM|M   MM|    MM|    MM|   MM|  MM| MM|MM|MMMMMM|")
  (pixel-glyph "3" 6 "|MMMMMM|   MM|  MM| MMMM|    MM|    MM|    MM|M   MM| MMMM|")
  (pixel-glyph "4" 7 "|    MM|   MMM|  M MM| M  MM|MM  MM|MMMMMMM|    MM|    MM|    MM|")
  (pixel-glyph "5" 6 "|MMMMMM|MM|MM|MMMMM|    MM|    MM|    MM|M   MM| MMMM|")
  (pixel-glyph "6" 6 "|  MMM| MM|MM|MMMMM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "7" 7 "|MMMMMMM|     MM|     MM|    MM|    MM|   MM|   MM|   MM|   MM|")
  (pixel-glyph "8" 6 "| MMMM|MM  MM|MM  MM|MM  MM| MMMM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "9" 6 "| MMMM|MM  MM|MM  MM|MM  MM|MM  MM| MMMMM|    MM|   MM| MMM|")
  (pixel-glyph ":" 2 "|||MM|MM||||MM|MM|")
  (pixel-glyph ";" 2 "|||MM|MM||||MM|MM| M|M|")
  (pixel-glyph "<" 5 "||   MM|  MM| MM|MM| MM|  MM|   MM|")
  (pixel-glyph "=" 5 "||||MMMMM||MMMMM|")
  (pixel-glyph ">" 5 "||MM| MM|  MM|   MM|  MM| MM|MM|")
  (pixel-glyph "?" 6 "| MMMM|   MM|    MM|   MM|  MM|  MM||  MM|  MM|")
  (pixel-glyph "@" 9 "|  MMMMM| M     M|M  MMM  M|M M  M  M|M M  M  M|M M  M  M|M  MMMMMM| M|  MMMMM|")
  (pixel-glyph "A" 6 "| MMMM|MM  MM|MM  MM|MM  MM|MMMMMM|MM  MM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "B" 6 "|MMMMM|MM  MM|MM  MM|MM  MM|MMMM|MM  MM|MM  MM|MM  MM|MMMMM|")
  (pixel-glyph "C" 6 "| MMMM|MM   M|MM|MM|MM|MM|MM|MM   M| MMMM|")
  (pixel-glyph "D" 6 "|MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MMMMM|")
  (pixel-glyph "E" 5 "|MMMMM|MM|MM|MM|MMMMM|MM|MM|MM|MMMMM|")
  (pixel-glyph "F" 5 "|MMMMM|MM|MM|MM|MMMMM|MM|MM|MM|MM|")
  (pixel-glyph "G" 6 "| MMMM|MM   M|MM|MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "H" 6 "|MM  MM|MM  MM|MM  MM|MM  MM|MMMMMM|MM  MM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "I" 4 "|MMMM| MM| MM| MM| MM| MM| MM| MM|MMMM|")
  (pixel-glyph "J" 6 "|    MM|    MM|    MM|    MM|    MM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "K" 7 "|MM   MM|MM  MM|MM MM|MMMM|MMM|MMMM|MM MM|MM  MM|MM   MM|")
  (pixel-glyph "L" 5 "|MM|MM|MM|MM|MM|MM|MM|MM|MMMMM|")
  (pixel-glyph "M" 10 "|M       MM|MM     MMM|MMM   MMMM|MMMM MMMMM|M MMMMMMMM|M  MMMM MM|M   MM  MM|M       MM|M       MM|")
  (pixel-glyph "N" 7 "|M     M|MM    M|MMM   M|MMMM  M|M MMM M|M  MMMM|M   MMM|M    MM|M     M|")
  (pixel-glyph "O" 6 "| MMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "P" 6 "|MMMMM|MM  MM|MM  MM|MM  MM|MMMMM|MM|MM|MM|MM|")
  (pixel-glyph "Q" 8 "| MMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|    MM|    MMM|")
  (pixel-glyph "R" 6 "|MMMMM|MM  MM|MM  MM|MM  MM|MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "S" 5 "| MMM|MM  M|MM|MMM| MMM|  MMM|   MM|M  MM| MMM|")
  (pixel-glyph "T" 6 "|MMMMMM|  MM|  MM|  MM|  MM|  MM|  MM|  MM|  MM|")
  (pixel-glyph "U" 6 "|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "V" 7 "|MM   MM|MM   MM|MM   MM|MM   MM| MM MM| MM MM|  MMM| MMM|   M|")
  (pixel-glyph "W" 11 "|MM   MM  MM|MM   MM  MM|MM   MM  MM|MM   MM  MM|MM   MM  MM|MM   MM  MM|MM   MM  MM|MM   MM  MM|MMMMMMMMMM|")
  (pixel-glyph "X" 6 "|MM  MM|MM  MM|MM  MM| MMMM|  MM| MMMM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "Y" 6 "|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|  MM|  MM|  MM|  MM|")
  (pixel-glyph "Z" 6 "|MMMMMM|    MM|   MM|   MM|  MM| MM| MM|MM|MMMMMM|")
  (pixel-glyph "[" 3 "|MMM|MM|MM|MM|MM|MM|MM|MM|MMM|")
  (pixel-glyph "\\" 5 "|MM|MM| MM| MM| MM|  MM|  MM|  MM|   MM|")
  (pixel-glyph "]" 3 "|MMM| MM| MM| MM| MM| MM| MM| MM|MMM|")
  (pixel-glyph "^" 6 "|  MM| MMMM|MM  MM|")
  (pixel-glyph "_" 6 "|||||||||MMMMMM|")
  (pixel-glyph "`" 2 "|M| M|")
  (pixel-glyph "a" 6 "||| MMMM|M   MM|    MM| MMMMM|MM  MM|MM  MM| MMMMM|")
  (pixel-glyph "b" 6 "|MM|MM|MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MMMMM|")
  (pixel-glyph "c" 5 "||| MMM|MM  M|MM|MM|MM|MM  M| MMM|")
  (pixel-glyph "d" 6 "|    MM|    MM| MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMMM|")
  (pixel-glyph "e" 6 "||| MMMM|MM  MM|MM  MM|MMMMMM|MM|MM   M| MMMM|")
  (pixel-glyph "f" 5 "|  MMM| MM|MMMM| MM| MM| MM| MM| MM| MM|")
  (pixel-glyph "g" 6 "||| MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMMM|    MM| M  MM|  MMM|")
  (pixel-glyph "h" 6 "|MM|MM|MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "i" 2 "|MM||MM|MM|MM|MM|MM|MM|MM|")
  (pixel-glyph "j" 4 "|  MM||  MM|  MM|  MM|  MM|  MM|  MM|  MM|  MM|MMM|")
  (pixel-glyph "k" 6 "|MM|MM|MM  MM|MM MM|MMMM|MM|MMMM|MM MM|MM  MM|")
  (pixel-glyph "l" 3 "|MM|MM|MM|MM|MM|MM|MM|MM| MM|")
  (pixel-glyph "m" 10 "|||MMMMM MMM|MM  MM  MM|MM  MM  MM|MM  MM  MM|MM  MM  MM|MM  MM  MM|MM  MM  MM|")
  (pixel-glyph "n" 6 "|||MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "o" 6 "||| MMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|")
  (pixel-glyph "p" 6 "|||MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MMMMM|MM|MM|")
  (pixel-glyph "q" 6 "||| MMMMM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMMM|    MM|    MM|")
  (pixel-glyph "r" 5 "|||MM MM|MMMMM|MM|MM|MM|MM|MM|")
  (pixel-glyph "s" 5 "||| MMM|MM  M|MMM| MMM|  MMM|M  MM| MMM|")
  (pixel-glyph "t" 5 "| MM| MM|MMMM| MM| MM| MM| MM| MM|  MM|")
  (pixel-glyph "u" 6 "|||MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMMM|")
  (pixel-glyph "v" 6 "|||MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMM|  MM|")
  (pixel-glyph "w" 10 "|||MM  MM  MM|MM  MM  MM|MM  MM  MM|MM  MM  MM|MM  MM  MM|MM  MM  MM|MMMMMMMM|")
  (pixel-glyph "x" 6 "|||MM  MM|MM  MM|MM  MM|  MM|MM  MM|MM  MM|MM  MM|")
  (pixel-glyph "y" 6 "|||MM  MM|MM  MM|MM  MM|MM  MM|MM  MM|MM  MM| MMMMM|    MM| M  MM|  MMM|")
  (pixel-glyph "z" 6 "|||MMMMMM|    MM|   MM|  MM| MM|MM|MMMMMM|")
  (pixel-glyph "{" 4 "  MM| MM| MM| MM| MM|MM| MM| MM| MM| MM|  MM|")
  (pixel-glyph "|" 2 "MM|MM|MM|MM|MM|MM|MM|MM|MM|MM|MM|")
  (pixel-glyph "{" 4 "MM| MM| MM| MM| MM|  MM| MM| MM| MM| MM|MM|")
  (pixel-glyph "~" 7 "||||  MM  M| M  MM|M  M|")
  default-glyph)
 find-glyph (\ (rec char i)
  (if (= i (array-length glyphs))
   default-glyph
   (: g (array-get glyphs i) (if (= char (.char g)) g (rec rec char (+ i 1))))))
 find-glyph (\ (char)
  (: bytes (@string->bytes char)
   (if (and (= (array-length bytes) 1) (< (array-get bytes 0) 123))
    (: glyph (array-get glyphs (array-get bytes 0))
     _
      (if (= (.char glyph) char)
       nil
       (crash (| bad-glyph (& char char glyph glyph))))
     glyph)
    (find-glyph find-glyph char 0))))
 find-kerning (\ (a b) 1.)
 # "Lay out text into positioned glyphs. Lines break at newline characters, and
    a word is wrapped to the next line whenever it wouldn't fit within
    max-width."
 layout-text (\ (text max-width)
  (:
   # "Width of the word starting at `chars` (until the next space, newline, or
     end), used to decide whether the word fits on the current line."
   word-width (\ (chars)
    (rec-2 chars 0. (\ (recurse chars acc)
     (% chars
      empty acc
      (more m) (:
       char (.item m)
       rest (.rest m)
       (if (or (= char " ") (= char "\n"))
        acc
        (:
         glyph (find-glyph char)
         kerning
          (% rest
           empty 0.
           (more n)
            (if (or (= (.item n) " ") (= (.item n) "\n"))
             0.
             (find-kerning char (.item n))))
         (recurse rest (f+ acc (f+ (.width glyph) kerning))))))))))
   (rec-4 (string->chars-list text) 0. 0. true (\ (rec chars x y at-word-start)
    (% chars
     empty (| empty)
     (more m) (:
      char (.item m)
      rest (.rest m)
      glyph (find-glyph char)
      (if (= char "\n")
       (:
        next-x 0.
        next-y (f+ y line-height)
        (| more (&
         item (& x x y y char char glyph glyph cursor-x next-x cursor-y next-y)
         rest (rec rest next-x next-y true))))
       (:
        wrap?
         (if at-word-start
          (if (= char " ")
           false
           (if (f> x 0.) (f> (f+ x (word-width chars)) max-width) false))
          false)
        line-x (if wrap? 0. x)
        line-y (if wrap? (f+ y line-height) y)
        width (.width glyph)
        kerning (% rest empty 0. (more next) (find-kerning char (.item next)))
        next-x (f+ line-x (f+ width kerning))
        next-cursor-x (f+ line-x (f- width (f/ kerning 2.)))
        (| more (&
         item
          (& x line-x y line-y char char glyph glyph
             cursor-x next-cursor-x cursor-y line-y)
         rest (rec rest next-x line-y (= char " "))))))))))))
 draw-glyph (\ (glyph color)
  (| all
   (iter->array
    (map
     (list->iter (.paths glyph))
     (\ (path) (| fill-path (& path path color color)))))))
 # "Render text, wrapping words to fit within max-width and breaking at
    newlines. `text` passes a huge width to disable wrapping."
 text-wrapped (\ (string color max-width)
  (:
   layouted (layout-text string max-width)
   (&
    draw
     (| all
      (iter->array
       (map (list->iter layouted) (\ (glyph)
        (| transform (&
         by (transform-translate (.x glyph) (.y glyph))
         what (draw-glyph (.glyph glyph) color)))))))
    width
     (fold
      (map
       (list->iter layouted)
       (\ (glyph) (f+ (.x glyph) (.width (.glyph glyph))))) 0. f-max)
    height
     (fold
      (map (list->iter layouted) (\ (glyph) (f+ (.y glyph) line-height)))
      0.
      f-max))))
 text (\ (string color) (text-wrapped string color 100000.))

 no-modifiers? (\ (key)
  (and-3 (not (.control key)) (not (.shift key)) (not (.alt key))))
 ctrl-modifier? (\ (key)
  (and-3 (.control key) (not (.shift key)) (not (.alt key))))
 alt-modifier? (\ (key)
  (and-3 (not (.control key)) (not (.shift key)) (.alt key)))
 shift-modifier? (\ (key)
  (and-3 (not (.control key)) (.shift key) (not (.alt key))))
 ctrl-shift-modifiers? (\ (key)
  (and-3 (.control key) (.shift key) (not (.alt key))))
 shift-alt-modifiers? (\ (key)
  (and-3 (not (.control key)) (.shift key) (.alt key)))
 key-escape? (\ (key) (and (= (.keycode key) 256) (no-modifiers? key)))
 key-enter? (\ (key) (and (= (.keycode key) 257) (no-modifiers? key)))
 key-backspace? (\ (key) (and (= (.keycode key) 259) (no-modifiers? key)))
 key-delete? (\ (key) (and (= (.keycode key) 261) (no-modifiers? key)))
 key-right? (\ (key) (and (= (.keycode key) 262) (no-modifiers? key)))
 key-left? (\ (key) (and (= (.keycode key) 263) (no-modifiers? key)))
 key-down? (\ (key) (and (= (.keycode key) 264) (no-modifiers? key)))
 key-up? (\ (key) (and (= (.keycode key) 265) (no-modifiers? key)))
 key-start? (\ (key) (and (= (.keycode key) 268) (no-modifiers? key)))
 key-end? (\ (key) (and (= (.keycode key) 269) (no-modifiers? key)))
 key-ctrl-enter? (\ (key) (and (= (.keycode key) 257) (ctrl-modifier? key)))
 key-ctrl-backspace? (\ (key) (and (= (.keycode key) 259) (ctrl-modifier? key)))
 key-ctrl-right? (\ (key) (and (= (.keycode key) 262) (ctrl-modifier? key)))
 key-ctrl-left? (\ (key) (and (= (.keycode key) 263) (ctrl-modifier? key)))
 key-alt-right? (\ (key) (and (= (.keycode key) 262) (alt-modifier? key)))
 key-alt-left? (\ (key) (and (= (.keycode key) 263) (alt-modifier? key)))
 key-alt-down? (\ (key) (and (= (.keycode key) 264) (alt-modifier? key)))
 key-alt-up? (\ (key) (and (= (.keycode key) 265) (alt-modifier? key)))
 key-shift-right? (\ (key) (and (= (.keycode key) 262) (shift-modifier? key)))
 key-shift-left? (\ (key) (and (= (.keycode key) 263) (shift-modifier? key)))
 key-shift-down? (\ (key) (and (= (.keycode key) 264) (shift-modifier? key)))
 key-shift-up? (\ (key) (and (= (.keycode key) 265) (shift-modifier? key)))
 key-shift-alt-down? (\ (key)
  (and (= (.keycode key) 264) (shift-alt-modifiers? key)))
 key-shift-alt-up? (\ (key)
  (and (= (.keycode key) 265) (shift-alt-modifiers? key)))
 key-shift-alt-left? (\ (key)
  (and (= (.keycode key) 263) (shift-alt-modifiers? key)))
 key-shift-start? (\ (key) (and (= (.keycode key) 268) (shift-modifier? key)))
 key-shift-end? (\ (key) (and (= (.keycode key) 269) (shift-modifier? key)))
 key-ctrl-shift-right? (\ (key)
  (and (= (.keycode key) 262) (ctrl-shift-modifiers? key)))
 key-ctrl-shift-left? (\ (key)
  (and (= (.keycode key) 263) (ctrl-shift-modifiers? key)))
 key-space? (\ (key) (and (= (.keycode key) 32) (no-modifiers? key)))
 key-a? (\ (key) (and (= (.keycode key) 65) (no-modifiers? key)))
 key-d? (\ (key) (and (= (.keycode key) 68) (no-modifiers? key)))
 key-n? (\ (key) (and (= (.keycode key) 78) (no-modifiers? key)))
 key-r? (\ (key) (and (= (.keycode key) 82) (no-modifiers? key)))
 key-s? (\ (key) (and (= (.keycode key) 83) (no-modifiers? key)))
 key-w? (\ (key) (and (= (.keycode key) 87) (no-modifiers? key)))
 key-ctrl-n? (\ (key) (and (= (.keycode key) 78) (ctrl-modifier? key)))

 # "Text editing

  A cursor consists of the following state:
   - the anchor position (where a selection started)
   - the active position (where the part controlled by the arrow keys is)
   - the desired x position"

 new-cursor (& anchor 0 active 0 desired-x 0.)
 cursor-start (\ (cursor) (min (.anchor cursor) (.active cursor)))
 cursor-end (\ (cursor) (max (.anchor cursor) (.active cursor)))
 cursor-has-selection? (\ (cursor) (!= (.anchor cursor) (.active cursor)))
 cursor-selection (\ (cursor)
  (& start (cursor-start cursor) end (cursor-end cursor)))

 text-x-offset (\ (string width offset)
  (if (= offset 0)
   0.
   (.cursor-x (list-get (layout-text string width) (- offset 1)))))
 list-indexed (\ (list)
  (rec-2 list 0 (\ (rec list i)
   (% list
    empty (| empty)
    (more m)
     (| more (&
      item (& index i glyph (.item m))
      rest (rec (.rest m) (+ i 1))))))))
 pick-closer (\ (x a b)
  (:
   ga (.glyph a)
   gb (.glyph b)
   dist-a (f-abs (f- (.x ga) x))
   dist-b (f-abs (f- (.x gb) x))
   (if (f< dist-a dist-b) a b)))
 find-offset-above (\ (x y glyphs)
  (:
   indexed (list-indexed glyphs)
   before
    (iter->list
     (take-while (list->iter indexed) (\ (ig) (f< (.y (.glyph ig)) y))))
   (% before
    empty (| none)
    more
     (| some
      (.index
       (reduce (list->iter before) (\ (a b)
        (if (f< (.y (.glyph a)) (.y (.glyph b)))
         b
         (pick-closer x a b)))))))))
 find-offset-below (\ (x y glyphs)
  (:
   indexed (list-indexed glyphs)
   after
    (iter->list
     (skip-while (list->iter indexed) (\ (ig) (f<= (.y (.glyph ig)) y))))
   (% after
    empty (| none)
    more
     (| some
      (.index
       (reduce (list->iter after) (\ (a b)
        (if (f< (.y (.glyph a)) (.y (.glyph b)))
         a
         (pick-closer x a b)))))))))
 find-line-start (\ (string offset) (:
  chars (string->chars-array string)
  (rec offset (\ (rec candidate)
   (cond
    (= candidate 0) 0
    (= (array-get chars (- candidate 1)) "\n") candidate
    else (rec (- candidate 1)))))))
 find-line-end (\ (string offset) (:
  chars (string->chars-array string)
  (rec offset (\ (rec candidate)
   (cond
    (= candidate (array-length chars)) (array-length chars)
    (= (array-get chars candidate) "\n") candidate
    else (rec (+ candidate 1)))))))

 word-char? (\ (char)
  (: c (ascii-char char)
   (or-4
    (= char "_")
    (and (>= c (ascii-char "a")) (<= c (ascii-char "z")))
    (and (>= c (ascii-char "A")) (<= c (ascii-char "Z")))
    (and (>= c (ascii-char "0")) (<= c (ascii-char "9"))))))
 punctuation-char? (\ (char) (and (!= char " ") (not (word-char? char))))
 num-leading-word-chars (\ (chars-list)
  (rec chars-list (\ (rec chars)
   (% chars
    empty 0
    (more m) (if (word-char? (.item m)) (+ 1 (rec (.rest m))) 0)))))
 num-leading-punctuation-chars (\ (chars-list)
  (rec chars-list (\ (rec chars)
   (% chars
    empty 0
    (more m) (if (punctuation-char? (.item m)) (+ 1 (rec (.rest m))) 0)))))
 
 # "Skipping (moving ctrl + left/right) =
    1. Skip spaces
    2. How many characters of punctuation follow?
       0: Skip all letters
       1: Skip the punctuation, then all letters after it
       2: Skip all punctuation"
 num-leading-skip-chars (\ (chars-list)
  (rec chars-list (\ (rec chars)
   (% chars
    empty 0
    (more m) (:
     char (.item m)
     rest (.rest m)
     (cond
      (= char " ") (+ (rec rest) 1)
      (word-char? char) (num-leading-word-chars chars)
      else
       (% rest
        empty 1
        (more next-m)
         (if (punctuation-char? (.item next-m))
          (num-leading-punctuation-chars chars)
          (+ (num-leading-word-chars rest) 1)))))))))
 find-word-boundary-after (\ (string offset)
  (+
   offset
   (num-leading-skip-chars
    (list-skip (string->chars-list string) offset))))
 find-word-boundary-before (\ (string offset)
  (-
   offset
   (num-leading-skip-chars
    (list-take-and-reverse (string->chars-list string) offset))))
 _ (assert (= (find-word-boundary-after "hello world" 0) 5))
 _ (assert (= (find-word-boundary-after "hello world" 5) 11))
 _ (assert (= (find-word-boundary-before "hello world" 11) 6))
 _ (assert (= (find-word-boundary-before "hello world" 5) 0))
 _ (assert (= (find-word-boundary-before "Hello world!" 12) 6))
 _ (assert (= (find-word-boundary-after "!hello" 0) 6))

 handle-text-edit-with-cursor (\ (string width cursor event)
  (% event
   (key-pressed key)
    (cond
     (key-enter? key) (:
      new-string (string-replace-range string (cursor-selection cursor) "\n")
      new-offset (+ (cursor-start cursor) 1)
      (&
       string new-string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset new-string width new-offset))))
     (key-ctrl-enter? key) (:
      line-end (find-line-end string (.active cursor))
      new-string (string-insert string line-end "\n")
      new-offset (+ line-end 1)
      (&
       string new-string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset new-string width new-offset))))
     (key-backspace? key)
      (if (cursor-has-selection? cursor)
       (: offset (cursor-start cursor)
        (&
         string
          (string-remove-range string (cursor-start cursor) (cursor-end cursor))
         cursor (&
          anchor offset
          active offset
          desired-x (text-x-offset string width offset))))
       (: offset (.active cursor)
        (if (= offset 0)
         (& string string cursor cursor)
         (&
          string (string-remove string (- offset 1))
          cursor (&
           anchor (- offset 1)
           active (- offset 1)
           desired-x (text-x-offset string width (- offset 1)))))))
     (key-ctrl-backspace? key)
      (if (cursor-has-selection? cursor)
       (: offset (cursor-start cursor)
        (&
         string
          (string-remove-range string (cursor-start cursor) (cursor-end cursor))
         cursor (&
          anchor offset
          active offset
          desired-x (text-x-offset string width offset))))
       (:
        offset (.active cursor)
        new-offset (find-word-boundary-before string offset)
        (&
         string (string-remove-range string new-offset offset)
         cursor (&
          anchor new-offset
          active new-offset
          desired-x (text-x-offset string width new-offset)))))
     (key-delete? key)
      (if (cursor-has-selection? cursor)
       (: offset (cursor-start cursor)
        (&
         string
          (string-remove-range string (cursor-start cursor) (cursor-end cursor))
         cursor
          (&
           anchor offset
           active offset
           desired-x (text-x-offset string width offset))))
       (: offset (cursor-start cursor)
        (if (= offset (string-length string))
         (& string string cursor cursor)
         (& string (string-remove string offset) cursor cursor))))
     (key-right? key) (:
      new-offset
       (if (cursor-has-selection? cursor)
        (cursor-end cursor)
        (min (string-length string) (+ (.anchor cursor) 1)))
      (&
       string string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset string width new-offset))))
     (key-shift-right? key) (:
      offset (.active cursor)
      (if (= offset (string-length string))
       (& string string cursor cursor)
       (&
        string string
        cursor (&
         anchor (.anchor cursor)
         active (+ offset 1)
         desired-x (text-x-offset string width (+ offset 1))))))
     (key-ctrl-right? key) (:
      new-offset (find-word-boundary-after string (.active cursor))
      (&
       string string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset string width new-offset))))
     (key-ctrl-shift-right? key) (:
      new-offset (find-word-boundary-after string (.active cursor))
      (&
       string string
       cursor (&
        anchor (.anchor cursor)
        active new-offset
        desired-x (text-x-offset string width new-offset))))
     (key-left? key) (:
      new-offset
       (if (cursor-has-selection? cursor)
        (cursor-start cursor)
        (max 0 (- (.anchor cursor) 1)))
      (&
       string string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset string width new-offset))))
     (key-shift-left? key) (:
      offset (.active cursor)
      (if (= offset 0)
       (& string string cursor cursor)
       (&
        string string
        cursor (&
         anchor (.anchor cursor)
         active (- offset 1)
         desired-x (text-x-offset string width (- offset 1))))))
     (key-ctrl-left? key) (:
      new-offset (find-word-boundary-before string (.active cursor))
      (&
       string string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset string width new-offset))))
     (key-ctrl-shift-left? key) (:
      new-offset (find-word-boundary-before string (.active cursor))
      (&
       string string
       cursor (&
        anchor (.anchor cursor)
        active new-offset
        desired-x (text-x-offset string width new-offset))))
     (key-down? key) (:
      layouted-text (layout-text string width)
      cursor-desired-x (.desired-x cursor)
      cursor-y
       (if (= (.active cursor) 0)
        0.
        (.y (list-get layouted-text (- (.active cursor) 1))))
      new-offset (find-offset-below cursor-desired-x cursor-y layouted-text)
      new-offset (% new-offset none (string-length string) (some v) v)
      (&
       string string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x cursor-desired-x)))
     (key-alt-down? key) (:
      start (find-line-start string (cursor-start cursor))
      end (find-line-end string (cursor-end cursor))
      (if (= end (string-length string))
       (& string string cursor cursor)
       (:
        next-line-end (find-line-end string (+ end 1))
        bytes (array->list (string->bytes string))
        a (list-slice bytes 0 start)
        b (list-slice bytes start end)
        c (list-slice bytes (+ end 1) next-line-end)
        d (list-skip bytes next-line-end)
        (&
         string
          (bytes->string
           (iter->array
            (concat-5
             (list->iter a)
             (list->iter c)
             (list->iter (| more (& item 10 rest (| empty))))
             (list->iter b)
             (list->iter d))))
         cursor (&
          anchor (+ (.anchor cursor) (+ (length (list->iter c)) 1))
          active (+ (.active cursor) (+ (length (list->iter c)) 1))
          desired-x (.desired-x cursor))))))
     (key-shift-down? key) (:
      layouted-text (layout-text string width)
      cursor-desired-x (.desired-x cursor)
      cursor-y
       (if (= (.active cursor) 0)
        0.
        (.y (list-get layouted-text (- (.active cursor) 1))))
      new-offset (find-offset-below cursor-desired-x cursor-y layouted-text)
      new-offset (% new-offset none (string-length string) (some v) v)
      (&
       string string
       cursor (&
        anchor (.anchor cursor)
        active new-offset
        desired-x cursor-desired-x)))
     (key-up? key) (:
      layouted-text (layout-text string width)
      cursor-desired-x (.desired-x cursor)
      cursor-y
       (if (= (.active cursor) 0)
        0.
        (.y (list-get layouted-text (- (.active cursor) 1))))
      new-offset (find-offset-above cursor-desired-x cursor-y layouted-text)
      new-offset (% new-offset none 0 (some v) v)
      (&
       string string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x cursor-desired-x)))
     (key-alt-up? key) (:
      start (find-line-start string (cursor-start cursor))
      end (find-line-end string (cursor-end cursor))
      (if (= start 0)
       (& string string cursor cursor)
       (:
        previous-line-start (find-line-start string (- start 1))
        bytes (array->list (string->bytes string))
        a (list-slice bytes 0 previous-line-start)
        b (list-slice bytes previous-line-start (- start 1))
        c (list-slice bytes start end)
        d (list-skip bytes end)
        (&
         string
          (bytes->string
           (iter->array
            (concat-5
             (list->iter a)
             (list->iter c)
             (list->iter (| more (& item 10 rest (| empty))))
             (list->iter b)
             (list->iter d))))
         cursor (&
          anchor (+ (.anchor cursor) (+ (length (list->iter c)) 1))
          active (+ (.active cursor) (+ (length (list->iter c)) 1))
          desired-x (.desired-x cursor))))))
     (key-shift-up? key) (:
      layouted-text (layout-text string width)
      cursor-desired-x (.desired-x cursor)
      cursor-y
       (if (= (.active cursor) 0)
        0.
        (.y (list-get layouted-text (- (.active cursor) 1))))
      new-offset (find-offset-above cursor-desired-x cursor-y layouted-text)
      new-offset (% new-offset none 0 (some v) v)
      (&
       string string
       cursor (&
        anchor (.anchor cursor)
        active new-offset
        desired-x cursor-desired-x)))
     (key-start? key) (:
      line-start (find-line-start string (.active cursor))
      (&
       string string
       cursor (&
        anchor line-start
        active line-start
        desired-x (text-x-offset string width line-start))))
     (key-shift-start? key) (:
      line-start (find-line-start string (.active cursor))
      (&
       string string
       cursor (&
        anchor (.anchor cursor)
        active line-start
        desired-x (text-x-offset string width line-start))))
     (key-end? key) (:
      line-end (find-line-end string (.active cursor))
      (&
       string string
       cursor (&
        anchor line-end
        active line-end
        desired-x (text-x-offset string width line-end))))
     (key-shift-end? key) (:
      line-end (find-line-end string (.active cursor))
      (&
       string string
       cursor (&
        anchor (.anchor cursor)
        active line-end
        desired-x (text-x-offset string width line-end))))
     else (& string string cursor cursor))
   (char-entered char)
    (:
     c (ascii-char char)
    (if
     (or
      (= c 10)
      (and (>= c 32) (<= c 126)))
     (:
      new-string (string-replace-range string (cursor-selection cursor) char)
      new-offset (+ (cursor-start cursor) 1)
      (&
       string new-string
       cursor (&
        anchor new-offset
        active new-offset
        desired-x (text-x-offset new-string width new-offset))))
     (& string string cursor cursor)))))

 handle-text-edit (\ (string event)
  (% event
   (key-pressed key)
    (cond
     (key-backspace? key)
      (if (> (string-length string) 0)
       (string-slice string 0 (- (string-length string) 1))
       string)
     (key-enter? key) (string-concat string "\n")
     else string)
   (char-entered char) (string-concat string char)))

 orchard-color (color "#2e6402")
 cursor-color (color "#ffcb10")
 int-color (color "#009ccb")
 string-color (color "#a86400")
 struct-color (color "#2eae00")
 enum-color (color "#db003e")
 array-color (color "#ff6d1e")
 function-color (color "#8a0cff")

 # "Draw the cursor, or — when the cursor has a selection — a highlight covering
    the selected range. Positions use cursor-x/cursor-y so they line up with
    where glyphs and the caret are drawn, and the highlight spans multiple
    (possibly wrapped) lines as a staircase: rest of the first line, full-width
    middle lines, and the start of the last line."
 draw-cursor (\ (cursor width layouted-text) (:
  position-at (\ (offset)
   (if (= offset 0)
    (point 0. 0.)
    (: g (list-get layouted-text (- offset 1))
     (point (.cursor-x g) (.cursor-y g)))))
  (if (cursor-has-selection? cursor)
   (:
    start-position (position-at (cursor-start cursor))
    end-position (position-at (cursor-end cursor))
    start-x (.x start-position)
    start-y (.y start-position)
    end-x (.x end-position)
    end-y (.y end-position)
    (if (= start-y end-y)
     (| fill-path (&
      path ([]
       (| move-to start-position)
       (| line-to (point end-x start-y))
       (| line-to (point end-x (f+ start-y line-height)))
       (| line-to (point start-x (f+ start-y line-height))))
      color cursor-color))
     (| fill-path (&
      path ([]
       (| move-to start-position)
       (| line-to (point width start-y))
       (| line-to (point width end-y))
       (| line-to end-position)
       (| line-to (point end-x (f+ end-y line-height)))
       (| line-to (point 0. (f+ end-y line-height)))
       (| line-to (point 0. (f+ start-y line-height)))
       (| line-to (point start-x (f+ start-y line-height))))
      color cursor-color))))
   (:
    position (position-at (.anchor cursor))
    x (.x position)
    y (.y position)
    (| fill-path (&
     path ([]
      (| move-to (point x y))
      (| line-to (point (f+ x 2.) y))
      (| line-to (point (f+ x 2.) (f+ y line-height)))
      (| line-to (point x (f+ y line-height))))
     color cursor-color))))))

 editable-text (\ (string color cursor max-width)
  (:
   layouted (layout-text string max-width)
    (&
     draw
      (| all ([]
       (draw-cursor cursor max-width layouted)
       (| all
        (iter->array
         (map (list->iter layouted) (\ (glyph)
          (| transform (&
           by (transform-translate (.x glyph) (.y glyph))
           what (draw-glyph (.glyph glyph) color)))))))))
     width
      (fold
       (map
        (list->iter layouted)
        (\ (glyph) (f+ (.x glyph) (.width (.glyph glyph)))))
       0.
       f-max)
     height
      (fold
       (map (list->iter layouted) (\ (glyph) (f+ (.y glyph) line-height)))
       0.
       f-max))))

 maybe-render-cursor (\ (enabled node)
  (if enabled (colored cursor-color node) node))
 maybe-render-trailing-cursor (\ (enabled node)
  (if enabled
   (sized-box
    (.width node)
    (.height node)
    (stack ([]
     (padding (& top 0. left (.width node) bottom 0. right 0.)
      (colored cursor-color (empty-box 2. line-height)))
     node)))
   node))
 maybe-render-parenthesized (\ (enabled color child)
  (if enabled
   (row ([]
    (text "(" color)
    (empty-box 1. 0.)
    child
    (empty-box 1. 0.)
    (text ")" color)))
   child))

 action-up? (\ (key) (or (key-up? key) (key-space? key)))
 action-down? (\ (key) (key-down? key))
 action-left? (\ (key) (key-left? key))
 action-right? (\ (key) (key-right? key))
 action-new? (\ (key) (key-enter? key))
 action-remove? (\ (key) (key-backspace? key))
 action-delete? (\ (key) (key-delete? key))
 action-swap-left? (\ (key) (key-alt-left? key))
 action-swap-right? (\ (key) (key-alt-right? key))

 is-identifier-char? (\ (char)
  (and-4 (!= char " ") (!= char "\n") (!= char "(") (!= char ")")))
 identifier-handle (\ (identifier event)
  (% event
   (key-pressed key)
    (cond
     (action-up? key) (| yield-focus identifier)
     else (| update (handle-text-edit identifier event)))
   (char-entered char)
    (if (= char " ")
     (| yield-focus identifier)
     (if (is-identifier-char? char)
      (| update (handle-text-edit identifier event))
      (| update identifier)))))
 identifier-render (\ (identifier color focused)
  (if (= identifier "")
   (sized-box 5. line-height
   (padding (& top 4. left 0. right 0. bottom 0.)
    (colored (if focused cursor-color color) (empty-box 5. 5.))))
   (maybe-render-trailing-cursor focused (text identifier color))))

 parse-many (\ (code) (:
  chars (string->chars-array code)
  char-at (\ (i) (array-get chars i))
  at-end? (\ (i) (= i (array-length chars)))
  is-digit (\ (char)
   (and
    (>= (ascii-char char) (ascii-char "0"))
    (<= (ascii-char char) (ascii-char "9"))))
  is-name (\ (char)
   (and-5
    (!= char "\n")
    (!= char " ")
    (!= char "(")
    (!= char ")")
    (!= char "\"")))
  digit-value (\ (char) (- (ascii-char char) (ascii-char "0")))
  consume-whitespace (\ (start)
   (rec start (\ (rec i)
    (if (at-end? i)
     i
     (if (or (= (char-at i) "\n") (= (char-at i) " "))
      (rec (+ i 1))
      i)))))
  parse-int (\ (start)
   (rec-2 start 0 (\ (rec i num)
    (if (at-end? i)
     (& offset i num num)
     (if (is-digit (char-at i))
      (rec (+ i 1) (+ (* num 10) (digit-value (char-at i))))
      (& offset i num num))))))
  parse-frac (\ (start)
   (rec-3 start 0 0 (\ (rec i frac digits)
    (if (at-end? i)
     (& offset i frac frac digits digits)
     (if (is-digit (char-at i))
      (rec (+ i 1) (+ (* frac 10) (digit-value (char-at i))) (+ digits 1))
      (& offset i frac frac digits digits))))))
  pow10 (\ (k)
   (rec k (\ (rec k)
    (if (= k 0) 1. (f* 10. (rec (- k 1)))))))
  finish-float (\ (start int-part)
   (: r (parse-frac start)
    float-val
     (f+ (int->float int-part) (f/ (int->float (.frac r)) (pow10 (.digits r))))
    (& offset (.offset r) ast (| float float-val))))
  parse-string (\ (start)
   (rec-2 start "" (\ (rec i acc)
    (if (at-end? i)
     (crash "string doesn't end")
     (: c (char-at i)
      (cond
       (= c "\"") (& offset (+ i 1) value acc)
       (= c "\\")
        (if (at-end? (+ i 1))
         (crash "expected escape char")
         (: e (char-at (+ i 1))
          escaped
           (cond
            (= e "\\") "\\"
            (= e "\"") "\""
            (= e "n") "\n"
            else (crash "unknown escape sequence"))
          (rec (+ i 2) (string-concat acc escaped))))
       else (rec (+ i 1) (string-concat acc c))))))))
  parse-name (\ (start)
   (rec-2 start "" (\ (rec i acc)
    (if (at-end? i)
     (& offset i value acc)
     (if (is-name (char-at i))
      (rec (+ i 1) (string-concat acc (char-at i)))
      (& offset i value acc))))))
  parse-rec (\ (mode start)
   (rec-2 mode start (\ (rec mode i)
    (% mode
     (list acc) (:
      e (rec (| expr) i)
      (% e
       none (& offset i items acc)
       (some s) (rec (| list (array-append acc (.ast s))) (.offset s))))
     expr (:
      i (consume-whitespace i)
      (if (at-end? i)
       (| none)
       (: c (char-at i)
        (cond
         (= c ")") (| none)
         (is-digit c) (:
          r (parse-int i)
          j (.offset r)
          (if (at-end? j)
           (| some (& offset j ast (| int (.num r))))
           (if (= (char-at j) ".")
            (: f (finish-float (+ j 1) (.num r))
             (| some (& offset (.offset f) ast (.ast f))))
            (| some (& offset j ast (| int (.num r)))))))
         (= c "\"") (:
          r (parse-string (+ i 1))
          (| some (& offset (.offset r) ast (| string (.value r)))))
         (= c "(") (:
          g (rec (| list ([])) (+ i 1))
          after (consume-whitespace (.offset g))
          (if (at-end? after)
           (crash "expected closing paren")
           (if (= (char-at after) ")")
            (| some (& offset (+ after 1) ast (| group (.items g))))
            (crash "expected closing paren"))))
         else (:
          r (parse-name i)
          (| some (& offset (.offset r) ast (| name (.value r)))))))))))))
  result (parse-rec (| list ([])) 0)
  end (consume-whitespace (.offset result))
  (if (at-end? end) (.items result) (crash "unexpected trailing input"))))
 parse (\ (code) (:
  items (parse-many code)
  (if (= (array-length items) 1)
   (array-get items 0)
   (crash "expected a single expression"))))

 _ (assert (= (parse "42") (| int 42)))
 _ (assert (= (parse "  42  ") (| int 42)))
 _ (assert (= (parse "foo") (| name "foo")))
 _ (assert (= (parse "\"hi\"") (| string "hi")))
 _ (assert (= (parse "1.5") (| float 1.5)))
 _ (assert (= (parse "(a b)") (| group ([] (| name "a") (| name "b")))))
 _ (assert
  (= (parse "(a 7 (b))")
   (| group ([] (| name "a") (| int 7) (| group ([] (| name "b")))))))

 parse-code-block (\ (code) (:
  items (parse-many code)
  count (array-length items)
  (cond
   (= count 0) (| empty)
   (= count 1) (| expr (array-get items 0))
   (= count 2)
    (% (array-get items 0)
     (name n) (| bind (& name n expr (array-get items 1)))
     _ (crash "a code block must start with a name to bind a value"))
   else (crash "a code block has too many expressions"))))

 analyze (\ (node)
  (rec node (\ (analyze node)
   (% node
    (name string) (| name string)
    (group children) (:
     _ (if (= (array-length children) 0) (crash "empty group") nil)
     first (array-get children 0)
     rest (array-skip children 1)
     (% first
      (name name)
       (cond
        (= name ":") (:
         # "rest is a sequence of (name value) binding pairs followed by a
            single body expression, so its length must be odd. We desugar a
            multi-binding let into nested single-binding lets right here."
         _ (if (even? (array-length rest)) (crash "bad let") nil)
         body-index (- (array-length rest) 1)
         (rec 0 (\ (recurse i)
          (if (= i body-index)
           (analyze (array-get rest body-index))
           (| let (&
            name
             (% (array-get rest i)
              (name n) n
              _ (crash "a let binding name must be a name"))
            value (analyze (array-get rest (+ i 1)))
            body (recurse (+ i 2))))))))
        (= name "[]") (| array (iter->array (map (array->iter rest) analyze)))
        (= name "&") (:
         _ (if (even? (array-length rest)) nil (crash "bad struct"))
         fields
          (rec 0 (\ (recurse i)
           (if (= i (array-length rest))
            ([])
            (array-insert
             (recurse (+ i 2))
             0
             (&
              name
               (% (array-get rest i) (name n) n _ (crash "bad struct field"))
              value (analyze (array-get rest (+ i 1))))))))
         (| struct fields))
        (string-starts-with name ".") (:
         _ (if (= (array-length rest) 1) nil (crash "bad field"))
         (| field (&
          of (analyze (array-get rest 0))
          name (| value (string-slice name 1 (string-length name))))))
        (= name "|") (:
         _ (if (= (array-length rest) 0) (crash "bad enum") nil)
         variant (% (array-get rest 0) (name n) n _ (crash "bad enum"))
         payload
          (if (= (array-length rest) 2)
           (analyze (array-get rest 1))
           (| value nil))
         (| enum (& variant variant payload payload)))
        (= name "%") (:
         _ (if (odd? (array-length rest)) nil (crash "bad switch"))
         condition (analyze (array-get rest 0))
         result
          (rec 1 (\ (recurse i)
           (if (= i (array-length rest))
            (& cases ([]) default (| none))
            (:
             body (analyze (array-get rest (+ i 1)))
             after (recurse (+ i 2))
             (% (array-get rest i)
              (name n)
               (if (= n "_")
                (& cases (.cases after) default (| some body))
                (&
                 cases
                  (array-insert
                   (.cases after)
                   0
                   (& variant n payload (| none) body body))
                 default (.default after)))
              (group children) (:
               _
                (if (= (array-length children) 2) nil (crash "bad switch case"))
               variant
                (% (array-get children 0)
                 (name v) v
                 _ (crash "bad switch case variant"))
               payload-name
                (% (array-get children 1)
                 (name p) p
                 _ (crash "bad switch case payload"))
               (&
                cases
                 (array-insert
                  (.cases after)
                  0
                  (& variant variant payload (| some payload-name) body body))
                default (.default after)))
              _ (crash "bad switch case"))))))
         (| switch (&
          condition condition
          cases (.cases result)
          default (.default result))))
        (= name "if") (:
         _ (if (= (array-length rest) 3) nil (crash "bad if"))
         (| switch (&
          condition (analyze (array-get rest 0))
          cases ([]
           (& variant "true" payload (| none) body (analyze (array-get rest 1)))
           (&
            variant "false"
            payload (| none)
            body (analyze (array-get rest 2))))
          default (| some (| crash (| value "if on non-bool"))))))
        (= name "cond") (:
         _ (if (even? (array-length rest)) nil (crash "bad cond"))
         (rec 0 (\ (rec i)
          (if (= i (array-length rest))
           (| crash (| value "no cond branch matched"))
           (| switch (&
            condition (analyze (array-get rest i))
            cases ([]
             (& variant "true" payload (| none) body (analyze (array-get rest (+ i 1))))
             (& variant "false" payload (| none) body (rec (+ i 2))))
            default (| some (| crash (| value "if on non-bool")))))))))
        (= name "\\") (:
         _ (if (= (array-length rest) 2) nil (crash "bad function"))
         arguments
          (% (array-get rest 0)
           (group g)
            (iter->array
             (map
              (array->iter g)
              (\ (arg) (% arg (name n) n _ (crash "bad function")))))
           _ (crash "bad function"))
         body (analyze (array-get rest 1))
         (| function (& arguments arguments body body)))
        else
         (| call (&
          function (analyze first)
          arguments (iter->array (map (array->iter rest) analyze))))
       )
      _
       (| call (&
        function (analyze first)
        arguments (iter->array (map (array->iter rest) analyze))))))
    (int i) (| value i)
    (float f) (| value f)
    (string s) (| value s)))))

 base-env
  (array->list ([]
   (& name "@add" definition (\ (a b) (@add a b)))
   (& name "@subtract" definition (\ (a b) (@subtract a b)))
   (& name "@multiply" definition (\ (a b) (@multiply a b)))
   (& name "@divide" definition (\ (a b) (@divide a b)))
   (& name "@modulo" definition (\ (a b) (@modulo a b)))
   (& name "@shift-left" definition (\ (a b) (@shift-left a b)))
   (& name "@shift-right" definition (\ (a b) (@shift-right a b)))
   (& name "@and" definition (\ (a b) (@and a b)))
   (& name "@or" definition (\ (a b) (@or a b)))
   (& name "@xor" definition (\ (a b) (@xor a b)))
   (& name "@compare" definition (\ (a b) (@compare a b)))
   (& name "@equal?" definition (\ (a b) (@equal? a b)))
   (& name "@kind" definition (\ (a) (@kind a)))
   (& name "@f-add" definition (\ (a b) (@f-add a b)))
   (& name "@f-subtract" definition (\ (a b) (@f-subtract a b)))
   (& name "@f-multiply" definition (\ (a b) (@f-multiply a b)))
   (& name "@f-divide" definition (\ (a b) (@f-divide a b)))
   (& name "@f-compare" definition (\ (a b) (@f-compare a b)))
   (& name "@int->float" definition (\ (a) (@int->float a)))
   (& name "@float->int" definition (\ (a) (@float->int a)))
   (& name "@string->bytes" definition (\ (a) (@string->bytes a)))
   (& name "@bytes->string" definition (\ (a) (@bytes->string a)))
   (& name "@string-get-byte" definition (\ (s i) (@string-get-byte s i)))
   (& name "@string->words" definition (\ (a) (@string->words a)))
   (& name "@words->string" definition (\ (a) (@words->string a)))
   (& name "@string-get-word" definition (\ (s i) (@string-get-word s i)))
   (& name "@struct" definition (\ (a) (@struct a)))
   (& name "@field" definition (\ (of name) (@field of name)))
   (& name "@fields" definition (\ (a) (@fields a)))
   (& name "@enum" definition (\ (variant payload) (@enum variant payload)))
   (& name "@variant" definition (\ (a) (@variant a)))
   (& name "@payload" definition (\ (a) (@payload a)))
   (& name "@array-length" definition (\ (a) (@array-length a)))
   (& name "@array-get" definition (\ (a i) (@array-get a i)))
   (& name "@array->list" definition (\ (a) (@array->list a)))
   (& name "@list->array" definition (\ (a) (@list->array a)))
   (&
    name "@function"
    definition
     (\ (arguments body captured) (@function arguments body captured)))
   (& name "@arguments" definition (\ (a) (@arguments a)))
   (& name "@captured" definition (\ (a) (@captured a)))
   (& name "@body" definition (\ (a) (@body a)))
   (&
    name "@call"
    definition (\ (function arguments) (@call function arguments)))
   (& name "@crash" definition (\ (a) (@crash a)))
   (& name "@collect-garbage" definition (\ (a) (@collect-garbage a)))
   (&
    name "@sandbox"
    definition (\ (limit function) (@sandbox limit function)))))

 names-of-env (\ (env)
  (rec env (\ (recurse env)
   (% env
    empty (| empty)
    (more m) (| more (& item (.name (.item m)) rest (recurse (.rest m))))))))
 name-in-scope? (\ (scope name)
  (rec scope (\ (recurse scope)
   (% scope
    empty false
    (more m) (if (= (.item m) name) true (recurse (.rest m)))))))
 add-to-scope (\ (names scope)
  (rec 0 (\ (recurse i)
   (if (= i (array-length names))
    scope
    (| more (& item (array-get names i) rest (recurse (+ i 1))))))))
 scope-without (\ (scope names)
  (rec scope (\ (recurse scope)
   (% scope
    empty (| empty)
    (more m)
     (if (any (array->iter names) (\ (n) (= n (.item m))))
      (recurse (.rest m))
      (| more (& item (.item m) rest (recurse (.rest m)))))))))
 collect-errors (\ (node scope)
  (rec-2 node scope (\ (check node scope)
   (% node
    (value v) (array->iter ([]))
    (name n)
     (if (name-in-scope? scope n)
      (array->iter ([]))
      (array->iter ([] (string-concat "unknown name " n))))
    (error message) (array->iter ([] message))
    (call c)
     (concat
      (check (.function c) scope)
      (concat-all
       (map (array->iter (.arguments c)) (\ (arg) (check arg scope)))))
    (function f) (check (.body f) (add-to-scope (.arguments f) scope))
    (enum e) (check (.payload e) scope)
    (struct fields)
     (concat-all
      (map (array->iter fields) (\ (field) (check (.value field) scope))))
    (array items)
     (concat-all
      (map (array->iter items) (\ (item) (check item scope))))
    (field f) (check (.of f) scope)
    (switch s)
     (concat-3
      (check (.condition s) scope)
      (concat-all (map (array->iter (.cases s)) (\ (case)
       (check (.body case)
        (% (.payload case) (some p) (add-to-scope ([] p) scope) _ scope)))))
      (% (.default s) (some d) (check d scope) _ (array->iter ([]))))
    (let l)
     (concat
      (check (.value l) scope)
      (check (.body l) (add-to-scope ([] (.name l)) scope)))
    _ (array->iter ([]))))))

 env-lookup (\ (env name)
  (rec env (\ (rec env)
   (% env
    empty (crash (string-concat "unknown name " name))
    (more m)
     (if (= (.name (.item m)) name) (.definition (.item m)) (rec (.rest m)))))))
 env-has? (\ (env name)
  (rec env (\ (rec env)
   (% env
    empty false
    (more m) (if (= (.name (.item m)) name) true (rec (.rest m)))))))

 wrap-captured (\ (body names)
  (rec names (\ (wrap names)
   (% names
    empty body
    (more m)
     (| let (&
      name (.item m)
      definition (| field (& of (| name "@captured") name (| value (.item m))))
      body (wrap (.rest m))))))))
 captured-struct (\ (names)
  (| struct
   (iter->array
    (map (list->iter names) (\ (name) (& name name value (| name name)))))))

 compile (\ (node bound env)
  (@function
   ([])
   (rec-2 node bound (\ (compile node bound)
    (% node
     (error message) (| crash (| value message))
     (value v) (| value v)
     (name n)
      (if (name-in-scope? bound n)
       (| name n)
       (if (env-has? env n)
        (| value (env-lookup env n))
        (| crash (| value (string-concat "unknown name " n)))))
     (struct fields)
      (| struct
       (iter->array
        (map
         (array->iter fields)
         (\ (field)
          (& name (.name field) value (compile (.value field) bound))))))
     (field f)
      (| call (&
       function (| value (env-lookup env "@field"))
       arguments ([] (compile (.of f) bound) (.name f))))
     (enum e)
      (| enum (& variant (.variant e) payload (compile (.payload e) bound)))
     (switch s)
      (| switch (&
       condition (compile (.condition s) bound)
       cases
        (iter->array
         (map (array->iter (.cases s)) (\ (case)
          (&
           variant (.variant case)
           payload (.payload case)
           body
            (compile
             (.body case)
             (% (.payload case)
              (some p) (add-to-scope ([] p) bound)
              _ bound))))))
       default (% (.default s) (some d) (| some (compile d bound)) _ (| none))))
     (array items)
      (| array
       (iter->array (map (array->iter items) (\ (item) (compile item bound)))))
     (function f) (:
      params (.arguments f)
      # "Parameters shadow enclosing names, so they must not be captured: a
         captured name equal to a parameter would otherwise be re-bound over
         the parameter, silently ignoring the argument."
      outer (scope-without bound params)
      (| make-function (&
       arguments (| value params)
       body
        (| value
         (wrap-captured (compile (.body f) (add-to-scope params bound)) outer))
       captured (captured-struct outer))))
     (call c)
      (| call (&
       function (compile (.function c) bound)
       arguments
        (iter->array
         (map (array->iter (.arguments c)) (\ (a) (compile a bound))))))
     (let l)
      (| let (&
       name (.name l)
       definition (compile (.value l) bound)
       body (compile (.body l) (add-to-scope ([] (.name l)) bound))))
     (crash c) (| crash (compile c bound))
     _ (crash (| cannot-compile node)))))
   nil))

 compile-fuel 100000000
 run-fuel 10000000
 eval-code (\ (source env)
  (% (@sandbox compile-fuel (\ () (parse-code-block source)))
   (crashed e) (& name (| none) errors ([] e) result (| empty))
   out-of-fuel (& name (| none) errors ([] "timeout") result (| empty))
   (returned block)
    (% block
     empty (& name (| none) errors ([]) result (| empty))
     (expr ast)
      (% (@sandbox compile-fuel (\ () (analyze ast)))
       (crashed e) (& name (| none) errors ([] e) result (| empty))
       out-of-fuel (& name (| none) errors ([] "timeout") result (| empty))
       (returned analyzed)
        (&
         name (| none)
         errors (iter->array (collect-errors analyzed (names-of-env env)))
         result 
          (% (@sandbox run-fuel (compile analyzed (| empty) env))
           (returned value) (| ok value)
           (crashed error) (| error error)
           out-of-fuel (| timeout))))
     (bind b)
      (% (@sandbox compile-fuel (\ () (analyze (.expr b))))
       (crashed e) (& name (| some (.name b)) errors ([] e) result (| empty))
       out-of-fuel
        (& name (| some (.name b)) errors ([] "timeout") result (| empty))
       (returned analyzed)
        (&
         name (| some (.name b))
         errors (iter->array (collect-errors analyzed (names-of-env env)))
         result 
          (% (@sandbox run-fuel (compile analyzed (| empty) env))
           (returned value) (| ok value)
           (crashed error) (| error error)
           out-of-fuel (| timeout)))))))

 _ (assert (= (.result (eval-code "(: x 5 x)" base-env)) (| ok 5)))
 _ (assert
  (= (.result (eval-code "(: a 5 b (@add a 3) b)" base-env)) (| ok 8)))
 _ (assert
  (= (.errors (eval-code "(: x 5 y)" base-env)) ([] "unknown name y")))

 struct-has-field? (\ (value name)
  (if (= (@kind value) (| struct))
   (any (array->iter (@fields value)) (\ (f) (= (.name f) name)))
   false))
 valid-element? (\ (e)
  (if (struct-has-field? e "draw")
   (if (struct-has-field? e "width")
    (if (struct-has-field? e "height")
     (and
      (= (@kind (@field e "width")) (| float))
      (= (@kind (@field e "height")) (| float)))
     false)
    false)
   false))
 valid-draw-position? (\ (p)
  (if (= (@kind p) (| struct))
   (if (struct-has-field? p "x")
    (if (struct-has-field? p "y")
     (and
      (= (@kind (@field p "x")) (| float))
      (= (@kind (@field p "y")) (| float)))
     false)
    false)
   false))
 valid-byte? (\ (v)
  (if (= (@kind v) (| int)) (and (>= v 0) (<= v 255)) false))
 valid-color? (\ (c)
  (if (= (@kind c) (| struct))
   (if (struct-has-field? c "r")
    (if (struct-has-field? c "g")
     (if (struct-has-field? c "b")
      (and-3
       (valid-byte? (@field c "r"))
       (valid-byte? (@field c "g"))
       (valid-byte? (@field c "b")))
      false)
     false)
    false)
   false))
 valid-path-segment? (\ (s)
  (if (= (@kind s) (| enum))
   (: v (@variant s)
    (if (or (= v "move-to") (= v "line-to"))
     (valid-draw-position? (@payload s))
     false))
   false))
 valid-draw-path? (\ (p)
  (if (= (@kind p) (| array)) (all (array->iter p) valid-path-segment?) false))
 valid-transformation-matrix? (\ (m)
  (if (= (@kind m) (| struct))
   (if (struct-has-field? m "a")
    (if (struct-has-field? m "b")
     (if (struct-has-field? m "c")
      (if (struct-has-field? m "d")
       (if (struct-has-field? m "e")
        (if (struct-has-field? m "f")
         (and
          (and-3
           (= (@kind (@field m "a")) (| float))
           (= (@kind (@field m "b")) (| float))
           (= (@kind (@field m "c")) (| float)))
          (and-3
           (= (@kind (@field m "d")) (| float))
           (= (@kind (@field m "e")) (| float))
           (= (@kind (@field m "f")) (| float))))
         false)
        false)
       false)
      false)
     false)
    false)
   false))
 valid-draw? (\ (d)
  (rec d (\ (recurse d)
   (if (= (@kind d) (| enum))
    (: v (@variant d)
     (cond
      (= v "nothing") true
      (= v "all")
       (: p (@payload d)
        (if (= (@kind p) (| array)) (all (array->iter p) recurse) false))
      (= v "fill-path")
       (: p (@payload d)
        (if (= (@kind p) (| struct))
         (if (struct-has-field? p "path")
          (if (struct-has-field? p "color")
           (and
            (valid-draw-path? (@field p "path"))
            (valid-color? (@field p "color")))
           false)
          false)
         false))
      (= v "translate")
       (: p (@payload d)
        (if (= (@kind p) (| struct))
         (if (struct-has-field? p "by")
          (if (struct-has-field? p "what")
           (and
            (valid-draw-position? (@field p "by"))
            (recurse (@field p "what")))
           false)
          false)
         false))
      (= v "transform")
       (: p (@payload d)
        (if (= (@kind p) (| struct))
         (if (struct-has-field? p "by")
          (if (struct-has-field? p "what")
           (and
            (valid-transformation-matrix? (@field p "by"))
            (recurse (@field p "what")))
           false)
          false)
         false))
      else false))
    false))))

 # "A computation cache is a tree mirroring the notebook:
    Cache = (| chapter ([] Cache) entry CacheEntry skip (&)),
      where chapters become chapters, code parts become entries, and other nodes
      get skipped.
    CacheEntry = (& code String evald <result of eval-code>)"
 # "Extend the environment with the binding produced by an eval-code result, if
    any: only named blocks whose body ran successfully add a definition."
 extend-env (\ (env r)
  (% (.name r)
   (some name)
    (% (.result r)
     (ok value) (| more (& item (& name name definition value) rest env))
     _ env)
   _ env))
 join-lines (\ (lines)
  (fold (array->iter lines) "" (\ (acc line)
   (if (= acc "") line (string-concat-3 acc "\n" line)))))

 # "Flatten a cache tree back into the flat linked list of entries in document
    order. Used internally to drive incremental reuse, which only cares about
    the sequence of code-block results, ignoring text/chapter structure."
 flatten-cache (\ (cache)
  (list-reverse
   (rec-2 cache (| empty) (\ (rec node acc)
    (% node
     (chapter children)
      (fold (array->iter children) acc (\ (a child) (rec child a)))
     (entry e) (| more (& item e rest acc))
     _ acc)))))

 # "Incrementally process one code block against the old cache. The state
    carries the current env and the not-yet-consumed tail of the old (flat)
    cache. Returns the updated env, remaining old cache, and the resulting cache
    entry."
 eval-code-incremental (\ (source state) (:
  env (.env state)
  old (.old state)
  prev (% old (more m) (| some (.item m)) _ (| none))
  reuse? (% prev (some e) (= (.code e) source) _ false)
  (if reuse?
   (:
    entry (% prev (some e) e _ (crash "unreachable"))
    (&
     env (extend-env env (.evald entry))
     old (% old (more m) (.rest m) _ (| empty))
     entry entry))
   (:
    r (eval-code source env)
    entry (& code source evald r)
    # "If a definition's result changed, everything after it might reference
       the old value, so clear the cache and re-evaluate the rest."
    cleared?
     (and
      (% (.name r) (some n) true _ false)
      (% prev (some e) (not (= (.result (.evald e)) (.result r))) _ true))
    (&
     env (extend-env env r)
     old (if cleared? (| empty) (% old (more m) (.rest m) _ (| empty)))
     entry entry)))))

 # "Evaluate a notebook, producing a cache tree that mirrors the book: each code
    part becomes (| entry cache-entry), each other part (| skip), and each
    chapter (| chapter array-of-children). The old cache (same tree shape) is
    flattened internally so unchanged code blocks reuse their previous results."
 eval-book (\ (book old-cache) (:
  result
   (rec-3 book base-env (flatten-cache old-cache) (\ (walk node env old)
    (% node
     (chapter chapter) (:
      acc
       (fold
        (array->iter (.parts chapter))
        (& env env old old nodes (| empty))
        (\ (state part) (:
         r (walk part (.env state) (.old state))
         (&
          env (.env r)
          old (.old r)
          nodes (| more (& item (.node r) rest (.nodes state)))))))
      (&
       env (.env acc)
       old (.old acc)
       node (| chapter (list->array (list-reverse (.nodes acc))))))
     (code source) (:
      r (eval-code-incremental source (& env env old old))
      (& env (.env r) old (.old r) node (| entry (.entry r))))
     _ (& env env old old node (| skip)))))
  (.node result)))

 any-to-string (\ (value)
  (rec value (\ (recurse value)
   (% (@kind value)
    int (int->string value)
    float "float"
    string (string-concat-3 "\"" value "\"")
    struct
     (string-concat
      (fold (array->iter (@fields value)) "(&"
       (\ (acc field)
        (string-concat-5
         acc
         " "
         (.name field)
         " "
         (recurse (.value field)))))
      ")")
    enum (:
     variant (@variant value)
     payload (@payload value)
     empty-payload?
      (if (= (@kind payload) (| struct))
       (= (array-length (@fields payload)) 0)
       false)
     (if empty-payload?
      (string-concat-3 "(| " variant ")")
      (string-concat-5 "(| " variant " " (recurse payload) ")")))
    array
     (string-concat
      (fold (array->iter value) "([]"
       (\ (acc item) (string-concat-3 acc " " (recurse item))))
      ")")
    function
     (: args (@arguments value)
      (string-concat-3 "(\\ ("
       (rec 0 (\ (rec i)
        (if (= i (array-length args))
         ""
         (string-concat-3
          (if (= i 0) "" " ")
          (array-get args i)
          (rec (+ i 1))))))
       ") ...)"))))))
 _ (assert (= (any-to-string (& a 1 b 2)) "(& a 1 b 2)"))
 _ (assert (= (any-to-string (& x (| some 3))) "(& x (| some 3))"))
 _ (assert (= (any-to-string (| some 5)) "(| some 5)"))
 _ (assert (= (any-to-string (| empty)) "(| empty)"))
 _ (assert (= (any-to-string ([] 1 2)) "([] 1 2)"))
 _ (assert (= (any-to-string (\ (x y) x)) "(\\ (x y) ...)"))
 _ (assert (= (any-to-string (\ () 0)) "(\\ () ...)"))

 # "Render a code block's result as a widget, but only if the cell explicitly
    opts in by evaluating to `(| widget <element>)`, where <element> is a drawing
    element `(& draw ... width ... height ...)`. If that element's draw tree is
    well-formed for the host, render it; anything else — a value that is not a
    `(| widget ...)`, a non-element payload, or a malformed draw tree — returns
    (| none) so the block falls back to showing the value as text. The validation
    runs inside the sandbox, so even a pathological draw tree can't crash the
    notebook — it just falls back."
 result-widget (\ (value)
  (if (= (@kind value) (| enum))
   (if (= (@variant value) "widget")
    (% (@sandbox run-fuel (\ () (:
        element (@payload value)
        (if (valid-element? element)
         (if (valid-draw? (.draw element)) (| some element) (| none))
         (| none)))))
     (returned r) r
     _ (| none))
    (| none))
   (| none)))

 # "Incremental evaluation with per-cell status.
    Each cache entry is now (& code String status Status evald Evald) where
    Status is (| outdated) | (| running) | (| done). Code cells are evaluated
    inline in document order, with each run bounded by `run-fuel`."
 empty-evald (& name (| none) errors ([]) result (| empty))

 # "The flat array of code-cell entries in document order."
 cache-entries (\ (cache) (list->array (flatten-cache cache)))

 # "Rebuild a cache tree, applying (f document-index entry) to each entry."
 map-entries-indexed (\ (cache f)
  (.node (rec-2 cache 0 (\ (go node i)
   (% node
    (chapter children) (:
     acc
      (fold (array->iter children) (& i i nodes (| empty))
       (\ (st child) (:
        r (go child (.i st))
        (& i (.i r) nodes (| more (& item (.node r) rest (.nodes st)))))))
     (& i (.i acc) node (| chapter (list->array (list-reverse (.nodes acc))))))
    (entry e) (& i (+ i 1) node (| entry (f i e)))
    _ (& i i node node))))))

 update-code-entry (\ (cache k f)
  (map-entries-indexed cache (\ (i e) (if (= i k) (f e) e))))

 first-outdated-index (\ (cache) (:
  entries (cache-entries cache)
  n (array-length entries)
  (rec 0 (\ (rec i)
   (if (>= i n)
    (| none)
    (if (= (@variant (.status (array-get entries i))) "outdated")
     (| some i)
     (rec (+ i 1))))))))

 # "Fold the env forward across the (done) code cells before index k."
 env-before (\ (cache k) (:
  entries (cache-entries cache)
  (rec-2 0 base-env (\ (rec i env)
   (if (>= i k)
    env
    (rec (+ i 1) (extend-env env (.evald (array-get entries i)))))))))

 # "Build a cache tree mirroring `book`, reusing unchanged done entries from
    `old-cache` up to the first divergence; the diverging code cell and every
    code cell after it are marked outdated (their old value kept for display)."
 rebuild-cache (\ (book old-cache) (:
  old-entries (cache-entries old-cache)
  old-count (array-length old-entries)
  (.node (rec-2 book (& i 0 diverged false) (\ (go node acc)
   (% node
    (chapter chapter) (:
     folded
      (fold (array->iter (.parts chapter)) (& acc acc nodes (| empty))
       (\ (st part) (:
        r (go part (.acc st))
        (&
         acc (& i (.i r) diverged (.diverged r))
         nodes (| more (& item (.node r) rest (.nodes st)))))))
     (&
      i (.i (.acc folded))
      diverged (.diverged (.acc folded))
      node (| chapter (list->array (list-reverse (.nodes folded))))))
    (code source) (:
     idx (.i acc)
     old (if (< idx old-count) (| some (array-get old-entries idx)) (| none))
     reusable
      (% old
       (some e)
        (and-3
         (not (.diverged acc))
         (= (.code e) source)
         (= (@variant (.status e)) "done"))
       _ false)
     entry
      (if reusable
       (% old (some e) e _ (crash "unreachable"))
       (&
        code source
        status (| outdated)
        evald
         (% old
          (some e) (if (= (.code e) source) (.evald e) empty-evald)
          _ empty-evald)))
     (&
      i (+ idx 1)
      diverged (or (.diverged acc) (not reusable))
      node (| entry entry)))
    _ (& i (.i acc) diverged (.diverged acc) node (| skip))))))))

 set-running (\ (st r)
  (& book (.book st) focus (.focus st) size (.size st) eval (.eval st) running r))
 set-eval (\ (st e)
  (& book (.book st) focus (.focus st) size (.size st) eval e running (.running st)))
 set-size (\ (st s)
  (& book (.book st) focus (.focus st) size s eval (.eval st) running (.running st)))

 # "Compile a code cell against `env`. Parse+analyze+compile run synchronously
    on the main thread; the result is either (| run (& name errors thunk)) with a
    0-arg thunk to run inline, or (| no-run (& name errors result)) for empty
    cells and parse/analyze failures that need no task."
 compile-cell-analyzed (\ (name-opt ast env)
  (% (@sandbox compile-fuel (\ () (analyze ast)))
   (crashed e) (| no-run (& name name-opt errors ([] e) result (| empty)))
   out-of-fuel (| no-run (& name name-opt errors ([] "timeout") result (| empty)))
   (returned analyzed) (:
    errs (iter->array (collect-errors analyzed (names-of-env env)))
    thunk (compile analyzed (| empty) env)
    (| run (& name name-opt errors errs thunk thunk)))))
 compile-cell (\ (source env)
  (% (@sandbox compile-fuel (\ () (parse-code-block source)))
   (crashed e) (| no-run (& name (| none) errors ([] e) result (| empty)))
   out-of-fuel (| no-run (& name (| none) errors ([] "timeout") result (| empty)))
   (returned block)
    (% block
     empty (| no-run (& name (| none) errors ([]) result (| empty)))
     (expr ast) (compile-cell-analyzed (| none) ast env)
     (bind b) (compile-cell-analyzed (| some (.name b)) (.expr b) env))))

 # "Map a sandboxed run result into a cell result."
 map-task-result (\ (r)
  (% r
   (returned v) (| ok v)
   (crashed e) (| error e)
   out-of-fuel (| timeout)
   _ (| error "task failed")))

 # "From code cell k with env-before-k, evaluate cells inline in document order.
    Each runnable cell is sandboxed with `run-fuel`. When past the last cell,
    stop."
 start-eval-from (\ (make-app st0 k0 env0)
  (rec-3 st0 k0 env0 (\ (self st k env) (:
   entries (cache-entries (.eval st))
   n (array-length entries)
   (if (>= k n)
    (| app (make-app (set-running st (| none))))
    (:
     entry (array-get entries k)
     compiled (compile-cell (.code entry) env)
     (% compiled
      (no-run r) (:
       new-eval
        (update-code-entry (.eval st) k
         (\ (e) (& code (.code e) status (| done) evald r)))
       (self (set-eval st new-eval) (+ k 1) (extend-env env r)))
      (run info) (:
       evald
        (&
         name (.name info)
         errors (.errors info)
         result (map-task-result (@sandbox run-fuel (.thunk info))))
       new-eval
        (update-code-entry (.eval st) k
         (\ (e) (& code (.code e) status (| done) evald evald)))
       (self
        (set-eval st new-eval)
        (+ k 1)
        (extend-env env evald))))))))))

 # "If nothing is running, evaluate from the first outdated cell."
 continue-eval (\ (make-app st)
  (% (.running st)
   (some r) (| app (make-app st))
   none (:
    first (first-outdated-index (.eval st))
    (% first
     (some k) (start-eval-from make-app st k (env-before (.eval st) k))
     none (| app (make-app st))))))

 make-notebook-app (\ (book)
  (rec
   (& book book focus (| at 0) eval (rebuild-cache book (| empty))
      size (& width 0. height 0.) running (| none))
   (\ (make-app state) (&
  handle (\ (event) (:
   enter-focus (\ (node)
    (% node
     new (| text)
     (text string)
      (&
       anchor (string-length string)
       active (string-length string)
       desired-x
        (text-x-offset
         string
         (f- (.width (.size state)) 4.)
         (string-length string)))
     (chapter chapter) (| at-title)
     (code string)
      (&
       anchor (string-length string)
       active (string-length string)
       desired-x (text-x-offset string 100000. (string-length string)))
     _ (crash "what's the focus for entering this node?")
     ))
   (% event
    (task-finished info) (:
     handle (.handle info)
     (% (.running state)
      (some r)
       (if (= (.handle r) handle)
        (:
         k (.index r)
         entry (array-get (cache-entries (.eval state)) k)
         mapped (map-task-result (.result info))
         new-evald
          (&
           name (.name (.evald entry))
           errors (.errors (.evald entry))
           result mapped)
         new-eval
          (update-code-entry (.eval state) k
           (\ (e) (& code (.code e) status (| done) evald new-evald)))
         new-env (extend-env (.env r) new-evald)
         (start-eval-from make-app
          (set-running (set-eval state new-eval) (| none)) (+ k 1) new-env))
        (| app (make-app state)))
      none (| app (make-app state))))
    (window-resized new-size)
     (continue-eval make-app (set-size state new-size))
    _ (:
     result
      (rec-2 (.book state) (.focus state) (\ (handle node focus)
       (% node
        new
         (% event
          (key-pressed key)
          (cond
           (key-escape? key) (& node node focus (| yield))
           (key-enter? key) (:
            new-node
             (% focus
              text (| text "")
              chapter (| chapter (& title "" parts ([])))
              code (| code "")
              )
            (& node new-node focus (| here (enter-focus new-node))))
           (key-left? key)
            (&
             node node
             focus
              (| here
               (% focus text (| text) chapter (| text) code (| chapter))))
           (key-right? key)
            (&
             node node
             focus
              (| here
               (% focus text (| chapter) chapter (| code) code (| code))))
           else (& node node focus (| here focus)))
          _ (& node node focus (| here focus)))
        (text string) (:
         is-escape (% event (key-pressed key) (key-escape? key) _ false)
         (if is-escape
          (& node (| text string) focus (| yield))
          (: edited
            (handle-text-edit-with-cursor
             string (f- (.width (.size state)) 4.) focus event)
           (& node (| text (.string edited)) focus (| here (.cursor edited))))))
        (chapter chapter) (:
         title (.title chapter)
         parts (.parts chapter)
         (% focus
          at-title
           (% event
            (key-pressed key)
             (cond
              (key-escape? key) (& node node focus (| yield))
              (key-down? key)
               (&
                node node
                focus (| here (if (= (array-length parts) 0) focus (| at 0))))
              (key-ctrl-n? key)
               (&
                node
                 (| chapter (&
                  title title
                  parts (array-insert parts 0 (| new))))
                focus (| here (| in (& index 0 inner (| text)))))
              else (&
               node
                (| chapter (& title (handle-text-edit title event) parts parts))
               focus (| here (| at-title)))
              )
            char (&
             node
              (| chapter (& title (handle-text-edit title event) parts parts))
             focus (| here (| at-title)))
            )
          (at i)
           (% event
            (key-pressed key)
             (cond
              (key-escape? key) (& node node focus (| yield))
              (key-up? key)
               (&
                node node
                focus (| here (if (= i 0) (| at-title) (| at (- i 1)))))
              (key-down? key)
               (&
                node node
                focus
                 (| here
                  (if (= i (- (array-length parts) 1)) focus (| at (+ i 1)))))
              (key-alt-up? key)
               (if (= i 0)
                (& node node focus (| here focus))
                (&
                 node
                  (| chapter (& title title parts (array-swap parts i (- i 1))))
                 focus (| here (| at (- i 1)))))
              (key-alt-down? key)
               (if (= i (- (array-length parts) 1))
                (& node node focus (| here focus))
                (&
                 node
                  (| chapter (& title title parts (array-swap parts i (+ i 1))))
                 focus (| here (| at (+ i 1)))))
              (key-shift-alt-up? key)
               (if (= i 0)
                (& node node focus (| here focus))
                (% (array-get parts (- i 1))
                 (chapter above) (:
                  block (array-get parts i)
                  new-above
                   (| chapter (&
                    title (.title above)
                    parts
                     (array-insert
                      (.parts above) (array-length (.parts above)) block)))
                  new-parts
                   (array-remove (array-update parts (- i 1) new-above) i)
                  (&
                   node (| chapter (& title title parts new-parts))
                   focus
                    (| here
                     (| in (&
                      index (- i 1)
                      inner (| at (array-length (.parts above))))))))
                 _ (& node node focus (| here focus))))
              (key-shift-alt-down? key)
               (if (= i (- (array-length parts) 1))
                (& node node focus (| here focus))
                (% (array-get parts (+ i 1))
                 (chapter below) (:
                  block (array-get parts i)
                  new-below
                   (| chapter (&
                    title (.title below)
                    parts (array-insert (.parts below) 0 block)))
                  new-parts
                   (array-remove (array-update parts (+ i 1) new-below) i)
                  (&
                   node (| chapter (& title title parts new-parts))
                   focus (| here (| in (& index i inner (| at 0))))))
                 _ (& node node focus (| here focus))))
              (key-shift-alt-left? key)
               (& node node focus (| eject (& index i)))
              (key-enter? key)
               (&
                node node
                focus
                 (| here
                  (| in (& index i inner (enter-focus (array-get parts i))))))
              (key-ctrl-n? key)
               (&
                node
                 (| chapter (&
                  title title
                  parts (array-insert parts (+ i 1) (| new))))
                focus (| here (| in (& index (+ i 1) inner (| text)))))
              (key-backspace? key) (:
               part (array-get parts i)
               deletable
                (% part (chapter c) (= (array-length (.parts c)) 0) _ true)
               (if deletable
                (: new-parts (array-remove parts i)
                 (&
                  node (| chapter (& title title parts new-parts))
                  focus (| here (if (= i 0) (| at-title) (| at (- i 1))))))
                (& node node focus (| here focus))))
              else (& node node focus (| here focus)))
            _ (& node node focus (| here focus)))
          (in f) (:
           index (.index f)
           inner-state (handle (array-get parts index) (.inner f))
           inner-node (.node inner-state)
           inner-focus (.focus inner-state)
           (% inner-focus
            (eject e) (:
             child
              (% inner-node (chapter c) c _ (crash "eject from non-chapter"))
             block (array-get (.parts child) (.index e))
             new-child
              (| chapter (&
               title (.title child)
               parts (array-remove (.parts child) (.index e))))
             (&
              node
               (| chapter (&
                title (.title chapter)
                parts
                 (array-insert
                  (array-update parts index new-child) (+ index 1) block)))
              focus (| here (| at (+ index 1)))))
            _ (&
             node
              (| chapter (&
               title (.title chapter)
               parts (array-update parts index inner-node)))
             focus
              (| here
               (% inner-focus
                yield (| at index)
                (here focus) (| in (& index index inner focus))
                _ (crash "weird inner focus"))))))
          _ (crash "bad chapter focus")))
        (code string)
         (cond
          (% event (key-pressed key) (key-escape? key) _ false) (:
           # "Escape exits the current node."
           (& node (| code string) focus (| yield)))
          (% event (char-entered c) (= c "(") _ false) (:
           # "Typing '(' auto-inserts a matching ')'. I do that by replaying
              events for '(', ')', and a left-arrow press."
           state1
            (handle-text-edit-with-cursor string 100000. focus (| char-entered "("))
           state2
            (handle-text-edit-with-cursor
             (.string state1)
             100000.
             (.cursor state1)
             (| char-entered ")"))
           state3
            (handle-text-edit-with-cursor
             (.string state2)
             100000.
             (.cursor state2)
             (| key-pressed
              (& keycode 263 control false shift false alt false)))
           (& node (| code (.string state3)) focus (| here (.cursor state3))))
          (if (% event (key-pressed k) (key-backspace? k) _ false)
           (: active (.active focus)
            (if
             (and-3
              (not (cursor-has-selection? focus))
              (> active 0)
              (< active (string-length string)))
             (= (string-slice string (- active 1) (+ active 1)) "()")
             false))
           false)
          (:
           # "Pressing backspace between two parentheses like '(|)' removes
              both. I do that by replaying events for backspace and delete."
           state1
            (handle-text-edit-with-cursor string 100000. focus event)
           state2
            (handle-text-edit-with-cursor
             (.string state1)
             100000.
             (.cursor state1)
             (| key-pressed
              (& keycode 261 control false shift false alt false)))
           (& node (| code (.string state2)) focus (| here (.cursor state2))))
          else (:
           edited
            (handle-text-edit-with-cursor string 100000. focus event)
           (& node (| code (.string edited)) focus (| here (.cursor edited)))))
        _ (crash "handle node type")
        )))
      (:
       new-book (.node result)
       new-focus
        (% (.focus result)
         (here f) f
         yield (enter-focus (.node result))
         (eject e) (| at (.index e)))
       new-cache (rebuild-cache new-book (.eval state))
       st1
        (&
         book new-book focus new-focus size (.size state)
         eval new-cache running (.running state))
       c (first-outdated-index new-cache)
       (% (.running state)
        (some r)
         (% c
          (some ci)
           (if (<= ci (.index r))
            (start-eval-from make-app (set-running st1 (| none)) ci
             (env-before new-cache ci))
            (| app (make-app st1)))
          none (| app (make-app st1)))
        none
         (% c
          (some ci)
           (start-eval-from make-app st1 ci (env-before new-cache ci))
          none (| app (make-app st1)))))))))
  render (\ () (:
   size (.size state)
   chapter-and-focus
    (rec-2 (.book state) (.focus state) (\ (rec node focus)
     (: chapter (% node (chapter chapter) chapter _ (crash "bad"))
      (% focus
       (in args) (:
        part (array-get (.parts chapter) (.index args))
        (% part
         chapter (rec part (.inner args))
         _ (& chapter chapter focus focus)))
       _ (& chapter chapter focus focus)))))
   chapter (.chapter chapter-and-focus)
   focus (.focus chapter-and-focus)
   current-caches
    (rec-2 (.eval state) (.focus state) (\ (rec cache focus)
     (: caches (% cache (chapter caches) caches _ (crash "bad cache"))
      (% focus
       (in args) (:
        child (array-get caches (.index args))
        (% child
         chapter (rec child (.inner args))
         _ caches))
       _ caches))))
   render-part (\ (part cache width focus)
    (% part
     new
      (padding 2.
       (row ([]
        (maybe-render-cursor
         (% focus outside false (inside f) (% f text true _ false))
         (text "text" blue))
        (empty-box 5. 0.)
        (maybe-render-cursor
         (% focus outside false (inside f) (% f chapter true _ false))
         (text "chapter" blue))
        (empty-box 5. 0.)
        (maybe-render-cursor
         (% focus outside false (inside f) (% f code true _ false))
         (text "code" blue))
        )))
     (text string)
      (padding 2.
       (% focus
        (inside cursor) (editable-text string black cursor (f- width 4.))
        outside (text-wrapped string black (f- width 4.))))
     (chapter chapter)
      (padding 2.
       (row ([]
        (padding (& top 3. bottom 0. right 4. left 0.)
         (colored black (empty-box 7. 7.)))
        (text (.title chapter) black))))
     (code string) (:
      evald
       (% cache
        (entry e) (.evald e)
        _ (& name (| none) errors ([]) result (| empty)))
      binding? (% (.name evald) (some n) true _ false)
      code-element
       (padding 2.
        (% focus
         (inside cursor) (editable-text string (color "#295829") cursor 100000.)
         outside (text string (color "#295829"))))
      run-element
       (% (.result evald)
        (ok value)
         (% (result-widget value)
          (some element) element
          none (text (any-to-string value) blue))
        (error value) (text (any-to-string value) red)
        timeout (text "timeout" yellow)
        empty (text "" black))
      errors-element (text (join-lines (.errors evald)) red)
      has-errors? (> (array-length (.errors evald)) 0)
      # "For definitions we don't surface the bound value, but we still show
         runtime crashes and timeouts. Plain expressions always show their run."
      show-run?
       (% (.result evald)
        (ok value) (not binding?)
        empty false
        _ true)
      result-element
       (padding 2.
        (if has-errors?
         (if show-run? (column ([] errors-element run-element)) errors-element)
         (if show-run? run-element (text "" black))))
      hide-result? (and (not has-errors?) (not show-run?))
      is-outside (% focus outside true _ false)
      single-line?
       (and
        (f<= (.height code-element) (f+ line-height 4.))
        (f<= (.height result-element) (f+ line-height 4.)))
      fits-inline?
       (f<= (f+ (f+ (.width code-element) 10.) (.width result-element)) width)
      (if hide-result?
       code-element
       (if (and-3 is-outside single-line? fits-inline?)
        (row ([] code-element (empty-box 10. 0.) result-element))
        (column ([] code-element result-element)))))
     _ (colored red (text "unknown part" white))))
   rendered
    (colored (color "#ffeadd")
     (sized-box (.width size) (.height size)
      (column ([]
       (empty-box 0. 4.)
       (padding 2. (scaled 1.5 (text (.title chapter) black)))
       (empty-box 0. 4.)
       (column
        (iter->array
         (map-indexed (array->iter (.parts chapter)) (\ (index part)
          (maybe-render-cursor (% focus (at i) (= i index) _ false)
           (render-part
            part
            (array-get current-caches index)
            (.width size)
            (% focus
             (in args)
              (if (= (.index args) index) (| inside (.inner args)) (| outside))
             _ (| outside))))))))))))
   (.draw rendered)))))))




 _ make-notebook-app



 _ "Widget framework

  The widget framework functions similar to that of Flutter: You define your UI
  by nesting very tiny, simple widgets in a declarative way. This widget tree
  gets converted into an element tree (elements are persistent nodes that can
  have internal state). On the next frame, you rebuild a widget tree and my
  framework updates the element tree accordingly.

  Having widget and element trees instead of just composing functions that
  return drawings allows you to keep internal state in the tree. This can be
  used for performance (for example, to now re-layout text) and is generally
  useful for state management.

  A widget defines the behavior of a UI part. It's really just a struct:
  (&
   new (\\ (config) ...)
   render (\\ (state) ...)
   new-constraints (\\ (state constraints) ...)
   mouse-clicked (\\ (state where) ...)
   handle (\\ (state event) ...)
   ).
  Sometimes, I talk about abstract widgets (this struct) and concrete widget
  instances (something like (text "Hi"), which is really just another struct
  (& config <parameters> widget <abstract text-widget>)).

  Here's what the widget functions do:
  - new: Takes a configuration and returns a state. The framework bundles that
    state up into an element.
  - render: Takes a state and renders it to (& size ... draw ...).
  - new-constraints: Takes a state and constraints and returns a new state.
  - mouse-clicked: Takes a state and position and returns either:
    - (| not-handled) to indicate that an external element should handle the
      click;
    - (| handled state) to indicate that the click was handled internally;
    - (| message ...) to indicate that the click was handled and the message
      should be passed up the tree to some element which handles it
      TODO: how do messages bubble up the tree?

  Elements have this shape:
  (&
   widget <the abstract widget>
   state ...
   constraints <the constraints last given to the element>
   drawing <the last rendered version of the widget>
   )
  Note that this already includes enough information to cache most widget trees:
  If a widget is given new constraints, but they are the same as the old ones,
  we don't need to tell it. Similarly, instead of rendering the widget, by
  keeping the rendered drawing up-to-date after every information that flows
  into the widget, we can cache successive renderings.
  This way, for example, scrolling a list may re-render the child,
 "

 _ "Constraints"

 tight-constraints (\ (size)
  (&
   width (| bounded (& min (.width size) max (.width size)))
   height (| bounded (& min (.height size) max (.height size)))))
 loosen-min-constraints (\ (constraints)
  (&
   width
    (% (.width constraints)
     (bounded b) (| bounded (& min 0. max (.max b)))
     (unbounded b) (| unbounded (& min 0.)))
   height
    (% (.height constraints)
     (bounded b) (| bounded (& min 0. max (.max b)))
     (unbounded b) (| unbounded (& min 0.)))))
 constraints-min-size (\ (constraints)
  (&
   width (% (.width constraints) (bounded b) (.min b) (unbounded b) (.min b))
   height (% (.height constraints) (bounded b) (.min b) (unbounded b) (.min b))
   ))

 clamp (\ (number lo hi) (f-min hi (f-max lo number)))
 clamp-size (\ (size constraints) (:
  w (.width size)
  h (.height size)
  (&
   width
    (% (.width constraints)
     (bounded b) (clamp w (.min b) (.max b))
     (unbounded u) (f-max w (.min u)))
   height
    (% (.height constraints)
     (bounded b) (clamp h (.min b) (.max b))
     (unbounded u) (f-max h (.min u))))))

 nothing-drawn (& width 0. height 0. draw (| nothing))


 make-element (\ (widget state constraints)
  (&
   widget widget
   state state
   constraints constraints
   drawing ((.render widget) state)))
 element-with-state (\ (element state)
  (make-element (.widget element) state (.constraints element)))
 new-element (\ (widget-instance)
  (:
   widget (.widget widget-instance)
   state ((.new widget) (.config widget-instance))
   constraints (tight-constraints (& width 0. height 0.))
   (make-element widget state constraints)))
 element-render (\ (element) (.drawing element))
 element-new-constraints (\ (element constraints)
  (if (= constraints (.constraints element))
   element
   (:
    state ((.new-constraints (.widget element)) (.state element) constraints)
    (make-element (.widget element) state constraints))))
 element-mouse-clicked (\ (element where)
  (% ((.mouse-clicked (.widget element)) (.state element) where)
   not-handled (| not-handled)
   (handled new-state) (| handled (element-with-state element new-state))
   (message message) (| message message)))
 element-handle (\ (element event)
  (element-with-state
   element
   ((.handle (.widget element)) (.state element) event)))

 empty-widget (&
  new (\ (_) (& width 0. height 0.))
  render (\ (size) (& size size draw (| nothing)))
  new-constraints (\ (_ constraints) (constraints-min-size constraints))
  mouse-clicked (\ (state where) (| not-handled))
  )
 empty (& config nil widget empty-widget)

 text-widget (&
  new (\ (string) (:
   drawn-text (text-wrapped string black 100.)
   (& string string drawn (& size (& width (.width drawn-text) height (.height drawn-text)) draw (.draw drawn-text)))))
  render (\ (state) (.drawn state))
  new-constraints (\ (state constraints) (:
   string (.string state)
   drawn-text
    (text-wrapped
     string
     black
     (% (.width constraints) (bounded b) (.max b) unbounded 100.))
   (&
    string string
    drawn (&
     size
      (clamp-size
       (& width (.width drawn-text) height (.height drawn-text))
       constraints)
     draw (.draw drawn-text)))))
  mouse-clicked (\ (state where) (| not-handled))
  )
 text (\ (string) (& config string widget text-widget))

 colored-widget (&
  new (\ (config) (& color (.color config) child (new-element (.child config))))
  render (\ (state) (:
   rendered-child (element-render (.child state))
   size (.size rendered-child)
   width (.width size)
   height (.height size)
   colored-rectangle
    (| fill-path (&
     path ([]
      (| move-to (& x 0. y 0.))
      (| line-to (& x width y 0.))
      (| line-to (& x width y height))
      (| line-to (& x 0. y height)))
     color (.color state)))
   (& size size draw (| all ([] colored-rectangle (.draw rendered-child))))))
  new-constraints (\ (state constraints)
   (&
    color (.color state)
    child (element-new-constraints (.child state) constraints)))
  mouse-clicked (\ (state where)
   (% (element-mouse-clicked (.child state) where)
    not-handled (| not-handled)
    (handled new-child) (| handled (& color (.color state) child new-child))
    (message message) (| message message)))
  )
 colored (\ (color child)
  (& config (& color color child child) widget colored-widget))

 align-widget (&
  new (\ (config)
   (&
    horizontal (.horizontal config)
    vertical (.vertical config)
    constraints (tight-constraints (& width 0. height 0.))
    child (new-element (.child config))))
  render (\ (state) (:
   rendered-child (element-render (.child state))
   child-size (.size rendered-child)
   child-width (.width child-size)
   child-height (.height child-size)
   our-width (% (.width (.constraints state)) (bounded b) (.max b) unbounded child-width)
   our-height (% (.height (.constraints state)) (bounded b) (.max b) unbounded child-height)
   (&
    size (& width our-width height our-height)
    draw
     (| transform
      (&
       by
        (transform-translate
         (f* (.horizontal state) (f- our-width child-width))
         (f* (.vertical state) (f- our-height child-height)))
       what (.draw rendered-child)))
       )))
  new-constraints (\ (state constraints)
   (&
    horizontal (.horizontal state)
    vertical (.vertical state)
    constraints constraints
    child
     (element-new-constraints
      (.child state)
      (loosen-min-constraints constraints))))
  mouse-clicked (\ (state where) (:
   rendered-child (element-render (.child state))
   child-size (.size rendered-child)
   child-width (.width child-size)
   child-height (.height child-size)
   our-width (% (.width (.constraints state)) (bounded b) (.max b) unbounded child-width)
   our-height (% (.height (.constraints state)) (bounded b) (.max b) unbounded child-height)
   child-mouse-x (f- (.x where) (f* (.horizontal state) (f- our-width child-width)))
   child-mouse-y (f- (.y where) (f* (.vertical state) (f- our-height child-height)))
   child-clicked (and-4 (f>= child-mouse-x 0.) (f< child-mouse-x child-width) (f>= child-mouse-y 0.) (f< child-mouse-y child-height))
   (% child-clicked
    false (| not-handled)
    true
     (%
      (element-mouse-clicked (.child state) (& x child-mouse-x y child-mouse-y))
      not-handled (| not-handled)
      (handled new-element)
       (| handled
        (&
         horizontal (.horizontal state)
         vertical (.vertical state)
         constraints (.constraints state)
         child new-element))
      (message message) (| message message)))
   ))
  )
 align (\ (horizontal vertical child)
  (&
   config (& horizontal horizontal vertical vertical child child)
   widget align-widget))
 center (\ (child) (align 0.5 0.5 child))

 stateful-widget (&
  new (\ (config)
   (&
    state (.initial config)
    update (.update config)
    builder (.builder config)
    child (new-element ((.builder config) (.initial config)))
    constraints (tight-constraints (& width 0. height 0.))))
  render (\ (state) (element-render (.child state)))
  new-constraints (\ (state constraints)
   (&
    state (.state state)
    update (.update state)
    builder (.builder state)
    child (element-new-constraints (.child state) constraints)
    constraints constraints))
  mouse-clicked (\ (state where)
   (% (element-mouse-clicked (.child state) where)
    not-handled (| not-handled)
    (handled new-element)
     (| handled
      (&
       state (.state state)
       update (.update state)
       builder (.builder state)
       child new-element
       constraints (.constraints state)))
    (message message) (:
     new-state ((.update state) (.state state) message)
     new-child (element-new-constraints (new-element ((.builder state) new-state)) (.constraints state))
     (| handled
      (&
       state new-state
       update (.update state)
       builder (.builder state)
       child new-child
       constraints (.constraints state)))
    )
   )
  )
  )
 stateful (\ (initial update builder)
  (&
   config (& initial initial update update builder builder)
   widget stateful-widget))

 on-click-widget (&
  new (\ (config) (& message (.message config) child (new-element (.child config))))
  render (\ (state) (element-render (.child state)))
  new-constraints (\ (state constraints)
   (&
    message (.message state)
    child (element-new-constraints (.child state) constraints)))
  mouse-clicked (\ (state where)
   (% (element-mouse-clicked (.child state) where)
    not-handled (| message (.message state))
    (handled new-child) (| handled (& message (.message state) child new-child))
    (message message) (| message message)))
  )
 on-click (\ (message child)
  (& config (& message message child child) widget on-click-widget))

 row-widget (&
  new (\ (children)
   (&
    children
     (iter->array
      (map (array->iter children) (\ (child) (new-element child))))
    constraints (tight-constraints (& width 0. height 0.))))
  render (\ (state) (:
   rendered-children
    (iter->array (map (array->iter (.children state)) element-render))
   layout
    (rec-2 (array->list rendered-children) 0. (\ (rec children x)
     (% children
      empty (& draws (| empty) width 0. height 0.)
      (more m) (:
       child (.item m)
       child-size (.size child)
       child-width (.width child-size)
       child-height (.height child-size)
       rest (rec (.rest m) (f+ x child-width))
       (&
        draws
         (| more (&
          item
           (| transform (&
            by (transform-translate x 0.)
            what (.draw child)))
          rest (.draws rest)))
        width (f+ child-width (.width rest))
        height (f-max child-height (.height rest)))))))
   (&
    size
     (clamp-size
      (& width (.width layout) height (.height layout))
      (.constraints state))
    draw (| all (list->array (.draws layout)))
   )))
  new-constraints (\ (state constraints)
   (:
    loose (loosen-min-constraints constraints)
    child-constraints
     (& width (| unbounded (& min 0.)) height (.height loose))
    (&
     children
      (iter->array
       (map
        (array->iter (.children state))
        (\ (child) (element-new-constraints child child-constraints))))
     constraints constraints)))
  mouse-clicked (\ (state where)
   (rec-2 0 0. (\ (rec index x)
    (if (= index (array-length (.children state)))
     (| not-handled)
     (:
      child (array-get (.children state) index)
      child-size (.size (element-render child))
      child-width (.width child-size)
      child-height (.height child-size)
      inside?
       (and-4
        (f>= (.x where) x)
        (f< (.x where) (f+ x child-width))
        (f>= (.y where) 0.)
        (f< (.y where) child-height))
      (if inside?
       (%
        (element-mouse-clicked
         child
         (& x (f- (.x where) x) y (.y where)))
        not-handled (| not-handled)
        (handled new-child)
         (| handled
          (&
           children (array-update (.children state) index new-child)
           constraints (.constraints state)))
        (message message) (| message message))
       (rec (+ index 1) (f+ x child-width))))))))
 )
 row (\ (children) (& config children widget row-widget))

 run-app (\ (widget)
  (rec (new-element widget) (\ (me element)
   (&
    handle (\ (event)
     (% event
      (window-resized size)
       (| app (me (element-new-constraints element (tight-constraints size))))
      (mouse-clicked where)
       (% (element-mouse-clicked element where)
        not-handled (| app (me element))
        (handled new-element) (| app (me new-element))
        (message message) (crash "unhandled message"))
      _ (crash event)
      ))
    render (\ () (.draw (element-render element)))
    ))))

 _ (\ (initial) (run-app
  (center (colored yellow (text "Alles Gute zum Geburtstag!")))))

 (\ (initial)
  (run-app
   (stateful 0
    (\ (counter message)
     (% message
      increment (+ counter 1)
      decrement (- counter 1)))
    (\ (counter)
     (row ([]
      (on-click (| decrement) (colored yellow (text "decrement")))
      (text (int->string counter))
      (on-click (| increment) (colored yellow (text "increment")))
      ))))))
)

===

General TODO:
- make notebook more beautiful (big section titles, better colors)
- support copy paste
- support syntax highlighting
- better incremental notebook
- better widget/rendering/caching abstraction (eg cache layouts and drawing instructions of subtrees)
- notebook zooming with ctrl +/-
- mouse input
- animation
- add if and cond to the IR?
- syncing data between devices
- provide optimize function that is then applied to every Pear function
- add more comments/documentation to bootstrapping pipeline
- sort struct fields?
- first person ("I") in error messages?
- make optimization cheaper: no inlining if pear had the chance to optimize, etc.