Btjzxgquartfrqifjlv

btjzxgquartfrqifjlv is a brainfuck derivative. It has the same instructions but...

Replace the brainfuck command	with	that has the Morse sequence
[	btj	-... - .---
]	zxg	--.. -..- --.
+	qua	--.- ..- .-
-	rtf	.-. - ..-.
<	rqi	.-. --.- ..
>	f	..-.
,	j	.---
.	lv	.-.. ...-

It's aimed at being easily trasmitted through international morse code communication channels.

Examples

Hello, World!

The following program prints the message “Hello, World!” to the standard output:

quabtjrtfrtffrtfbtjffquafrtfrtfrtfrtfrtfrqirqizxgrqirtfrtfrqirtfrtfrtfzxgfrtflvfffqualvfflvlvquaquaquabtjlvfzxgrqirqirqirqilvquaquaqualvrtfrtfrtfrtfrtfrtflvrqirqirtflvffffqualv

Cat Program

An infinitely repeating cat program, terminating only on a user input of the null character, is presented below:

j lv btj j lv zxg

Truth-Machine

A truth-machine is implemented below:

jlvbtjrtfrtffquabtjffzxgrqibtjlvzxgrqirqizxg

See also

wepmlrio, another Morse code-based language trivial brainfuck substitution

Morsefuck, a brainfuck equivalent which veridically employs Morse code

Implementation

An implementation in the Common Lisp programming language, based upon special variables and the execution of directly assembled Lisp forms by a macro, is provided in the following:

(defparameter +COMMANDS+
  '("btj" "zxg" "qua" "rtf" "rqi" "f" "j" "lv"))

(defun search-possible-command ()
  (declare (special source index))
  (the (or null fixnum)
    (position-if #'(lambda (source-character)
                     (declare (type character source-character))
                     (find source-character "bfjlqrz" :test #'char=))
      source :start index)))

(defun probe-command ()
  (declare (special source index))
  (loop for command of-type simple-string in +COMMANDS+
    when (search command source :start2 index
                 :end2 (min (+ index (length command)) (length source)))
      do (return (intern (string-upcase command) :keyword))
    finally (return NIL)))

(defun extract-commands ()
  (declare (special source index))
  (let ((commands NIL))
    (declare (type list commands))
    (loop do
      (setf index (search-possible-command))
      (if index
        (let ((command (probe-command)))
          (declare (type (or null keyword) command))
          (when command
            (push command commands)
            (incf index (length (symbol-name command)))))
        (loop-finish)))
    (coerce (nreverse commands) '(vector keyword *))))

(defun current-command ()
  (declare (special commands ip))
  (the (or null keyword)
    (when (array-in-bounds-p commands ip)
      (aref commands ip))))

(defun parse-loop ()
  (declare (special commands ip))
  (let ((loop-body NIL))
    (declare (type list loop-body))
    (incf ip)
    (loop do
      (case (current-command)
        ((NIL)     (error "Unmatched forward jump."))
        (:zxg      (loop-finish))
        (otherwise (push (parse-command) loop-body))))
    (the list `(loop until (zerop current-cell) do ,@(or (nreverse loop-body) '('()))))))

(defun parse-command ()
  (declare (special commands ip))
  (prog1
    (case (current-command)
      ((NIL) NIL)
      (:btj (parse-loop))
      (:zxg (error "Unmatched back jump."))
      (:qua `(incf current-cell))
      (:rtf `(decf current-cell))
      (:rqi `(decf cell-pointer))
      (:f   `(incf cell-pointer))
      (:j   `(progn (format T "~&>> ") (setf current-cell (char-code (read-char))) (clear-input)))
      (:lv  `(write-char (code-char current-cell)))
      (otherwise (error "Invalid command identifier: ~s." (current-command))))
    (incf ip)))

(defun collect-commands ()
  (declare (special commands ip))
  (loop until (>= ip (length commands)) collect (parse-command)))

(defun build-lisp-code (source &aux (index 0))
  (declare (type string source) (type (or null fixnum) index) (special source index))
  (let ((commands (extract-commands))
        (ip       0))
    (declare (type (vector keyword *)) (type fixnum ip) (special commands ip))
    (collect-commands)))

(defmacro interpret-Btjzxgquartfrqifjlv (code)
  `(let ((memory       (make-hash-table :test #'eql))
         (cell-pointer 0))
     (declare (type hash-table memory) (type integer cell-pointer))
     (flet ((get-current-cell ()
              (the (unsigned-byte 8) (gethash cell-pointer memory 0)))
            ((setf get-current-cell) (new-value)
              (declare (type integer new-value))
              (the (unsigned-byte 8) (setf (gethash cell-pointer memory 0) (mod new-value 256)))))
       (symbol-macrolet ((current-cell (get-current-cell)))
         ,@(build-lisp-code code)))
     (values)))