Brainhook

Brainhook is an esolang created by User:Yayimhere to minimize Brainfuck.

memory

memory is a tape the continues to the right forever. the tape pointer moves right every command. each cell is 6 bit and wrap(so if 0 is decremented its set to 63).

commands

commands

command	description
#	go back to the first cell of the tape
-	decrement the cell
(...)	loops ... while current cell non zero.
X	NOP

examples

Iterative Cell Value Modification

Utilizing the third memory cell as a iteration driver, the second cell is repeatedly decremented until it reaches a value of one (1):

XX-#X(#--#X)

implementation

An interpreter implementation in Common Lisp shall be adduced:

(deftype hexad ()
  "An unsigned integer number compact of six attiguous bits."
  '(unsigned-byte 6))

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

(deftype list-of (&optional (element-type '*))
  "A list of elements adhering to the ELEMENT-TYPE."
  (let ((predicate (gensym)))
    (declare (type symbol predicate))
    (setf (symbol-function predicate)
      #'(lambda (candidate)
          (declare (type T candidate))
          (and
            (listp candidate)
            (every
              #'(lambda (current-element)
                  (declare (type T current-element))
                  (typep current-element element-type))
              (the list candidate)))))
    `(satisfies ,predicate)))

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

(deftype hash-table-of (&optional (key-type '*) (value-type '*))
  "A hash table mapping keys of the KEY-TYPE to 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 current-key
                of-type T
                being the hash-keys in (the hash-table candidate)
              using
                (hash-value current-value)
              always
                (and
                  (typep current-key   key-type)
                  (typep current-value value-type))))))
    `(satisfies ,predicate)))

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

(deftype jump-table ()
  "Defines a bidirectional mapping atwixen jump points."
  '(hash-table-of fixnum fixnum))

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

(defclass Tape ()
  ((cells
    :initform      (make-array 1
                     :element-type    'hexad
                     :initial-element 0
                     :adjustable      T
                     :fill-pointer    T)
    :accessor      tape-cells
    :type          (vector hexad *)
    :documentation "A dynamic vector of unsigned 6-bit integers.")
   (pointer
    :initform      0
    :accessor      tape-pointer
    :type          fixnum
    :documentation "The cell pointer as the current index into the CELLS."))
  (:documentation
    "The program memory as a dextrally infinite dispansion of hexads."))

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

(defun prepare-a-pristine-tape ()
  "Returns a fresh Tape."
  (the Tape
    (make-instance 'Tape)))

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

(defun move-the-cell-pointer-right (tape)
  "Moves the TAPE's cell pointer one step to the right and returns no
   value."
  (declare (type Tape tape))
  (with-slots (cells pointer) tape
    (declare (type (vector hexad *) cells))
    (declare (type fixnum           pointer))
    (incf pointer)
    (when (>= pointer (fill-pointer cells))
      (vector-push-extend 0 cells)))
  (values))

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

(defun reset-the-cell-pointer (tape)
  "Moves the TAPE's cell pointer to the first cell and returns no value."
  (declare (type Tape tape))
  (setf (tape-pointer tape) 0)
  (values))

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

(defun current-cell-value (tape)
  "Returns the 6-bit value of the TAPE's currently selected cell."
  (declare (type Tape tape))
  (the hexad
    (aref
      (tape-cells   tape)
      (tape-pointer tape))))

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

(defun (setf current-cell-value) (new-value tape)
  "Wraps the NEW-VALUE into the hexad range [0, 63] and stores thilk in
   the TAPE's current while, while returning no value."
  (declare (type integer new-value))
  (declare (type Tape    tape))
  (setf
    (aref
      (tape-cells   tape)
      (tape-pointer tape))
    (mod new-value 64))
  (values))

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

(defmethod print-object ((tape Tape) (destination T))
  (declare (type Tape   tape))
  (declare (type stream destination))
  (loop
    initially
      (format destination "[")
    for current-cell-value of-type hexad   across (tape-cells tape)
    and requires-comma-p   of-type boolean = NIL then T
    do  (format destination "~@[, ~*~]~d"
          requires-comma-p
          current-cell-value)
    finally
      (format destination "]"))
  (the Tape tape))

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

(defun build-the-jump-table-for (code)
  "Returns a hash table connecting the Brainhook CODE's jump points."
  (declare (type string code))
  (let ((connections  (make-hash-table :test #'eql))
        (start-points NIL))
    (declare (type jump-table       connections))
    (declare (type (list-of fixnum) start-points))
    (loop
      for current-token    of-type character across code
      and current-position of-type fixnum    from   0 by 1
      if (char= current-token #\() do
        (push current-position start-points)
      else if (char= current-token #\)) do
        (if start-points
          (let ((start-point (pop start-points))
                (end-point   current-position))
            (declare (type fixnum start-point))
            (declare (type fixnum end-point))
            (psetf
              (gethash start-point connections) end-point
              (gethash end-point   connections) start-point))
          (error "No matching \"(\" token could detected for the ~
                  \")\" instruction at the position ~d."
            current-position))
      end
      finally
        (when start-points
          (error "The \")\" token~p at the position~:p ~{~d~^, ~} ~
                  could not be matched."
            (length   start-points)
            (nreverse start-points))))
    (the jump-table connections)))

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

(defun interpret-the-brainhook-code (code)
  "Interprets the piece of Brainhook source CODE and returns no value."
  (declare (type string code))
  (let ((jump-table (build-the-jump-table-for code))
        (ip         0)
        (tape       (prepare-a-pristine-tape)))
    (declare (type jump-table jump-table))
    (declare (type fixnum     ip))
    (declare (type Tape       tape))
    (loop while (< ip (length code)) do
      (case (char code ip)
        (#\#
          (reset-the-cell-pointer      tape)
          (move-the-cell-pointer-right tape))
        (#\-
          (decf (current-cell-value tape))
          (move-the-cell-pointer-right tape))
        (#\(
          (when (zerop (current-cell-value tape))
            (setf ip
              (gethash ip jump-table))
            (move-the-cell-pointer-right tape)))
        (#\)
          (setf ip
            (1-
              (gethash ip jump-table))))
        (#\X
          (move-the-cell-pointer-right tape))
        (otherwise
          NIL))
      (incf ip))
    (print tape))
  (values))

See also

• brainhooking