Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2009-11-29

KMRCLを眺める (26) deflex

| 19:00 | KMRCLを眺める (26) deflex - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (26) deflex - わだばLisperになる

今回は、KMRCLのmacros.lispの中からDEFLEXです。

Common Lispにはグローバルな(トップレベルの)レキシカル変数というものがないのですが、DEFLEXは、それの動きを模倣するためのマクロです。

From USENETとなっていますが、調べてみるとRob Warnockさん作のようです。

;; From USENET
(defmacro deflex (var val &optional (doc nil docp))
  "Defines a top level (global) lexical VAR with initial value VAL,
      which is assigned unconditionally as with DEFPARAMETER. If a DOC
      string is provided, it is attached to both the name |VAR| and the
      name *STORAGE-FOR-DEFLEX-VAR-|VAR|* as a documentation string of
      kind 'VARIABLE. The new VAR will have lexical scope and thus may
      be shadowed by LET bindings without affecting its global value."
  (let* ((s0 (load-time-value (symbol-name '#:*storage-for-deflex-var-)))
         (s1 (symbol-name var))
         (p1 (symbol-package var))
         (s2 (load-time-value (symbol-name '#:*)))
         (backing-var (intern (concatenate 'string s0 s1 s2) p1)))
    `(progn
      (defparameter ,backing-var ,val ,@(when docp `(,doc)))
      ,@(when docp
              `((setf (documentation ',var 'variable) ,doc)))
      (define-symbol-macro ,var ,backing-var))))

という定義で分かるように、*STORAGE-FOR-DEFLEX-VAR-|VAR|*の値をシンボルマクロで包んでいますが、シンボルマクロで包むのと包まないのでは、

(DEFLEX /FOO/ 33) ;*STORAGE-FOR-DEFLEX-VAR-/FOO/*も33

(LET ((FN (LET ((/FOO/ 44))
            (LAMBDA ()
              /FOO/))))
  (LET ((/FOO/ 55))
    (FUNCALL FN)))
;⇒ 44

(LET ((FN (LET ((*STORAGE-FOR-DEFLEX-VAR-/FOO/* 44))
            (LAMBDA () *STORAGE-FOR-DEFLEX-VAR-/FOO/*))))
  (LET ((*STORAGE-FOR-DEFLEX-VAR-/FOO/* 55))
    (FUNCALL FN)))
;⇒ 55

のように動作が変わってきます。

ところで、

(load-time-value (symbol-name '#:*storage-for-deflex-var-))

という風にLOAD-TIME-VALUEしている意図が分からないのですが、理由が分かる方是非とも教えてください。

普通に

(intern (concatenate 'string "*STORAGE-FOR-DEFLEX-VAR-" s1 "*") p1)

じゃ駄目なんでしょうか…。