searchfuck
Jump to navigation
Jump to search
Searchfuck is a brainfuck equivalent with all commands being the most common google searches.
Commands
| Searchfuck | Brainfuck |
|---|---|
| youtube | > |
| < | |
| whatsapp web | + |
| - | |
| gmail | . |
| amazon | , |
| translate | [ |
| traductor | ] |
Examples
Cat Program
The following repeating cat program terminates on a null character input:
amazon translate gmail amazon traductor
Truth-Machine
A truth-machine in this language shall be demonstrated:
amazon gmail translate google google youtube whatsapp web translate youtube youtube traductor facebook translate gmail traductor facebook facebook traductor
Implementation
An interpreter implementation in Common Lisp shall be furnished:
(defun tape-p (candidate)
"Determines whether the CANDIDATE represents a hash table which maps
signed integer keys to unsigned byte values."
(declare (type T candidate))
(the boolean
(not (null
(and (hash-table-p candidate)
(loop
for current-key of-type T being the hash-keys in candidate
using (hash-value current-value)
always (and (integerp current-key)
(typep current-value '(unsigned-byte 8)))))))))
(deftype tape ()
"Defines the memory's tape as a sparse vector of signed integer-valued
indices, associated with unsigned byte cell values."
'(satisfies tape-p))
(declaim (type string *source-code*))
(declaim (type fixnum *source-position*))
(declaim (type character *source-character*))
(declaim (type boolean *source-is-exhausted-p*))
(declaim (type string *current-token*))
(defparameter *source-code* "" "The searchfuck code to analyze.")
(defparameter *source-position* 0 "The current index into the *SOURCE-CODE*.")
(defparameter *current-token* "" "The most recently extracted token from the *SOURCE-CODE*.")
(define-symbol-macro *source-character*
(the character (char *source-code* *source-position*)))
(define-symbol-macro *source-is-exhausted-p*
(the boolean
(not (null (string= *current-token* "")))))
(defun whitespace-character-p (candidate)
"Determines whether the CANDIDATE represents a whitespace character."
(declare (type character candidate))
(the boolean
(not (null
(member candidate '(#\Linefeed #\Newline #\Space #\Tab) :test #'char=)))))
(defun get-next-token ()
"Stores the next token in the *CURRENT-TOKEN* and returns thilk."
(setf *current-token*
(subseq *source-code*
(setf *source-position*
(or (position-if-not #'whitespace-character-p *source-code*
:start *source-position*)
(length *source-code*)))
(setf *source-position*
(or (position-if #'whitespace-character-p *source-code*
:start *source-position*)
(length *source-code*)))))
(the string *current-token*))
(defun current-token-equals-p (expected-token)
"Determines whether the *CURRENT-TOKEN* equals the EXPECTED-TOKEN."
(declare (type string expected-token))
(the boolean
(not (null (string= *current-token* expected-token)))))
(defun convert-searchfuck-to-brainfuck (searchfuck-code)
"Converts the SEARCHFUCK-CODE into a brainfuck program and returns a
fresh string containing the result."
(declare (type string searchfuck-code))
(psetf *source-code* searchfuck-code
*source-position* 0)
(get-next-token)
(the string
(with-output-to-string (brainfuck-code)
(declare (type string-stream brainfuck-code))
(loop until *source-is-exhausted-p* do
(format brainfuck-code "~a"
(cond
((current-token-equals-p "") "")
((current-token-equals-p "youtube") ">")
((current-token-equals-p "facebook") "<")
((and (current-token-equals-p "whatsapp")
(get-next-token)
(current-token-equals-p "web")) "+")
((current-token-equals-p "google") "-")
((current-token-equals-p "gmail") ".")
((current-token-equals-p "amazon") ",")
((current-token-equals-p "translate") "[")
((current-token-equals-p "traductor") "]")
(T "")))
(get-next-token)))))
(defun locate-forward-jump-point (brainfuck-code start-position)
"Proceeding from the START-POSITION into the BRAINFUCK-CODE, returns
the position of the matching forward jump point (\"[\")."
(declare (type string brainfuck-code) (type fixnum start-position))
(the fixnum
(loop
for current-position of-type fixnum from start-position downto 0
for current-token of-type character = (char brainfuck-code current-position)
with nesting-level of-type fixnum = 0
if (and (char= current-token #\[) (zerop nesting-level)) do
(return current-position)
else if (and (char= current-token #\[) (plusp nesting-level)) do
(decf nesting-level)
else if (char= current-token #\]) do
(incf nesting-level)
end
finally
(error "No matching forward jump point detected."))))
(defun locate-back-jump-point (brainfuck-code start-position)
"Proceeding from the START-POSITION into the BRAINFUCK-CODE, returns
the position of the matching back jump point (\"]\")."
(declare (type string brainfuck-code) (type fixnum start-position))
(the fixnum
(loop
for current-position of-type fixnum from start-position below (length brainfuck-code)
for current-token of-type character = (char brainfuck-code current-position)
with nesting-level of-type fixnum = 0
if (and (char= current-token #\]) (zerop nesting-level)) do
(return current-position)
else if (and (char= current-token #\]) (plusp nesting-level)) do
(decf nesting-level)
else if (char= current-token #\[) do
(incf nesting-level)
end
finally
(error "No matching back jump point detected."))))
(defun interpret-brainfuck (code)
"Interprets the piece of brainfuck source CODE and returns no value."
(declare (type string code))
(let ((ip 0)
(tape (make-hash-table :test #'eql))
(cell-pointer 0))
(declare (type fixnum ip)
(type tape tape)
(type integer cell-pointer))
(symbol-macrolet ((current-cell-value
(the (or (unsigned-byte 8) integer)
(gethash cell-pointer tape 0))))
(declare (type (or (unsigned-byte 8) integer) current-cell-value))
(loop while (array-in-bounds-p code ip) do
(case (char code ip)
(#\> (incf cell-pointer))
(#\< (decf cell-pointer))
(#\+ (setf current-cell-value
(mod (1+ current-cell-value) 256)))
(#\- (setf current-cell-value
(mod (1- current-cell-value) 256)))
(#\. (format T "~c" (code-char current-cell-value)))
(#\, (format T "~&>> ")
(finish-output)
(setf current-cell-value
(char-code (read-char NIL NIL #\Null)))
(clear-input))
(#\[ (when (zerop current-cell-value)
(setf ip (locate-back-jump-point code (1+ ip)))))
(#\] (unless (zerop current-cell-value)
(setf ip (locate-forward-jump-point code (1- ip)))))
(otherwise NIL))
(incf ip))))
(values))
(defun interpret-searchfuck (code)
"Interprets the piece of searchfuck source CODE and returns no value."
(declare (type string code))
(interpret-brainfuck
(convert-searchfuck-to-brainfuck code))
(values))