We are currently working on new rules for what content should and shouldn't be allowed on this website, and are looking for feedback! See Esolang:2026 topicality proposal to view and give feedback on the current draft.
brainhooking
Jump to navigation
Jump to search
- This article is not detailed enough and needs to be expanded. Please help us by adding some more information.
brainhooking is brainhook but smaller. its made by the same creator.
changes
first of all now theres only 500 cells(with wraping around), second of all the # command is gone, and - is changed to +(n) which will add the signed binary number n onto the current cell.
examples
cell value modification
This example employs positive and negative binary numbers in order to set the first three memory cells to 63, 1, and 63, respectively:
+1+01+0111111
implementation
The following interpreter implementation in Common Lisp imputes the representation of signed binary numbers, actuated via the + instruction, in the form of their two's complementation representation:
(deftype hexad ()
"An unsigned integer number in the range [0, 63]."
'(unsigned-byte 6))
;;; -------------------------------------------------------
(deftype list-of (&optional (element-type '*))
"A list of elements adhering to the ELEMENT-YTPE."
(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 affiliating keys of the KEY-TYPE with 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 ()
"A mapping atwixen a brainhooking program's jump points defined per
procurationem of their zero-based indices into the code."
'(hash-table-of fixnum fixnum))
;;; -------------------------------------------------------
(defun binary-digit-p (candidate)
"Determines whether the CANDIDATE represents a binary digit."
(declare (type character candidate))
(the boolean
(not (null
(or (char= candidate #\0)
(char= candidate #\1))))))
;;; -------------------------------------------------------
(defun decode-the-twos-complement (bits number-of-bits)
"Decodes the two's-complement-encoded BITS, tallying the NUMBER-OF-BITS
in size, and returns the tantamount signed integer decimal value."
(declare (type unsigned-byte bits))
(declare (type (integer 0 *) number-of-bits))
(the integer
(let ((discriminator-position (1- number-of-bits)))
(declare (type (integer 0 *) discriminator-position))
(if (logbitp discriminator-position bits)
(+ (- (expt 2 discriminator-position))
(ldb (byte discriminator-position 0) bits))
bits))))
;;; -------------------------------------------------------
(defun read-a-signed-binary-number (source start-position)
"Proceeding from the inclusive START-POSITION into the SOURCE,
consumes a binary number and returns two values: (1) the signed
decimal moutance and (2) the position into the SOURCE immediately
succeeding the occupied tmema."
(declare (type string source))
(declare (type fixnum start-position))
(let ((end-position
(or (position-if-not #'binary-digit-p source
:start start-position)
(length source))))
(declare (type fixnum end-position))
(the (values integer fixnum)
(if (> end-position start-position)
(values
(decode-the-twos-complement
(parse-integer source
:start start-position
:end end-position
:radix 2)
(- end-position start-position))
end-position)
(values 0 start-position)))))
;;; -------------------------------------------------------
(defclass Tape ()
((cells
:initform (make-array 500
:element-type 'hexad
:initial-element 0
:adjustable NIL
:fill-pointer NIL)
:accessor tape-cells
:type (simple-array hexad (500))
:documentation "A vector comprehending 500 hexad-valued cells.")
(pointer
:initform 0
:accessor tape-pointer
:type fixnum
:documentation "The cell pointer as the current index into the CELLS."))
(:documentation
"Implements the program memory a vector of 500 hexad-valued cells."))
;;; -------------------------------------------------------
(defun prepare-a-pristine-tape ()
"Creates and returns a fresh Tape."
(the Tape
(make-instance 'Tape)))
;;; -------------------------------------------------------
(defun move-the-cell-pointer-right (tape)
"Relocates the TAPE's cell pointer one step to the right, contingently
wrapping around to its start, and returns no value."
(declare (type Tape tape))
(with-slots (cells pointer) tape
(declare (type (simple-array hexad (500)) cells))
(declare (type fixnum pointer))
(incf pointer)
(when (>= pointer (length cells))
(setf pointer 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 range [0, 63], stores thilk in the
TAPE's current cell, and returns 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 brainhooking 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-brainhooking-code (code)
"Interprets the brainhooking 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)
(#\+
(incf ip)
(multiple-value-bind (incrementation new-ip)
(read-a-signed-binary-number code ip)
(declare (type integer incrementation))
(declare (type fixnum new-ip))
(incf (current-cell-value tape) incrementation)
(setf ip new-ip))
(move-the-cell-pointer-right tape))
(#\(
(when (zerop (current-cell-value tape))
(setf ip
(gethash ip jump-table))
(move-the-cell-pointer-right tape))
(incf ip))
(#\)
(setf ip
(gethash ip jump-table)))
(#\X
(move-the-cell-pointer-right tape)
(incf ip))
(otherwise
(incf ip))))
(print tape))
(values))
See also
Brainhook as a less minimized predecessor