bf_2.clj

bf_2.clj

(ns bf.core)

(defmulti run-symbol
  (fn [symbol _] symbol))

(defmethod run-symbol \+
  [_ {:keys [pos] :as state}]
  (update-in state [:stack pos] inc))

(defmethod run-symbol \-
  [_ {:keys [pos] :as state}]
  (update-in state [:stack pos] dec))

(defmethod run-symbol \>
  [_ {:keys [stack pos] :as state}]
  (let [new-pos (inc pos)]
    (assoc state :pos new-pos
                 :stack (if (>= new-pos (count stack))
                          (conj stack 0)
                          stack))))

(defmethod run-symbol \<
  [_ {:keys [pos] :as state}]
  (let [new-pos (dec pos)]
    (if (neg? new-pos)
      (update-in state [:stack] into [0])
      (assoc state :pos new-pos))))

(defmethod run-symbol \.
  [_ {:keys [pos] :as state}]
  (-> (get-in state [:stack pos])
      char
      print)
  state)

(defmethod run-symbol \,
  [_ {:keys [pos] :as state}]
  (->> (read-line)
       first
       (assoc-in state [:stack pos])))

(defmethod run-symbol :default
  [symbol state]
  (if (fn? symbol)
    (loop [{:keys [pos stack] :as state} state]
      (if (zero? (stack pos))
        state
        (recur (symbol state))))
    state))

(defn compile-simple
  "Creates composition of functions from Brainfuck code."
  [code]
  (->> (map #(partial run-symbol %) code)
       reverse
       (apply comp)))

(defn update-last
  [coll & args]
  (apply update-in coll [(dec (count coll))] args))

(defn extract-loops
  [code]
  (loop [[current & rest] code
         loops []
         result []]
    (cond
      ; Returns result when all code processed
      (nil? current) result
      ; Start of a new loop
      (= current \[) (recur rest (conj loops []) result)
      ; End of a loop when it inside another loop
      (and (= current \]) (> (count loops) 1)) (recur rest
                                                      (butlast loops)
                                                      (update-last result conj
                                                                   (compile-simple (last loops))))
      ; End of a top level loop
      (= current \]) (recur rest
                            (butlast loops)
                            (conj result (compile-simple (last loops))))
      ; Code inside a loop
      (seq loops) (recur rest
                         (update-last loops conj current)
                         result)
      ; Code outside a loop
      :else (recur rest loops (conj result current)))))

(defn compile-code
  [code]
  (-> (extract-loops code)
      compile-simple))

(defn run-code 
  "Compiles Brainfuck code and runs it with default state."    
  [code]
  ((compile-code code) {:stack [0]
                        :pos 0}))