searchfuck

From Esolang
Jump to navigation Jump to search

Searchfuck is a brainfuck equivalent with all commands being the most common google searches.

Commands

Searchfuck Brainfuck
youtube >
facebook <
whatsapp web +
google -
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))