LISPUSER

LISPMEMOLisp is a programmable programming language. -- John Foderaro

(top)  (memo)  (rss)

On Lisp でハマるところ トップレベルでレキシカルスコープな変数を定義する

flatline さんとこの On Lisp ネタに反応。

http://d.hatena.ne.jp/flappphys/20070324#p1

サークルの先輩から「なんかどのLispも動的スコープだと思っている人が多くない?」と指摘を受ける.

ELispは最初から動的スコープ.

Schemeは静的スコープで有名である.動的スコープの実現はライブラリによる方針を取っている.SRFIに(割と歴史の古い)fluid-letが提案されたものの取り消され,現在 "parameter" 系が標準になっているらしい.マルチスレッドとの相性が肝のようだ.

Common Lispも基本は静的スコープだが,動的スコープも仕様に組み込まれている.defparameter等のオペレータで定義した変数は動的スコープになる(special variable, dynamic variable)し,ローカル変数はdynamic-extentとしてdeclareすれば動的スコープに変更できる.

しかし「トップレベルで静的スコープの変数を作るにはどうするの?」これが分からない.できないんじゃね?

どこかで見たような話題ですね。みんな引っかかっているような気が。 On Lisp の継続のところでこれでハマった記憶がありますねー。 たしかに defvar は変数を special 宣言しちゃうのでスペシャル変数しかできないです。 ANSI Common Lisp でトップレベルのレキシカルスコープ変数を実現するにはコレ。

