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 "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+.")

clojureでコンパイル

clojureのcompile関数をうまく動かすまでに結構手間取ったのでメモ

1. ソースの置かれているディレクトリ(パッケージのルートになるとこ)にクラスパスが通っている
2. カレントディレクトリからみた出力先(*compile-path*)ディレクトリにクラスパスが通っている
3. 出力先ディレクトリが存在する <- ここ重要
4. SLIME経由で使ってるなら、ただしくクラスパスが設定されるようになっているか注意する

ジンジャーエールを作る-その1

今日の昼食を食べた店で、自家製ジンジャーエールがあったので頼んでみたらおいしかった。自分でも作ってみたい、そしてそのジンジャーエールでモスコミュールを作りたい、と思った。レシピを調べて見たところ、割と皆さん自分の好きなように作っているっぽかったので、簡単そうなハチミツに付けるだけのものを試してみた。

材料は

• 新ショウガ 150g (スライス)
• はちみつ ショウガが浸るくらい
• シナモン 粉の奴を大さじ1杯

これだけ。こいつを炭酸水で割るとジンジャーエールが出来上がるらしい。シナモンが多すぎるような気がするが、入れてしまったものはしかたない。これらを瓶の中にぶち込んで冷蔵庫で放置する。

果たして、まともに飲めるものができるのだろうか。

Emacs LispでファイルIOその2

open,closeを書いたのでついでに with-open-fileも書いてみた。

(defmacro with-open-file (clause &rest body)
  (destructuring-bind
      (direction filename stream)
      (let ((tmp (reverse clause)))
	(if (= (length tmp) 2)
	    (cons :input tmp)
	  tmp))
    `(let ((,stream (open ,filename ,direction)))
       (prog1
	   (progn
	     ,@body)
	 (close ,stream)))))

McCLIMでグラフを書く

McCLIMでグラフを描画する。ノードが循環すると繰り返し処理をしようとして落ちるようだ。

(require :asdf)
(asdf:oos 'asdf:load-op :mcclim)

(in-package :clim-user)

(define-application-frame graph-frame ()
  ()
  (:menu-bar t)
  (:panes
   (app :application
	:min-width 200
	:min-height 200
	:scroll-bars nil
	:display-time :command-loop
	:display-function 'draw))
  (:layouts
   (default (horizontally () app))))

(define-graph-frame-command (com-quit :menu t) ()
  (frame-exit *application-frame*))

(defstruct node (name "") (children nil))
(defparameter gl (let* ((2a (make-node :name "2A"))
			(2b (make-node :name "2B"))
			(2c (make-node :name "2C"))
			(1a (make-node :name "1A" :children (list 2a 2b)))
			(1b (make-node :name "1B" :children (list 2b 2c))))
		   (make-node :name "0" :children (list 1a 1b))))
(define-presentation-type node ())
(defun test-graph (root-node &rest keys)
  (apply #'clim:format-graph-from-root gl
	 #'(lambda (node stream)
	       (clim:surrounding-output-with-border (stream :shape :underline)
		 (write-string (node-name node) stream)))
	 #'node-children
	 keys))
(defgeneric draw (frame stream))
(defmethod draw ((frame application-frame) stream)
  (declare (ignore frame))
  (test-graph gl :stream stream))

(defun run ()
  (clim:run-frame-top-level (clim:make-application-frame 'graph-frame)))

McCLIMはPostScriptを出力する事もできるらしい。

(defun output-postscript (filename)
  (with-open-file (out filename :direction :output)
    (with-output-to-postscript-stream
	(stream out
		:header-comments '(:title "PostScript Test"))
      (test-graph gl :stream stream))))

Emacs LispでファイルIO

Emacs Lispで、ファイルから入力する処理をCommonLispのノリで書こうとしたら・・・

>(require 'cl)
>(with-open-file (in "hoge.txt" :direction :input)
   (with-open-file (out "fuga.txt" :direction :output)
     (princ (read in) out)))
Debugger entered--Lisp error: (void-function with-open-file)

あれ?

>(open "hoge.txt")
Debugger entered--Lisp error: (void-function open)

・・・あれ?

ELispってファイルオープンしてストリームを作ることができないのか・・・。

調べて見たところ、streamとして使えるのは以下のとおりらしい。

• 入力
  • buffer
  • marker (バッファ内のマーカの位置)
  • string
  • function (2種類の呼び出し方を扱えるもの)
  • t (ミニバッファ)
  • nil (standard-input)
  • symbol (関数定義)
• 出力
  • buffer
  • marker (バッファ内のマーカの位置)
  • function (1つの文字を引数にして呼ばれる)
  • t (エコー領域)
  • nil (standard-output)
  • symbol (関数定義)

つまりはバッファを介さないとファイル入出力ができないっぽい。

なので、open/closeでストリームを扱っているつもりになれる関数を書いてみた。

(require 'cl)

(setf *opening-stream-buffers*
      (make-hash-table))

(defmacro with-default-values (binds &rest body)
  `(progn
     ,@(mapcar
	(lambda (bind)
	  `(unless ,(first bind)
	     (setf ,(first bind) ,(second bind))))
	binds)
     ,@body))

(defun open (filename &optional direction)
  (with-default-values
   ((direction :input))
   (let ((buf (create-file-buffer filename)))
     (when (eq direction :input)
       (with-current-buffer buf
	 (insert-file-contents filename)))
     (setf (gethash buf *opening-stream-buffers*) (list direction filename))
     buf)))

(defun close (buf)
  (when (eq (first (gethash buf *opening-stream-buffers*))
	    :output)
    (with-current-buffer buf
      (write-region
       (point-min) (point-max)
       (second (gethash buf *opening-stream-buffers*))))
    (kill-buffer buf)))