ネストしたquasiquoteの悪夢

S式 -> Cのトランスレータを書こうと前々から思っていじってはいるが、結局うまい方法を思いつけずに挫折ということを繰り返している。

今の考えはマクロ -> make-instance -> emitという流れにしようというもの。とりあえずマクロとオブジェクトの定義部分を書こうとして、自分でも理解しきれないネストしたquasiquoteを書いたのでネタとして載せておく。

myパッケージは自分の使うOn LispやANSI Common Lispその他から拝借した関数などをまとめたパッケージ。

(cl:defpackage :trans
  (:import-from :common-lisp &optional &rest &body &key))

(in-package :trans)

(cl:defun remove-lambda-keywords (lst)
  (cl:mapcar
   #'(cl:lambda (x)
       (cl:car (my:mklist x)))
   (cl:remove-if
    #'(cl:lambda (x) (cl:member x '(&body &optional &key &rest)))
    lst)))

(cl:defun make-accessor-sym (sym)
  (my:symb sym "-OF"))

(cl:defun make-keyword (sym)
  (cl:intern (my:mkstr sym) :keyword))

(cl:defun make-slot (arg)
  `(,arg :accessor ,(make-accessor-sym arg)
	 :initarg ,(make-keyword arg)
	 :initform cl:nil))

;;引数のデフォルト値はnil
(cl:defmacro define-c-class (name (&rest args))
  (cl:let ((args-symbols (remove-lambda-keywords args)))
  `(cl:progn
     (cl:defclass ,name ()
       ,(cl:mapcar #'make-slot args-symbols))
     (cl:defmacro ,name (,@args)
       `(cl:make-instance
	 ',',name
	 ,,@(cl:mapcan
	    #'(cl:lambda (arg)
		`(,(make-keyword arg)
		   (cl:if (cl:listp ,arg)
			   `(list ,@,arg)
			   ,arg)))
	    args-symbols))))))


(define-c-class if (test then &optional else))
(define-c-class block (&body body))
(define-c-class for (init test update &body body))

リーダマクロでlambdaを短縮する

Clojureでは無名関数を作るために用いるのは、lambdaでは無くfnという特殊式なため Common Lispより3文字短い。3文字程度なら良いのだけど、Clojureにはさらに無名関数のためのリーダマクロが用意されている。

;;この式が
#(list %1 %2)

;;こうなる(イメージ)
(fn [%1 %2] (list %1 %2))

Clojureに心引かれる箇所は色々あるけれど、このリーダマクロなら多少は自分で書いてみることができるのでは無いかと思ったので、試しに書いてみた。

展開されるようにした。また、引数は%nではなく$nで表現した。

(defun dollar-symbol-p (sym)
  (and (symbolp sym) (char= #\$ (char (symbol-name sym) 0))))

(defun dollar-symbol-index (sym)
  (and (dollar-symbol-p sym)
       (parse-integer
	(symbol-name sym)
	:start 1 :junk-allowed t)))

(defun short-lambda-reader (stream ch1 ch2)
  (declare (ignore ch1 ch2))
  (let* ((body  (read-delimited-list #\} stream t))
	 (dollars (remove-if-not #'dollar-symbol-p (my:flatten body)))
	 (rest-p (find "$R" dollars :test #'string= :key #'symbol-name))
	 (largest
	  (apply #'max (or (remove nil (mapcar #'dollar-symbol-index dollars))
			   '(0)))))
    (let ((args (loop :for i from 1 to largest
		   :collect (my:symb "$" i))))
      `(lambda ,(if rest-p
		    `(,@args &rest ,rest-p)
		    `(,@args))
	 ,@body))))

(defun enable-short-lambda-reader ()
  (set-macro-character #\} (get-macro-character #\)))
  (set-dispatch-macro-character #\# #\{ #'short-lambda-reader))

(enable-short-lambda-reader)

;;example
;;$1が第1引数を表す。$rは$nの中で最大のもの以降の残りの要素に束縛される。
(#{(list $1 $2 $4 $r)} 1 2 3 4 5 6)
=> (1 2 4 (5 6))

'#{(list $1 $2 $4 $r)}
=> (LAMBDA ($1 $2 $3 $4 &REST $R) (LIST $1 $2 $4 $R))

(remove-if #{(member $1 '(a b c))} '(a b c d e f g))
=>(D E F G)

(#{(mapcar #{(print $1) (mod $1 2)} (remove-if-not #'numberp $1))}
	    '(a b 1 2 3 4 f "hoge"))
1
2
3
4
=>(1 0 1 0)

うーん、結構見づらいような。 1つの式のみ書けるようにして、#{list $1}としたほうが見やすいかもしれない。

Clojure on AndroidでAlertDialog

Xperiaを買ったのでClojure on Androidで遊ぼうとしている。

JavaもClojureもAndroidも素人なのでいろんなとこで時間をくってるが、とりあえずボタンクリックでAlertDialogを表示するところまでいった。

(ns org.example.Test.AlertDialog
(:gen-class
 :extends android.app.Activity
 :implements (android.view.View$OnClickListener)
 :exposes-methods {onCreate superOnCreate}))

(import '(android.app AlertDialog)
 '(android.util Log))

(defn -onCreate [this #^android.os.Bundle bundle]
  (.superOnCreate this bundle)
  (.setContentView this org.example.Test.R$layout/main)
  (let [btn (.findViewById this org.example.Test.R$id/Btn1)]
    (Log/d "tag" (str "this is log:" (.toString btn)))
    (.setOnClickListener btn this)))

(defn -onClick [this view]
 (Log/d "tag" "this is log2:" view)
 (let [al (new android.app.AlertDialog$Builder this)]
   (doto al
     (.setTitle "AlertDialog!")
     (.setMessage "hoge!")
     (.setCancelable true))
   (.. al create show)))

Btn1はres/layout/main.xml中でandroid:id="@+id/Btn1"と定義したボタン。

ログの出力はandroid.util.Logクラスのstaticメソッドで行える。

ネストクラス(クラスの中で定義されたクラスなど)は/ではなく$で参照するらしい。

悪い例) android.app.AlertDialog.Builder
悪い例) android.app.AlertDialog/Builder
良い例) android.app.AlertDialog$Builder

自宅にある日本酒リスト(2010/03/30)

現在自宅にある日本酒一覧

• 九頭龍 大吟醸燗酒 (黒龍酒造株式会社/福井)
• 梵 特醸(磨き5割8分) (加藤吉平商店/福井)
• いづみ橋 とんぼラベル1号 (泉橋酒造株式会社/神奈川)
• 田ゆう 純米 (泉橋酒造株式会社/神奈川)
• 溪 純米吟醸 本生 (王祿酒造株式会社/島根)
• 溪 純米吟醸 にごり (王祿酒造株式会社/島根)
• 雪吟 吟醸純米生貯蔵酒 (桃川株式会社/青森)

九頭龍、いづみ橋、田ゆうは川崎の「地酒や たけくま酒店」にて購入。

溪は父親がどこからか購入してきた。

雪吟は大学の卒業式(学位授与式)後に後輩にもらった。

梵は大学の友人にもらった。

田ゆうは神奈川県海老名市にある泉橋酒造で作られたものだが、使用している米は川崎で取れたものとのこと。

ClojureでTwitter

Clojureの練習がてらTwitterクライアントの作成を目指す。

取り合えず、タイムラインを取得してJTableで表示してみた。

(require 'clojure.contrib.http.agent)
(import java.net.URLEncoder sun.misc.BASE64Encoder)
(import '(javax.swing.table AbstractTableModel))

(def status-list (atom []))

(defn seq->map [seq]
  (reduce
   (fn [map [key val]]
     (assoc map key val))
   {}
   seq))

(defn basic-authentication [id pass]
  (str "Basic "
       (.encode (BASE64Encoder.)
		(.getBytes (str id ":" pass)))))

(defn xml-request
    ([uri] (xml-request uri {}))
    ([uri headers]
     (clojure.xml/parse
      (clojure.contrib.http.agent/stream
       (clojure.contrib.http.agent/http-agent
	uri
	:headers headers)))))

(defn xml-request-with-auth
    ([uri auth] (xml-request-with-auth uri auth {}))
  ([uri auth headers]
   (xml-request
    uri
    (merge headers {"Authorization" auth} ))))

(defn collect-from-status [{tag :tag content :content :as status} & tags]
  (filter
   (fn [st] (some #(= % (:tag st)) tags))
   content))

(defn collect-default-elements [status]
  (seq->map
   (map
    (fn [st] [(:tag st) (first (:content st))])
    (concat
     (collect-from-status
      status
      :text
      :created_at
      :id
      :in_reply_to_status_id)
     (collect-from-status
      (first (collect-from-status status :user))
      :name
      :screen_name
      :profile_image_url
      :location
      :description)))))

;;例："Sun Mar 28 00:18:31 +0000 2010"
(defn time->number [time-str]
  (let [[week month day hour minitu sec _ year]
	(re-seq #"\w+" time-str)
	m-num
	 ({"Jan" 1, "Feb" 2, "Mar" 3, "Apr" 4, "May" 5,
		 "Jun" 6, "Jul" 7, "Aug" 8, "Sep" 9,  "Oct" 10,
		 "Nov" 11, "Dec" 12}
	  month)]
    (+
     (* (Integer/parseInt year) 10000000000)
     (* m-num 100000000)
     (* (Integer/parseInt day) 1000000)
     (* (Integer/parseInt hour) 10000)
     (* (Integer/parseInt minitu) 100)
     (Integer/parseInt sec))))

(defn sort-status-list [statuses]
  (sort #(> (time->number (:created_at %1)) (time->number (:created_at %2)))
	(map collect-default-elements statuses)))

(defn update-timeline [statuses id pass]
  (let [since-id (:id (first @statuses))]
    (reset! statuses
	    (concat
	     (sort-status-list
	      (:content
	       (xml-request-with-auth
	       (if (nil? since-id)
		    "http://twitter.com/statuses/home_timeline.xml"
		    (str
		     "http://twitter.com/statuses/home_timeline.xml?"
		     since-id))
		(basic-authentication id pass)
		{})))
	     @statuses))))

(defn model [column-names statuses]
  (proxy [AbstractTableModel] []
	 (getRowCount [] (count @statuses))
	 (getValueAt [row col]
		     (if (= col 0)
			 (:screen_name (nth @statuses row))
			 (:text (nth @statuses row))))
	 (getColumnName [c](print (nth column-names c))
			(nth column-names c))
	 (getColumnCount []
			 (count column-names))
	 (isCellEditable [r c] false)))

;;atomであるstatus-listの内容を表示する
(defn run []
  (let [f (javax.swing.JFrame. "Test")
	m (model  ["name" "本文"] status-list)
	tbl (javax.swing.JTable. m)]
    (doto f
	  (.setSize 300 300)
	  (.setVisible true))
    (doto tbl
	  (.setVisible true))
    (.. f getContentPane
	(add (new javax.swing.JScrollPane tbl)))))

;;(update-timeline status-list "id" "pass")
;;(run)

Clojure始めました2

Clojureをさわり始めたので、メモ。

;;空白文字が入る箇所に,(カンマ)を入れても良い。

;;rangeは[end] [start end] [start end step]の3パターンで利用できる.
;;start(デフォルトは0)からstep(デフォルトは0)ずつend未満の値を集める
(print (range 0 10))
|(0 1 2 3 4 5 6 7 8 9)
(print (range 0 10 2))
|(2 4 6 8)

;;mapはシーケンスの各要素を引数として関数を呼び出した結果を集めて返す。
;;無名関数はfnで作成できるが、省略記法として#(hoge %)のように
;;作成することもできる。この時、%は第1引数を、%nは第n引数を表す。
(map #(* % %) (range 10))

;;同様の処理はforでは以下のように書ける。
;;forはループではなくリスト内包表記というらしい。
;;CLと違い、forやlet,defnなどで変数束縛や仮引数を書く場所は
;;丸括弧()ではなく角括弧[]で括る。
(for [x (range 10)] (* x x))
->(0 1 4 9 16 25 36 49 64 81)

;;forにはwhenやwhileなどのキーワードを指定して式を評価する条件を与える
;;ことができる。
;;whenは条件が真の場合のみ本体を評価して値を集める。
;;whileは条件が真の間本体を評価して値を集め、条件が偽になった時点で終了する。
(for [x (range 10) :when (odd? x)] x)
->(1 3 5 7 9)
(for [x (range 10) :while (< x 5)] x)
(0 1 2 3 4)

;;forにキーワードwhenを与えた場合と同じような動作はfilterで行える。
(filter odd? (range 10))
->(1 3 5 7 9)

;;forは変数束縛(?)を複数指定出来る。
;;並行に束縛されるのではなく、多重ループのような順序で束縛される。
;;後ろに書いた変数ほど先に束縛が繰り返される。
(for [x "abc" y "ABC"] (str x y))
->("aA" "aB" "aC" "bA" "bB" "bC" "cA" "cB" "cC")

;;Scheme等でネタにされた'Lisp脳'的FizzBuzzは以下のように書ける。
;;condはCLなどと異なり、条件式と真の時の動作を括弧では括らず順番に書く。
;;:elseの箇所は偽以外ならなんでも良いと思う。
;;(rem a b)はa/bの余りを返す。remainderの略だと思う。
(defn fizzbuzz []
  (map
   #(cond
     (zero? (rem % 15)) "FizzBuzz"
     (zero? (rem % 5)) "Buzz"
     (zero? (rem % 3)) "Fizz"
     :else %)
   (range 1 31)))

;;シーケンスは遅延評価されるため無限長のシーケンスを扱える。
;;takeでシーケンスの要素を先頭から指定した個数分取り出せる。
;;シーケンスは変更不可能なので、シーケンスに対する処理を行うと新しいシーケンスが作られている。
;;リストのように丸括弧で表示されていても、シーケンス操作の返り値の実際のクラスはシーケンスである。
'(1)
->(1)
(class '(1))
->clojure.lang.PersistentList
(map (fn [x] x) '(1))
->(1)
(class (map (fn [x] x) '(1)))
->clojure.lang.LazySeq

;;マップ(hash-map)はキーと値のペアを並べたもの。
;;関数として扱うこともでき、その場合は引数にキーを取り、対応する値を返す。
({1 2 3 4 5 6} 3)
->4

;;キーワードは、マップからそのキーワードに対する値を取り出す関数でもある。
(:a {:a 2 :b 3})
->2

;;ベクタも関数として扱うことができ、その場合は引数にインデックスを取る。
([1 2 3] 0)
->1

;;関数定義にはdefnを用いる。
;;mapcatはCLのmapcanのように各要素に関数を適用した後のリストを
;;つなげ合わせて返すようだ。
(defn flatten [tree]
  (mapcat
   #(if (list? %)
     (flatten %)
     (list %))
   tree))

(flatten '(1 2 (3 4)))
->(1 2 3 4)

;;リスト(というかシーケンス)の長さを返すにはcountを用いる。
;;自前で実装すると、例えば以下のようになる。
;;CLでは両方あるけれど、Clojureにはcar/cdrは存在せず、first/restのみ利用できる。
;;また、nilは空リストでは無いので気をつける。ex) (nil? ()) => false
(defn length [lst]
  (if (empty? lst)
      0
      (+ 1 (length (rest lst)))))

;;ClojureではJavaの仕様上末尾再帰を最適化しないらしい。
;;かわりにrecurを利用すると関数の初め(またはloop)に飛ぶ。
;;相互再帰はtrampolineで行える。
;;末尾再帰よりも遅延シーケンスを利用するのがClojure流らしい。
;;関数は引数の個数によって動作を変える事が出来る。
;;仮引数と関数本体を括弧で括ったものを列挙すれば良い。
(defn length-tail
    ([lst] (length-tail lst 0))
  ([lst acc]
   (if (empty? lst)
       acc
       (recur (rest lst) (+ 1 acc)))))

Clojure始めました

土曜日(3/20)にShibuya.lisp#5に参加した。残念ながら予定があったので懇親会は不参加。

毎度のことながらTT、LTの発表は濃かったりおもしろかったりで素晴らしかったですが、どうも今回はClojure祭り状態のようで、Lisperを目指しているくせに1度も触ったことのない私は精神的ダメージを負うことになったのでした。

会場にオーム社の方々(らしい)が来ており、商魂たくましく(?)会場で書籍の販売を行っている中に狙いすましたかのように「プログラミングClojure」が置いてあったのでついうっかり購入してしまった。

ということで、書籍を読みつつLispの最先端たるClojureを書いてみようと思う。

Emacs使いたるもの、設定をせずにプログラミングを始めるというのはおそらくありえないので、 clojure-modeとswank-clojureの導入を行おうとした。

clojure-contribのコンパイルに、書籍の内容と異なり antではなくmavenというツールを使ったり、各所の解説でrequireしている swank-clojure-autoload.elなんてファイルが存在しなかったりしてだいぶ時間がかかった。

swank-clojure-autoloadの内容をググって調べ、slime-lisp-implementationsの設定にそれっぽい記述をすることで一応動くようになった。

(setq slime-lisp-implementations
      `((sbcl
	 ("/usr/local/bin/sbcl"
	  "--core" "/home/kurohuku/emacslib/sbcl.core-with-swank")
	 :init (lambda (port-file _)
		 (format "(progn
(load \"/home/kurohuku/emacslib/util.lisp\")
(setf swank::*coding-system* \"utf-8-unix\")
(swank:start-server %S))\n" port-file))
	 :coding-system utf-8-unix)
(clojure
 ,(swank-clojure-cmd)
 :init swank-clojure-init)
))

ググってたらClojureでクラスパスを表示する方法を見つけた。便利そうなのでメモっておく。

(println
 (seq
   (.getURLs (java.lang.ClassLoader/getSystemClassLoader))))