6
\$\begingroup\$

I'm currently learning Clojure to try to get a good understanding of functionnal programming, so I wrote this brainfuck interpreter that takes a filename on the command line. I tried to make it as correct as I could, but I'm sure there are many things that would make more sense that I didn't think about, or bugs (although it works with the examples on wikipedia). Please criticize!

(ns brainfuck.core (:gen-class))

;; Input functions
(def valid-chars '(\< \> \[ \] \. \, \+ \-))

(defn valid-char?
  "Tests whether a character is valid brainfuck. Works with one or
  more characters at a time."
  ([c] (some #{c} valid-chars))
  ([c & others] (every? valid-char? (conj others c))))

(defn filter-invalid
  "Removes characters that aren't valid brainfuck."
  [code]
  (filter valid-char? code))

(defn get-code
  "Returns the sanitized content of file."
  [file]
  (filter-invalid (slurp file)))

(defn get-input
  "Returns one number entered by the user. If the user enters a
  character, it is converted to ASCII. If the user enters a string,
  this function returns 0."
  []
  (let [input (read-line)]
    (if (zero? (count input))
      0
      (int (first input)))))

;; Helper functions
(defn make-context
  "Creates the base context."
  [code-src]
  {:code code-src, :ip 0, :data (vec (repeat 30000 0)), :data-pointer 0})

(defn current-data
  "Returns the current data cell pointed to by :data-pointer."
  [context]
  (nth (context :data) (context :data-pointer)))

(defn current-instruction
  "Returns the current instruction."
  [context]
  (nth (context :code) (context :ip)))

(defn inc-ip
  "Increments the instruction pointer."
  [context]
  (update-in context [:ip] inc))

(defn dec-ip
  "Decrements the instruction pointer."
  [context]
  (update-in context [:ip] dec))

;; Functions to interpret instructions
(defn jump-to-matching-rb
  "Sets instruction pointer to the matching ].
  Should only be called with one argument, the other is for recursion."
  ([context] (jump-to-matching-rb (inc-ip context) 1))
  ([context level]
    (if (= level 0)
      (dec-ip context) ;; we've found the matching bracket
      (cond
        (= (nth (context :code) (context :ip)) \[)
          (jump-to-matching-rb (inc-ip context) (inc level))
        (= (nth (context :code) (context :ip)) \])
          (jump-to-matching-rb (inc-ip context) (dec level))
        :else
          (jump-to-matching-rb (inc-ip context) level)))))

(defn jump-to-matching-lb
  "Sets the instruction pointer to the matching [."
  ([context] (jump-to-matching-lb (dec-ip context) 1))
  ([context level]
    (if (= level 0)
      context ;; we've found the matching bracket
      (cond
        (= (nth (context :code) (context :ip)) \])
          (jump-to-matching-lb (dec-ip context) (inc level))
        (= (nth (context :code) (context :ip)) \[)
          (jump-to-matching-lb (dec-ip context) (dec level))
        :else
          (jump-to-matching-lb (dec-ip context) level)))))

(defn interpret-left-bracket
  "Interprets the [ brainfuck instruction."
  [context]
  (if (= (current-data context) 0)
    (jump-to-matching-rb context)
    context))

(defn interpret-right-bracket
  "Interprets the ] brainfuck instruction."
  [context]
  (jump-to-matching-lb context))

(defn interpret-current
  "Interprets the current instruction and return the modified context.
  For each instruction, the corresponding alteration to the context
  is made and the modified context is returned."
  [context]
  (let [c (current-instruction context)]
    (case c
      \> (update-in context [:data-pointer] inc)
      \< (update-in context [:data-pointer] dec)
      \+ (update-in context [:data (context :data-pointer)] inc)
      \- (update-in context [:data (context :data-pointer)] dec)
      \. (do (print (char (nth (context :data) (context :data-pointer)))) context)
      \, (assoc-in context [:data (context :data-pointer)] (get-input))
      \[ (interpret-left-bracket context)
      \] (interpret-right-bracket context))))

(defn interpret
  "Interprets the brainfuck program."
  [context]
  (loop [ctx context]
    (if (< (ctx :ip) (count (ctx :code)))
      (recur (inc-ip (interpret-current ctx))))))

(defn -main
  "Brainfuck interpreter. Run it with a filename as argument."
  [file]
  (interpret (make-context (get-code file))))
\$\endgroup\$
3
\$\begingroup\$

I'm not sure why you need valid-char? to accept multiple chars

If write

(def valid-char? #{\< \> \[ \] \. \, \+ \-})

And if you really need it:

(def valid-chars? [& chars]                                                                         
  (every? valid-char? chars))

It's more idiomatic to put the keyword for in a map lookup:

(defn current-instruction [context]
  (nth (:code context) (:ip context)))

Also, it looks like your jump-to-matching-* methods should be calling current-context rather than doing this same calculation.

It's general using whitespace commas (see make-context) is not considered good style. It distracts from readability. Normally you'd split each key-value pair on a new line for clarity.

I don't actually know how [ and ] work, so this might not be valid, but at first glance I'd want separate out the find-matching-bracket from the jump-to. I wonder if the find code can be written in a way to be direction-agnostic so that you only have to write it once? Maybe not.

The logic in interpret-current is really simple but I consider moving each command to a function to make the dispatch really clear. An (arguable) more elegant approach would be a multimethod:

(defmulti interpret-context current-instruction)

(defmethod interpret-context \>
  [context]
  (update-in context [:data-pointer] inc))

(defmethod interpret-context \<
  [context]
  (update-in context [:data-pointer] inc))

;; etc...
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.