The first thing that I want to fix in this series is offloading memory. There are basically two kinds of questions I regularly deal with:

• How did I solve this problem / build this software / configure this program X months ago?

• What was I trying to remember to change X seconds ago?

I’ve started using deft to answer both of these. Deft stores notes in a folder full of flat files and adds an incremental search buffer to emacs (searching > organising). This means that my notes are simple plain text which I can easily edit, backup, grep or serve on the web.

For long-term memory I create a new note every time I solve a problem or learn something useful. Within emacs M-’ brings up the deft window, typing triggers the incremental search and hiting Enter opens the first matching note.

For short-term memory I have a single note called stack. Hitting C-’ opens the stack note with the cursor on a new blank line for adding items to the stack. Hitting C-DEL deletes the previous line and C-q closes the stack. Hopefully this is sufficiently low-friction that the extra memory makes up for the context switch.

My config is here. I’m considering writing a gnome-shell extension which displays the last line of the stack in the status bar to remind me what I’m supposed to be doing when my mental stack gets rudely dumped. I also want to add the global key bindings to gnome-shell so I don’t have to navigate to emacs first.

This is a very simple tool, which is kind of the point. The more stucture and options added to a note-taking tool the more effort it takes to actually use it and the more likely it is that I lose my entire mental stack whilst doing so.

First, a little background. From a high-level point of view, a constraint solver does three things:

• specifies a search space in the form of a set of constraints

• turns that search space into a search tree

• searches the resulting tree for non-failed leaves

Currently core.logic (and cKanren before it) complects all three of these. My patch partly decomplects the latter from the first two, allowing different search algorithms to be specified independently of the problem specification.

Let’s look at how core.logic works. I’m going to gloss over a lot of implementation details in order to make the core ideas clearer.

The search tree in core.logic is representated as a lazy stream of the non-failed leaves of the tree. This stream can be:

• nil - the empty stream

• (Choice. head tail) - a cons cell

Disjunction of two goals produces a new goal which contains the search trees of the two goals as adjacent branches. In core.logic, this is implemented by combining their streams with mplus. A naive implementation might look like this:

1
2
3
4

(defn mplus [stream1 stream2]
  (cond
    (nil? stream1) stream2
    (choice? stream1) (Choice. (.head stream1) (mplus (.tail stream1) stream2))))

This amounts to a depth-first search of the leaves of the tree. Unfortunately, search trees in core.logic can be infinitely deep so a depth-first search can get stuck. If the first branch has an infinite subtree we will never see results from the second branch.

1
2
3
4
5
6
7
8
9
10
11
12

;; simple non-terminating goal
(def forevero
  (fresh []
    forevero))

(run* [q]
  (conde
    [forvero]
    [(== q 1)]))

;; with depth-first search blocks immediately, returning (...)
;; with breadth-first search blocks after the first result, returning (1 ...)

We can perform breadth-first search by adding a new stream type:

• (fn [] stream) - a thunk representing a branch in the search tree

And then interleaving results from each branch:

1
2
3
4

(defn mplus [stream1 stream2]
  (cond
    ...
    (fn? stream1) (fn [] (mplus stream2 (stream1)))))

This is how core.logic implements fair disjunction (fair in the sense that all branches of conde will be explored equally). However, we still have a problem with fair conjunction. Conjunction is performed in core.logic by running the second goal starting at each of the leaves of the tree of the first goal. In terms of the stream representation, this looks like:

1
2
3
4
5

(defn bind [stream goal]
  (cond
    (nil? stream) nil ;; failure
    (choice? stream) (Choice. (bind (.head stream) goal) (bind (.tail stream) goal))
    (fn? stream) (fn [] (bind (stream) goal))))

This gives rise to similar behaviour as the naive version of mplus:

1
2
3
4
5
6
7

(run* [q]
  (all
    forevero
    (!= q q)))

;; with unfair conjunction blocks immediately, returning (...)
;; with fair conjunction the second branch causes failure, returning ()

I suspect the reason that core.logic didn’t yet have fair conjunction is entirely due to this stream representation, which complects all three stages of constraint solving and hides the underlying search tree. Since shackles is based on gecode it has the advantage of a much clearer theoretical framework (I strongly recommend this paper, not just for the insight into gecode but as a shining example of how mathematical intuition can be used to guide software design).

The first step in introducing fair conjunction to core.logic is to explicitly represent the search tree. The types are similar:

• nil - the empty tree
• (Result. state) - a leaf
• (Choice. left right) - a branch
• (Thunk. state goal) - a thunk containing the current state and a sub-goal

Defining mplus is now trivial since it is no longer responsible for interleaving results:

1
2

(defn mplus [tree1 tree2]
  (Choice. tree1 tree2))

And we now have two variants of bind:

1
2
3
4
5
6
7
8
9
10
11
12
13

(defn bind-unfair [tree goal]
  (cond
    (nil? goal) nil ;; failure
    (result? tree) (goal (.state tree)) ;; success, start the second tree here
    (choice? tree) (Choice. (bind-unfair (.left tree) goal) (bind-unfair (.right tree) goal))
    (thunk? tree) (Thunk. (.state tree) (bind-unfair ((.goal tree) state) goal))))

(defn bind-fair [tree goal]
  (cond
    (nil? goal) nil ;; failure
    (result? tree) (goal (.state tree)) ;; success, start the second tree here
    (choice? tree) (Choice. (bind-fair (.left tree) goal) (bind-fair (.right tree) goal))
    (thunk? tree) (Thunk. (.state tree) (bind-fair (goal state) (.goal tree))))) ;; interleave!

The crucial difference here is that bind-fair takes advantage of the continuation-like thunk to interleave both goals, allowing each to do one thunk’s worth of work before switching to the next.

(We keep bind-unfair around because it tends to be faster in practice - when you know what order your goals will be run in you can use domain knowledge to specify the most optimal order. However, making program evaluation dependent on goal ordering is less declarative and there are also some problems that cannot be specified without fair conjunction. It’s nice to have both.)

Now that we explicity represent the tree we can use different search algorithms. My patch defaults to lazy, breadth-first search (to maintain the previous semantics) but it also supplies a variety of others including a parallel depth-first search using fork-join.

I still need to write a few more tests and sign the clojure contributor agreement before this can be considered for merging. I also have a pesky performance regression in lazy searches - this branch sometimes does more work than the original when only finding the first solution. I’m not sure yet whether this is down to a lack of laziness somewhere or maybe just a result of a slightly different search order. Either way, it needs to be fixed.

After this change, core.logic still complects the specification of the search space and the generation of the search tree (eg we have to choose between bind-unfair and bind-fair in the problem specification). At some point I would like to either fix that in core.logic or finish work on shackles. For now though, I’m going back to working on droplet.

The core idea is that strucjure (and the OMeta library on which it is based) is not just yet-another-parser, but is instead a concise language for describing, manipulating and transforming data structures. The VPRI folks have done some amazing things with OMeta. My goal with strucjure is to see how much further this idea can be taken.

(Note: For the purposes of this post I’ll use the terms pattern and view interchangeably. There is a difference, but the line between the two is not yet clear to me and will probably change in future implementations)

Pattern matching

Pattern matching is a concept found in many functional languages. The basic idea is something like a switch statement, combined with a mini-language for describing patterns which the input should be tested against. The first pattern which matches has its corresponding branch executed.

As a very simple example, we can use strucjure to write fizzbuzz like this:

1
2
3
4
5
6
7

(doseq [i (range 100)]
  (prn
   (match [(mod i 3) (mod i 5)]
          [0 0] "fizzbuzz"
          [0 _] "fizz"
          [_ 0] "buzz"
          _      i)))

This is a concise, readable description of the various cases and replaces a chain of if-statements.

If we stopped there, you could be forgiven for not caring. Simple examples don’t really demonstrate the power of pattern matching. Let’s instead look at a more complicated example - red-black trees. An important operation on red-black trees is re-establishing the balance invariants after inserting a new node. Here is a java implementation of the balance operation (from this implementation):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

// make a left-leaning link lean to the right
private Node rotateRight(Node h) {
    assert (h != null) && isRed(h.left);
    Node x = h.left;
    h.left = x.right;
    x.right = h;
    x.color = x.right.color;
    x.right.color = RED;
    x.N = h.N;
    h.N = size(h.left) + size(h.right) + 1;
    return x;
}

