# HG changeset patch
# User Nolan Prescott <mail@nprescott.com>
# Date 1628905967 14400
#      Fri Aug 13 21:52:47 2021 -0400
# Node ID a596a983817548e17e5862dd0ca2d9c3e7884ab5
# Parent  0000000000000000000000000000000000000000
add ook.el

Ook!

diff --git a/ook.el b/ook.el
new file mode 100644
--- /dev/null
+++ b/ook.el
@@ -0,0 +1,26 @@
+(defmacro ook (&rest body)
+  (let ((tokens (cl-loop for (a b) on body by #'cddr while b collect (list a b)))
+        (compiletime-openers nil)
+        (compiletime-closers nil)
+        (program nil))
+    (dolist (pair tokens)
+      (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) compiletime-openers)
+             (push (gensym) compiletime-closers)
+             (push (car compiletime-openers) program)
+             (push `(if (= (aref tape position) 0) (go ,(car compiletime-closers))) program))
+            ((equal pair '(Ook? Ook!))
+             (push `(if (> (aref tape position) 0)
+                        (go ,(pop compiletime-openers))) program)
+             (push (pop compiletime-closers) program))))
+    `(let ((position 0)
+           (tape (make-vector 100 0))
+           (output (get-buffer-create "*Ook*")))
+       (cl-tagbody
+        ,@(reverse program)))))