Xtrod
Jump to navigation
Jump to search
Xtrod was User:Ractangle's attempt to minimise the Brainfuck instructions
Instruction minimise
><+-,.[] The standard bf set ><+-![] Merged I/O into one command (0 for output, anything else for input) (<-![] Merged + and > (<-!| Skips an instruction if zero. Otherwise jump to the nearest |
The final table should look like this:
| Symbol | Action |
|---|---|
| ( | Mover the pointer to the right and Increments the previous cell |
| < | BF move pointer left |
| - | BF decrement cell |
| ! | I/O, gets output if not zero, gets input if zero |
| | | Skips an instruction if zero, go to the nearest | if not zero
|
Oh and don't worry, you can wrap the cell pointer in Xtrod
Examples
Cat Program
This repeating cat program terminates on a null character input, advancing for each input request to the next cell:
||<!!|
Implementation
This implementation in Common Lisp imputes that the jumping instruction permits navigations in both a sinistral and dextral airt, taking during the distance measurement to the possible targets merely operative symbols into account, and preferring the left neighbor in the case of spatial equality.
(defun command-character-p (candidate)
"Determines whether the CANDIDATE represents an Xtrod instruction symbol."
(declare (type character candidate))
(the boolean
(not (null (find candidate "(<-!|" :test #'char=)))))
;;; -------------------------------------------------------
(defun coerce-into-simple-base-string (source)
"Returns a simple base string representation of the SOURCE."
(declare (type string source))
(the simple-base-string (coerce source 'simple-base-string)))
;;; -------------------------------------------------------
(defun remove-comments-from-code (source)
"Returns a simple base string representation of the SOURCE, purged
from any non-operative characters."
(declare (type string source))
(the simple-base-string
(coerce-into-simple-base-string
(remove-if-not #'command-character-p source))))
;;; -------------------------------------------------------
(defstruct (Tape
(:constructor make-pristine-tape ()))
"Defines an infinite tape of unsigned byte-valued cells in terms of an
unsigned integer number's binary representation."
(bits #b00000000 :type unsigned-byte :read-only NIL)
(pointer 0 :type integer :read-only NIL)
(smallest-accessed-cell-index 0 :type integer :read-only NIL))
;;; -------------------------------------------------------
(defun translate-current-cell-index-into-bit-offset (tape)
"Returns the unsigned bit offset corresponding to the TAPE's current
cell pointer position."
(declare (type Tape tape))
(the (integer 0 *)
(* (- (tape-pointer tape) (tape-smallest-accessed-cell-index tape))
8)))
;;; -------------------------------------------------------
(defun current-cell-value (tape)
"Returns the unsigned byte value stored in the TAPE's selected cell."
(declare (type Tape tape))
(the (unsigned-byte 8)
(ldb (byte 8 (translate-current-cell-index-into-bit-offset tape))
(tape-bits tape))))
;;; -------------------------------------------------------
(defun (setf current-cell-value) (new-value tape)
"Stores the NEW-VALUE in the TAPE's currently selected cell, ensuring
the range [0, 255], and returns no value."
(declare (type integer new-value) (type Tape tape))
(setf
(ldb (byte 8 (translate-current-cell-index-into-bit-offset tape))
(tape-bits tape))
(mod new-value 256))
(values))
;;; -------------------------------------------------------
(defun move-cell-pointer-right (tape)
"Moves the TAPE's cell pointer one step to the right and returns no value."
(declare (type Tape tape))
(incf (tape-pointer tape))
(values))
;;; -------------------------------------------------------
(defun move-cell-pointer-left (tape)
"Moves the TAPE's cell pointer one step to the left and returns no value."
(declare (type Tape tape))
(decf (tape-pointer tape))
(when (< (tape-pointer tape) (tape-smallest-accessed-cell-index tape))
(psetf
(tape-smallest-accessed-cell-index tape) (tape-pointer tape)
(tape-bits tape) (ash (tape-bits tape) 8)))
(values))
;;; -------------------------------------------------------
(defun locate-neighboring-jump-points (source start-point)
"Locates the two nearest jump points from the START-POINT in the
SOURCE, each along another laterality, and returns four values:
(1) The position in the SOURCE of the nearest jump point to the
START-POINT's left, if such exists; otherwise NIL.
(2) The distance from the START-POINT to the nearest jump point to
its left, if such exists; otherwise NIL.
(3) The position in the SOURCE of the nearest jump point to the
START-POINT's right, if such exists; otherwise NIL.
(4) The distance from the START-POINT to the nearest jump point to
its right, if such exists; otherwise NIL."
(declare (type simple-base-string source) (type fixnum start-point))
(let ((previous-point
(when (plusp start-point)
(position #\| source
:start 0 :end (1- start-point) :from-end T :test #'char=)))
(next-point
(position #\| source :start (1+ start-point) :test #'char=)))
(declare (type (or null fixnum) previous-point next-point))
(the (values (or null fixnum) (or null fixnum) (or null fixnum) (or null fixnum))
(values previous-point
(and previous-point (abs (- start-point previous-point)))
next-point
(and next-point (abs (- start-point next-point)))))))
;;; -------------------------------------------------------
(defun locate-nearest-jump-point (source start-point)
"Returns the position of the nearest jump point to the START-POINT in
the SOURCE."
(declare (type simple-base-string source) (type fixnum start-point))
(multiple-value-bind (previous-point distance-from-left
next-point distance-from-right)
(locate-neighboring-jump-points source start-point)
(declare (type (or null fixnum) previous-point distance-from-left
next-point distance-from-right))
(the fixnum
(or (and previous-point next-point
(or (and (< distance-from-left distance-from-right)
previous-point)
next-point))
previous-point
next-point
(error "Cannot find a jump target for position ~d." start-point)))))
;;; -------------------------------------------------------
(defun interpret-Xtrod (code &key (displays-prompt-p T))
"Interprets the piece of Xtrod source CODE and returns no value."
(declare (type string code) (type boolean displays-prompt-p))
(let ((optimized-code (remove-comments-from-code code))
(ip 0)
(tape (make-pristine-tape)))
(declare (type simple-base-string optimized-code) (type fixnum ip) (type Tape tape))
(loop while (< ip (length optimized-code)) do
(case (schar code ip)
(#\(
(incf (current-cell-value tape))
(move-cell-pointer-right tape))
(#\<
(move-cell-pointer-left tape))
(#\-
(decf (current-cell-value tape)))
(#\!
(cond
((zerop (current-cell-value tape))
(when displays-prompt-p
(format *standard-output* "~&>> "))
(finish-output *standard-output*)
(setf (current-cell-value tape)
(char-code
(read-char *standard-input* NIL
(code-char 0))))
(clear-input *standard-input*))
(T
(format *standard-output* "~c"
(code-char
(current-cell-value tape))))))
(#\|
(if (zerop (current-cell-value tape))
(incf ip 1)
(setf ip (locate-nearest-jump-point optimized-code ip))))
(otherwise NIL))
(incf ip)))
(values))
See also
- BF instruction minimalization - other attempts at BF minimalization by other people