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)))
Category:Brainfuck equivalents
Category:Languages
Category:Cell-based
Category:Brainfuck derivatives
Category:Turing complete
Category:Low-level
Category:Implemented