# HG changeset patch # User Nolan Prescott # 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)))))