// make a right-leaning link lean to the left
private Node rotateLeft(Node h) {
    assert (h != null) && isRed(h.right);
    Node x = h.right;
    h.right = x.left;
    x.left = h;
    x.color = x.left.color;
    x.left.color = RED;
    x.N = h.N;
    h.N = size(h.left) + size(h.right) + 1;
    return x;
}

// flip the colors of a node and its two children
private void flipColors(Node h) {
    // h must have opposite color of its two children
    assert (h != null) && (h.left != null) && (h.right != null);
    assert (!isRed(h) &&  isRed(h.left) &&  isRed(h.right))
        || (isRed(h)  && !isRed(h.left) && !isRed(h.right));
    h.color = !h.color;
    h.left.color = !h.left.color;
    h.right.color = !h.right.color;
}

// restore red-black tree invariant
private Node balance(Node h) {
    assert (h != null);

    if (isRed(h.right))                      h = rotateLeft(h);
    if (isRed(h.left) && isRed(h.left.left)) h = rotateRight(h);
    if (isRed(h.left) && isRed(h.right))     flipColors(h);

    h.N = size(h.left) + size(h.right) + 1;
    return h;
}

This pile of if-statements obscures the intent of the code, which is to re-arrange the tree so that no red node has a red child. What we really want to see is ‘if the tree looks like foo, replace it with bar’. Using pattern matching we can express this directly (code based on this implementation):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

(defrecord Leaf [])
(defrecord Red [left value right])
(defrecord Black [left value right])

(defview balance
  ;; if it looks like one of these...
  (or
   (Black. (Red. (Red. ?a ?x ?b) ?y ?c) ?z ?d)
   (Black. (Red. ?a ?x (Red. ?b ?y ?c)) ?z ?d)
   (Black. ?a ?x (Red. (Red. ?b ?y ?c) ?z ?d))
   (Black. ?a ?x (Red. ?b ?y (Red. ?c ?z ?d))))
  ;; replace it with this...
  (Red. (Black. a x b) y (Black. c z d))

  ;; otherwise, leave it alone
  ?other
  other)

(Note that this isn’t exactly the same operation as the code above, because the corresponding implementation has a slightly different insert algorithm too. Nevertheless, converting this operation to java would result in the same grotesque expansion of if-statements).

Strucjure is not very optimized yet, but if you use a more mature pattern-matching library then this code would be as fast as what you would write by hand. For complex patterns core.match often does a better job of optimizing the decision tree than I can manage by hand, in much the same way that GCC does a better job of writing assembly code than I ever could.

Strucjure patterns are first-class values and can call other patterns or recursively call themselves, so they can express much more complex patterns than other pattern matchers. For example:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

