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)))
Category:Languages Category:Turing complete Category:Turing tarpits Category:Queue-based Category:No IO Category:Unimplemented