FuckPack

FuckPack is brainfuck, but with these other commands:

Jump Commands

J
Jump to the cell id numbered as the current bit.

Arithematic Commands

*
multiply the current cell by the next cell.

Bitshift commands

}
shift the byte bitwise left.

Bitwise commands

X
not the current cell(Bitwise)

Examples

Cat program

The following one-time cat program, whose intricacy and nimiety shall be vindicated by its telos, avails in the demonstration of the multiplication (*) and cell pointer indexing (J) facilities.

Starting from the cell with the index 255, which is set to the value 255, the cells from this position to inclusive zero (0) are computed using the multiplication with the successor. As a consectary, each cell cell[i] stores the value i, with 0 ≤ i ≤ 255.

The user is ultimately prompted for an input character, which, while being stored in the current cell, is not printed immediately. Instead, the program jumps to the cell at position i, with i being equal to the ASCII code of the user input, finally printing its content.

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*- <+*-
<+*- <+*- <+*-
,J.

Bit shifting

The following program generates the ASCII code for the letter “A”, that is, 65, by employing bit shifting, and prints the character.

+}}}}}}+ .

Logical NOT

The following program generates the ASCII code for the letter “A”, that is, 65, by employing the logical NOT operator, and prints the character.

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++ X .

Implementation

The following code constitutes an implementation in Common Lisp:

(defun compute-jump-table (code)
  (declare (type string code))
  (let ((jump-table  (make-hash-table :test #'eql))
        (jump-starts NIL))
    (declare (type hash-table jump-table) (type list jump-starts))
    (loop for position of-type fixnum from 0 below (length code) do
      (case (char code position)
        (#\[ (push position jump-starts))
        (#\] (unless jump-starts
               (error "Unmatched ']'."))
             (let ((start-position (pop jump-starts)))
               (declare (type fixnum start-position))
               (setf (gethash start-position jump-table) position)
               (setf (gethash position jump-table) start-position)))
        (otherwise NIL)))
    (the hash-table
      (if jump-starts
        (error "One or more unmatched '['.")
        jump-table))))

(defun binary-not (bits &optional (number-of-bits (max 8 (integer-length bits))))
  (declare (type integer bits) (type (integer 0 *) number-of-bits))
  (the integer
    (loop with    inverted-bits of-type integer = 0
          for     bit-position of-type (integer 0 *) from 0 below number-of-bits
          do      (setf (ldb (byte 1 bit-position) inverted-bits)
                        (1- (ldb (byte 1 bit-position) bits)))
          finally (return inverted-bits))))

(defun interpret-FuckPack (code &aux (jump-table (compute-jump-table code))
                                     (position   0)
                                     (memory     (make-hash-table :test #'eql))
                                     (pointer    0))
  (declare (type string code) (type fixnum position) (type hash-table jump-table)
           (type hash-table memory) (type integer pointer))
  (symbol-macrolet ((character    (the character (char code position)))
                    (exhausted-p  (the boolean   (not (array-in-bounds-p code position))))
                    (current-cell (the integer   (gethash pointer memory 0))))
    (loop until exhausted-p do
      (case character
        (#\J (setf pointer current-cell))
        (#\* (setf current-cell
                   (* current-cell (gethash (1+ pointer) memory 0))))
        (#\} (setf current-cell (ash current-cell 1)))
        (#\X (setf current-cell (binary-not current-cell)))
        (#\+ (incf current-cell))
        (#\- (decf current-cell))
        (#\> (incf pointer))
        (#\< (decf pointer))
        (#\. (write-char (code-char current-cell)))
        (#\, (format T "~&>> ")
             (setf current-cell (char-code (read-char)))
             (clear-input))
        (#\[ (when (zerop current-cell)
               (setf position (gethash position jump-table 0))))
        (#\] (unless (zerop current-cell)
               (setf position (gethash position jump-table 0))))
        (otherwise NIL))
      (incf position))))