;; lexical
(defvar *actual-cont* #'values)
(define-symbol-macro =cont= *actual-cont*)

シンボルマクロは special じゃないので、これで擬似的にトップレベルの静的スコープが実現できます(もちろん変数名のキャプチャには注意しましょう。どうしても嫌なら gensym を使ってもいいかも)。あと、 ``*`` で囲んだ変数名はスペシャル変数につけるものと相場が決まっているので、ここでは cont の変数名を変更しています。

元ネタを探したら c.l.l のスレッド が見つかりました。Google は便利だなぁ…。

とかいってるうちに Shiro さんから回答がでてましたね。 でもまぁ、こっちの方法も今流行の SBCL でも警告がでないという利点があるので載せておきます。

defvar は大抵 special 宣言 + setq みたいな実装になっています

   ;; GNU CLISP より抜粋
   (defmacro defvar (&whole whole-form
                   symbol &optional (initial-value nil svar) docstring)
     (unless (symbolp symbol)
       (error-of-type 'source-program-error
         :form whole-form
         :detail symbol
         (TEXT "~S: non-symbol ~S cannot be a variable")
         'defvar symbol))
     (if (constantp symbol)
       (error-of-type 'source-program-error
         :form whole-form
         :detail symbol
         (TEXT "~S: the constant ~S must not be redefined to be a variable")
         'defvar symbol))
     `(LET ()
        (PROCLAIM '(SPECIAL ,symbol)) ;; (proclaim (special ...))
        ,@(if svar
            `((UNLESS (BOUNDP ',symbol)
                (SYS::SET-SYMBOL-VALUE ',symbol ,initial-value))))
        ,@(if docstring
              `((SYS::%SET-DOCUMENTATION ',symbol 'VARIABLE ',docstring)))
        ',symbol))
 ;; SBCL より抜粋
 (defmacro-mundanely defparameter (var val &optional (doc nil docp))
   #!+sb-doc
   "Define a parameter that is not normally changed by the program,
   but that may be changed without causing an error. Declare the
   variable special and sets its value to VAL, overwriting any
   previous value. The third argument is an optional documentation
   string for the parameter."
   `(progn
      (eval-when (:compile-toplevel)
        (%compiler-defvar ',var))  ;; (proclaim (special ...))
      (eval-when (:load-toplevel :execute)
        (%defparameter ',var ,val ,doc ',docp (sb!c:source-location)))))
 
 (defun %compiler-defvar (var)
   (sb!xc:proclaim `(special ,var)))

というわけで、トップレベルにレキシカルスコープな変数を導入するマクロを用意します。

(defmacro =defvar (name value)
  (let (($symbol (gensym)))
    `(progn
       (defparameter ,$symbol ,value)
       (define-symbol-macro ,name ,$symbol))))

道具立てもこんな感じにちょっといじります。 変更点は、命名規則の変更 ( *cont* だとスペシャル変数っぽいので ) と、 =defun=cont= を使わない可能性があるので コンパイラにそのように指示を追加しました。あと、ANSI CL だと restart というシンボルも当たるので別名にしてあります。

(defmacro =lambda (parms &body body)
  `#'(lambda (=cont= ,@parms) ,@body))
     
(defmacro =defun (name parms &body body)
  (let ((f (intern (concatenate 'string
                                "=" (symbol-name name)))))
    `(progn
       (defmacro ,name ,parms
         `(,',f =cont= ,,@parms))
       (defun ,f (=cont= ,@parms)
         (declare (ignorable =cont=))
         ,@body))))

(defmacro =bind (parms expr &body body)
  `(let ((=cont= #'(lambda ,parms ,@body))) ,expr))
     
(defmacro =values (&rest retvals)
  `(funcall =cont= ,@retvals))
     
(defmacro =funcall (fn &rest args)
  `(funcall ,fn =cont= ,@args))
     
(defmacro =apply (fn &rest args)
  `(apply ,fn =cont= ,@args))

んでは道具が揃ったところで継続ベースの深さ優先探索と幅優先探索をやってみましょう。

(=defvar =saved= nil)

(=defun =restart ()
  (if =saved=
      (funcall (pop =saved=))
      (=values 'done)))

(=defun dft-node (tree)
  (cond ((null tree) (=restart))
        ((atom tree) (=values tree))
        (t
         (push #'(lambda () (dft-node (cdr tree))) =saved=)
         (dft-node (car tree)))))

(=defun bft-node (tree)
  (cond ((null tree) (=restart))
        ((atom tree) (=values tree))
        (t
         (setf =saved= (nconc =saved= (list #'(lambda () (bft-node (car tree))) )))
         (bft-node (cdr tree)))))

(=defun dft2 (tree)
  (setf =saved= nil)
  (=bind (node) (dft-node tree)
    (cond ((eq node 'done) (=values nil))
          (t (princ node)
             (=restart)))))

(=defun bft2 (tree)
  (setf =saved= nil)
  (=bind (node) (bft-node tree)
    (cond ((eq node 'done) (=values nil))
          (t (princ node)
             (=restart)))))

(=defun dft-query (tree)
  (=bind (node) (dft-node tree)
    (if (eq node 'done)
        'done
        node)))

(=defun bft-query (tree)
  (=bind (node) (bft-node tree)
    (if (eq node 'done)
        'done
        node)))

上記のコードをロードして、あとは REPL で試します。

CL-USER> (dft2 '(1 (A B) (C ((D))) 2 (E F)))
1ABCD2EF
NIL
CL-USER> (bft2 '(1 (A B) (C ((D))) 2 (E F)))
12ABCEFD
DONE

トップレベルといったりきたりしてみます。

CL-USER> (dft-query '(1 (A B) (C ((D))) 2 (E F)))
1
CL-USER> (=restart)
A
CL-USER> (=restart)
B
CL-USER> (=restart)
C
CL-USER> (=restart)
D
CL-USER> (=restart)
2
CL-USER> (=restart)
E
CL-USER> (=restart)
F
CL-USER> (=restart)
DONE
CL-USER> (bft-query '(1 (A B) (C ((D))) 2 (E F)))
1
CL-USER> (=restart)
2
CL-USER> (=restart)
A
CL-USER> (=restart)
B
CL-USER> (=restart)
C
CL-USER> (=restart)
E
CL-USER> (=restart)
F
CL-USER> (=restart)
D
CL-USER> (=restart)
DONE
CL-USER> 

これで SBCL でも気持ちよく On Lisp できますね。 Happy Hacking !

posted: 2007/03/31 23:26 | permanent link to this entry | Tags: LISP

(top)  (memo)  (rss)