Ook! in Emacs Lisp

2021-07-13

Since writing about strategic-communication I've been goofing off with more silly languages. Presented here without excuse is Ook!, implemented in Emacs Lisp.

This is a world where people ... write a programming language for orangutans.

Programming Sucks, by Peter Welch

Ook!

Ook! is a trivial substitution of another language with exactly one funny twist. Where previously you may have implemented the necessary instructions with individual opcodes or character instructions:

character	instruction
>	shift right
<	shift left
+	increment
-	decrement
,	input
.	output
[	begin loop
]	loop end

You might also realize that 8 is really just 2³ and reduce your instruction set down to just Ook!, Ook?, Ook. and alternate the pairwise combinations.

token	instruction
Ook. Ook?	shift right
Ook? Ook.	shift left
Ook. Ook.	increment
Ook! Ook!	decrement
Ook. Ook!	input
Oook! Ook.	output
Ook! Ook?	begin loop
Ook? Ook!	loop end

Compilation

With strategic-communication I tried writing a compiler to C, while I was happy enough with the result I wanted to try something else this time. It is pretty typical to interpret brainfuck and I've even written a crumby "to Forth" compiler; I wanted to try out a few different things so I resolved to implement Ook! in Emacs Lisp using a macro technique that would instead expand the Ook! program into Emacs Lisp without an interpreter. This is a fun exercise because it means the program is technically valid without ever passing through a string stage and separate parse step.

The classic example program for Ook!, taken from the esolang wiki, is this:

Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook.
Ook! Ook. Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook?
Ook! Ook! Ook? Ook! Ook? Ook. Ook. Ook. Ook! Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook. Ook! Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook! Ook.
Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook.
Ook? Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook! Ook. Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook.
Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook!
Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. Ook! Ook.

What I set out to accomplish was making that exact input into a valid program (in lisp syntax) so I might run it like this:

(ook¹ Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook.
Ook! Ook. Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook?
Ook! Ook! Ook? Ook! Ook? Ook. Ook. Ook. Ook! Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook. Ook! Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook! Ook.
Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook.
Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook.
Ook? Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook. Ook. Ook. Ook. Ook.
Ook! Ook. Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook.
Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook!
Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. Ook! Ook.)

¹ this will be the macro

Implementation

The series of tokens only makes sense when considered as their respective pair, so the first thing to do is collect the discrete pieces:

(defun collect-by-twos (code)
  (cl-loop for (a b) on code by #'cddr while b
           collect (list a b)))

From there all it takes is some translating from the corresponding token pairs to their respective Emacs Lisp code:

