BF (BestCoder)

Not to be confused with brainfuck. For the category-theoretic object, see BF (category).

BF is brainfuck but weird, based upon a deliberately confounding transposition of the instruction identifiers, thus forming a trivial brainfuck substitution.

Commands

BF's equivalence with brainfuck capacitates the following unambiguous mapping betwixt the two cognate languages:

BF	brainfuck	Description
-	>	Move the cell pointer to the right.
+	<	Move the cell pointer to the left.
<	+	Increment the memory cell at the cell pointer.
>	-	Decrement the memory cell at the cell pointer.
[	.	Output the character signified by the cell at the cell pointer.
]	,	Input a character and store it in the cell at the cell pointer.
.	[	Jump past the matching ] if the cell at the pointer equals zero (0).
,	]	Jump back to the matching [ if the cell at the pointer does not equal zero (0).

Examples

Hello, World!

This program issues the message “Hello, World!” to the standard output:

<.>>->.--<->>>>>++,+>>+>>>,->[---<[--[[<<<.[-,++++[<<<[>>>>>>[++>[----<[

Cat Program

A repeating cat program, which terminates on a null character input, shall be presented:

].[],

Truth-Machine

A truth-machine is adduced alow:

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

Interpreter

An interpreter implementation in Common Lisp shall be adduced:

(deftype octet ()
  "An unsigned byte value in the closed integral interval [0, 255]."
  '(unsigned-byte 8))

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

(declaim (type simple-string *program*))
(declaim (type fixnum        *ip*))
(declaim (type character     *current-token*))
(declaim (type boolean       *program-is-exhausted-p*))
(declaim (type unsigned-byte *tape*))
(declaim (type integer       *cell-pointer*))
(declaim (type integer       *lowest-accessed-cell-index*))
(declaim (type T             *byte-selector-the-current-cell*))
(declaim (type boolean       *current-cell-contains-zero-p*))
(declaim (type character     +NULL-CHARACTER+))

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

(defparameter *program* ""
  "The BF source code to execute.")

(defparameter *ip* 0
  "The instruction pointer (IP) position into the \"*program*\".")

(define-symbol-macro *current-token*
  (the character
    (schar *program* *ip*)))

(define-symbol-macro *program-is-exhausted-p*
  (the boolean
    (not (array-in-bounds-p *program* *ip*))))

(defparameter *tape* #b00000000
  "The memory tape as an integer-encoded bit sequence, each attiguous
   catena of eight bits forming a cell's unsigned byte representation,
   the lowest bits mapping to the cell amenable to the smallest address,
   increasing in the subscripts towards the most significant bit (MSB)
   positions.")

(defparameter *cell-pointer* 0
  "The current cell pointer position.")

(defparameter *lowest-accessed-cell-index* 0
  "The bit offset into the \"*tape*\"'s binary sequence which
   corresponds to the unsigned byte's lowest significant bit (LSB) in
   the cell designated by the \"*cell-pointer*\".")

(define-symbol-macro *byte-selector-for-the-current-cell*
  (the T
    (byte 8
      (* (- *cell-pointer* *lowest-accessed-cell-index*) 8))))

(define-symbol-macro *current-cell-contains-zero-p*
  (the boolean (not (null (zerop (current-cell-value))))))

(defconstant +NULL-CHARACTER+ (code-char 0)
  "Represents the \"null character\", amenable to the ASCII code zero
   (0), in an implementation-independent manner.")

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

(defun move-the-cell-pointer-left ()
  "Translates the cell pointer one step to the left and returns no value."
  (decf *cell-pointer*)
  (when (< *cell-pointer* *lowest-accessed-cell-index*)
    (psetf *lowest-accessed-cell-index* *cell-pointer*
           *tape*                       (ash *tape* 8)))
  (values))

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

(defun move-the-cell-pointer-right ()
  "Translates the cell pointer one step to the right and returns no value."
  (incf *cell-pointer*)
  (values))

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

(defun current-cell-value ()
  "Returns the unsigned byte value stored in the tape's current cell."
  (the octet (ldb *byte-selector-for-the-current-cell* *tape*)))

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

(defun (setf current-cell-value) (new-value)
  "Stores the NEW-VALUE in the tape's current cell and returns no value."
  (declare (type integer new-value))
  (setf (ldb *byte-selector-for-the-current-cell* *tape*)
        (mod new-value 256))
  (values))

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

(defun locate-the-matching-back-jump-point (&aux (start-point *ip*))
  "Moves the instruction pointer (IP) forward to the matching back
   jump instruction and returns no value."
  (declare (type fixnum start-point))
  (incf *ip*)
  (loop with nesting-level of-type fixnum = 0
    if *program-is-exhausted-p* do
      (error "Unmatched forward jump point at position ~d." start-point)
    else if (char= *current-token* #\,) do
      (if (zerop nesting-level)
        (loop-finish)
        (decf nesting-level))
    else if (char= *current-token* #\.) do
      (incf nesting-level)
    end
    do (incf *ip*))
  (values))

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

(defun locate-the-matching-forward-jump-point (&aux (start-point *ip*))
  "Moves the instruction pointer (IP) backward to the matching forward
   jump instruction and returns no value.."
  (declare (type fixnum start-point))
  (decf *ip*)
  (loop with nesting-level of-type fixnum = 0
    if *program-is-exhausted-p* do
      (error "Unmatched back jump point at position ~d." start-point)
    else if (char= *current-token* #\.) do
      (if (zerop nesting-level)
        (loop-finish)
        (decf nesting-level))
    else if (char= *current-token* #\,) do
      (incf nesting-level)
    end
    do (decf *ip*))
  (values))

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

(defun interpret-BF (code)
  "Interprets the piece of BF source CODE and returns no value."
  (declare (type string code))
  (psetf *program*                    (coerce code 'simple-string)
         *ip*                         0
         *tape*                       #b00000000
         *cell-pointer*               0
         *lowest-accessed-cell-index* 0)
  (loop until *program-is-exhausted-p* do
    (case *current-token*
      (#\<  (incf (current-cell-value)))
      (#\>  (decf (current-cell-value)))
      (#\+  (move-the-cell-pointer-left))
      (#\-  (move-the-cell-pointer-right))
      (#\[  (format T "~c" (code-char (current-cell-value))))
      (#\]  (format T "~&>> ")
            (finish-output)
            (setf (current-cell-value)
                  (char-code (read-char NIL NIL +NULL-CHARACTER+)))
            (clear-input))
      (#\.  (when *current-cell-contains-zero-p*
              (locate-the-matching-back-jump-point)))
      (#\,  (unless *current-cell-contains-zero-p*
              (locate-the-matching-forward-jump-point)))
      (otherwise NIL))
    (incf *ip*))
  (values))