Quinary Bueue

Quinary Bueue is an esolang by User:ChuckEsoteric08.

Specification

Command	Description
0	enqueue 0
1	enqueue 1
[	dequeue, if zero jump after matching ]
]	jump back to matching [

Computational class

Quinary Bueue is Turing-complete because it can simulate brainfuck with fixed amount of unbounded cells. First we should translate brainfuck into a version with wrapping tape. Then we translate it into Quinary Bueue like that:

Create new cell:

0

> becomes:

[1]0

+> becomes:

[1]10

-> becomes:

[1]00, move to this cell, 10

-[ becomes:

[

-]> becomes:

]0

Example: program ++[>+<-] with two cells first becomes:

+>>+>>+>>-[>+>->>+>>-]>>

And then becomes:

00
[1]10
[1]0
[1]10
[1]0
[1]10
[1]0
[
[1]0
[1]10
[1]00[1]0[[1]]0
[1]0
[1]10
[1]0
]0
[1]0

Implementation

The following implementation is provided in Common Lisp:

(deftype hash-table-of (&optional (key-type T) (value-type T))
  "Defines a hash table of keys conforming to the KEY-TYPE and
   values of the VALUE-TYPE."
  (let ((predicate (gensym)))
    (declare (type symbol predicate))
    (setf (symbol-function predicate)
      #'(lambda (candidate)
          (declare (type T candidate))
          (and (hash-table-p candidate)
               (loop for    key of-type T being the hash-keys in candidate
                     using  (hash-value value)
                     always (and (typep key key-type)
                                 (typep value value-type))))))
    `(satisfies ,predicate)))

(deftype list-of (&optional (element-type T))
  "Defines a list of zero or more elements of the ELEMENT-TYPE."
  (let ((predicate (gensym)))
    (declare (type symbol predicate))
    (setf (symbol-function predicate)
      #'(lambda (candidate)
          (declare (type T candidate))
          (and (listp candidate)
               (loop for    element of-type T in candidate
                     always (typep element element-type)))))
    `(satisfies ,predicate)))

(defstruct (BQueue
  (:constructor make-bqueue (&aux (head-pointer (list 0))
                                  (tail-pointer head-pointer)))
  (:conc-name NIL)
  (:print-object
    (lambda (bqueue stream)
      (declare (type BQueue bqueue)
               (type (or null (eql T) stream string) stream))
      (format stream "(BQueue~{ ~d~^,~})"
        (rest (head-pointer bqueue))))))
  "Implements a binary queue based upon the \"tail concatenation\"
   principle of lists."
  (head-pointer (error "Missing head pointer.")
                :type (list-of bit) :read-only NIL)
  (tail-pointer (error "Missing tail pointer.")
                :type (list-of bit) :read-only NIL))

(defun enqueue (bqueue new-element)
  "Inserts the NEW-ELEMENT at the BQUEUE's rear and returns no value."
  (declare (type BQueue bqueue) (type bit new-element))
  (setf (rest (tail-pointer bqueue)) (list new-element))
  (setf (tail-pointer bqueue)        (rest (tail-pointer bqueue)))
  (values))

(defun dequeue (bqueue)
  "Removes and returns the front element from the BQUEUE, or signals an
   error upon its vacancy."
  (declare (type BQueue bqueue))
  (the bit
    (if (rest (head-pointer bqueue))
      (prog1 (second (head-pointer bqueue))
        (pop (head-pointer bqueue)))
      (error "Cannot dequeue from an empty queue."))))

(defun compute-jump-points (code)
  "Returns a jump table which associates the jump points in the Quinary
   Bueue source CODE."
  (declare (type string code))
  (let ((jump-table   (make-hash-table :test #'eql))
        (start-points NIL))
    (declare (type (hash-table-of fixnum fixnum) jump-table))
    (declare (type (list-of fixnum)              start-points))
    (loop for token    of-type character across code
          and position of-type fixnum    from   0 by 1
          if (char= token #\[) do
            (push position start-points)
          else if (char= token #\]) do
            (if start-points
              (let ((jump-start (pop start-points)))
                (declare (type fixnum jump-start))
                (psetf (gethash jump-start jump-table) position
                       (gethash position   jump-table) jump-start))
              (error "Unmatched \"]\" instruction at position ~d." position))
          finally
            (when start-points
              (error "Unmatched \"[\" instruction~p at position~:p ~{~d~^ , ~}."
                (length start-points) start-points)))
    (the (hash-table-of fixnum fixnum) jump-table)))

(defun interpret-Quinary-Bueue (code)
  "Interprets the piece of Quinary Bueue source CODE and returns the memory queue."
  (declare (type string code))
  (let ((ip         0)
        (jump-table (compute-jump-points code))
        (memory     (make-bqueue)))
    (declare (type fixnum                        ip)
             (type (hash-table-of fixnum fixnum) jump-table)
             (type BQueue                         memory))
    (loop while (< ip (length code)) do
      (case (char code ip)
        (#\0 (enqueue memory 0) (incf ip))
        (#\1 (enqueue memory 1) (incf ip))
        (#\[ (when (zerop (dequeue memory))
               (setf ip (gethash ip jump-table)))
             (incf ip))
        (#\] (setf ip (gethash ip jump-table)))
        (otherwise (incf ip))))
    (the BQueue memory)))