(defmacro ook (&rest body)
  (let ((opener nil)
        (closer nil)
        (program nil))
    (dolist (pair (collect-by-twos body))
                  (cond ((equal pair '(Ook. Ook?)) (push '(cl-incf position) program))
                        ((equal pair '(Ook? Ook.)) (push '(cl-decf position) program))
                        ((equal pair '(Ook. Ook.)) (push '(cl-incf (aref tape position)) program))
                        ((equal pair '(Ook! Ook!)) (push '(cl-decf (aref tape position)) program))
                        ((equal pair '(Ook! Ook.)) (push '(write-char (aref tape position) output) program))
                        ((equal pair '(Ook. Ook!)) (push '(string-to-char (read-key-sequence "input:")) program))
                        ((equal pair '(Ook! Ook?))
                             (push (gensym) opener)
                             (push (gensym) closer)
                             (push (car opener) program)
                             (push `(if (= (aref tape position) 0) (go ,(car closer))) program))
                        ((equal pair '(Ook? Ook!))
                             (push `(if (> (aref tape position) 0)
                                        (go ,(pop opener))) program)
                             (push (pop closer) program))))
    `(let ((position 0)
           (tape (make-vector 30000 0))
           (output (get-buffer-create "*Ook*")))
       (cl-tagbody
        ,@(reverse program)))))

I freely admit that this isn't a very good macro. I became so caught up in making the thing work that I haven't spent much time considering how to do it more optimally. Specifically I think it should be possible to construct the generated form without pushing and reversing. In fact, doing so works up to the point where there is more than a single form to be generated (which is only the case for the two looping tokens). I opted for using tagbody and go partly because it was easy and partly because I have never tried them before. The result is almost hilariously bad generated code:

generated output (306 lines)

(let
    ((position 0)
     (tape
      (make-vector 30000 0))
     (output
      (get-buffer-create "*Ook*")))
  (cl-tagbody
   (cl-incf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   g18
   (if
       (=
        (aref tape position)
        0)
       (go g19))
   (cl-decf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf position)
   (cl-decf
    (aref tape position))
   (if
       (>
        (aref tape position)
        0)
       (go g18))
   g19
   (cl-decf position)
   (write-char
    (aref tape position)
    output)
   (cl-incf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   g20
   (if
       (=
        (aref tape position)
        0)
       (go g21))
   (cl-decf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf position)
   (cl-decf
    (aref tape position))
   (if
       (>
        (aref tape position)
        0)
       (go g20))
   g21
   (cl-decf position)
   (cl-incf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (write-char
    (aref tape position)
    output)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (cl-incf position)
   (cl-incf position)
   (cl-incf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   g22
   (if
       (=
        (aref tape position)
        0)
       (go g23))
   (cl-decf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf position)
   (cl-decf
    (aref tape position))
   (if
       (>
        (aref tape position)
        0)
       (go g22))
   g23
   (cl-decf position)
   (write-char
    (aref tape position)
    output)
   (cl-incf position)
   (cl-incf position)
   (cl-incf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   g24
   (if
       (=
        (aref tape position)
        0)
       (go g25))
   (cl-decf position)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf position)
   (cl-decf
    (aref tape position))
   (if
       (>
        (aref tape position)
        0)
       (go g24))
   g25
   (cl-decf position)
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (cl-decf position)
   (cl-decf position)
   (cl-decf position)
   (cl-decf position)
   (write-char
    (aref tape position)
    output)
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (cl-incf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (cl-decf
    (aref tape position))
   (write-char
    (aref tape position)
    output)
   (cl-incf position)
   (cl-incf position)
   (cl-incf
    (aref tape position))
   (write-char
    (aref tape position)
    output)))

That Isn't Compilation

I can already hear the cries of computer nerds everywhere, howling that transforming one syntax to another through macro expansion isn't really compilation. They are wrong. Being the magnanimous sort that I am though I present the following:

Native Compilation

Emacs has recently integrated native compilation via libgccjit. I had such a good time debugging emacs that I've been playing with the latest features available in git. Here then is a native compilation of a Sierpinski triangle program:

(defun sierpinski ()
  (ook Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
       Ook. Ook! Ook? Ook. Ook? Ook. Ook. Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook.
       Ook. Ook. Ook? Ook. Ook? Ook. Ook! Ook! Ook? Ook! Ook. Ook? Ook. Ook. Ook.
       Ook. Ook. Ook? Ook. Ook? Ook. Ook. Ook? Ook. Ook! Ook? Ook! Ook! Ook! Ook?
       Ook. Ook? Ook. Ook? Ook. Ook. Ook? Ook. Ook? Ook. Ook! Ook! Ook? Ook! Ook.
       Ook. Ook. Ook? Ook. Ook? Ook? Ook! Ook. Ook? Ook. Ook. Ook! Ook? Ook! Ook!
       Ook? Ook. Ook? Ook. Ook? Ook. Ook! Ook? Ook! Ook! Ook. Ook? Ook! Ook? Ook.
       Ook. Ook! Ook? Ook! Ook! Ook? Ook! Ook. Ook. Ook. Ook? Ook. Ook. Ook. Ook.
       Ook. Ook? Ook. Ook? Ook. Ook? Ook! Ook! Ook? Ook. Ook? Ook. Ook? Ook! Ook?
       Ook. Ook! Ook? Ook? Ook. Ook? Ook! Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook.
       Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook? Ook. Ook.
       Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook. Ook? Ook! Ook!
       Ook? Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook! Ook. Ook!
       Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook? Ook. Ook? Ook! Ook. Ook? Ook! Ook.
       Ook. Ook? Ook. Ook. Ook! Ook? Ook. Ook? Ook. Ook? Ook? Ook! Ook. Ook? Ook.
       Ook. Ook? Ook!))

(native-compile #'sierpinski)

program output

                               *
                              * *
                             *   *
                            * * * *
                           *       *
                          * *     * *
                         *   *   *   *
                        * * * * * * * *
                       *               *
                      * *             * *
                     *   *           *   *
                    * * * *         * * * *
                   *       *       *       *
                  * *     * *     * *     * *
                 *   *   *   *   *   *   *   *
                * * * * * * * * * * * * * * * *
               *                               *
              * *                             * *
             *   *                           *   *
            * * * *                         * * * *
           *       *                       *       *
          * *     * *                     * *     * *
         *   *   *   *                   *   *   *   *
        * * * * * * * *                 * * * * * * * *
       *               *               *               *
      * *             * *             * *             * *
     *   *           *   *           *   *           *   *
    * * * *         * * * *         * * * *         * * * *
   *       *       *       *       *       *       *       *
  * *     * *     * *     * *     * *     * *     * *     * *
 *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

That is all it takes! How neat is that? Of course that is probably not what the designers of native compilation had in mind when they wrote it, it is however a fun way to try things out. For example it is interesting to browse through the generated assembly. Or perhaps there is a notable performance difference with the natively compiled version. I borrowed a quick and dirty timer mechanism from here for the following comparison which were averaged over multiple runs:

(timeit (sierpinski))
;;; 0.19574018710000002

(timeit (compiled-sierpinski))
;;; 0.0120942364

Thoughts

This hasn't been heavily tested. Specifically I think my input functionality might not match how some brainfuck programs work, pausing to read a single input key before continuing, rather than consuming bytes from something like STDIN. I'm not overly concerned and won't be spending too much time worrying about, I've got to start extending Emacs in my brand new DSL.