newLISP で On Lisp する．．．第１４章（その１）

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

　第１４章 アナフォリックマクロ です。
　V.10.0以降の newLISP では、setf などで使えるアナフォリックなシステム変数 $it が導入されています。

　まずは、Common Lisp の標準オペレータのアナフォリックな変種 から、
（third は、newlisp-utility.lsp で定義してあります。）

(define-macro (aif)
; (aif test-form then-form &optional else-form)
  (letex (_test-form (args 0)
          _then-form (args 1)
          _else-form (third (args)))
    (let (it _test-form)
      (if it _then-form _else-form))))

　上記マクロ aif は、“On Lisp”本書に沿ったマクロです。
　しかし、newlisp-utility.lsp には、macro の aif が定義されています。

(module "macro.lsp")
(macro (aif S A B)
  (let (it S) 
    (if it A B))))

　どちらを使っても、結果は同じですが、どちらか一方しか使えません。ご注意を。
　お薦めは、macro の aif です（笑）。
　さて、このマクロを使えば、組込find で find-if がすっきり書けます（defun は、newlisp-utility.lsp に定義してあります）。

(defun find-if (func lst)
  (aif (find nil lst (fn (x y) (func y)))
       (lst it)))

　動作は（oddp は、newlisp-utility.lsp に定義してあります）、

> (find-if oddp '(2 3 4))
3
> 

　もちろん、次のマクロ

(define-macro (awhen)
; (awhen test-form &body body)
  (letex (_test-form (args 0)
          _body (cons 'begin (1 (args))))
    (aif _test-form _body)))

　を使って

(defun find-if (func lst)
  (awhen (find nil lst (fn (x y) (func y)))
       (lst it)))

　でもかまいません。
　マクロawhile には、do ではなくnewLISP の組込while を使います。

(define-macro (awhile)
; (awhile expr &body body)
  (letex (_expr (args 0)
          _body (cons 'begin (1 (args))))
    (while (setq it _expr)
      _body)))

　使い方はというと、

> (let (x '(apple orange melon)) (awhile (pop x) (print "eat ") (println it) ) x)
eat apple
eat orange
eat melon
()

　そして、マクロaand は、

(define-macro (aand)
; (aand  &rest args)
  (if (args)
      (letex (_len  (length (args))
              _1st  (args 0)
              _rest (cons 'aand (1 (args))))
        (cond ;((zero? _len) nil) 
              ((= _len 1) _1st)
              (true (aif _1st _rest))))
    true)
)

　前の“On newLISP”の頃、newLISP組込の and は、引数無しで nil を返しましたが、現在では、Common Lisp と同じ、真（true）を返します。
　さて、動作は( lookup は、newLISPでは、組込です）、

> [cmd]
(setq person '((marry ((Address ((City NewYork) (Street "123 Main Street")))(Job "Engineer")))
               (john  ((Address ((City Chicago) (Street "124 Main Street")))(Job "Desinger")))))
[/cmd]
((marry ((Address ((City NewYork) (Street "123 Main Street"))) (Job "Engineer"))) 
 (john ((Address ((City Chicago) (Street "124 Main Street"))) (Job "Desinger"))))
> (aand (lookup 'marry person) (lookup 'Address it) (lookup 'City it))
NewYork
> (aand (lookup 'marry person) (lookup 'Address it) (lookup 'Street it))
"123 Main Street"
> (aand (lookup 'john person) (lookup 'Address it))
((City Chicago) (Street "124 Main Street"))
> (aand (lookup 'john person) (lookup 'Job it))
"Desinger"
> 

　そして、マクロacond は、再帰的にマクロを呼び出しています。

(define-macro (acond)
; (acond &rest clauses)
  (if (null? (args))
      nil
    (letex (_cl1st  (args 0 0)
            _clrest (cons 'begin (1 (args 0)))
            _acondrest (cons 'acond (1 (args))) 
            _sym (gensym))　
      (let (_sym _cl1st)
        (if _sym
            (let (it _sym) _clrest)
          _acondrest)))))

　さらなるアナフォリックなオペレータ からは、（labels は、newlisp-utility.lsp に定義してあります）

(define-macro (alambda)
; (alambda parms &body body)
  (letex (_funcbody (append '(_self) (list (args 0)) (1 (args))))
    (labels (_funcbody)
      _self)))

　現在の newLISP では、self は 組込関数なので、変数_self とアンダースコアを付けてあります。
　それを除けは、マクロlabels があるので、実装は簡単です（i- は、newlisp-utility.lsp に定義してあります） 。

> ((alambda (x) (if (= x 0) 1 (* x (_self (i- x))))) 3)
6
> 

　“On Lisp”本書の例count-instances を定義すると、

(defun count-instances (obj lists)
  (map (alambda (lst)
         (if lst
             (+ (if (= (first lst) obj) 1 0)
                (_self (rest lst)))
           0))
         lists))

　そして、動作は、

> (count-instances 'a '((a b c) (d a r p a) (d a r) (a a)))
(1 2 1 2)

　さて、newLISPには、block も return もないので、ablock の代わりに、abegin を定義します（笑）。

(define-macro (abegin)
; (abegin &rest args)
  (letex (_args (args))
    ((alambda (exprs)
      (case (length exprs)
        (0 nil)
        (1 (eval (first exprs)))
        (t (let (it (eval (first exprs)))
             (_self (rest exprs))))))
     '_args)))

　ポイントは、最後の行のクォート（’）。
　いかにも命令型の例（笑）を、

> [cmd]
(abegin 
    (println "ho ")
    (println (string it 1 ))
    (println (string it 2 )) 
    (println (string it 3 ))
    nil)
[/cmd]
ho 
ho 1
ho 12
ho 123
nil
> 

　失敗 からは、次回のお楽しみ（笑）。

　以上、如何でしょうか？