Archive for the ‘get’ Tag

newLISP で On Lisp する...第16章(その1)

(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsponnewlisp.lsp に定義してあります。)

 第16章 マクロを定義するマクロ の始まりです。今回は、省略属性 を実装します。

 先ずは、省略 から。

(define addrev define)
(define addrevs setq)

 “On Lisp” 本書のマクロaddrev は、newLISPでは、マクロの必要がありません。define が使えますから(楽)。しかも、マクロaddrevs でさえ、マクロの必要がありません。マクロaddrev も、setq としても良かったのですが(笑)。
 変数と関数が、同一名前空間にある強みです。

 そして、属性 。newLISPには 属性 がありません。ましてや、関数get もありません。だから、終わりにしても良かったのですが、context で実現してみます。
 先ずは、関数get から、(defun と reference-inversionマクロ群は newlisp-utility.lsp に定義してあります。)

(defun get (symbol indicator)
  (letex (_sym (sym indicator symbol))
    (reference-inversion:set _sym)))

 newLISP組込sym を使って、symbol 名の contex に indicator名のシンボル名を作ります。そのシンボルが予めあれば、その値が表示され、無ければ nil が返ります。 reference-inversion:set は、前回も使った newLISP でインバージョン可能な参照を実現するマクロ群の一つです。
 使い方は、

> (setf (get 'ball1 'color) 'red)
red
> (get 'ball1 'color)
nil
> 

 ただの setf では、属性が設定されません。
 しかし、

> (addrevs _r reference-inversion setfr _r:setf)
(lambda-macro () 
 (letex (reference-inversion:_body (cons 'begin (map (curry append '(reference-inversion:reference-inversion 
       setf)) 
     (explode (args) 2)))) 
  (begin 
   reference-inversion:_body)))