(defview balanced-height
  Leaf
  0

  (and (Black. _
         (balanced-height ?l)
         (balanced-height ?r))
       #(= l r))
  (+ 1 l)

  (and (Red. _
         (and (not Red) (balanced-height ?l))
         (and (not Red) (balanced-height ?r)))
       #(= l r))
  l)

This is a pattern which only matches balanced red-black trees, by recursively matching against each branch and returning the number of black nodes per path (see property 5 here).

Parsing

Strucjure supports patterns which only consume part of the input and can chain these patterns together. Combine that with pattern matching and you can very easily write back-tracking recursive-descent parsers.

We can use this for traditional text parsing (you have to be feeling a little masochistic at the moment because strucjure can’t directly handle strings yet, only sequences of \c \h \a \r \s). For example, strucjure parses its own readme to ensure all the examples are correct.

Parsing doesn’t have to be limited to text. We can apply the same techniques to any sequential data structure.

1
2
3
4
5
6
7
8
9
10
11

user> (defnview zero-or-more-prefix [elem]
        (prefix & (elem ?x) & ((zero-or-more-prefix elem) ?xs)) (cons x xs)
        (prefix ) nil)
#'user/zero-or-more-prefix
user> (defview self-counting
        (prefix 1) 'one
        (prefix 2 2) 'two
        (prefix 3 3 3) 'three)
#'user/self-counting
user> (run (zero-or-more-prefix self-counting) [1 3 3 3 2 2 1 2 2])
(one three two one two)

Since we live in lisp land, code is data too. We can use strucjure to easily and readably (hopefully) operate over sexps.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

;; generic parser for (right-binding) infix operators with precedence

(defn value? [all form]
  (not-any? #(contains? % form) all))

(defn bind* [all current]
  (if-let [[ops & tighter] current]
    (view
     (prefix & ((bind* all tighter) ?x) (and #(contains? ops %) ?op) & ((bind* all current) ?y)) `(~op ~x ~y)
     (prefix & ((bind* all tighter) ?x)) x)
    (view
     (prefix [((bind* all all) ?x)]) x
     (prefix (and #(value? all %) ?x)) x)))

(defn bind [binding-levels]
  (bind* binding-levels binding-levels))

;; run 'bind with basic arithmetic precedences
(defmacro math [& args]
  (run (bind [#{'+ '-} #{'* '/}]) args))

(macroexpand '(math 1 - 2 + 3 - 4))
;; (- 1 (+ 2 (- 3 4)))
(macroexpand '(math 1 + 2 * 7 + 1 / 2))
;; (+ 1 (+ (* 2 7) (/ 1 2)))
(macroexpand '(math 1 + 2 * (7 + 1) / 2))
;; (+ 1 (* 2 (/ (7 + 1) 2)))

No more death-by-polish-notation!

(The operators above really ought to bind to the left but, unlike ometa, strucjure doesn’t yet support left-recursion and I’m too lazy to manually transform the grammar. It’s a temporary limitation.)

Taking this to its logical conclusion, the syntax for patterns and views in strucjure is itself defined using views. This is a fairly complex DSL but with strucjure it’s was very easy to write, read and modify the parser.

Generic programming

Clojure has some great facilities for generic traversals in the form of clojure.walk:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

(defn walk
  "Traverses form, an arbitrary data structure.  inner and outer are
  functions.  Applies inner to each element of form, building up a
  data structure of the same type, then applies outer to the result.
  Recognizes all Clojure data structures. Consumes seqs as with doall."

  {:added "1.1"}
  [inner outer form]
  (cond
   (list? form) (outer (apply list (map inner form)))
   (instance? clojure.lang.IMapEntry form) (outer (vec (map inner form)))
   (seq? form) (outer (doall (map inner form)))
   (coll? form) (outer (into (empty form) (map inner form)))
   :else (outer form)))

(defn postwalk
  "Performs a depth-first, post-order traversal of form. Calls f on
each sub-form, uses f's return value in place of the original.
Recognizes all Clojure data structures except sorted-map-by.
Consumes seqs as with doall."
  {:added "1.1"}
  [f form]
  (walk (partial postwalk f) f form))

Essentially, all this is doing is specifying how to take apart clojure data structures and how to put them back together again. Strucjure supports passing optional :pre-view and :post-view functions to modify the input to or output from any named view encountered during parsing, so we can do something very similar:

1
2
3
4
5
6
7
8
9

(defview clojure
  (and list? ((zero-or-more clojure) ?xs)) xs
  (and clojure.lang.IMapEntry [?x ?y]) [x y]
  (and seq? ((zero-or-more clojure) ?xs)) xs
  (and coll? ?coll ((zero-or-more clojure) ?xs)) (into (empty coll) xs)
  ?other other)

(defn postwalk [form f]
  (run clojure form {:post-view (fn [_ sub-form] (f sub-form)}))

The problem with using this (or clojure.walk) for generic traversals is that it loses context. When a given sub-form is encountered, the function f is given no indication of where in the data structure that sub-form is or how it is being used. If we apply the above idea to domain-specific views we can do generic traversals with context. The motivating example for this was a simple game I was porting called l-seed (I haven’t yet updated l-seed to use strucjure, but you can see a precursor to it in l-seed.syntax). In l-seed, players submit programs defining the growth of their plant species and compete with other player’s plants for sunlight and nutrients. The plant language can be defined like this:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

(defview +name+
  string? %)

(defview +tag+
  string? %)

(defview +length+
  (and number? #(<= 0 %)) %)

(defview +direction+
  (and number? #(<= -360 % 360)) %)

(defview +relation+
  (or '= '> '>= '< '<=) %)

(defview +property+
  (or 'tag 'length 'direction) %)

(defview +condition+
  ['and & ((zero-or-more +condition+) ?conditions)] (cons 'and conditions)
  ['or & ((zero-or-more +condition+) ?conditions)] (cons 'or conditions)
  ['not (+condition+ ?condition)] (list 'not condition)
  [(+relation+ ?relation) (+property+ ?property) ?value] (list relation property value))

(defview +condition-head+
  ['when (+condition+ ?condition)] (list 'when condition)
  'whenever 'whenever)

(defview +action+
  ['grow-by (+length+ ?length)] (list 'grow-by length)
  ['turn-by (+direction+ ?direction)] (list 'turn-by direction)
  ['turn-to (+direction+ ?direction)] (list 'turn-to direction)
  ['tag (+tag+ ?tag)] (list 'tag tag)
  ['blossom (+tag+ ?tag)] (list 'blossom tag)
  ['branch & ((zero-or-more (zero-or-more +action+)) ?action-lists)] (cons 'branch action-lists))

(defview +rule+
  ['rule (+name+ ?name) (+condition-head+ ?condition-head) & ((zero-or-more +action+) ?actions)] (apply list 'rule name condition-head actions))

(defview +rules+
  [& ((zero-or-more +rule+) ?rules)] rules)

(Note that we specify both how to take apart a data structure and how to put it together. Really, the latter should be derived from the former. I think strucjure will eventually feature reversible patterns for this purpose.)

We can then operate on these programs in a generic way. For example, deciding which rule to execute next:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

(defn select* [properties]
  (defview
    [`+relation+ ?relation] (resolve relation)
    [`+property+ ?property] (get properties property)
    [`+condition+ ['and & ?conds]] (every? true? conds)
    [`+condition+ ['or & ?conds]] (some true? conds)
    [`+condition+ ['not ?cond]] (not cond)
    [`+condition+ [?relation ?property ?value]] (relation property value)
    [`+condition-head+ ['when ?condition]] condition
    [`+condition-head+ ['whenever]] true
    [`+rule+ ['rule _ ?condition & ?actions]] (when condition actions)
    [`+rules+ [& ?rules]] (choose (filter seq rules))
    [_ ?other] other))

(defn select [rules properties]
  "Pick a valid rule and return its list of actions (or nil if no rules are valid)"
  (utilpostwalk +rules+ rules (select* properties)))

Writing code like this allows us to separate the shape of the data from the computation we perform over it.

We’re also not limited to just walking over data structures. We can perform more complex operations in the same generic fashion.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

(defn map-reduce [strucjure form map-op reduce-op]
  "Call map-op on every sub-form and reduce results with reduce-op"
  (let [acc (atom (reduce-op))]
    (run strucjure form
           {:post-view (fn [name form]
                         (swap! acc reduce-op (map-op name form))
                         form)})
    @acc))

(defn collect [strucjure form filter-op]
  "Return all sub-forms satisfying filter-op"
  (let [acc (atom nil)]
    (run strucjure form
           {:post-view (fn [name form]
                         (if (filter-op name form)
                           (swap! acc conj result)))})
    @acc))

Types

I originally learned to code in haskell. One of the things I miss about strong static typing is it that it automatically provides documentation about the data structures used in your program. Strucjure patterns can fulfill the same role. In l-seed, if you are confused about what a rule should look like you can just go look at the +rule+ pattern.

We can’t quite get static typing out of this, but we do get runtime checking for complex typedata-structures:

1
2
3
4

(defmacro defgenotype [name & rules]
  ;; compile-time syntax check for the genotype language
  (run +rules+ rules)
  `(def ~name '~(vec rules)))

In theory, it should also be possible to generate random data structures satisfying a given pattern. This would be useful for providing examples and for generative testing. In erlang, proper allows using type-specs directly alongside hand-written generators. I haven’t yet implemented this in strucjure but I think it should be reasonably easy once reversible patterns are implemented.

State machines

One can think of parsers in general as state machines with look-ahead and backtracking. OMeta takes this idea and runs with it:

Most interesting ideas have more than one fruitful way to view them, and it occurred to us that, abstractly, one could think of TCP/IP as a kind of “non‐deterministic parser with balancing heuristics”, in that it takes in a stream of things, does various kinds of pattern‐matching on them, deals with errors by backing up and taking other paths, and produces a transformation of the input in a specified form as a result.

Since the language transformation techniques we use operate on arbitrary objects, not just strings (see above), and include some abilities of both standard and logic programming, it seemed that this could be used to make a very compact TCP/IP. Our first attempt was about 160 lines of code that was robust enough to run a website. We think this can be done even more compactly and clearly, and we plan to take another pass at this next year.

I haven’t yet tried doing anything like this in strucjure, but all the machinery is there. It would make an interesting complement to droplet.

Moving forward

There are of lot of different directions for improvement and experimentation.

One of my top priorities is better error reporting. This sucks:

1

clojure.lang.ExceptionInfo: throw+: #strucjure.view.PartialMatch{:view #strucjure.view.Or{:views [#strucjure.view.Match{:pattern #strucjure.pattern.Seq{:pattern #strucjure.pattern.Chain{:patterns [#strucjure.view.Import{:view-fun #<test$bind_STAR_$fn__2339 test$bind_STAR_$fn__2339@60a896b8>, :pattern #strucjure.pattern.Bind{:symbol x}} #strucjure.pattern.Head{:pattern #strucjure.pattern.And{:patterns [#strucjure.pattern.Guard{:fun #< clojure.lang.AFunction$1@5c3f3b9b>} #strucjure.pattern.Bind{:symbol op}]}} #strucjure.view.Import{:view-fun #<test$bind_STAR_$fn__2343 test$bind_STAR_$fn__2343@3b626c6d>, :pattern #strucjure.pattern.Bind{:symbol y}}]}}, :result-fun #< clojure.lang.AFunction$1@3abc8690>} #strucjure.view.Match{:pattern #strucjure.pattern.Seq{:pattern #strucjure.pattern.Chain{:patterns [#strucjure.view.Import{:view-fun #<test$bind_STAR_$fn__2347 test$bind_STAR_$fn__2347@2f267610>, :pattern #strucjure.pattern.Bind{:symbol x}}]}}, :result-fun #< clojure.lang.AFunction$1@6112c9f>}]}, :input (1 - 2 + 3 - 4), :remaining (- 2 + 3 - 4), :output 1}

I have some ideas about how to improve this but nothing totally concrete. I could, at the very least, return the bindings that existed at the point of failure along with some kind of failure stack. If I can figure out a reasonable way to implement cut that will also help.

Another short-term priority is some form of tail call elemination. Many patterns and views are naturally implemented in a recursive fashion:

1
2
3

(defnview zero-or-more [elem]
  (prefix (elem ?x) & ((zero-or-more elem) ?xs)) (cons x xs)
  (prefix ) nil)

But in the current implementation of strucjure this will quickly overflow the stack. The current workaround is to define such views by hand:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

(defrecord ZeroOrMore [view]
  View
  (run* [this input opts]
    (when (or
           (nil? input)
           (instance? clojure.lang.Seqable input))
      (loop [elems (seq input)
             outputs nil]
        (if-let [[elem & elems] elems]
          (if-let [[remaining output] (run view elem opts)]
            (if (nil? remaining)
              (recur elems (cons output outputs))
              [(cons elem elems) (reverse outputs)])
            [(cons elem elems) (reverse outputs)])
          [nil (reverse outputs)])))))

(def zero-or-more ->ZeroOrMore)

This is gross. I don’t have any ideas on how to overcome this.

I’ve already briefly mentioned reversible patterns. At the beginning of this post I warned that I would use the terms view and pattern interchangeably. The line between them in strucjure is currently blurry but I think that the distinction should be that patterns must be reversible while views are allowed to destroy information.

Lastly, there will eventually be a need for some level of optimization. Given the extra flexibility in strucjure I don’t expect to ever be as fast as core.match but there is certainly lots of room for improvement on the current code. Originally, strucjure patterns were compiled into efficient clojure code but the implementation was complicated and it was difficult to rapidly iterate around it. I will probably return to compilation once the semantics and interface settle down.

For now, I’m going to dogfood strucjure in various projects while ruminating on improvements. I’m already very happy with how much leverage can be had from such a simple idea, especially if I can fix the problems above. Hopefully the examples here might get other people thinking along the same lines.

So here is my goal - to create better tools for the problems I regularly encounter. My focus is on building distributed systems and p2p networks but I suspect that these tools will be generally useful. When working as a freelancer I am necessarily constrained to using proven ideas and techniques because the risk assumed is not mine. Hacker School is a chance for me to explore some more far-out ideas. These ideas are drawn primarily from two places: the Viewpoint Research Institute and the Berkeley Order Of Magnitude project.

Viewpoint Research Institute

Specifically, I’m interested in the Steps Towards Expressive Programming project. Their goal is no less than the reinvention of programming. By way of proof of concept they aim to develop an entire computing system, from OS to compilers to applications, in less than 20k LOC. Such a system would be compact enough to be understood in its entirety by a single person, something that is unthinkable in todays world of multi-million LOC systems. Amazingly, their initial prototypes of various subsystems actually approach this goal.

Their approach relies heavily on the use of DSLs to capture high-level, domain-specific expressions of intent which are then compiled into efficient code. By way of example, they describe their TCP-IP stack:

Most interesting ideas have more than one fruitful way to view them, and it occurred to us that, abstractly, one could think of TCP/IP as a kind of “non‐deterministic parser with balancing heuristics”, in that it takes in a stream of things, does various kinds of pattern‐matching on them, deals with errors by backing up and taking other paths, and produces a transformation of the input in a specified form as a result.

Since the language transformation techniques we use operate on arbitrary objects, not just strings (see above), and include some abilities of both standard and logic programming, it seemed that this could be used to make a very compact TCP/IP. Our first attempt was about 160 lines of code that was robust enough to run a website. We think this can be done even more compactly and clearly, and we plan to take another pass at this next year.

The ‘language transformation techniques’ they refer to are embodied in OMeta, a PEG-based language for parsing and pattern-matching. OMeta provides an incredible amount of leverage for such a simple abstraction. For starters, it leads to very concise and readable descriptions of tokenisers, parsers and tree transformers which are all crucial for developing DSLs.

Berkeley Order Of Magnitude

The Berkeley Order Of Magnitude project has spent a number of years experimenting with using logic languages for distributed systems. Like the STEPS project, their goals are audaciously ambitious.

Enter BOOM, an effort to explore implementing Cloud software using disorderly, data-centric languages. BOOM stands for the Berkeley Orders Of Magnitude project, because we seek to enable people to build systems that are OOM bigger than are building today, with OOM less effort than traditional programming methodologies.

Among their myriad publications they describe an API-compliant reimplementation of Hadoop and HDFS in ~1K lines of Overlog code, which they then extend with a variety of features (eg master-node failover via MultiPaxos) not yet found in Hadoop. Thanks to a number of high-level optimisations enabled by the simpler code-base their implementation is almost as fast as the original.

For me, the most interesting aspect is the amount of reflective power gained by treating everything as data:

One key to our approach is that everything is data, i.e. rows in tables that can be queried and manipulated. This includes persistent data (e.g. filesystem metadata), runtime state (e.g. Hadoop scheduler bookkeeping), summary stats (e.g. for advanced straggler scheduling), in-flight msgs and system events, even parsed code. When everything in a system is data, it becomes easy to do things like parallelize computations on the state, make it fault tolerant, and express (and enforce) invariants on legal states of the system.

The latest project from the BOOM group is the Bloom language. Bloom has a more solid theoretical foundation than their previous languages and also enables an amazing level of static analysis, even being able to guarantee that certain Bloom programs are eventually consistent.

Core Ideas

What can I take away from these projects? Here are some vague ideas, which to my mind all seem related.

Higher-level reasoning

The STEPS notes talk about ‘separating meaning from tactics’. It’s often easier to specify what a correct solution to a problem looks like than it is to actually find it. In many domains, finding a solution is then just a matter of applying a suitable search algorithm. For example, constraint solvers such as gecode or core.logic express a problem as a set of logical constraints on the possible solutions and then search through the space of variable assignments to find a solution. By automatically pruning parts of the search space which break one or more constraints and applying user-specified search heuristics, constraint solvers can often be faster than hand-coded solvers for complex problems whilst at the same time allowing a clear, concise, declarative specification of the problem.

Everything is data

Constraint solving is enabled by treating both the problem specification and the solution space as data, reducing the problem to search. In lisps, treating code as data enables macros and code rewriting. In Overlog, everything from persistent data to scheduler state to the language runtime is available as data and can be queried and manipulated using the same powerful abstractions. Tracing in Overlog is as simple as adding a rule that fires whenever a new fact is derived, because the derivation itself is stored alongside the fact.

Whatever you are working on, making it accessible as plain data enables turning the full power and expressivity of your language directly onto the problem. This is where OO falls down, in trying to hide data behind custom interfaces. Rob Pike recently put it: “It has become clear that OO zealots are afraid of data”.

Reflection

When you expose the internals of a system as data to that same system, amazing (and, yes, sometimes terrifying) things happen. The STEPS folks manage to stay withing their code budget by building highly dynamic, self-hosting, meta-circular, introspective languages. Many of the amazing results of the Overlog project, from the optimising compiler to declarative distributed tracing, resulted from exposing the language runtime and program source code to the same logic engine that it implements. Turning a system in on itself and allowing it to reason about its own behaviour is an incredibly powerful idea. Certainly it can be dangerous, and it’s all too easy to tangle oneself in knots, but the results speak for themselves. This is an idea that has been expounded many times before but I think there is still so much more to explore here.

Progress

My attempts to keep up with this have been focused on three projects.

Shackles is a constraint solver supporting both finite-domain and logical constraints. It was originally an experiment to see what, if any, extra power could be gained from implementing a gecode-style solver using persistent data-structures (constraint solvers in traditional languages spend much of their time cloning program state to enable back-tracking). Fortunately, core.logic now supports finite domain variables with constraint propagation and there has been noise about implementing user-specified search heuristcs, so that’s one less piece of code I need to write :D

Strucjure is similar to OMeta but aims to be a good clojure citizen rather than a totally separate tool. As such, all of its core components are protocols, semantic actions are plain clojure code and the resulting patterns and views are just nested records which can be manipulated by regular clojure code. Following the principles above, the syntax of strucjure patterns/views is self-defined using views and the test suite parses the documentation to verify the correctness of the examples.

Droplet is based on the Bloom^L language (an extension of the Bloom language that operates over arbitrary semi-lattices). Droplet is so far less developed than the other projects but the core interpreter is working as well as basic datalog-like rules. Again, droplet attempts to be a good clojure citizen. Rules are just clojure functions. The datalog syntax is implemented via a simple macro which produces a rule function. Individual droplets are held in agents and communicate either via agent sends or over lamina queues. I’m currently working out a composable, extensible query language that is able to operate over arbitrary semi-lattices, rather than just sets. In its current (and largely imaginary) form, it looks something like this.

I’ll go into more detail on the latter two projects soon but for now I’m content to just throw these ideas out into the world, without justification, and see what bounces back.

The readme on github has detailed descriptions of the syntax etc which I won’t repeat here. What I do want to do is run through a realistic example.

The readme has a large number of examples and I want to be sure that these are all correct and up to date. As part of the test-suite for strucjure I parse the readme source, pull out all the examples and make sure that they all run correctly and return the expected output.

1
2
3
4
5
6
7

jamie@alien:~/strucjure$ lein test strucjure.test
WARNING: newline already refers to: #'clojure.core/newline in namespace: strucjure.test, being replaced by: #'strucjure.test/newline

lein test strucjure.test

Ran 1 tests containing 166 assertions.
0 failures, 0 errors.

The readme parser is pretty simple. Since I control both the parser and the readme source so it doesn’t need to be bullet-proof, just the simplest thing that will get the job done. Strucjure is very bare-bones at the moment though so we have to create a lot of simple views that really belong in a library somewhere.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

(defview space
  \space %)

(defview newline
  \newline %)

(defview not-newline
  (not \newline) %)

(defview line
  (and (not []) ; have to consume at least one char
       (prefix & ((zero-or-more not-newline) ?line)
               & ((optional newline) ?end)))
  line)

(defview indented-line
  (prefix & ((one-or-more space) _) & (line ?line))
  line)

We want a tokeniser for various parts of the readme. We could write it like this:

1
2
3
4
5
6
7

(defnview tokenise [sep]
  ;; empty input
  [] '(())
  ;; throw away separator, start a new token
  [& (sep _) & ((tokenise sep) ?results)] (cons () results)
  ;; add the current char to the first token
  [?char & ((tokenise sep) [?result & ?results])] (cons (cons char result) results))

Unfortunately in the current implementation of strucjure that recursive call goes on the stack, so this view will blow up on large inputs. For now we just have to implement this view by hand to get access to recur.

1
2
3
4
5
6
7
8
9
10
11
12

(defn tokenise [sep]
  (view/->Raw
   (fn [input opts]
     (when-let [elems (seq input)]
       (loop [elems elems
              token-acc nil
              tokens-acc nil]
         (if-let [[remaining _] (view/run sep elems opts)]
           (recur remaining nil (cons (reverse token-acc) tokens-acc))
           (if-let [[elem & elems] elems]
             (recur elems (cons elem token-acc) tokens-acc)
             [nil (reverse (cons (reverse token-acc) tokens-acc))])))))))

The rest of the parser makes more sense reading in reverse order. We start by splitting up the readme by code delimiters (triple backticks). This gives us chunks of alternating text and code, so we parse every other chunk as a block of code.

1
2
3
4
5
6
7

(defview code-delim
  (prefix \` \` \`)
  :code-delim)

(defview readme
  ((tokenise code-delim) ?chunks)
  (apply concat (map (partial run code-block) (take-nth 2 (rest chunks)))))

We only want to look at code blocks that are marked as clojure code.

1
2
3

(defview code-block
  [\c \l \o \j \u \r \e \newline & (code-block-inner ?result)]
  result)

A few of the code blocks don’t contain examples - we can detect these because they don’t start with a “user> ” prompt. All the other blocks contain a list of examples separated by prompts.

1
2
3
4
5
6
7
8
9
10
11

(defview prompt
  (prefix \u \s \e \r \> \space)
  :prompt)

(defview code-block-inner
  (and (prompt _)
       ((tokenise prompt) ?chunks))
  (map (partial run example) (filter #(not (empty? %)) chunks))

  _ ;; not a block of examples
  nil)

An example consists of an input, which may be on multiple lines, zero or more lines of printed output and finally a result.

1
2
3
4
5
6
7

(defview example
  [& (line ?input-first)
   & ((zero-or-more-prefix indented-line) ?input-rest)
   & ((one-or-more-prefix line) ?output-lines)]
  {:input (with-out-str (doseq [line (cons input-first input-rest)] (print (apply str line) \space)))
   :prints (with-out-str (doseq [line (butlast output-lines)] (println (apply str line))))
   :result (run result (last output-lines))})

The result is either a return value or an exception.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

;; #"[a-zA-Z\.]"
(defview exception-chars
  (or \.
      #(<= (int \a) (int %) (int \z))
      #(<= (int \A) (int %) (int \Z)))
  %)

(defview result
  [\E \x \c \e \p \t \i \o \n \I \n \f \o \space
   \t \h \r \o \w \+ \: \space
   \# & ((one-or-more exception-chars) ?exception)
   & _]
  [:throws (apply str exception)]

  ?data
  [:returns (apply str data)])

That’s it - parsing done.

Now we just have to turn the results into unit tests. We have to be careful about comparing the results of the examples because they might contain closures, which look different every time.

1
2
3
4
5

(defn replace-fun [unread-form]
  (.replaceAll unread-form "#<[^>]*>" "#<fun>"))

(defn prints-as [string form]
  (= (replace-fun string) (replace-fun (with-out-str (pr form)))))

Running the examples is a little tricky because some of them create bindings or classes that are used by later examples. We end up needing to eval the code at runtime.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

(defn example-test [input prints result]
  (match result
         [:returns ?value]
         (do
           (is (prints-as value (input)))
           (is (= prints (with-out-str (input)))))

         [:throws ?exception]
         (do
           (is (try+ (input)
                     nil
                     (catch java.lang.Object thrown
                       (prints-as exception (class thrown)))))
           (is (= prints (with-out-str
                           (try+ (input)
                                 (catch java.lang.Object _ nil))))))))

(defmacro insert-example-test [{:keys [input prints result]}]
  `(example-test (fn [] (eval '(do (use '~'strucjure) ~(read-string input)))) ~prints '~result))

(defmacro insert-readme-test [file]
  `(do
     ~@(for [example (run readme (seq (slurp (eval file))))]
         `(insert-example-test ~example))))

(deftest readme-test
  (insert-readme-test "README.md"))

This is fun. Not only does strucjure parse its own syntax, it reads its own documentation!

Parts of this were a little painful. The next version of strucjure will definitely have improved string matching. I’m also looking at optimising/compiling views, as well as memoisation. Previous versions of strucjure supported both but were hard to maintain. For now I’m going to be moving on to using strucjure to build other useful DSLs.

We’ll start with the fundamental property of distributed systems:

Messages sent between machines may arrive zero or more times at any point after they are sent

This is the sole reason that building distributed systems is hard.

For example, because of this property it is impossible for two computers communicating over a network to agree on the exact time. You can send me a message saying “it is now 10:00:00” but I don’t know how long it took for that message to arrive. We can send messages back and forth all day but we will never know for sure that we are synchronised.

If we can’t agree on the time then we can’t always agree on what order things happen in. Suppose I say “my user logged on at 10:00:00” and you say “my user logged on at 10:00:01”. Maybe mine was first or maybe my clock is just fast relative to yours. The only way to know for sure is if something connects those two events. For example, if my user logged on and then sent your user an email and if you received that email before your user logged on then we know for sure that mine was first.

This concept is called causal ordering and is written like this:

A->B (event A is causally ordered before event B)

Let’s define it a little more formally. We model the world as follows: We have a number of machines on which we observe a series of events. These events are either specific to one machine (eg user input) or are communications between machines. We define the causal ordering of these events by three rules:

If A and B happen on the same machine and A happens before B then A->B

If I send you some message M and you receive it then (send M)->(recv M)

If A->B and B->C then A->C

We are used to thinking of ordering by time which is a total order - every pair of events can be placed in some order. In contrast, causal ordering is only a partial order - sometimes events happen with no possible causal relationship i.e. not (A->B or B->A).

This image shows a nice way to picture these relationships.

On a single machine causal ordering is exactly the same as time ordering (actually, on a multi-core machine the situation is more complicated, but let’s forget about that for now). Between machines causal ordering is conveyed by messages. Since sending messages is the only way for machines to affect each other this gives rise to a nice property:

If not(A->B) then A cannot possibly have caused B

Since we don’t have a single global time this is the only thing that allows us to reason about causality in a distributed system. This is really important so let’s say it again:

Communication bounds causality

The lack of a total global order is not just an accidental property of computer systems, it is a fundamental property of the laws of physics. I claimed that understanding causal order makes many other concepts much simpler. Let’s skim over some examples.

Vector Clocks

Lamport clocks and Vector clocks are data-structures which efficiently approximate the causal ordering and so can be used by programs to reason about causality.

If A->B then LC_A < LC_B

If VC_A < VC_B then A->B

Different types of vector clock trade-off compression vs accuracy by storing smaller or larger portions of the causal history of an event.

Consistency

When mutable state is distributed over multiple machines each machine can receive update events at different times and in different orders. If the final state is dependent on the order of updates then the system must choose a single serialisation of the events, imposing a global total order. A distributed system is consistent exactly when the outside world can never observe two different serialisations.

CAP Theorem

The CAP (Consistency-Availability-Partition) theorem also boils down to causality. When a machine in a distributed system is asked to perform an action that depends on its current state it must decide that state by choosing a serialisation of the events it has seen. It has two options:

1. Choose a serialisation of its current events immediately
2. Wait until it is sure it has seen all concurrent events before choosing a serialisation

The first choice risks violating consistency if some other machine makes the same choice with a different set of events. The second violates availability by waiting for every other machine that could possibly have received a conflicting event before performing the requested action. There is no need for an actual network partition to happen - the trade-off between availability and consistency exists whenever communication between components is not instant. We can state this even more simply:

Ordering requires waiting

Even your hardware cannot escape this law. It provides the illusion of synchronous access to memory at the cost of availabilty. If you want to write fast parallel programs then you need to understand the messaging model used by the underlying hardware.

Eventual Consistency

A system is eventually consistent if the final state of each machine is the same regardless of how we choose to serialise update events. An eventually consistent system allows us to sacrifice availability without having the state of different machines diverge irreparably. It doesn’t save us from having the outside world see different serialisations of update events. It is also difficult to construct eventually consistent data structures and to reason about their composition.

Further reading

CRDTs provide guidance on constructing eventually consistent data-structures.

Bloom is a logic-based DSL for writing distributed systems. The core observation is that there is a natural connection between monotonic logic programs (logic programs which do not have to retract output when given additional inputs) and available distributed systems (where individual machines do not have to wait until all possible inputs have been received before producing output). Recent work from the Bloom group shows how to merge their approach with the CRDT approach to get the best of both worlds.

Nathan Marz suggests an architecture for data processing systems which avoids much of the pain caused by the CAP theorem. In short, combine a consistent batch-processing layer with an available, eventually consistent real-time layer so that the system as a whole is available but any errors in the (complicated, difficult to program) eventually consistent layer are transient and cannot corrupt the consistent data store.

The first is self-explanatory and pretty well-known. I frequently have to fire up a python process through a port to do something simple like send an email. Even the standard library is incomplete and inconsistent.

The second doesn’t start to hurt until your codebase gets a bit bigger. For example, Smarkets makes a lot of use of fixed-precision decimal arithmetic which leads to code like this:

1

decimal:mult(Qty,  decimal:sub(decimal:to_decimal(1), Price))

It also means any time you want to change a data-structure for one with an equivalent interface you have to rewrite whole swathes of code.

The third point is a bit more contentious. I’m fairly convinced that the erlang philosophy of fail-early, crash-only, restartable tasks is the right solution for most problems. What bugs me is that erlang conflates addresses, queues and actors by giving each process a single mailbox. This leads to problems like requiring the recipient of a message to have a global name if it is to be independently restartable, which means you can’t run more than one copy of that message topology on the same node. It also encourages processes to send messages directly to other processes which makes it difficult to create flexible, rewirable topologies or to isolate pieces of a topology for testing. I would prefer a model in which processes send and receive messages through queues which are wired together outside of the process. This would also allow restarting a process (and clearing but not deleting its queues) without giving it a global name.

I’m not about to run out now and rewrite erl-telehash in another language. It’s close enough to complete (for my purposes at least) that I’ll just continue with the existing code. For future experiments, however, I want something better.

The top candidate at the moment is clojure. It has the potential to replace my use of erlang and python, saving lots of cross-language pain. Agents look a lot like a (cleaner, saner) implementation of the mealy machines that I wrote at Smarkets. Lamina neatly solves the queue pains I described above. Datalog is the natural way to describe a lot of collections, including th_bucket which is in its current form is not obviously correct. The clojure community just seems to churn out well-designed libraries (lamina, aleph, slice, incanter, pallet, cascalog, storm, overtone etc).

In the short term I will get started by rewriting binmap, since it’s fresh in my mind and simple enough to finish quickly. If that goes well it might eventually become an educational port of swift.

Here is the basic idea. Conceptually a binmap is a tree of bitmaps. In a leaf at the bottom of the tree each bit in the bitmap represents one bit. In a leaf one layer above the bottom each bit in the bitmap represents two bits. In a leaf two layers above the bottom each bit in the bitmap represents four bits etc.

1
2
3
4
5
6
7

type t =
  { layers : int
  ; tree : tree }

type tree =
  | Bitmap of int
  | Branch of tree * tree

Let’s pretend for simplicity our bitmaps are only 1 bit wide. Then the string 00000000 would be represented as:

1
2

{ layers = 3
; tree = Bitmap 0 }

And the string 00001100 would be:

1
2
3
4
5
6
7

{ layers = 3
; tree =
    Branch
      (Bitmap 0)
      (Branch
        (Bitmap 1)
        (Bitmap 0)) }

The worst case for this data structure is the string 0101010101… In this case we use about 6.5x as much memory as needed by a plain bitmap (3 words for a Branch with two pointers, 4 words for a Bitmap with a pointer to a boxed Int32). The c++ version uses some simple tricks to reduce this overhead to just over 2x that of a plain bitmap. We can replicate these in ocaml by using a bigarray to simulate raw memory access.

Our data structure looks like this:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

module Array =
struct
  include Bigarray.Array1
  let geti array i = Bitmap.to_int (Bigarray.Array1.get array i)
  let seti array i v = Bigarray.Array1.set array i (Bitmap.of_int v)
end

type t =
    { length : int
    ; layers : int
    ; mutable array : (Bitmap.t, Bitmap.bigarray_elt, Bigarray.c_layout) Array.t
    ; pointers : Widemap.t
    ; mutable free : int }

type node =
  | Bitmap of Bitmap.t
  | Pointer of int

let get_node binmap node_addr is_left =
  let index = node_addr + (if is_left then 0 else 1) in
  match Widemap.get binmap.pointers index with
  | false -> Bitmap (Array.get binmap.array index)
  | true -> Pointer (Array.geti binmap.array index)

let set_node binmap node_addr is_left node =
  let index = node_addr + (if is_left then 0 else 1) in
  match node with
  | Bitmap bitmap ->
      Widemap.set binmap.pointers index false;
      Array.set binmap.array index bitmap
  | Pointer int ->
      Widemap.set binmap.pointers index true;
      Array.seti binmap.array index int

Each pair of cells in the array represents a branch. Leaves are hoisted into their parent branch, replacing the pointer. Widemap.t is an extensible bitmap which we use here to track whether a given cell in the array is a pointer or a bitmap. The length field is the number of bits represented by bitmap. The free field will be explained later.

Our previous example string 00001100 would now be represented like this:

1
2
3
4
5
6
7
8
9
10
11
12

(*
  0 -> Bitmap 0
  1 -> Pointer 2
  2 -> Bitmap 1
  3 -> Bitmap 0
*)

{ length = 8;
; layers = 3;
; array = [| 0, 2, 1, 0 |]
; pointers = Widemap.of_string "0100"
; free = 0 }

When the bitmap is changed we may have to add or delete pairs eg if the above example changed to 00001111 it would be represented as:

1
2
3
4
5
6

(*
  0 -> Bitmap 0
  1 -> Bitmap 1
  2 -> ?
  3 -> ?
*)

We can grow and shrink the array as necessary, but since deleted pairs won’t necessarily be at the end of the used space the bigarray will become fragmented. To avoid wasting space we can write a linked list into the empty pairs to keep track of free space. 0 is always the root of the tree so we can use it as a list terminator. The free field marks the start of the list.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

let del_pair binmap node_addr =
  Array.seti binmap.array node_addr binmap.free;
  binmap.free <- node_addr

(* double the size of a full array and then initialise the freelist *)
let grow_array binmap =
  assert (binmap.free = 0);
  let old_len = Array.dim binmap.array in
  assert (old_len mod 2 = 0);
  assert (old_len <= max_int);
  let new_len = min max_int (2 * old_len) in
  assert (new_len mod 2 = 0);
  let array = create_array new_len in
  Array.blit binmap.array (Array.sub array 0 old_len);
  binmap.array <- array;
  binmap.free <- old_len;
  for i = old_len to new_len-4 do
    if i mod 2 = 0  then Array.seti array i (i+2)
  done;
  Array.seti array (new_len-2) 0

let add_pair binmap node_left node_right =
  (if binmap.free = 0 then grow_array binmap);
  let node_addr = binmap.free in
  let free_next = Array.geti binmap.array binmap.free in
  binmap.free <- free_next;
  set_node binmap node_addr true node_left;
  set_node binmap node_addr false node_right;
  node_addr

I haven’t yet written any code to shrink the array but it should be fairly straightforward to recursively copy the tree into a new array and rewrite the pointers.

With the freelist our modified example now looks like this:

1
2
3
4
5

{ length = 8;
; layers = 3;
; array = [| 0, 2, 0, 0 |]
; pointers = Widemap.of_string "0100"
; free = 2 }

With the representation sorted the rest of the code more or less writes itself.

The only difficulty lies in choosing the width of the bitmaps used. Using smaller bitmaps increases the granularity of the binmap allowing better compression by compacting more nodes. Using larger bitmaps increases the size of the pointers allowing larger bitmaps to be represented. I’ve written the binmap code to be width-agnostic; it can easily be made into a functor of the bitmap module.

The paper linked below suggests using a layered address scheme to expand the effective pointer size, where the first bit of the pointer is a flag indicating which layer the address is in. I would suggest rather than putting the flag in the pointer it would be simper to use information implicit in the structure of the tree eg is the current layer mod 8 = 0. Either way, this hugely increases the size of the address space at a the cost of a little extra complexity.

The original version is here and my version is here. This is just an experiment so far, I certainly wouldn’t suggest using it without some serious testing.

Overall I’m not sure how useful this particular data structure is but this method of compacting tree-like types in ocaml is certainly interesting. I suspect it could be at least partially automated.

I’ve built a quick proof of concept using twilio. Dial +1 (650) 763-8833 and you will be put on hold. As soon as there are two people on hold they will be linked together into a conference call.

This isn’t a great solution, since you have to sit around and wait for the next person to arrive. Perhaps a better method would be to have users register by SMS and then make outbound calls to both users once a connection is ready.

I also hooked up a chat bot to the SMS api. Eliza is ready and waiting on +1 (650) 763-8782 to listen to your problems and ask vague questions.

I’m not sure where to go with this. I have a vague idea that it could be turned into a game but the details elude me.

Before actually running the routing table the router has to find out its own address, as it is seen from the outside world. It does this by sending +end signals to a list of known telehash nodes (eg telehash.org:42424).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

record(bootstrap, { % the state of the router when bootstrapping
    timeout, % give up if no address received before this time
    addresses % list of addresses contacted to find out our address
   }).

bootstrap(Addresses, Timeout) ->
    ?INFO([bootstrapping]),
    State = #bootstrap{timeout=Timeout, addresses=Addresses},
    {ok, _Pid} = gen_server:start_link(?MODULE, State, []).
          
init(State) ->
    switch:listen(),
    case State of
  #bootstrap{timeout=Timeout, addresses=Addresses} ->
      Telex = telex:end_signal(util:random_end()),
      lists:foreach(fun (Address) -> switch:send(Address, Telex) end, Addresses),
      erlang:send_after(Timeout, self(), giveup);
  #state{} ->
      ok
    end,
    {ok, State}.

Then we listen until we either get a reply with a _to field or run out of time.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

handle_info({switch, {recv, From, Telex}}, #bootstrap{addresses=Addresses}=Bootstrap) ->
    % bootstrapping, waiting to receive a message telling us our own address
    case {lists:member(From, Addresses), telex:get(Telex, '_to')} of
  {true, {ok, Binary}} ->
      try util:to_end(util:binary_to_address(Binary)) of
      End ->
          Self = util:to_bits(End),
          Table = touched(From, Self, empty_table(Self)),
          dialer:dial(End, [From], ?ROUTER_DIAL_TIMEOUT),
          refresh(Self, Table),
          ?INFO([bootstrap, finished, {self, Binary}, {from, From}]),
          {noreply, #state{self=Self, pinged=sets:new(), table=Table}}
      catch
      _ ->
          ?WARN([bootstrap, bad_self, {self, Binary}, {from, From}]),
          {noreply, Bootstrap}
      end;
  _ ->
      {noreply, Bootstrap}
    end;

handle_info(giveup, #bootstrap{}=Bootstrap) ->
    % failed to bootstrap, die
    ?INFO([giveup, {state, Bootstrap}]),
    {stop, {shutdown, gaveup}, Bootstrap};

Once we know our own address we can fill in the state record and start managing the routing table.

1
2
3
4
5

-record(state, { % the state of the router in normal operation
    self, % the bits of the routers own end
    pinged, % set of addresses which have been pinged and not yet replied/timedout
    table % the routing table, a bit_tree containing buckets of nodes
   }).

One of the jobs of the router is to remove unresponsive nodes from the routing table. To check if a node is responsive we just a random +end signal and wait for a reply. If the node is unresponsive it gets marked as stale and we try to find a suitable replacement. The node won’t actually be dropped from the table until a replacement is found - this prevents the table from getting flushed if our network connection goes down.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

ping(To) ->
    Telex = telex:end_signal(util:random_end()),
    % do this in a message to self to avoid some awkward control flow
    self() ! {pinging, To},
    switch:send(To, Telex),
    erlang:send_after(?ROUTER_PING_TIMEOUT, self(), {timeout, Address}).

timedout(Address, Self, Table) ->
    bit_tree:update(
      fun (_Suffix, _Depth, _Gap, Bucket) ->
        case bucket:timedout(Address, Bucket) of
        {node, Node, Update} ->
            % try to touch this node, might be suitable replacement
            ping(Node),
            Update;
        Update ->
            Update
        end
      end,
      util:to_bits(Address),
      Self,
      Table
     ).

handle_info({pinging, Address}, #state{pinged=Pinged}=State) ->
    % do this in a message to self to avoid some awkward control flow
    ?INFO([recording_ping, {address, Address}]),
    Pinged2 = sets:add_element(Address, Pinged),
    {noreply, State#state{pinged=Pinged2}};
handle_info({timeout, Address}, #state{self=Self, pinged=Pinged, table=Table}=State) ->
    case lists:member(Address, Pinged) of
  true ->
      % ping timedout
      ?INFO([timeout, {address, Address}]),
      Table2 = timedout(Address, Self, Table),
      {ok, State#state{table=Table2}};
  false ->
      % address already replied
      {ok, State}
    end;

One of the rules of the router is that it should never pass on information about a node that it hasn’t personally confirmed to exist. Once we receive a message from a node we know that it exists (later we will implement ring/line to protect against address spoofing):

1
2
3
4
5
6
7
8
9
10

touched(Address, Self, Table) ->
    bit_tree:update(
      fun (Suffix, _Depth, Gap, Bucket) ->
        May_split = (Gap < ?K), % !!! or (Depth < ?ROUTER_TABLE_EXPANSION)
        bucket:touched(Address, Suffix, now(), Bucket, May_split)
      end,
      util:to_bits(Address),
      Self,
      Table
     ).

On receiving a .see command we record all the contained addresses as potential nodes and ping them to try to confirm their existence.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

seen(Address, Self, Table) ->
    bit_tree:update(
      fun (Suffix, _Depth, _Gap, Bucket) ->
        case bucket:seen(Address, Suffix, now(), Bucket) of
        {node, Node, Update} ->
            % check if this node is stale
            ping(Node),
            Update;
        Update ->
            Update
        end
      end,
      util:to_bits(Address),
      Self,
      Table
     ).

On receiving a +end signal we reply with a .see command containing the nearest K addresses which we have confirmed to exist.

1
2
3
4
5
6
7
8
9
10
11
12

see(To, End, Table) ->
    Telex = telex:see_command(nearest(?K, End, Table)),
    switch:send(To, Telex).

nearest(N, End, Table) when N>=0 ->
    Bits = util:to_bits(End),
    iter:take(
      N,
      iter:flatten(
  iter:map(
    fun ({_Prefix, Bucket}) -> bucket:by_dist(End, Bucket) end,
    bit_tree:iter(Bits, Table)))).

On receiving a message we have handle the above three cases, which gets a little ugly.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

handle_info({switch, {recv, From, Telex}}, #state{self=Self, pinged=Pinged, table=Table}=State) ->
    % this counts as a reply
    Pinged2 = sets:del_element(From, Pinged),
    % touched the sender
    % !!! eventually will check _line here
    ?INFO([touched, {node, From}]),
    Table2 = touched(From, Self, Table),
    % maybe seen some nodes
    Table3 =
  case telex:get(Telex, '.see') of
      {ok, Binaries} ->
      try [util:binary_to_address(Bin) || Bin <- Binaries] of
          Addresses ->
          ?INFO([seen, {nodes, Addresses}, {from, From}]),
          lists:foldl(fun (Address, Table_acc) -> seen(Address, Self, Table_acc) end, Table2, Addresses)
      catch
          _ ->
          ?INFO([bad_seen, {nodes, Binaries}, {from, From}]),
          Table2
      end;
      _ ->
      Table2
  end,
    % maybe send some nodes back
    case telex:get(Telex, '+end') of
  {ok, Hex} ->
      try util:hex_to_end(Hex) of
      End ->
          ?INFO([see, {'end', End}, {from, From}]),
          see(From, End, Table3)
      catch
      _ ->
          ?WARN([bad_see, {'end', Hex}, {from, From}])
      end;
  _ ->
      ok
    end,
    {noreply, State#state{pinged=Pinged2, table=Table2}};

The last responsibility of the router is to periodically refresh buckets which haven’t recently seen any activity.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

handle_info(refresh, #state{self=Self, table=Table}=State) ->
    ?INFO([refreshing_table]),
    refresh(Self, Table),
    {noreply, State};
handle_info({dialed, _, _}, State) ->
    % response from a bucket refresh, we don't care
    {noreply, State};

dialed(Address, Self, Table) ->
    bit_tree:update(
      fun (_Suffix, _Depth, _Gap, Bucket) ->
        bucket:dialed(now(), Bucket)
      end,
      util:to_bits(Address),
      Self,
      Table
     ).

needs_refresh(Bucket, Now) ->
    case bucket:last_dialed(Bucket) of
  never ->
      true;
  Last ->
      (timer:now_diff(Now, Last) div 1000) < ?ROUTER_REFRESH_TIME
    end.

refresh(Self, Table) ->
    Now = now(),
    iter:foreach(
      fun ({Prefix, Bucket}) ->
        case needs_refresh(Bucket, Now) of
        true ->
            ?INFO([refreshing_bucket, {prefix, Prefix}, {bucket, Bucket}]),
            To = util:random_end(Prefix),
            From = nearest(?K, To, Table),
            dialer:dial(To, From, ?ROUTER_DIAL_TIMEOUT);
        false ->
            ok
        end
      end,
      bit_tree:iter(Self, Table)
     ),
    erlang:send_after(?ROUTER_REFRESH_TIME, self(), refresh),
    ok.

That’s it. As usual the (untested) code is in the repo. The next post will probably deal with taps.

Now obviously the documentation is not at fault here. I assumed that each handler got its own process solely because the callbacks resembled gen_server. However, a little googling reveals that several other people made the same mistake so I thought it was worth mentioning.

Here is how I found this out. I was working on the router implementation for telehash. When I tested the bootstrapping algorithm everything looked fine until the first dial, after which nothing else happened. Straight away I suspected a bug in the dialer, but repeating the exact same call in the console worked fine. After a few deadends I opened pman to look for anything suspicious but couldn’t find the dialer process (because it doesn’t exist, it’s an event handler). I assumed that it was somehow crashing silently and wasted an hour or so reading and rereading the code and stepping through various calls in the debugger. No matter what I tried the dialer worked absolutely perfectly unless it was called by the router.

Eventually I noticed that the switch_event process was blocking inside a receive and the whole thing unravelled. The dialer is an event handler so when started it calls:

1

  gen_event:add_handler(switch_event, dialer, State)

which is a synchronous call to the switch_event process. The router event handler is running inside the switch_event process so when the router tries to dial it deadlocks.

The moral of this story is RTFM.

This is easily fixed by changing

1

  dialer:dial(End, [Address])

to

1

  spawn(fun () -> dialer:dial(End, [Address]) end)

but there were more problems. Most of the event handlers used erlang:send_after to handle timeouts but since they all run in the same process they all receive each others timeouts. Also, every event handler is run sequentially so the switch_event process becomes a huge bottleneck.

The solution I settled on was to change each event handler into a gen_server and write a simple event handler that just forwards events to its owner. By using gen_event:add_sup_handler and listening for event handler exits we can keep the two in sync.

Usual disclaimer: none of this is properly tested yet.

The Kademlia paper has much to say on the issue of routing, most of it contradictory. My takeaway from many readings and from browsing the source code of various different implementations is that the following points are the most important:

• each bucket should contain at most K nodes
• we should only ever report node addresses which we have personally confirmed exist
• responsive nodes should never be removed from buckets
• nodes should never be removed from buckets unless a suitable replacement exists

The first three points make the routing table very resistant to flooding and spoofing. In particular, they prevent a common attack for p2p networks where some bad guy floods the routing tables of all the other nodes so that all traffic is routed through nodes controlled by the bad guy. The last point prevents nodes from flushing their routing tables if their own network connection goes down.

I think the implementation I have come up with is fairly clean, if a little lengthy. Like the bit_tree I want the bucket to be completely pure. All side effects will be handled by the router itself. The main data structures are explained pretty well by the comments:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

-define(K, ?DIAL_DEPTH).

-record(node, {
    address, % node #address{} record
    'end', % node end
    suffix, % the remaining bits of the nodes end left over from the bit_tree
    status, % one of [live, stale, cache]
    last_seen % for live/stale nodes, the time of the last received message. for cache nodes the time of the last .see reference to the node
   }).

-record(bucket, {
    nodes, % gb_tree mapping addresses to {Status, Last_seen}
    % remaining fields are pq's of nodes sorted by their last_seen field
    live, % nodes currently expected to be alive
    stale, % nodes which have not replied recently
    cache % potential nodes which we have not yet verified 
   }). % invariant: pq_maps:size(live) + pq_maps:size(stale) <= ?K

The bucket is a two-stage data structure. This allows us the keep nodes of different statuses sorted by the last_seen time but still be able to get/delete nodes just knowing the address. The get_node function should make it clear how this works:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

get_node(Address,
   #bucket{nodes=Nodes, live=Live, stale=Stale, cache=Cache}) ->
    case gb_trees:lookup(Address, Nodes) of
  {value, {Status, Last_seen}} ->
      case Status of
      live ->
          {ok, pq_maps:get({Last_seen, Address}, Live)};
      stale ->
          {ok, pq_maps:get({Last_seen, Address}, Stale)};
      cache ->
          {ok, pq_maps:get({Last_seen, Address}, Cache)}
      end;
  none ->
      none
    end.

This is only long because records are purely a compile time structure ie we can’t write Bucket#bucket.Status so we have to pattern match on Status instead. We also define add_node/2, del_node/2 and update_node/2, which look pretty similar, as well as to_list/1, from_list/1 and sizes/1.

The router is going to react to various events by calling the appropriate bucket functions and possibly sending out messages based on the result. The first event it has to handle is a node becoming unresponsive. The bucket will mark this node as stale and return a cache node which the router can attempt to verify.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

% this address failed to reply in a timely manner
timedout(Address, Bucket) ->
    log:info([?MODULE, timing_out, Address, Bucket]),
    case get_node(Address, Bucket) of
  {ok, Node} ->
      case Node#node.status of
      live ->
          % mark as stale, return a cache node that might be a suitable replacement
          Bucket2 = update_node(Node#node{status=stale}, Bucket),
          pop_cache_hi(Bucket2);
      _ ->
          % if cache or stale already we don't care 
          ok(Bucket)
      end;
  none ->
      % wtf? we don't even know this node?
      % one way this could happen: 
      % send N1, sendN1, timedout N1, add N2 (pushing N1 out of stale), timedout N1 
      log:warning([?MODULE, unknown_node_timedout, Address, Bucket]),
      ok(Bucket)
    end.

% return most recently seen cache node, if any exist
pop_cache_hi(#bucket{cache=Cache}=Bucket) ->
    case pq_maps:pop_hi(Cache) of
  {_Key, Node, Cache2} ->
      {node, Node, ok(Bucket#bucket{cache=Cache2})};
  false ->
      ok(Bucket)
    end.

The next event is receiving a .see command. This may be as a result of a +end sent by the router but is more likely to be part of a dialing process happening elsewhere. The beauty of Kademlia is that the router can populate the routing table just by listening in on dialing attempts.

For each node listed in the .see command the router will call seen. This adds the node to the cache and returns the least recently seen live node so the router can check that it is still responsive.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

% this address has been reported to exist by another node
seen(Address, Time, Suffix, Bucket) ->
    log:info([?MODULE, seeing, Address, Bucket]),
    case get_node(Address, Bucket) of
  {ok, Node} ->
      case Node#node.status of
      cache ->
          % for cache nodes being in a .see is good enough
          ok(update_node(Node#node{last_seen=Time}, Bucket));
      _ ->
          % for live/stale nodes we require direct contact so ignore this
          ok(Bucket)
      end;
  none ->
      % put node in cache, return a live node to ping
      Node = #node{
        address = Address,
        'end' = util:to_end(Address),
        suffix = Suffix,
        status = cache,
        last_seen = Time
       },
      Bucket2 = add_node(Node, Bucket),
      case peek_live_lo(Bucket) of
      none -> ok(Bucket2);
      {ok, Live_node} -> {node, Live_node, ok(Bucket2)}
      end
    end.

% return the oldest live node
peek_live_lo(#bucket{live=Live}) ->
    case pq_maps:peek_lo(Live) of
  none -> none;
  {_, Node} -> {ok, Node}
    end.

Any time we receive a message we learn that the node sending it exists (or not - we’ll deal with address spoofing in a later post) so we can potentially mark it as a live node. The touched function checks if the node is already in the bucket or if it needs to be added.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

% this address has been verified as actually existing
touched(Address, Suffix, Time, Bucket, May_split) ->
    log:info([?MODULE, touching, Address, Bucket]),
    case get_node(Address, Bucket) of
  {ok, Node} ->
      case Node#node.status of
      live ->
          % update last_seen time
          ok(update_node(Node#node{last_seen=Time}, Bucket));
      stale ->
          % update last_seen time and promote to live
          ok(update_node(Node#node{last_seen=Time, status=live}, Bucket));
      cache ->
          % potentially promote the node to live
          Bucket2 = del_node(Node, Bucket),
          new_node(Address, Suffix, Time, Bucket2, May_split)
      end;
  none ->
      % potentially add the node to live
      new_node(Address, Suffix, Time, Bucket, May_split)
    end.