ClojureでBrainf*ck

プログラミング言語の勉強する時は、

1. Hello World!
2. FizzBuzz
3. Brainfu*k

というのを最初に書いてみることにしている。

ClojureでもBrainfu*kを書いてみた。

(defstruct env :inst :pc :program :last :ptr :memory)

(defmulti execute :inst)

(defmethod execute \> [{pc :pc ptr :ptr :as env}] ;increment pointer
	   (merge env
		  {:pc (inc pc),
		   :ptr (inc ptr)}))

(defmethod execute \< [{pc :pc ptr :ptr :as env}] ;decrement pointer
	   (merge env
		  {:pc (inc pc),
		   :ptr (dec ptr)}))

(defmethod execute \+ [{pc :pc ptr :ptr mem :memory :as env}] ;increment value
	   (merge env
		  {:pc (inc pc),
		   :memory
		   (assoc mem ptr
			  (let [val (get mem ptr)]
			    (if (nil? val) 1 (inc val))))}))

(defmethod execute \- [{pc :pc ptr :ptr mem :memory :as env}] ;decrement value
	   (merge env
		  {:pc (inc pc),
		   :memory
		   (assoc mem ptr
			  (let [val (get mem ptr)]
			    (if (nil? val) -1 (dec val))))}))

(defmethod execute \. [{pc :pc ptr :ptr mem :memory :as env}] ;put char
	   (let [val (get mem ptr)]
	     (.print System/out (format "(%c%d)"
			    (if (nil? val) 0 val)
			    (if (nil? val) 0 val))))
	   (assoc env :pc (inc pc)))

(defmethod execute \, [{pc :pc ptr :ptr mem :memory :as env}] ;get char
	   (print *in*)
	   (merge
	    env
	    {:pc (inc pc),
	     :memory (assoc mem ptr (.read System/in))}))

(defmethod execute \[ [{pc :pc ptr :ptr
			program :program mem :memory :as env}] ;while(*ptr){
	   (let [val (get mem ptr)]
	     (if (or (nil? val) (zero? val))
		 (loop [indexed
			(drop pc
			      (map
			       #(cons %1 %2)
			       program
			       (iterate inc 0)))]
		    (if (= (first (first indexed)) \])
			(assoc env :pc (inc (rest (first indexed))))
			(recur (rest indexed))))
		 (assoc env :pc (inc pc)))))

(defmethod execute \] [{pc :pc ptr :ptr
			program :program mem :memory :as env}] ;}
	   (let [val (get mem ptr)]
	     (if (not (or (nil? val) (zero? val)))
		 (loop [indexed
			(reverse
			 (take pc
			       (map
				#(list %1 %2)
				program
				(iterate inc 0))))]
		    (if (= (first (first indexed)) \[)
			(assoc env :pc (inc (second (first indexed))))
			(recur (rest indexed))))
		 (assoc env :pc (inc pc)))))

(defn load-instruction [{pc :pc program :program :as env}]
  (assoc env :inst (nth program pc)))

(defn brainfuck [program]
  (loop [env (struct env nil 0 program (count program) 0 {})]
     (if (< (:pc env) (:last env))
	 (recur (execute (load-instruction env)))
	 'done)))

;;(brainfuck "+[>,.<]")
;;(brainfuck "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+.")