> (setf (get 'ball1 'color) 'red)
red
> (get 'ball1 'color)
nil
> (_r setf (get 'ball1 'color) 'red)
red
> (get 'ball1 'color)
red
> (_r:setf (get 'ball1 'color) 'yellow)
yellow
> (get 'ball1 'color)
yellow
> (setfr (get 'ball1 'color) 'blue)
blue
> (get 'ball1 'color)
blue
> 

 といった具合に、reference-inversion:setfを使えば、属性が設定されます。
 表記に (_r setf …) を使うか、(_r:setf …) あるいは、(setfr …)を使うかは、お好みで(笑)。
 そして、属性を参照するマクロです。

(define-macro (color)
; (color symbol)
  (letex (_sym (sym 'color (eval (args 0))))
    (reference-inversion:set _sym)))

 使い方は、関数get と同様、

> (color 'ball1)
yellow
> (setf (color 'ball1) 'green)
green
> (color 'ball1)
yellow
> (_r:setf (color 'ball1) 'green)
green
> (color 'ball1)
green
> 

 reference-inversionマクロ群を使って、インバージョン可能なマクロになっています。
 アクセス用マクロの自動定義 は、こうなります。

(define-macro (propmacro propname)
  (letex (_propname propname)
    (setq _propname (lambda-macro ()
      (letex (_sym (sym '_propname (eval (args 0))))
        (reference-inversion:set _sym))))))

(define-macro (propmacros)
  (letex (_pair (cons 'begin (map (curry cons 'propmacro) (explode (args)))))
    _pair))

 動作は、

> color
(lambda-macro () 
 (letex (_sym (sym 'color (eval (args 0)))) (reference-inversion:set _sym)))
> (propmacros size color)
(lambda-macro () 
 (letex (_sym (sym 'color (eval (args 0)))) (reference-inversion:set _sym)))
> color
(lambda-macro () 
 (letex (_sym (sym 'color (eval (args 0)))) (reference-inversion:set _sym)))
> size
(lambda-macro () 
 (letex (_sym (sym 'size (eval (args 0)))) (reference-inversion:set _sym)))
> 

 どちらで定義しても同じです。

 アナフォリックマクロ は次回に。

 以上、如何でしょうか?

newLISP で On Lisp する。。。第2章(その2)

(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。)
前回に引き続いて On Lisp 第2章 関数
今回は、属性としての関数 からです。のっけから難物です(笑)。
case 文は、newLISPでも使えます。defun に newlisp-utility.lspのマクロを使えば、本文通り記述できます。

(defun behave (animal)
  (case animal
    (dog (wag-tail)
         (bark))
    (rat (scurry)
         (squeak))
    (cat (rub-legs)
         (scratch-carpet))))

試しに、wag-tail と bark を定義して試すと、

> (defun wag-tail ()  (print "wag-tail "))
(lambda () (print "wag-tail "))
> (defun bark ()  (print "bark "))
(lambda () (print "bark "))
> (behave 'dog)
wag-tail bark "bark " 

となります。ここまでは良いのですが、残念ながら、newLISPには属性はありません。したがって、属性を使った関数behave は、定義できません。
とはいっても、それで終わらないのが、newLISPです。
そう、newLISPには context があります。context を使えば、同様の実装ができます。

> (new 'Tree 'dog)
dog
> (dog "behavior" (fn () (wag-tail) (bark)))
(lambda () (wag-tail) (bark))
> (dog "behavior")
(lambda () (wag-tail) (bark)) 

前に紹介した context の使い方です。このように、関数もセットできます。前回見たように関数をデータオブジェクトとして扱えるのですから当然ですね。関数の呼び出しに、funcall は要りません。

> ((dog "behavior"))
wag-tail bark "bark " 

ということで、Common Lisp の属性を使った behave は、newLISP では context を使って、こうなります。

(defun behave (animal)
  ((animal "behavior")))

setf も使えます。

> (setf (dog "behavior") (fn () (wag-tail)))
(lambda () (wag-tail)) 
> (dog "behavior")
(lambda () (wag-tail)) 

context を予め定義する必要があるとか、キーとなるシンボルに "" を付ける(文字列として与える)必要があるとか、違いはありますが、気になるなら、マクロを組めばよいことですよね(笑)。
では、Common Lisp のように関数get を用意してみましょう。

(define-macro (get)
  (letex (_ctx (context (args 0))
          _key (term (args 1)))
    (_ctx _key)))

こんな感じでしょうか?
動作はというと

> (dog "behavior" (fn () (wag-tail) (bark)))
(lambda () (wag-tail) (bark))
> (get dog behavior)
(lambda () (wag-tail) (bark))

うまく行っているようです。クォートが付いていないことは、気にしないで下さい。後で説明します。
しかし、

> (setf (get dog behavior) (lambda () (wag-tail)))
(lambda () (wag-tail))
> (get dog behavior)
(lambda () (wag-tail) (bark))

setf でうまくセットされません。Common Lisp のマクロは、マクロ展開した後、マクロを呼び出したところに戻って評価されますが、newLISP の場合は、マクロ展開した後、マクロを呼び出したところの環境を使って、マクロ内で評価されます。この違いが、ここでは致命的です。
では、newLISP では、関数get はできない?結論からいうとできます。V10.1.6 から導入されたモジュール macro.lsp を使います。

(module "macro.lsp")
(macro (getm C K)
  (C (term K)))

これで、getm を定義して、試してみると、

> (get dog behavior)
(lambda () (wag-tail) (bark))
> (getm dog 'behavior)
(lambda () (wag-tail) (bark))
> (setf (getm dog 'behavior) (lambda () (wag-tail)))
(lambda () (wag-tail))
> (getm dog 'behavior)
(lambda () (wag-tail))
> (get dog behavior)
(lambda () (wag-tail))

この通り、setf も使えます。macro は、V10.1.6 から組み込まれた reader-event を使っていて、定義した内容を newLISP インタープリタがコードを評価する前に展開します。つまり、Common Lisp のマクロのように、展開式をマクロを呼び出したところに展開し、その後評価されるわけです。
これで、前述の関数behave も、

(defun behave (animal)
  ((getm animal 'behavior)))

と定義できます。

> (behave dog)
wag-tail "wag-tail "

動作もこの通り(笑)。さて、getm と baehave の第一引数にクォートがついていません。
これは第一引数が context だからです。
Common Lisp のようにクォートを付けた引数を取る get と behave の最終スクリプトは、

(macro (get C K)
  ((eval C) (term K)))
(defun behave (animal)
  (let (f (getm animal 'behavior))
    (if f (f) ((eval animal) "behavior" '()))))

となり、動作は、

> (get 'dog 'behavior)
nil
> (behave 'dog)
()
> (get 'dog 'behavior)
()
> (setf (get 'dog 'behavior) (fn () (wag-tail) (bark)))
(lambda () (wag-tail) (bark))
> (get 'dog 'behavior)
(lambda () (wag-tail) (bark))
> (behave 'dog)
wag-tail bark "bark "

こんな感じです。
関数behave のちょっとした細工は、context を予め定義しておかない時に発生するエラーの予防です。

さて、前の“On newLISP”では定義しなかった関数 get ができたところで、残り スコープ からは次回に。

以上、如何でしょうか?