Brainf*** compiler (Alan Dipert)

bfc.clj

(defn bfc
  [program]
  (let [allowed #{\+ \- \< \> \[ \] \.}
        src (->> program (filter allowed)
                 (interpose \space) (apply str))
        fns (zipmap '(- + < > . ?) (repeatedly gensym))]
    (letfn [(bfc* [s]
              (if (vector? s)
                `(while (not (~(fns '?))) ~@(map bfc* s))
                `(~(fns s))))]
      `(let [tape# (int-array 60000 0)
             pointer# (atom 0)
             ~(fns '-) #(aset tape# @pointer# (dec (aget tape# @pointer#)))
             ~(fns '+) #(aset tape# @pointer# (inc (aget tape# @pointer#)))
             ~(fns '<) #(swap! pointer# dec)
             ~(fns '>) #(swap! pointer# inc)
             ~(fns '.) #(print (char (aget tape# @pointer#)))
             ~(fns '?) #(zero? (aget tape# @pointer#))]
         ~@(map bfc* (read-string (str "(" src ")"))) nil))))