ArrowFuck
Jump to navigation
Jump to search
ArrowFuck is a programing language created by User:Mipinggfxgbtftybfhfyhfn 100% backwards compatible with Brainfuck being the only diference that ArrowFuck stores memory in a 2D space.
Commands
| Command | Function |
|---|---|
| > | Moves the memory pointer to the right. |
| < | Moves the memory pointer to the left. |
| ^ | Moves the memory pointer up. |
| v | Moves the memory pointer down. |
| + | Increments the actual cell. |
| - | Decrements the actual cell. |
| . | Outputs the character corresponding to the value of the actual cell. |
| , | Inputs a character and stores it's ascii value in the cell. |
| [ | Jump past the maching ] if the cell is 0. |
| ] | Jump to the to the matching [ if the cell is nonzero. |
Examples
Reverse Cat Program
The following variation on the traditional cat program queries the standard input for characters until the null character has been committed, storing each such input in a cell of its own, ere progressing downwards to the next fresh cell. Ensuing from the input conduit's exhaustion, the cell pointer traverses all modified cells in the athwart direction, thus replicating the user-supplied message in the reverse form:
,[v,]^[.^]
Implementation
An implementation in Common Lisp shall be adduced below:
(defun get-boolean-value-of (object)
"Returns for the \"generalized boolean\" OBJECT a veridicous ``boolean tantamount."
(declare (type T object))
(the boolean (not (null object))))
;;; -------------------------------------------------------
(defmacro define-predicated-type (type-name (candidate-name &rest lambda-list)
&body body)
"Defines a derived type stevened by the TYPE-NAME, utilizing the
LAMBDA-LIST for its formal parameters, while indagating the candidate
via the CANDIDATE name when evaluating the BODY forms."
(let ((predicate-name (gensym)))
(declare (type symbol predicate-name))
`(deftype ,type-name ,lambda-list
,(or (stringp (first body)) (pop body)
"")
(let ((,predicate-name (gensym)))
(declare (type symbol ,predicate-name))
(setf (symbol-function ,predicate-name)
#'(lambda (,candidate-name)
(declare (type T ,candidate-name) (ignorable ,candidate-name))
,@body))
`(satisfies ,,predicate-name)))))
(defun designates-any-type-p (type-specifier)
"Determines whether the TYPE-SPECIFIER represents the generic sentinel ``*."
(declare (type T type-specifier))
(the boolean
(get-boolean-value-of
(and (symbolp type-specifier) (eq type-specifier '*)))))
(define-predicated-type hash-table-of (candidate
&optional (key-type '*) (value-type '*))
"A hash table whose keys conform to the KEY-TYPE and whose values
assume the VALUE-TYPE."
(and
(hash-table-p candidate)
(or (and (designates-any-type-p key-type)
(designates-any-type-p value-type))
(loop
for current-key of-type T
being the hash-keys in (the hash-table candidate)
using (hash-value current-value)
always
(and (or (designates-any-type-p key-type)
(typep current-key key-type))
(or (designates-any-type-p value-type)
(typep current-value value-type)))))))
(define-predicated-type list-of (candidate &optional (element-type '*))
"A list of zero or more elements complying to the ELEMENT-TYPE."
(and (listp candidate)
(or (designates-any-type-p element-type)
(loop for current-element of-type T in (the list candidate)
always (typep current-element element-type)))))
;;; -------------------------------------------------------
(deftype location ()
"A two-dimensional position as an (x, y) cons cell."
'(cons integer integer))
(deftype octet ()
"An unsigned byte value in the range [0, 255]."
'(unsigned-byte 8))
(deftype jump-table ()
"Associates the forward and back jump points via their indices in the code."
'(hash-table-of fixnum fixnum))
;;; -------------------------------------------------------
(defun build-jump-table-for (code)
"Returns for the piece of ArrowFuck source CODE a jump table."
(declare (type string code))
(let ((jump-table (make-hash-table :test #'eql))
(forward-jump-points NIL))
(declare (type jump-table jump-table))
(declare (type (list-of fixnum) forward-jump-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 forward-jump-points)
else if (char= current-token #\]) do
(if forward-jump-points
(let ((forward-jump-point (pop forward-jump-points))
(back-jump-point current-position))
(declare (type fixnum forward-jump-point))
(declare (type fixnum back-jump-point))
(psetf (gethash forward-jump-point jump-table) back-jump-point
(gethash back-jump-point jump-table) forward-jump-point))
(error "Unmatched back jump point at position ~d." current-position))
end
finally
(when forward-jump-points
(error "Unmatched forward jump point~p at position~:p ~{~d~^, ~}."
(length forward-jump-points) forward-jump-points)))
(the jump-table jump-table)))
(defun get-destination-jump-point (jump-table point-of-departure)
"Returns the jump point associated with the POINT-OF-DEPARTURE in the
JUMP-TABLE, or signals an error of an unspecified type upon its
disrespondency."
(declare (type jump-table jump-table))
(declare (type fixnum point-of-departure))
(the fixnum
(or (gethash point-of-departure jump-table)
(error "No matching destination for jump point ~d." point-of-departure))))
;;; -------------------------------------------------------
(defclass Tape ()
((cells
:initform (make-hash-table :test #'equal)
:reader tape-cells
:type (hash-table-of location octet)
:documentation "A sparse vector of unsigned byte-valued cells,
amenable to x-y cons cells.")
(pointer
:initform (cons 0 0)
:accessor tape-pointer
:type location
:documentation "The two-dimensional cell pointer as an x-y cons cell."))
(:documentation
"Represents the ArrowFuck program memory as a two-dimensional sparse
vector of unsigned byte-valued cells."))
(defun prepare-pristine-tape ()
"Creates and returns a fresh tape."
(the Tape (make-instance 'Tape)))
(defun copy-tape-pointer (tape)
"Returns a fresh copy of the TAPE's cell pointer."
(declare (type Tape tape))
(the location
(cons (car (tape-pointer tape)) (cdr (tape-pointer tape)))))
(defun current-cell-value (tape)
"Returns the unsigned byte value ensconced in the TAPE's currently
selected cell."
(declare (type Tape tape))
(the octet (gethash (copy-tape-pointer tape) (tape-cells tape) 0)))
(defun (setf current-cell-value) (new-value tape)
"Stores the NEW-VALUE in the TAPE's currently selected cell, potentially
wrapping its state around into the range [0, 255], and returs no value."
(declare (type Tape tape))
(setf (gethash (copy-tape-pointer tape) (tape-cells tape) 0)
(mod new-value 256))
(values))
(defun move-cell-pointer-right (tape)
"Translates the TAPE's cell pointer one step to the right and returns
no value."
(declare (type Tape tape))
(incf (car (tape-pointer tape)))
(values))
(defun move-cell-pointer-left (tape)
"Translates the TAPE's cell pointer one step to the left and returns
no value."
(declare (type Tape tape))
(decf (car (tape-pointer tape)))
(values))
(defun move-cell-pointer-up (tape)
"Translates the TAPE's cell pointer one step up and returns no value."
(declare (type Tape tape))
(incf (cdr (tape-pointer tape)))
(values))
(defun move-cell-pointer-down (tape)
"Translates the TAPE's cell pointer one step down and returns no
value."
(declare (type Tape tape))
(decf (cdr (tape-pointer tape)))
(values))
;;; -------------------------------------------------------
(defun interpret-ArrowFuck (code &key (displays-prompt-p T))
"Interprets the piece of ArrowFuck source CODE and returns no value."
(declare (type string code))
(declare (type boolean displays-prompt-p))
(let ((ip 0)
(jump-table (build-jump-table-for code))
(tape (prepare-pristine-tape)))
(declare (type fixnum ip))
(declare (type jump-table jump-table))
(declare (type Tape tape))
(symbol-macrolet
((program-is-completed-p
(the boolean
(get-boolean-value-of (>= ip (length code)))))
(current-token
(the character (aref code ip))))
(declare (type boolean program-is-completed-p))
(declare (type character current-token))
(loop until program-is-completed-p do
(case current-token
(#\> (move-cell-pointer-right tape))
(#\< (move-cell-pointer-left tape))
(#\^ (move-cell-pointer-up tape))
(#\v (move-cell-pointer-down tape))
(#\+ (incf (current-cell-value tape)))
(#\- (decf (current-cell-value tape)))
(#\. (format T "~c" (code-char (current-cell-value tape))))
(#\, (when displays-prompt-p
(format T "~&>> "))
(finish-output)
(setf (current-cell-value tape)
(char-code (read-char NIL NIL #\Null)))
(clear-input))
(#\[ (when (zerop (current-cell-value tape))
(setf ip
(get-destination-jump-point jump-table ip))))
(#\] (unless (zerop (current-cell-value tape))
(setf ip
(get-destination-jump-point jump-table ip))))
(otherwise NIL))
(incf ip))))
(values))
See also
Brainmulti, a brainfuck derivative which employs a three-dimensional tape