Brainappend

brainappend is a brainfuck derivative by User:Joaozin003, partly inspired by Vague where the braces ([ and ]) append their contents to the source code (including themselves). This makes looping much more difficult.
== Instructions ==
Instruction 	Command
+, -, <, >, , and .	Same as brainfuck
] 	If the value of the current memory cell is not 0, then append the source code enclosed by this and the matching [, including the braces themselves, e.g. [>] appends [>] when ] gets ran
[ 	If the value of the current memory cell is 0, then jump to the matching ].
== Examples ==
=== Cat program (NUL-terminated) ===
 ,[.,]
Gets a character, then appends [.,] to the source code if it is not NUL.
===Truth-machine===
The following program implements a truth-machine:
 ,.>+++++++++++++++++++++++++++++++++++++++++++++++++
 <------------------------------------------------[>.<]
== See also ==
* Brainfuck
* Vague
== Implementation ==
An implementation in Common Lisp shall be produced below:
 (deftype hash-table-of (&optional (key-type T) (value-type T))
 "Defines a hash table composed of entries whose key match the KEY-TYPE
 and whose values assume the VALUE-TYPE."
 (let ((predicate (gensym)))
 (declare (type symbol predicate))
 (setf (symbol-function predicate)
 #'(lambda (candidate)
 (declare (type T candidate))
 (and
 (hash-table-p candidate)
 (loop
 for key of-type T being the hash-keys in (the hash-table candidate)
 using (hash-value value)
 always (and (typep key key-type) (typep value value-type))))))
 `(satisfies ,predicate)))
 
 (deftype octet ()
 "Defines an unsigned byte as an integer in the range [0, 255]."
 '(unsigned-byte 8))
 
 (deftype memory ()
 "Defines the program memory as a hash table-based vector of unsigned bytes."
 '(hash-table-of integer octet))
 
 (defun make-memory ()
 "Returns a new memory instance."
 (the memory (make-hash-table :test #'eql)))
 
 (defun cell-value-at (memory index)
 "Returns the value stored in the MEMORY cell at the INDEX."
 (declare (type memory memory) (type integer index))
 (the octet (gethash index memory 0)))
 
 (defun (setf cell-value-at) (new-value memory index)
 "Stores the NEW-VALUE in the MEMORY cell at the INDEX and returns no value."
 (declare (type memory memory) (type integer index))
 (setf (gethash index memory 0) (mod new-value 256))
 (values))
 
 (defun find-left-bracket (code start)
 "Commencing with the START index into the CODE, returns the position
 of the matching \"[\" token, or signals an error of an unspecified type
 upon its disrespondency."
 (declare (type string code) (type fixnum start))
 (the fixnum
 (loop
 with nesting-level of-type fixnum = 0
 for position of-type fixnum from start downto 0
 for token of-type character = (char code position)
 if (and (char= token #\[) (zerop nesting-level)) do
 (return position)
 else if (and (char= token #\[) (/= nesting-level 0)) do
 (decf nesting-level)
 else if (char= token #\]) do
 (incf nesting-level)
 end
 finally
 (error "No matching left bracket (\"[\") found."))))
 
 (defun find-right-bracket (code start)
 "Commencing with the START index into the CODE, returns the position
 of the matching \"]\" token, or signals an error of an unspecified type
 upon its disrespondency."
 (declare (type string code) (type fixnum start))
 (the fixnum
 (loop
 with nesting-level of-type fixnum = 0
 for position of-type fixnum from start below (fill-pointer code)
 for token of-type character = (char code position)
 if (char= token #\[) do
 (incf nesting-level)
 else if (and (char= token #\]) (zerop nesting-level)) do
 (return position)
 else if (and (char= token #\]) (/= nesting-level 0)) do
 (decf nesting-level)
 end
 finally (error "No matching right bracket (\"]\") found."))))
 
 (defun interpret-brainappend (initial-code)
 "Interprets the brainappend INITIAL-CODE and returns no value."
 (declare (type string initial-code))
 (let ((code (make-array (length initial-code)
 :element-type 'character
 :initial-contents initial-code
 :adjustable T
 :fill-pointer T))
 (ip 0)
 (memory (make-memory))
 (cell-pointer 0))
 (declare (type string code) (type fixnum ip)
 (type memory memory) (type integer cell-pointer))
 (loop while (< ip (fill-pointer code)) do
 (case (char code ip)
 (#\+ (incf (cell-value-at memory cell-pointer)))
 (#\- (decf (cell-value-at memory cell-pointer)))
 (#\> (incf cell-pointer))
 (#\< (decf cell-pointer))
 (#\, (format T "~&>> ")
 (finish-output)
 (let ((input (read-char NIL NIL #\Null)))
 (declare (type character input))
 (setf (cell-value-at memory cell-pointer)
 (if (char= input #\Newline)
 0
 (char-code input))))
 (clear-input))
 (#\. (write-char
 (code-char
 (cell-value-at memory cell-pointer))))
 (#\[ (when (zerop (cell-value-at memory cell-pointer))
 (setf ip (find-right-bracket code (1+ ip)))))
 (#\] (unless (zerop (cell-value-at memory cell-pointer))
 (let ((start-point (find-left-bracket code (1- ip))))
 (declare (type fixnum start-point))
 (format code "~a" (subseq code start-point (1+ ip))))))
 (otherwise NIL))
 (incf ip)))
 (values))
Category:Brainfuck derivativesCategory:LanguagesCategory:2023Category:Cell-basedCategory:Low-level Category:Implemented