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))