A Brainfuck interpreter written in Clojure

bf.clj

;;; bf.clj --- A Brainfuck interpreter written in Clojure
;; The idea to implement loop instructions without waste of stack
;; is borrowed from a interpreter by Blake Williams, available at
;; https://github.com/BlakeWilliams/Clojure-Brainfuck

;;; Data Constructors and Manipulators
;; TODO(omasanori): Consider writing a macro to remove duplication of code.
(defn valid-address?
  "Returns true if `address` is valid, otherwise false."
  [address]
  (and (integer? address)
       (not (neg? address))))
(defn pointer
  "Returns a new pointer."
  []
  (atom 0 :validator valid-address?))
(defn read-pointer
  "Returns the value of `ptr`."
  [ptr]
  (deref ptr))
(defn inc-pointer
  [ptr]
  (swap! ptr inc'))
(defn dec-pointer
  [ptr]
  (swap! ptr dec'))

(defn cell
  "Returns a new cell."
  []
  (atom 0 :validator integer?))
(defn read-cell
  [cll]
  (deref cll))
(defn write-cell
  [cll]
  (reset! cll value))
(defn inc-cell
  [cll]
  (swap! cll inc'))
(defn dec-cell
  [cll]
  (swap! cll dec'))

;;; Cells and Data Pointer
(def ^:dynamic *data-pointer*
  "Points a cell witch the program can read/write now."
  (pointer))
(def ^:dynamic *cells*
  "Holds cells used by the program."
  (repeatedly cell))
(defn current-cell
  "Returns a cell pointed by *data-pointer*."
  []
  (nth *cells* (read-pointer *data-pointer*)))

;;; Instruction Pointer
(def ^:dynamic *inst-pointer*
  "Points a instruction running now."
  (pointer))
(defn current-inst
  "Returns a instruction pointed by *inst-pointer*."
  [program]
  (nth program (read-pointer *inst-pointer*)))

;;; Jump Instructions
;; TODO(omasanori): Consider writing a macro to remove duplication of code.
(defn jump-forward
  "Forwards *inst-pointer* to ] which corresponds to current [."
  [program]
  (loop [depth 1]
    (when-not (zero? depth)
      (inc-pointer *inst-pointer*)
      (case (current-inst program)
        \[ (recur (inc' depth))
        \] (recur (dec' depth))
        (recur depth)))))
(defn jump-backward
  "Backs *inst-pointer* to [ corresponds to current ]."
  (loop [depth 1]
    (when-not (zero? depth)
      (dec-pointer *inst-pointer*)
      (case (current-inst program)
        \[ (recur (dec' depth))
        \] (recur (inc' depth))
        (recur depth)))))

;;; Input/Output Instructions
(defn read-char
  "Reads a character from *in* and stores to the current cell."
  []
  (write-cell (current-cell) (.read *in*)))
(defn write-char
  "Writes the value of the current cell to *out* as a character."
  []
  (print (char (read-cell (current-cell)))))

;;; Interpreter Loop
(defn run*
  "Executes `program` with current thread's *data-pointer*,
  *inst-pointer* and *cells*."
  [program]
  (loop []
    (case (current-inst program)
      \> (inc-pointer *data-pointer*)
      \< (dec-pointer *data-pointer*)
      \+ (inc-cell (current-cell))
      \- (dec-cell (current-cell))
      \, (read-char)
      \. (write-char)
      \[ (when (zero? (read-cell (current-cell)))
           (jump-forward program))
      \] (when-not (zero? (read-cell (current-cell)))
           (jump-backward))
      nil)
    (inc-pointer *inst-pointer*)
    (when-not (= (read-pointer *inst-pointer*) (count program))
      (recur))))
(defn run
  "Executes `program` with new *data-pointer*, *inst-pointer* and
  *cells*."
  [program]
  (binding [*data-pointer* (pointer)
            *inst-pointer* (pointer)
            *cells* (repeatedly cell)]
    (run* program)))

;;; Other Utilities
(def hello-world
  "A 'hello world' Brainfuck program borrowed from
  https://gist.github.com/1491858 ."
  "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.")

(defn silly-loop
  "Returns a Brainfuck program with `n`-depth loop. Simple implementations
  using recursions for loops will cause stack overflow with enough `n`."
  [n]
  (apply str "+" (concat (repeat n \[) "-" (repeat n \]))))