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

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

今回は、第４章 の リストに対する操作 。
リストに作用する小さな関数 は、以下のようになります。

(module "macro.lsp")
(define last1 last)
(macro (single L)
  (and L (list? L) (not (rest L))))
(macro (append1 L Obj)
  (append L (list Obj)))
(macro (conc1 L Obj)
  (extend L (list Obj)))
(macro (mklist Obj)
  (if (listp Obj) Obj (list Obj)))

newLISP に、インライン宣言はありません。
そのため、効率性のために、macro を使います（macro の日本語訳はこちら）。
macro を有効にするためにスクリプトの先頭で

(module "macro.lsp")

としていますが、前に紹介した include を使って、

(include "macro.lsp")

としておけば、二重ロードを防げます。
動作は、

> (single '())
()
> (single 'a)
nil
> (single '(a))
true
> (single '(a b))
nil
> (let (x '(1 2))(println (append1 x 3)) x)
(1 2 3)
(1 2)
> (let (x '(1 2))(println (conc1 x 3)) x)
(1 2 3)
(1 2 3)
> (let (x '(1 2))(println (append1 x 3)) x)
(1 2 3)
(1 2)

こんな感じです。
macro を使いたくない場合は、conc1 以外は、macro を define に置き換えれば、そのまま使えます。
ただし、conc1 は破壊的関数です。newLISP で破壊的関数を書くには、マクロが必要です。
macro を使いたくない場合、conc1 は、

(define-macro (conc1)
  (letex (_lst0 (args 0)
          _lst1 (args 1))
    (extend _lst0 (list _lst1))))

となります。
newLISP の組込関数last は、Common Lisp の last とは違いって、リストではなく、要素で返します。つまり、last1 と同じ。
では、Common Lisp 流の last を使いたい時は、どうするのか？
インデックス機構を使って、

> (-1 '(a b c))
(c)
> (-2 '(a b c))
(b c)
> (-3 '(a b c))
(a b c)
> (0 '(a b c))
(a b c)
> (1 '(a b c))
(b c)
> (2 '(a b c))
(c)

直接リストから、取り出せます。
ちなみに、Common Lisp 流の last を newLISP で定義すると

(context 'clisp)
(defun clisp:last (lst n)
  (if (consp lst)
      (if (and n (number? n))
          (let (len (length lst))
            (if (< len n) lst
                ((- (length lst) n) lst)))
        (-1 lst))
    lst))
(context MAIN) 

こんな感じ？

続いて、リストに作用する関数の大規模なもの の方です。

(defun longer (x y)
  (labels ((compare (x y)
             (and (consp x)
                  (or (null y)
                      (compare (cdr x) (cdr y))))))
    (if (and (listp x) (listp y))
        (compare x y)
      (> (length x) (length y)))))

(defun filter+ (f lst)
  (local (acc)
    (dolist (x lst)
      (let (val (f x))
        (if val (push val acc -1))))
    acc))

(defun group (src n)
  (if (zerop n) (error "zero length"))
  (labels ((rec (src acc)
             (let ((rests (nthcdr n src)))
               (if (consp rests)
                   (rec rests (cons (subseq src 0 n) acc))
                 (reverse (cons src acc))))))
    (if src (rec src '()) nil)))　

zerop と labels は、newlisp-utility.lsp に定義してありますので、関数longer は、何の変更もなく動きます。
動作はというと、

> (longer '(a b (c (d)) e f g) '(a b (c d) e f g))
nil
> (longer '(a b c d e f g) '(a b (c d) e f g))
true

関数filter+ は、newLISP組込関数に filter があるので filter+ と名前を変えています。
newLISP の組込push は、項目をリストの最後に挿入できるので、reverse を使っていません。

> (filter+ (fn (x) (if (numberp x) (+ 1 x))) '(a 1 b 3 c d 4))
(2 4 5)

newLISP では、λ式に fn が使えるので楽です。また、関数filter+ を使わなくても、

> (replace nil (mapcar (fn (x) (if (numberp x) (+ 1 x))) '(a 1 b 3 c d 4)))
(2 4 5)

で、実現できます（“On Lisp” 後注48より）。
次の関数group は、newLISP にはない関数 nthcdr と subseq を使っています。newLISP ではどちらもインデックス機構で実現できるので、わざわざ組込関数にしていないのでしょう。以下に、それらの定義を記しておきます。

(defun nthcdr (num lst)
  (when (consp lst) (num lst)))

(defun subseq (lst start end)
  (if (nil? end)
      (start lst)
    (let (len (- end start))
      (start len lst))))

また、newLISPには組込関数rest があるので内部変数rest は、rests に変えてあります。
動作はというと。

> (group '(a b c d e f g) 2)
((a b) (c d) (e f) (g))

しかし、newLISP では組込関数explode が関数group と同様な機能を持っています。

> (explode '(a b c d e f g) 2)
((a b) (c d) (e f) (g))

本書にもあるように、関数group は後でも使われるので、以降は、こう定義します。

(define group explode)

さて、リストに対する操作 の最後は、関数flatten と prune 。

(defun flatten (x)
  (labels ((rec (x acc)
             (cond ((null x) acc)
                   ((atom x) (cons x acc))
                   (t (rec (car x) (rec (cdr x) acc))))))
    (rec x '())))

(defun prune (test tree)
  (labels ((rec (tree acc)
           (cond ((null tree) (reverse acc))
                 ((consp (car tree))
                  (rec (cdr tree)
                  (cons (rec (car tree) '()) acc)))
                 (t (rec (cdr tree)
                         (if (test (car tree))
                             acc
                           (cons (car tree) acc)))))))
    (rec tree '())))

関数flatten は、内部関数rec の引数 nil を '() に変えてあるほかは、本文と同じです。
動作はというと、

> (flatten '(a (b c) ((d e) f)))
(a b c d e f)

この機能もまた、newLISP で組込関数flat として、用意されています。

> (flat '(a (b c) ((d e) f)))
(a b c d e f)

以降は、こう定義します。

(define flatten flat)

先ほどの 組込関数explode と同様、newLISP には、ユーティリティに相応しい関数が、最初から組み込まれています。
さて、次の関数prune も、関数flatten のときと同様、nil を '() に変えてあります。nil のままだと、flattenも同様ですが、nil が cons されてそのままリストに残ってしまいます。また、funcall もはずしてあります。動作はというと、

> (prune evenp '(1 2 (3 (4 5) 6) 7 8 (9)))
(1 (3 (5)) 7 (9))
> (prune oddp '(1 2 (3 (4 5) 6) 7 8 (9)))
(2 ((4) 6) 8 ())

もちろん、#' は要りません。
ちなみに、CommonLisp（ｘｙｚｚｙを含む）で、oddp 使った時は、

> (prune oddp '(1 2 (3 (4 5) 6) 7 8 (9)))
(2 ((4) 6) 8 nil)

となります。意味的には同じですが、気になる方は最後の行を

(replace '() (rec tree '()) nil)))

とすれば見た目も同じになります。どちらをとるかはお好みで。
検索 からは、次回に。

以上、如何でしょうか？