bf_in_clojure.clj

(ns bf.core)

(defn bf>
  [[stack current]]
  (let [new-current (inc current)]
    [(if (>= new-current (count stack))
       (conj stack 0)
       stack)
     new-current]))

(defn bf<
  [[stack current]]
  (let [new-current (dec current)]
    (if (neg? new-current)
      [(into [0] stack) 0]
      [stack new-current])))

(defn bf+
  [[stack current]]
  [(update-in stack [current] inc) current])

(defn bf-
  [[stack current]]
  [(update-in stack [current] dec) current])

(defn bf-dot
  [[stack current]]
  (print (char (get stack current)))
  [stack current])

(defn compile-simple
  [code]
  (->> (reverse code)
       (remove char?)
       (apply comp)))

(defn bf-loop
  [loop-prog]
  (let [loop-fn (compile-simple loop-prog)]
    (fn [[stack current]]
      (loop [[stack current] [stack current]]
        (let [[new-stack new-current] (loop-fn [stack current])]
          (if (pos? (get new-stack new-current))
            (recur [new-stack new-current])
            [new-stack new-current]))))))

(defn update-last
  [coll fnc]
  (update-in coll [(dec (count coll))] fnc))

(defn extract-loops
  [code]
  (loop [[current & rest] code
         loop-codes []
         result []]
    (cond
      (nil? current) result
      (= current \[) (recur rest (conj loop-codes []) result)
      (and (= current \]) (> (count loop-codes) 1)) (recur rest (update-last (butlast loop-codes)
                                                                             #(conj % (bf-loop (last loop-codes))))
                                                           result)
      (= current \]) (recur rest (butlast loop-codes)
                            (conj result (bf-loop (last loop-codes))))
      (seq loop-codes) (recur rest (update-last loop-codes #(conj % current))
                              result)
      :else (recur rest loop-codes (conj result current)))))

(defn compile-code
  [code]
  (->> code
       (map #(get {\> bf>
                   \< bf<
                   \+ bf+
                   \- bf-
                   \. bf-dot} % %))
       extract-loops
       compile-simple))

(defn run-code
  [code]
  ((compile-code code) [[0] 0]))

(run-code "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..
           +++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.")

; Hello World!