Skip to content
2011/05/28 / highmt

clojureで名前空間つきリードマクロをつくる

環境: Clojure 1.2.0

お約束ですが、やっちゃいけません。

実際、Paul Graham がリードマクロの利点のひとつとしてあげている
read が再帰的に処理される、という例
(http://www.komaba.utmc.or.jp/~flatline/onlispjhtml/readMacros.html)

user=> ''a
(quote a)

は、自分でマクロ展開すれば実現できますし、

user=> (defmacro q [form] (list 'quote (macroexpand form)))
#'user/q
user=> (q (q a))
(quote a)

ほんとうにリード時の処理が必要!ってなる場面は少ないような気がします。

ユーザー定義リードマクロが好ましくないとする理由はいろいろあるようですが、
ひとつに名前空間のサポートがない、ということがあります。
(http://clojure-log.n01se.net/date/2008-11-06.html)

ということで名前空間つきリードマクロ(namespaced reader macro)を
試みてみました。

これって cl-annot な方向なのかも…

;;;
;;; (ns rdm
;;;   (:require clojure.contrib.def))
;;;

(defn dispatch-reader-macro
  "see:
  [http://briancarper.net/blog/449/clojure-reader-macros
   http://rd.clojure-users.org/entry/view/56001]"
  [ch fun]
  (let [dm (.get (doto (.getDeclaredField clojure.lang.LispReader "dispatchMacros")
                   (.setAccessible true))
                 nil)]
    (aset dm (int ch) fun)))

(defn true-sym
  "a helper function to treat namespace aliases."
  [ns sym]
  (symbol (str (if-let [t-ns ((ns-aliases *ns*) ns)] t-ns ns))
          (str sym)))

(defn find-true-var
  "a helper function to treat var renamings."
  [sym]
  (if-let [ns (.getNamespace sym)]
    (find-var (true-sym (symbol ns)
                        (symbol (.getName sym))))
    ((ns-map *ns*) sym)))

(defn get-ns-reader-macro-fun
  "a helper function to get a var of the readermacro."
  [form]
  (cond
   (symbol? form) (find-true-var form)
   (list? form) (recur (first form))
   :else (throw (Exception. (str "read error: " form)))))

(defn get-ns-reader-macro-args
  "a helper function to get args of the readermacro."
  [form]
  (cond
   (symbol? form) nil
   (list? form) (rest form)
   :else (throw (Exception. (str "read error: " form)))))

(defn read-form
  "a helper function to read a form following the readermacro."
  [rdr]
  (clojure.lang.LispReader/read rdr true nil true))

(defn dispatch-ns-reader-macro
  "a helper function to apply a var of the readermacro to args of it."
  [rdr letter-sharp]
  (let [rmsym (read-form rdr)
        rmfun (get-ns-reader-macro-fun rmsym)
        rmargs (get-ns-reader-macro-args rmsym)]
    (if rmfun
      (apply rmfun rdr rmsym rmargs)
      (throw (Exception. (str "reader macro not defined: " rmsym))))))

(dispatch-reader-macro \# dispatch-ns-reader-macro)

(defmacro defreadermacro
  "defines the readermacro.
usage:
  ##name form
  ##(name & args) form
name can be ns/name."
  {:arglists '([name args & body])}
  [name & macro-args]
  (let [[mname# margs#] (clojure.contrib.def/name-with-attributes name macro-args)]
  `(defn ~mname# ~margs#)))


;;;
;;; client
;;;

(defreadermacro uppercase-string
  "makes string uppercase."
  [rdr sym & args]
  (let [c (.read rdr)]
    (if (= c (int \"))
      (.toUpperCase (.invoke
                     (clojure.lang.LispReader$StringReader.)
                     rdr
                     c))
      (throw (Exception. (str "read error: " (char c) args))))))
;;user> ##uppercase-string"a"
;;"A"

(defreadermacro my-quote
  "simulates quote."
  [rdr sym & args]
  (let [form (read-form rdr)]
    (list 'quote form)))
;;user> ##my-quote ##my-quote a
;;(quote a)

(defreadermacro my-wrap
  "something a little more complicated."
  [rdr sym & args]
  (let [form (read-form rdr)
        wrapper (first args)]
    (if (list? wrapper)
      `(~@wrapper ~form)
      `(~wrapper ~form))))

;;user> ##(my-wrap (let [x 1])) (+ x 1)
;;2
;;user=> (in-ns 'user2)
;;#<Namespace user2>
;;user2=> (clojure.core/refer-clojure)
;;nil
;;user2=> ##(user/my-wrap (let [x 1])) (+ x 1)
;;2
;;user2=> (alias 'user1 'user)
;;nil
;;user2=> ##(user1/my-wrap (let [x 1])) (+ x 1)
;;2
;;user2=> (refer 'user :rename {'my-wrap 'wrap})
;;nil
;;user2=> ##(wrap (let [x 1])) (+ x 1)
;;2

read-form 以外にもいろんな read-* を提供するようにすれば
(で binding で rdr 隠すとかして呼びやすくすれば)
そんなにわかりにくくない形でユーザー定義リードマクロを導入できるのかも。

ちなみに最初はリードマクロの実体にマルチメソッドを使って
varを作らないようにしていたのですが
varをつくらないと refer, rename の解決ができない
(というかそもそも refer の対象にすらならない)
ということが判明しあえなく却下。
refer ってシンボル間の関係じゃなくて var へのマッピングを追加するんだ
ということをあらためて思い知らされました。

広告

One Comment

  1. highmt / 6月 1 2011 06:40
    (defmacro q [form] (list 'quote (macroexpand form)))
    

    だとサブフォームのマクロ展開がされない問題はともかく、
    clojure.contrib.macro-utils/mexpand-all を使ったとしても

    user> (use '[clojure.contrib.macro-utils])
    nil
    user> (defmacro q2 [form] (list 'quote (mexpand-all form)))
    #'user/q2
    user> (q2 (and 1))
    1
    user> (q2 (and 1 (q2 2)))
    (let* [and__3468__auto__ 1] (if and__3468__auto__ (quote 2) and__3468__auto__))
    

    などとなって非常に具合が悪いですね。
    難しいのかな…

コメントは停止中です。

%d人のブロガーが「いいね」をつけました。