BaguaFuck
Jump to navigation
Jump to search
BaguaFuck, or ☰☱☲☳☴☵☶☷Fuck, is based on Brainfuck, substituting the traditional ASCII symbols for the simplified Chinese names of the Taoist bagua.
Command table
| This Esolang | Brainfuck |
|---|---|
乾 |
> |
兑 |
< |
离 |
+ |
震 |
- |
巽 |
. |
坎 |
, |
艮 |
[ |
坤 |
] |
Example
Hello, world!
离离离离离离艮乾离离离离离离离离离 离离离兑震坤乾巽兑离离离离离离离艮 乾离离离离兑震坤乾离巽离离离离离离 离巽巽离离离巽兑离离离离离离艮乾震 震震震震震震震震震震兑震坤乾震巽震 震震震震震震震震震震震巽兑离离离离 离离离离离离离艮乾离离离离离兑震坤 乾巽兑离离离艮乾离离离离离离离离兑 震坤乾巽离离离巽震震震震震震巽震震 震震震震震震巽兑离离离离离离艮乾震 震震震震震震震震震震兑震坤乾震巽乾 离离离离离离离离离离离离离巽兑兑兑
99 bottles of beer
Too long.
Cat Program
坎艮巽坎坤
Turing Completeness
It is turing complete because Brain Explode is.
Implementation
An interpreter implementation in Common Lisp shall constitute the following code tmema's furnishment.
Please note that the concrete character set deployed constitutes a dependency on the Common Lisp implementation; in corollary, Unicode support may or may not be a feature incorporated in the personal environment. The interpreter at hand has been developed and tested with Steel Bank Common Lisp (SBCL) version 1.1.4 as part of the Lisp Cabinet 0.3.5 bundle.
(deftype command ()
"Defines a BaguaFuck command as a tuple of a character and an optional
jump point index."
'(cons character (or null fixnum)))
;;; -------------------------------------------------------
(deftype program ()
"Defines an executable BaguaFuck program as a vector of (character, jump index)-tuples."
'(simple-array command (*)))
;;; -------------------------------------------------------
(deftype octet ()
"Defines an unsigned byte value in the range [0, 255]."
'(unsigned-byte 8))
;;; -------------------------------------------------------
(defun parse-the-baguafuck-code (code)
"Converts the BaguaFuck source CODE into a vector of character-index tuples."
(declare (type string code))
(the program
(map '(simple-array command (*))
#'(lambda (token)
(declare (type character token))
(cons token NIL))
code)))
;;; -------------------------------------------------------
(defun contex-the-jump-points (program)
"Connects the jump commands in the BaguaFuck PROGRAM by adminiculum of
their zero-based indices into the same and returns no value."
(declare (type program program))
(let ((forward-jump-points
(make-array 0
:element-type 'fixnum
:initial-element 0
:adjustable T
:fill-pointer T)))
(declare (type (vector fixnum *) forward-jump-points))
(macrolet
((memorize-the-current-position ()
"Pushes the CURRENT-POSITION onto the FORWARD-JUMP-POINTS
stack's top location and returns no value."
`(progn
(vector-push-extend current-position forward-jump-points)
(values)))
(pop-the-current-position ()
"Removes and returns the top element from the FORWARD-JUMP-POINTS stack."
`(the fixnum
(if (plusp (length forward-jump-points))
(prog1
(aref forward-jump-points (1- (fill-pointer forward-jump-points)))
(decf (fill-pointer forward-jump-points)))
(error "You cannot pop the top element of an empty ~
jump point stack."))))
(command-at (index)
"Accesses the place at the INDEX into the PROGRAM vector."
`(the command (aref program ,index))))
(loop for current-position of-type fixnum from 0 below (length program) do
(case (car (aref program current-position))
(#\艮
(memorize-the-current-position))
(#\坤
(let ((start-point (pop-the-current-position))
(end-point current-position))
(declare (type fixnum start-point end-point))
(psetf (cdr (command-at start-point)) end-point
(cdr (command-at end-point)) start-point)))
(otherwise NIL))))
(when (plusp (length forward-jump-points))
(error "One or more unmatched forward jump points exist.")))
(values))
;;; -------------------------------------------------------
(defstruct (Cell
(:constructor prepare-a-new-cell (predecessor successor)))
"Represents a memory cell as a doubly linked list node."
(value 0 :type octet :read-only NIL)
(predecessor NIL :type (or null Cell) :read-only NIL)
(successor NIL :type (or null Cell) :read-only NIL))
;;; -------------------------------------------------------
(defclass Tape ()
((header
:initform (prepare-a-new-cell NIL NIL)
:type Cell
:documentation "The front node, a sentinel facilitating insertions.")
(trailer
:initform (prepare-a-new-cell NIL NIL)
:type Cell
:documentation "The rear node, a sentinel facilitating insertions.")
(pointer
:initform (prepare-a-new-cell NIL NIL)
:type Cell
:documentation "A reference to the currently selected cell."))
(:documentation "Furnishes a bilaterally infinite catena of unsigned
byte-valued cells, represented by a doubly linked list."))
;;; -------------------------------------------------------
(defmethod initialize-instance :after ((tape Tape) &key)
"Establishes the vincula atwixen the inchoate node, represented by the
TAPE's pointer, the header and the trailer sentinels, and returns no value."
(declare (type Tape tape))
(with-slots (header trailer pointer) tape
(declare (type Cell header trailer pointer))
(psetf (cell-successor header) pointer
(cell-predecessor pointer) header
(cell-successor pointer) trailer
(cell-predecessor trailer) pointer))
(values))
;;; -------------------------------------------------------
(defun insert-a-cell-atwixen (predecessor successor)
"Inserts a fresh cell atwixen the PREDECESSOR and SUCCESSOR nodes, its
state's configuration compliant with the default plasmature, and
returns the thus yielded cell."
(declare (type Cell predecessor successor))
(the Cell
(let ((new-cell (prepare-a-new-cell predecessor successor)))
(declare (type Cell new-cell))
(psetf (cell-successor predecessor) new-cell
(cell-predecessor successor) new-cell)
new-cell)))
;;; -------------------------------------------------------
(defun move-the-cell-pointer-left (tape)
"Relocates the TAPE's cell pointer one step to the left and returns no value."
(declare (type Tape tape))
(with-slots (header pointer) tape
(declare (type Cell header pointer))
(setf pointer
(if (eq (cell-predecessor pointer) header)
(insert-a-cell-atwixen header pointer)
(cell-predecessor pointer))))
(values))
;;; -------------------------------------------------------
(defun move-the-cell-pointer-right (tape)
"Relocates the TAPE's cell pointer one step to the right and returns no value."
(declare (type Tape tape))
(with-slots (trailer pointer) tape
(declare (type Cell trailer pointer))
(setf pointer
(if (eq (cell-successor pointer) trailer)
(insert-a-cell-atwixen pointer trailer)
(cell-successor pointer))))
(values))
;;; -------------------------------------------------------
(defun current-cell-value (tape)
"Returns the byte value stored in the TAPE's currently selected cell."
(declare (type Tape tape))
(the octet (cell-value (slot-value tape 'pointer))))
;;; -------------------------------------------------------
(defun (setf current-cell-value) (new-value tape)
"Stores the NEW-VALUE in the TAPE's currently selected cell,
contingently preceded by a wrapping into the valid unsigned byte
range of [0, 255], and returns no value."
(declare (type Tape tape))
(setf (cell-value (slot-value tape 'pointer)) (mod new-value 256))
(values))
;;; -------------------------------------------------------
(defun execute-the-baguafuck-program (program)
"Executes the BaguaFuck PROGRAM and returns no value."
(declare (type program program))
(contex-the-jump-points program)
(let ((ip 0)
(tape (make-instance 'Tape)))
(declare (type fixnum ip) (type Tape tape))
(loop while (< ip (length program)) do
(destructuring-bind (token . jump-destination) (aref program ip)
(declare (type character token))
(declare (type (or null fixnum) jump-destination)
(ignorable jump-destination))
(case token
(#\乾
(move-the-cell-pointer-right tape))
(#\兑
(move-the-cell-pointer-left tape))
(#\离
(incf (current-cell-value tape)))
(#\震
(decf (current-cell-value tape)))
(#\巽
(format *query-io* "~c"
(code-char (current-cell-value tape))))
(#\坎
(format *query-io* "~&>> ")
(finish-output *query-io*)
(setf (current-cell-value tape)
(char-code (read-char *query-io* NIL #\Null)))
(clear-input *query-io*))
(#\艮
(when (zerop (current-cell-value tape))
(setf ip jump-destination)))
(#\坤
(unless (zerop (current-cell-value tape))
(setf ip jump-destination)))
(otherwise NIL))
(incf ip))))
(values))
;;; -------------------------------------------------------
(defun interpret-the-baguafuck-code (code)
"Interprets the piece of BaguaFuck source CODE and returns no value."
(declare (type string code))
(execute-the-baguafuck-program
(parse-the-baguafuck-code code))
(values))