Rotator

Rotator is an esolang based on brainfuck by User:ChuckEsoteric08.

Description

Rotator has wrapping tape of 5 nonnegative unbounded cells, and < was removed. Another change is that after a command is executed pointer is moved right.

Computational class

The language is Turing-complete since 5-cell brainfuck can be translated into it:

brainfuck	Rotator
+	+>>
-	->>
,	,>>
.	.>>
[	[>>
]	]>>
>	>>>
<	>>

Examples

Cat Program

A repeating cat program, which terminates on a null character input, is produced below:

,>>[>>.>>,>>]>>

Digit Sequence

This program prints the digit sequence “1234” by assigning these four digits to the first memory cells, ere traversing the same range via the jump instructions, and terminating utilizing the zero-valued desinent cell:

+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>
>>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>
>>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>+>>
>>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>+>>
+>>+>>+>>+>>+>>+>>+>>
>>>>>>
[>>.>>>>>]>>

Implementation

An interpreter implementation in Common Lisp shall be adduced below:

(defun fixnum-list-p (object)
  "Determines whether the OBJECT represents a list containing merely \"fixnum\" elements."
  (declare (type T object))
  (the boolean
    (not (null
      (and (listp object)
           (every
             #'(lambda (current-element)
                 (declare (type T current-element))
                 (typep current-element 'fixnum))
             (the list object)))))))

;;; -------------------------------------------------------

(deftype fixnum-list ()
  "Defines a list comprehending zero or more \"fixnum\" elements."
  '(satisfies fixnum-list-p))

;;; -------------------------------------------------------

(defstruct (Command
  (:constructor make-a-command (symbol position)))
  "Encapsulates a command's symbol, its index into the source string,
   and an optional destination index into the parsed command vector, if
   a jump instruction is modeled."
  (symbol      (error "Missing symbol.")   :type standard-char :read-only T)
  (position    (error "Missing position.") :type fixnum        :read-only T)
  (destination 0                           :type fixnum        :read-only NIL))

;;; -------------------------------------------------------

(defun extract-the-commands (code)
  "Extracts the Rotator commands from the CODE and returns these in a vector."
  (declare (type string code))
  (the (simple-array Command (*))
    (coerce
      (loop
        for current-token    of-type character across code
        and current-position of-type fixnum    from   0 by 1
        when (find current-token ">+-,.[]" :test #'char=) collect
          (make-a-command current-token current-position))
      '(simple-array Command (*)))))

;;; -------------------------------------------------------

(defun connect-the-jump-points (program)
  "Connects the PROGRAM jump instructions' destination indices and returns no value."
  (declare (type (simple-array Command (*)) program))
  (loop
    with forward-jump-points of-type fixnum-list =      NIL
    for  current-command     of-type Command     across program
    and  current-position    of-type fixnum      from   0 by 1
    do
      (case (command-symbol current-command)
        (#\[
          (push current-position forward-jump-points))
        (#\]
          (if forward-jump-points
            (let ((forward-jump-point (pop forward-jump-points))
                  (back-jump-point    current-position))
              (declare (type fixnum forward-jump-point back-jump-point))
              (psetf (command-destination current-command)
                       forward-jump-point
                     (command-destination (aref program forward-jump-point))
                       back-jump-point))
            (error "The back jump command at the position ~d does ~
                    not correspond to any forward jump token."
              (command-position current-command))))
        (otherwise
          NIL))
    finally
      (when forward-jump-points
        (let ((unmatched-positions (map 'list #'command-position forward-jump-points)))
          (declare (type fixnum-list unmatched-positions))
          (error "The forward jump command~p at the position~:p ~
                  ~{~d~^, ~} do not correspond to any forward jump ~
                  ~2:*token~p."
            (length unmatched-positions)
            unmatched-positions))))
  (values))

;;; -------------------------------------------------------

(defstruct (Tape
  (:constructor prepare-a-pristine-tape ()))
  "A quintuple annulation of unbounded, non-negative, integer-valued cells."
  (cells    (make-array 5
              :element-type    '(integer 0 *)
              :initial-element 0
              :adjustable      NIL
              :fill-pointer    NIL)
            :type      (simple-array (integer 0 *) (5))
            :read-only T)
   (pointer 0
            :type      (integer 0 4)
            :read-only NIL))

;;; -------------------------------------------------------

(defun advance-the-cell-pointer (tape)
  "Moves the TAPE's cell pointer one step to the right and returns no value."
  (declare (type Tape tape))
  (setf (tape-pointer tape) (mod (1+ (tape-pointer tape)) 5))
  (values))

;;; -------------------------------------------------------

(defun current-cell-value (tape)
  "Returns the current TAPE cell's value."
  (declare (type Tape tape))
  (the (integer 0 *) (aref (tape-cells tape) (tape-pointer tape))))

;;; -------------------------------------------------------

(defun (setf current-cell-value) (new-value tape)
  "Stores the NEW-VALUE in the current TAPE cell and returns no value."
  (declare (type integer new-value) (type Tape tape))
  (setf (aref (tape-cells tape) (tape-pointer tape)) (max new-value 0))
  (values))

;;; -------------------------------------------------------

(defun interpret-rotator (code)
  "Interprets the piece of Rotator source CODE and returns no value."
  (declare (type string code))
  (let ((commands (extract-the-commands code))
        (ip       0)
        (tape     (prepare-a-pristine-tape)))
    (declare (type (simple-array Command (*)) commands) (type fixnum ip) (type Tape tape))
    (connect-the-jump-points commands)
    (symbol-macrolet ((current-command (the Command (aref commands ip))))
      (declare (type Command current-command))
      (loop while (< ip (length commands)) do
        (case (command-symbol current-command)
          (#\>
            (advance-the-cell-pointer tape))
          (#\+
            (incf (current-cell-value tape)))
          (#\-
            (decf (current-cell-value tape)))
          (#\.
            (format T "~c" (code-char (current-cell-value tape)))
            (finish-output))
          (#\,
            (format T "~&>> ")
            (finish-output)
            (setf (current-cell-value tape) (char-code (read-char NIL NIL #\Null)))
            (clear-input))
          (#\[
            (when (zerop (current-cell-value tape))
              (setf ip (command-destination current-command))))
          (#\]
            (unless (zerop (current-cell-value tape))
              (setf ip (command-destination current-command))))
          (otherwise
            (error "The symbol \"~c\" at the position ~d was not ~
                    expected to occur."
              (command-symbol   current-command)
              (command-position current-command))))
        (advance-the-cell-pointer tape)
        (incf ip))))
  (values))