A Brainfuck interpreter written in Clojure
;;; 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 \])))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment