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 |

2010-06-26

CLで学ぶ「プログラミングGauche」 (9.8)

| 14:35 | CLで学ぶ「プログラミングGauche」 (9.8) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.8) - わだばLisperになる

このブログの以前のエントリーを眺めていたら CLで学ぶ「プログラミングGauche」 というのも続き物としてやっていたことを思い出しました。

実に2年ぶりですが、前回9.7章だったので、9.8から突然再開してみます。

前回: CLで学ぶ「プログラミングGauche」 (9.7) - わだばLisperになる - cadr group

9.8 グラフ

リストでグラフを表現する方法。

SchemeもCommon Lispもデータ構造の基本はリストですね。

9.9 具象と抽象の往復

とりあえず試行錯誤して作ってゆくという場合に用いるデータ構造として、リストというのは柔軟で便利、という教え。

古来からLISPは試行錯誤するプログラミングに強いと言われて来ましたが、リストというデータ構造もまたそういうスタイルに貢献しているのかなと思いました。

2008-08-12

CLで学ぶ「プログラミングGauche」 (9.7)

| 20:58 | CLで学ぶ「プログラミングGauche」 (9.7) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.7) - わだばLisperになる

9.7 準クォート

準クォートの扱いもCLとGaucheとであまり違いはないかと思います。

あまり使用されませんが、CLの場合は、,@以外に、,.のようなものがあり、,@がリストをappend的につくけるのに対し、,.は、nconc的にくつけます。

また、古いコードでは、,@の代りに`(foo . ,bar)と書いたコードも良く見かけます。当然といえば、当然なのですが、これは、,@と違ってリストの最後の要素になった時にしか使えません。

ドットとコンマはくつけて書けるので、.,fooの様に書いていることもあるのですが、見た目が,.と紛らわしいです(;´Д`)

(let ((foo (copy-list '(1 2 3 4 5)))
      (bar (copy-list '(6 7 8 9 0))))
  (list `(,foo ,bar)
        foo))
;=> (((1 2 3 4 5) (6 7 8 9 0)) (1 2 3 4 5))

(let ((foo (copy-list '(1 2 3 4 5)))
      (bar (copy-list '(6 7 8 9 0))))
  (list `(,@foo ,@bar)
        foo))
;=> ((1 2 3 4 5 6 7 8 9 0) (1 2 3 4 5))

(let ((foo (copy-list '(1 2 3 4 5)))
      (bar (copy-list '(6 7 8 9 0))))
  (list `(,.foo ,.bar)
        foo))
;=> ((1 2 3 4 5 6 7 8 9 0) (1 2 3 4 5 6 7 8 9 0))

(let ((foo (copy-list '(1 2 3 4 5)))
      (bar (copy-list '(6 7 8 9 0))))
  (list `(,.foo .,bar) ; ,@barと同じ
        foo))

また、ネストすると非常に難解になりますが、大概ネストさせる必要があるのは、マクロを書くマクロを作成する時位のものだと思うので、ある程度パターンは決まってくるかと思います。

つまり、`(,x ,y)という表記をどうやって作るか、というような問題に大体集約できるかと思いますので、適当に例題を作って遊んでみると良い練習になるかもしれません。

;; `(,x ,y) を作りたい。(xとyはそれぞれ変数に格納)
(let ((foo 'x) (bar 'y))
  ``(,,foo ,,bar))

;=> `(,X ,Y)

;; '(x y z) '(a b c)を合成して、`(,x ,y ,z ,a ,b ,c)を作りたい。(元リストはそれぞれ変数に格納)
(let ((foo '(x y z))
      (bar '(a b c)))
  ``(,,@foo ,,@bar))

;=> `(,X ,Y ,Z ,A ,B ,C)

2008-08-08

CLで学ぶ「プログラミングGauche」 (9.6)

| 16:12 | CLで学ぶ「プログラミングGauche」 (9.6) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.6) - わだばLisperになる

9.6 リストの変更と 一般化set!

Gaucheのように一般化されたset!は、CLにもclsetfという名前で存在しています。

読み出して来た場所に値を格納するというのは便利で、Schemeより代入を使う傾向のあるCLでは、仲間が沢山あり、また、このsetfをカスタマイズする構文が用意されています。(defsetf foo ...)や、(defun (setf foo) ..)等。

〜fという系統や、push、pop等の仲間が読み出して来た場所に代入する代表的なものかと思います。

(let ((foo (copy-tree '(1 2 3 (4 (5 6 7 8 9))))))
  ;; 値を代入
  (setf (first foo) 1000)

  ;; 2番目の数を1000増加させる
  (incf (second foo) 1000)

  ;; 4番目のリストをポップ
  (pop (fourth foo))

  ;; 4番目のリストにプッシュ
  (push 888 (fourth foo))

  ;; 4番目のリストにプッシュ
  (push 999 (fourth foo))
  foo)

;==>(1000 1002 3 (999 888 (5 6 7 8 9))))

2008-08-06

CLで学ぶ「プログラミングGauche」 (9.5)

| 18:27 | CLで学ぶ「プログラミングGauche」 (9.5) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.5) - わだばLisperになる

9.5 名前つきlet

Schemeには名前つきletがありますが、CLのletにはそういった拡張はありません。

近いところでは、局所関数のlabels位になるかと思います。

また、処理系によっては、named-let等の名前で隠し持っていることもあるようです。

調べた限りでは、SBCLだと、named-let、cmuclだとiterateというのを見付けられました。

どちらも、labelsに展開されるマクロですが…。

使用上の注意点としては、Schemeと違って末尾再帰の最適化をしてくれるとは限らないので、ループと全く同じ感覚で使うためには、それなりに処理系に応じて下調べが必要だと思われます。

(defun fact (n)
  (labels ((*fact (n acc)
             (if (zerop n)
                 acc
                 (*fact (1- n) (* acc n)))))
    (*fact n 1)))

;; SBCL
(import 'sb-impl::named-let)

(defun fact-2 (n)
  (named-let *fact ((n n) (acc 1))
    (if (zerop n)
        acc
        (*fact (1- n) (* acc n)))))

;cmuclだとiterateという名前で存在。

2008-07-31

CLで学ぶ「プログラミングGauche」 (9.4)

| 08:49 | CLで学ぶ「プログラミングGauche」 (9.4) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.4) - わだばLisperになる

9.4 連想リストふたたび

連想リストについての復習といった感じ。

元の連想リストを破壊的に変更したりする例を取り上げています。

CLでも同じ感じかなと。

2008-07-30

CLで学ぶ「プログラミングGauche」 (9.3)

| 08:05 | CLで学ぶ「プログラミングGauche」 (9.3) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.3) - わだばLisperになる

9.3 手続きによるパターンの抽象化

9.3は、memberと、deleteと、assocの共通点を括り出してまとめて抽象化してみせるという内容です。

何となくの個人的な感覚ですが、CLというか伝統的なLISPだと、高階関数的に関数で括り出すんじゃなくて、ベタな感じで関数で括り出すかマクロにする傾向が強い気がします。

Schemeを学ぶなら、この辺のところを重点的に学ぶとプログラミング技法的に得られるものも多いんだろうなあという気がしています。

以下CLでさらってみたもの

(defun traverse (fallback get-key return repeat)
  (lambda (elt lst &optional (cmp-fn #'equal))
    (labels ((frob (lst)
                (cond ((endp lst) fallback)
                      ((funcall cmp-fn elt (funcall get-key lst)) (funcall return lst))
                      ('T (funcall repeat #'frob lst)))))
      (frob lst))))

(setf (fdefinition 'member2)
      (traverse () 
                #'car
                #'values
                (lambda (rep lst) (funcall rep (cdr lst)))))

抽象化の手法の違い

CLでは、今回の例のような方法で括り出すよりは、関数を定義するマクロを作ってしまうという割とそのまんまな方法で解決しているコードの方が多い気がします。大同小異ですけれど…。

(use-package :lispworks)

(defmacro define-traverse-function (name &key fallback get-key return repeat)
  (with-unique-names (frob lst)
    `(defun ,name (elt lst &optional (cmp-fn #'equal))
       (labels ((,frob (,lst)
                  (cond ((endp ,lst) ,fallback)
                        ((funcall cmp-fn elt (,get-key ,lst)) (,return ,lst))
                        ('T (,repeat #',frob ,lst)))))
         (,frob lst)))))

(define-traverse-function member2
    :fallback nil
    :get-key car
    :return values
    :repeat (lambda (rep lst) (funcall rep (cdr lst))))

(MEMBER2 'baz '(foo bar baz))
;=> (baz)

2008-07-29

CLで学ぶ「プログラミングGauche」 (9.2)

| 08:05 | CLで学ぶ「プログラミングGauche」 (9.2) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.2) - わだばLisperになる

また間が開いてしまいました。今回は、9.2です。

9.2 連想リスト

連想リストは古いLISPからの伝統ということでCLもSchemeも共通といったところでしょう。

Schemeでは、SRFIの拡張で、assocが比較のための述語をオプションで取れるとのこと。

MacLISP等の時代は、比較述語によってバリエーションが作られるということが行なわれていたようで、equalで比較するassoc、eqで比較するassqがあったりしました。この辺の伝統は、一部のSRFIや、elispに残っているようですが、CLは、デフォルトの述語をeqlにして他は:testキーワードで述語を指定するという風に統一されたので派生の専用関数を作るということはあまり行なわれなくなりました。

(assoc 'foo '((bar . 3) (foo . 2) (baz . 1)) :test #'eq)

ということで、本の内容とは全く関係のないことを延々と書いてしまいました…。

次回は9.3から再開したいと思います。

2008-07-18

CLで学ぶ「プログラミングGauche」 (9.1)

| 00:05 | CLで学ぶ「プログラミングGauche」 (9.1) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.1) - わだばLisperになる

「プログラミングGauche」をCLで演習してみていましたが、2ヶ月も放置してしまいました。

どうも一回の内容を長くしてしまうと億劫になってしまうようなので、細切れに行くことに方針変更しました。

9.1 集合

このセクションで登場するmemberですが、CLでは、memberは、比較の為の関数を:testで指定できるので、srfi-1拡張相当です。

デフォルトでは、eqlが比較に使われます。

また、keyが取れて、

member
(member 'bar '((foo) (bar) () (baz)) :key #'car)
;=> ((BAR) NIL (BAZ))

のようなこともできます。

(defparameter *inventory* '(cookie dagger))

(member 'cookie *inventory* :test #'equal)

(defun has-item? (item)
  (member item *inventory*))
delete

srfi-1のdeleteに相当するものは、CLでは、removeになります。

また、同じ機能で引数リストを破壊的に変更するものにdeleteがあります。

(remove 1 '(1 2 1 2 1 2 1 2))
;=> (2 2 2 2)

itemを取り除く上限の個数も標準で指定できます。

(remove 1 '(1 2 1 2 1 2 1 2) :count 1)

;=> (2 1 2 1 2 1 2)

[練習問題]

CLのremoveは、この問題のように全く削除要素がみつからなかった場合に、与えられた引数をそのまま返しても良いということになっています。

CLHS: Function REMOVE, REMOVE-IF, REMOVE-IF-NOT...

逆にいえば、この仕様だとremoveの結果を破壊することの安全が保証されていないので破壊する場合は、リストをコピーしてやる必要があります。

(defun delete-1 (item lst test)
  (if (endp lst)
      ()
      (let ((tail (delete-1 item (cdr lst) test)))
        (if (funcall test item (car lst))
            tail
            (if (eq (cdr lst) tail)
                lst
                (cons (car lst) tail))))))

(let ((data (list 1 2 3 4 5)))
  (eq data (delete-1 0 data #'equal)))
;=> T
代入

Gaucheのset!に相当するものは、setfか、setqになります。

また、Schemeの命名規則では、名前の最後に!が付くと破壊的操作となりますが、CLの場合、CL以前のLISPの色々な命名規則が混っていますので、いまいち統一感に欠けます。

nconc、nreverse等、nが付いたり、remove系に対してのdelete系というのが主なところです。

2008-05-19

CLで学ぶ「プログラミングGauche」 (8.3〜8.4.5)

| 05:45 | CLで学ぶ「プログラミングGauche」 (8.3〜8.4.5) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (8.3〜8.4.5) - わだばLisperになる

今回は、8.3から再開です。

8.3 真偽値を扱う手続き

8.3.1 等価述語以外の述語

SchemeもCLも大体同じです。というか、SchemeとCLが分岐する前から定番になっていたところなので、似ているのも当然といえば、当然。

  • 型を判定するもの
schemeCL
pair?consp
null?null
boolean?(typep x 'boolean)
symbol?symbolp
number?numberp
char?characterp
string?stringp
  • 性質を判定
odd?oddp
even?evenp
zero?zerop
char-alphabetic?alpha-char-p

CL(というか伝統的LISPでは)最後に付くpは、predicateの略で、述語には、-pを付ける伝統があります。最初期の述語には、atom、null等、語尾にpはついてませんが、60年代初頭のLISP 1.5から、既に-pという述語が定着しているようなので、LISP1から、1.5の間になんらかの出来事があったんでしょう。

8.3.2 否定

notの使い方。

CLのnotは、NILが多様な意味を持つために、nullと全く同じ働きをするのですが、両者は意味的に使いわけられています。

8.3.3 述語を取る手続き

これは、SRFIとCLでは名前の付け方にちょっと違いがあり

SRFICL
anysome
everyevery

のようになっています。

(some #'oddp '(2 4 8 1))
;=> T

(every #'oddp '(1 3 5))
;=> T
  • every-pred

every-predはないので作成

(defun every-pred (&rest fns)
  (lambda (&rest arg)
    (every (lambda (f) (every f arg))
           fns)))

(defun some-pred (&rest fns)
  (lambda (&rest arg)
    (some (lambda (f) (some f arg))
          fns)))

なんとなくanyじゃなくて、CLっぽくsome-predにしました。

every-pred応用例

(setf (symbol-function 'positive-integer?) 
      (every-pred #'integerp #'plusp))

(positive-integer? 4)
;=> T

(positive-integer? -3)
;=> NIL

(positive-integer? 2.4)
;=> NIL

(setf (symbol-function 'nonnegative?) (complement #'minusp))

(nonnegative? 2)
;=> T

(nonnegative? 0)
;=> T

(nonnegative? -2)
;=> NIL

[練習問題]

上で書いてしまってました…。

8.4 条件判断

CLとschemeと違うところは、

(if nil 'foo)
;=> NIL

となり、未定義にはならない所。

  • cond

CLには、Schemeのようにcondで=>は使えません。

setqが代入時の結果の値を返すことと、代入を組み合わせて

(let ((lst '(55 77 99)))
  (let (=>)
    (cond ((setq => (find-if #'oddp lst)) (* => 2))
          (:else 0))))
;=> 110

というのもたまに見かけます。(主に80年代位のコードで)

condでは、もともと=>が使えたりはしないので、いつから=>が使えるようになったのかと調べてみると、どうも、1978年のThe Revised Report on SCHEME(AIM-452)位からのようです。

P17に定義があるのですが、CLのマクロに翻訳してみました。

(import 'kmrcl:with-gensyms)

(defmacro test (pred fn alt)
  (with-gensyms (p f a)
    `(let ((,p ,pred) 
           (,f (lambda () ,fn))
           (,a (lambda () ,alt)))
       (if ,p 
           (funcall (funcall ,f) ,p)
           (funcall ,a)))))

(defmacro rs-cond (&rest clauses)
  (with-gensyms (v r)
    (cond ((null clauses) ''nil)
          ((null (cdar clauses))
           `(let ((,v ,(caar clauses))
                  (,r (lambda ()
                        (rs-cond ,@(cdr clauses)))))
              (if ,v ,v ,r)))
          ((eq (cadar clauses) '=>)
           `(test ,(caar clauses) ,(caddar clauses)
                  (rs-cond ,@(cdr clauses))))
          (t `(if ,(caar clauses)
                  (progn ,@(cdar clauses))
                  (rs-cond ,@(cdr clauses)))))))

(test 33333 #'list nil)
;=> (33333)

再帰的に展開され、ifに全部変換されます。

testマクロが肝のようですが、良くこんなの考えつくなーと感心します。

SRFI-61の拡張は、主に述語部が多値を返して、それを結果として受け取りたいような場合に使うようです。

CLでも、

(cond ((values 1 2))) ;=> 1

のようにcondの述部は、多値を返しません。

SRFI-61に相当するものもないので、欲しい場合は作ることになります。

自分も前に汚ないのを作ってみたことがあります。

8.4.2 CASE

caseはelse節のキーワードが、elseか、otherwiseかの違い位で同じです。

SRFI-87のような拡張はありません。

(case 1
  (0 'zero)
  (otherwise 'one))
;=> ONE

これも前に作ってみました。

8.4.3 andとor

andとorについても同じです。

8.4.4 whenとunless

これまた、CLと、Schemeとで違いはありません。

8.4.5 and-let*

and-let*はCLにないので、作るほかありません。

(defmacro and-let* ((&rest binds) &body body)
  (reduce (lambda (c res)
            `(let ((,(car c) ,(cadr c)))
               (and ,(car c) ,res)))
          binds
          :initial-value `(progn ,@body)
          :from-end 'T))

(and-let* ((a :a)
           (b :b)
           (c :c))
  (print (list a b c)))

;=> (:A :B :C) 

CL界隈には、and-let*的なものはないので便利なときには便利かもしれません。

次回9章から再開です。

2008-05-12

CLで学ぶ「プログラミングGauche」 (8〜8.2.5)

| 18:20 | CLで学ぶ「プログラミングGauche」 (8〜8.2.5) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (8〜8.2.5) - わだばLisperになる

今回は8章「真偽値と条件判断」から再開です。

8.1 述語と等価述語

CLでも「述語」とはいうような気がしますが、等価述語というのかは良く分かりません(^^;

8.2 等価性

8.2.1 内容が同じ

CLでequal?に相当するのは、equalで

(equal (list 1 2 3) (list 1 2 3))
;=> T

(equal (list 1 2 3) (cons 1 (list 2 (+ 1 1 1))))
;=> T

両者の型と値が同じならば等しいというところも同じです。

8.2.2 入れ物が同じ
(eq (cons 1 2) (cons 1 2))
;=> NIL

(let ((x (cons 1 2)))
  (eq x x))
;=> T

eq?に相当するものは、eqで、入れ物、つまり、LISPのオブジェクトとして等しい場合に真。ポインタの比較に喩えれるのも一緒で、確実に比較できるのは、シンボルのみというのも一緒。

また、シンボルについての説明で、同じ名前のシンボルは、同じ実体を指すというもの同じ。

しかし、CLの場合パッケージがあり、正確な名前はパッケージ名付きであることに注意する必要があります。

カレントパッケージとパッケージ名が同一の場合は、省略できるので、xはcl-user::xやfoo::x等、パッケージごとに複数存在可能です。

この場合、名前が違えば、全部違うオブジェクトかといえばそうでもなく、シンボルが外部パッケージから取り込まれている(importした)場合は、違うパッケージ名でもeqになることがあります。取り込んで来たオブジェクトなので、同一なオブジェクトであるのは自明ではありますが、ややこしいところでもあります。

8.2.3 数値として同じ
(eql 1 1)
;=> T

(eql 1.0 1.0)
;=> T

(eql 1 1.0)
;=> NIL

eqlは、型が同じで、値が同じならTというもの同じ

値を比較したい場合には、=を使うというのも同じ。

(= 1 1.0)
;=> T

文字の比較

(char= #\a #\a)
;=> T

(char= #\a #\A)
;=> NIL

(eql #\a #\a)
;=> T

HyperSpecには、

eql and equal compare characters in the same way that char= does.

とあるので、eqlとequalはchar=の機能としても使えるようです。

  • 文字列
(string= "abc" "abc")
;=> T

(string= "abc" "ABC")
;=> NIL
  • 大文字小文字の違いを無視したい場合
;; char-ci=?、string-ci=?
(char-equal #\a #\A)
;=> T

;; string=ci?
(string-equal "abc" "ABC")
;=> T

名前が若干違っています。-equalという風に冗長に書かなければいけない場合には、大文字小文字を区別しない、という命名規則です。

8.2.4 その他の等価性

isomorphic?はCLにはないので、探してみたのですが、みつからないので、Gaucheのを適当に移植してみました。といっても禄にテストしていないので、ちゃんと機能するのか不明です(^^;

(let ((p (cons 1 2)))
  (isomorphic? (list p p) (list p '(1 2))))
;=> nil

(let ((p (cons 1 2)))
  (isomorphic? (list p p) (list p p)))
;=> t

(let ((p (make-array 100 :fill-pointer 1 :adjustable 'T)))
  (vector-push 1 p)
  (isomorphic? p (vector 0 (+ 0 1))))
;=> t

;; 
(defun ISOMORPHIC? (a b &rest args)
  (let ((ctx (if (consp args)
                 (if (hash-table-p (car args))
                     (car args)
                     (error "hash table required, but got ~S." (car args)))
                 (make-hash-table))))
    (ISO? a b ctx)))

(defun ISO? (a b ctx)
  (let (win tem)
    (cond ((or (characterp a) (numberp a))
           (eql a b))
          ((null a) (null b))
          ((progn (setf (values tem win) (gethash a ctx))
                  win) ;node has been appeared
           (eq tem b))
          (:else
           (setf (gethash a ctx) b)
           (typecase a
             (cons (and (consp b)
                        (iso? (car a) (car b) ctx)
                        (iso? (cdr a) (cdr b) ctx)))
             (string (and (stringp b) (string= a b)))
             (keyword (eql a b))
             (symbol (eq a b))
             (vector (VECTOR-ISO? a b ctx))
             (otherwise (OBJECT-ISOMORPHIC? a b ctx))))))))

(progn
  (declaim (inline vector->list))
  (defun VECTOR->LIST (vec) (coerce vec 'list)))

(defun VECTOR-ISO? (a b ctx)
  (and (vectorp b)
       (do ((la (vector->list a) (cdr la))
            (lb (vector->list b) (cdr lb)))
           ((endp la) (endp lb))
         (cond ((endp lb) (return nil))
               ((ISO? (car la) (car lb) ctx))
               (:else (return nil))))))

(defmethod OBJECT-ISOMORPHIC? (a b context)
  (equal a b))
8.2.5 等価述語をとる手続き

(member-if 等価述語 リスト)のようなことを示しているのだと思いますが、これはCLでも同じです。

ということで次回は、8.3章から再開です。

2008-05-05

CLで学ぶ「プログラミングGauche」 (7.7〜7.9)

| 16:41 | CLで学ぶ「プログラミングGauche」 (7.7〜7.9) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (7.7〜7.9) - わだばLisperになる

7.7章から再開です。

7.7 省略可能引数とキーワード引数

省略可能引数とキーワード引数は、Gaucheの拡張で便利なのでCLから輸入されたとのことです。

CLでは、Gaucheと違って前回の内容でも書いたラムダリストパラメータで色々指定することになります。

可変長引数をリストとして受け取ってlet-optionals*で自前で分解する、という方法ではなく、

(defun my-make-list (num &optional args))

という風に指定することになります。

どうしても、let-optionalsが使いたいんだ!!という場合は、マクロを書くことになると思います…。

(defmacro let-optionals* ((&rest args) (&rest vars-and-inits) &body body)
  (let ((vars-and-inits (copy-list vars-and-inits)))
    `(let* ,(map-into vars-and-inits 
                      (lambda (val vi) `(,(car vi) ,val))
                      args
                      vars-and-inits)
       ,@body)))

(let-optionals* (1 2) ((a 100) (b 200) (c 300))
  (list a b c))
;=> (1 2 300)

等々。

キーワードに関しても、同じように、

(defun my-make-list (num &key (init-elt nil)))

のように指定します。

また、キーワードかどうか判定するには、keywordpを使います。

(keywordp :foo)

キーワード引数のメリットとしてはGauche本の解説の通りですが、CLの場合、:fooというのは、keywordパッケージに登録されたシンボルということになり、keyword:fooの省略形であるというところが違います。また、キーワードはnilや、tのように自己を評価した結果は自分自身になります。

ちなみに、何がなんでも、let-keywordが使いたいんだ!!という場合は、これまたマクロを書くことになると思います…。

(defmacro let-keyword (args (&rest keys-and-inits) &body body)
  (let* ((g (gensym))
         (vars-and-inits (mapcar (lambda (x) 
                                   `(,(intern (string (car x)))
                                      (or (getf ,g ,(car x)) ,(cadr x))))
                                 keys-and-inits)))
    `(let ((,g ,args))
       (let ,vars-and-inits
         ,@body))))

;; other-argsに対応するの忘れてました…。

どっちにしろ、普通に引数で指定した方が便利なので、CLを学ぼうという方は、そちらで書いて下さい(^^;

7.8 部分適用

ここでは、cutの説明がありますが、CLにはcutに相当するスタンダードなものはないと思います。

しかし、色々な試みはあって、リーダーマクロ

(mapcar #'(lambda (x) (* 2 x))
        '(1 2 3))

(mapcar #L(* 2 _) '(1 2 3))

のように書けるようにしたりしている人は多いようです。

参考:no title

また、cutマクロを作るのもそんなに難しくないと思うので自作されるのも良いかと思います。

自分は、CL版のdefine-syntaxを利用してcutを移植してみたことがありました。

define-syntaxでcut:Common Lispであんまり衛生的ではないdefine-syntax - わだばLisperになる - cadr group

7.9 多値

多値の役割についても、SchemeとCLで違いはないと思います。

7.9.1 多値を受けとる

CLでSchemeのreceiveに相当するものは、 multiple-value-bindになるかと思います。

;(defun min&max (&rest args)
;  (values (apply #'min args) (apply #'max args)))

(multiple-value-bind (min-val max-val)
    (min&max 3 1 2)
  (list min-val max-val))

;=> (1 3)

let-valuesとlet-values*に相当する標準的なものはありませんが、そういうユーティリティは沢山あると思います。

自分は、metabang-bindを良く使います。

このパッケージのbindは、destructuring-bindと、multiple-value-bindを一緒にした上に構造体もバインドできるというものです。

let-valuesだと

(bind (((:values min-val max-val) (min&max 3 1 2)))
  (list min-val max-val))

のように書けます。

value-refに相当するものとしては、nth-valueがあり

(nth-value 1 (min&max 3 1 2))
;=> 3

という風になります。

7.9.2 多値を返す

多値を返すのには、Schemeと同じくvaluesを使います。

(values 1 2 3 4)
;=> 1,2,3,4

ということで、次回は8章からです。

2008-04-28

CLで学ぶ「プログラミングGauche」 (7.3〜7.6)

| 04:36 | CLで学ぶ「プログラミングGauche」 (7.3〜7.6) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (7.3〜7.6) - わだばLisperになる

今回は、7.3からの再開です。

7.3 ローカル変数

このセクションで、lambdaとletの関係の説明がでてきます。

CLではlet、let*はlambdaの糖衣構文ではなく、スペシャルフォームです。

歴史的には、MacLISP等でもletはlambdaの糖衣構文として登場したようで、Schemeの方が伝統に忠実といったところかもしれません。

CLもレキシカルスコープなのでletとlet*の機能については、ほぼ同じです。

letrecですが、CLには、let、let*からの延長としてのletrecに正確に相当するものはなく、似たところでは、labelsでしょうか。

labelsで置き換えると

(labels ((sum (lst)
	   (cond ((null lst) 0)
		 ((numberp (car lst)) (+ (car lst) (sum (cdr lst))))
		 ('T (sum (cdr lst))))))
  (sum '(1 3 #:f 6 #:t 9)))
;=> 19

;; ローカルな相互再帰
(labels ((even? (n)
	   (cond ((zerop n) 'T)
		 ((> n 0) (odd? (1- n)))
		 ('T (odd? (1+ n)))))
	 (odd? (n)
	   (cond ((zerop n) nil)
		 ((> n 0) (even? (1- n)))
		 ('T (even? (1+ n))))))
  (even? 10))
;=> T

のようになります。

labelsは、CL以前のMacLISP系処理系には存在しませんでした。

意外にも初期のSchemeに存在していたりするのですが、CLのlabelsは、Scheme由来なのかもしれません。

Schemeではletrecに吸収されたのか、消えてしまいましたが…。

何れにせよ、どちらも大元は、LISP1.5のLABELに由来するものだとは思います。

7.4 可変長引数を取る

可変長引数については、CLとSchemeとでは違っていて、引数の性質については、ラムダリストパラメータで指定します。

MacLISP系は大体共通でEmacs Lispでも大体同じです。

ラムダリストパラメータを使わない場合は、Schemeと同じくすべて必須引数になります。

指定した場所以降を纏めてリストにして受け取りたい場合は、&restをつけます。

;; Scheme
((lambda (a . b) (list a b))
 1 2 3)
;=> (1 (2 3))

;; CL
((lambda (a &rest b) (list a b))
 1 2 3)
;=> (1 (2 3))

Scheme風にドット表記も使える局面はあることはあるのですが、ラムダリストパラメータも使えるので、トリビアとして憶えておく位かもしれません。

(destructuring-bind (a . b) '(1 2 3)
  (list a b))
;=> (1 (2 3))

defmacroの引数等でもこういう風に書くことは可能ではあります。

[練習問題]

(defun my-list (&rest args)
  args)

(MY-LIST 1 2 3 4)
;=> (1 2 3 4)

SBCLでもLISTの実装はこのまんまなコードです。

しかし、CLでは、&restで受けとる引数リストが新規に作成されることを義務づけているわけではないので、処理系によっては、このコードではまずいらしいです。*1

具体的には、applyの引数にした場合、元がリストで与えられるので問題になります。

ということは、SBCLでは、&restで受けとったパラメータは新規にコンスされたことが保証されているのでしょう。

(let ((lst '(1 2 3 4 5))
      (lst2 '(i ii iii)))
  (nconc (apply #'my-list lst) lst2)
  lst)
;=> (1 2 3 4 5)

;処理系によっては、
;=> (1 2 3 4 5 I II III)
;でも良いらしい。

X3J13では議論の結果、主にパフォーマンスの問題からこのように決定されたようです。

パフォーマンスと引き換えに、プログラマは、&restパラメータを破壊するような操作はしないように気を付ける必要があります。

とはいえ、コンピュータのパフォーマンスはどんどん上がってきているので、今どきは、&restは新規にコンスされているのが殆どのようです。

7.5 可変長引数を渡す

可変長引数を渡す際にapplyを使う、というのはCLでもリストで受け取ることになるので手法として共通です。

(defun append/log (&rest args)
  (format t "ARGS=~A~%" args)
  (apply #'append args))

(append/log '(a b c) '(1 2 3) '(7 8 9))
;>>> ARGS=((A B C) (1 2 3) (7 8 9))
;=> (A B C 1 2 3 7 8 9)

7.6 引数のパターンマッチング

lengthを使うのが不経済な場合がある(引数が何万もあったら?)ということでmatchが登場します。

Gaucheのutil.matchで採用されているのはAndrew Wright氏のmatcherらしいですが、近い感じのものとしては、FARE-MATCHERがあるようです。

FARE-MATCHERはWright氏のmatchとは書法が若干違って、パターン部がなんというか「動的な表現?」になっています。

話の流れ上、lengthが不経済な局面でmatchの実装がlengthより経済的でなければならない訳ですが、ちょっと確認してみました。

(use-package "FARE-MATCHER")

(let ((lst (loop :for i :from 0 :to 10000000 :collect i)))
  (values
   (time
    (case (length lst)
      (0 ())
      (1 'one!)
      (otherwise 'many!)))
   (time
    (match lst
      (() ())
      ((list a) 'one!)
      (_ 'many!)))))
;>>> length  0.039 seconds of real time
;>>> match  0.0 seconds of real time

要素数を10,000,000位にしないと、はっきりとした差は出ませんが、とりあえず、この局面では、FARE-MATCHERでも効率が良いようです(当たり前か(笑))

ということで、FARE-MATCHERのmatchを使うことにしてみました。

(defun append2 (a b)
  (if (consp a)
      (cons (car a) (append2 (cdr a) b))
      b))

(defun my-append (&rest args)
  (match args
    (() ())
    (`(,a) a)
    (`(,a ,@b) (append2 a (apply #'append b)))))

;; もしくは
(defun my-append (&rest args)
  (match args
    (() ())
    ((list a) a)
    ((cons a b) (append2 a (apply #'append b)))))

(MY-APPEND '(1 2 3 4) '(i ii iii iv) '(a b c d))
;=> (1 2 3 4 I II III IV A B C D)

のように書けます。

matchは便利なのでGaucheが羨しかったのですが、とりあえずfare-matcherをどしどし使って行くことにしました。

2008-04-21

CLで学ぶ「プログラミングGauche」 (7.2)

| 01:48 | CLで学ぶ「プログラミングGauche」 (7.2) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (7.2) - わだばLisperになる

7.2 手続きを取る手続き

前回からの続きです。7章は割と長いので小分けにしててくてく進んで行きます。

このセクションは高階関数のセクションで、かなり良いことが書いてあると思うので、個人的には何回も復習して,こういった種類の抽象化ができるようになりたいところです。

なぜ関数プログラミングは重要か」という有名な論文がありますが、このセクションもまた関数プログラムのエッセンスを濃縮して教えてくれているように思います。

とりあえず、for-eachの解説からなのですが、CLだと、mapcがfor-eachに相当します。

共通点としては、全体の返り値はあてにしないで、ループ構文として副作用目的で使われる、ということです。

そのため、for-each返り値は未定義であり、それは期待して使われないものということになっています。

mapcもCLtL2にはスタイルとして副作用目的で使われる、とあります。ちなみに、mapcの返り値は、未定義ではなく第2引数となっています。(つまり1番目のリスト)

また、昔(MacLISPの頃)は、mapcは好んで使われていたようですが、dolistが登場してからは、dolistが人気のようで、あまり使われなくなって来ています。

ここでは、とりあえず形が似ているということと、dolistはマクロなので高階関数の引数にするには都合が悪いので、mapcでfor-eachの代用をさせます。

また、schemeのmapは、CLのmapcarに相当しますが、R5RS的には引数の評価順序が規定されていないそうで、規定されたものには、srfi-1のmap-in-orderがあるようです。Gaucheのmapは、map-in-orderになっているとのことです。CLのmapcarは(というか基本的にどの関数でも)頭から順に評価されます。

色々CLに翻訳

(defun tree-walk (walker proc tree)
  (funcall walker (lambda (elt)
                    (if (listp elt)
                        (tree-walk walker proc elt)
                        (funcall proc elt)))
           tree))

(tree-walk #'mapc #'print '((1 2 3) 4 5 (6 (7 8))))
;=> 1 2 3 4 5 6 7 8

(defun reverse-for-each (proc lst)
  (mapc proc (reverse lst)))

(tree-walk #'reverse-for-each #'print '((1 2 3) 4 5 (6 (7 8))))
;>>> 1 2 3 4 5 6 7 8

(tree-walk #'mapcar (lambda (x) (* x 2))
           '((1 2 3) 4 5 (6 (7 8))))
;=> ((2 4 6) 8 10 (12 (14 16)))

(defun reverse-map (proc lst)
  (mapcar proc (reverse lst)))

(tree-walk #'reverse-map (lambda (x) x)
           '((1 2 3) 4 5 (6 (7 8))))
;=> (((8 7) 6) 5 4 (3 2 1))

(defun reversed (walker)
  (lambda (proc lst)
    (funcall walker proc (reverse lst))))

(funcall (reversed #'mapcar) #'values '(1 2 3 4))
;=> (4 3 2 1)

(tree-walk (reversed #'mapcar) (lambda (x) x)
           '((1 2 3) 4 5 (6 (7 8))))
;=> (((8 7) 6) 5 4 (3 2 1))

という流れで、ステップを踏んでどんどん骨組みを括り出す方法が解説されているのですが、非常にためになります!

[練習問題]

;; 6章の練習問題やってなかった…。
(defun filter (pred lst)
  (reduce (lambda (x res)
            (if (funcall pred x)
                (cons x res)
                res))
          lst :initial-value () :from-end 'T))

(defun for-each-numbers (proc lst)
  (mapc proc (filter #'numberp lst)))

(for-each-numbers #'print '(1 2 #:f 3 4 #:t))
;>>> 1 2 3 4

(defun map-numbers (proc lst)
  (mapcar proc (filter #'numberp lst)))

(map-numbers #'values '(1 2 #:f 3 4 #:t))
;=> '(1 2 3 4)

(defun numbers-only (walker)
  (lambda (proc lst)
    (funcall walker (lambda (x) 
                      (and (numberp x)
                           (funcall proc x)))
             (filter #'numberp lst))))) 

(funcall (numbers-only #'mapcar) #'values '(1 2 #:f 3 4 #:t))
;=> (1 2 3 4)

(funcall (numbers-only #'mapc) #'print '(1 2 #:f 3 4 #:t))
;>>> 1 2 3 4

(defun numbers-only-for-tree (walker)
  (lambda (proc tree)
    (funcall walker proc
	     (filter (lambda (x) (or (listp x) (numberp x)))
		     tree))))

(tree-walk (numbers-only-for-tree #'mapc) #'print 
           '((1 2 3 #:t) 4 5 (6 (7 8 #:t ((((((#:f 9))))))))))
;>>>1 2 3 4 5 6 7 8 9

(tree-walk (numbers-only-for-tree #'mapcar) #'values 
 '((1 2 3 #:t) 4 5 (6 (7 8 #:t ((((((#:f 9))))))))))
;=> ((1 2 3) 4 5 (6 (7 8 ((((((9)))))))))

;; おまけ
;; funcallが目に痛いという場合、リーダーマクロで!にしてしまうのはどうか
;; という試み。その代わり、!が名前に使い辛くなるという諸刃の剣。
(set-macro-character #\! (lambda (str char)
                           (declare (ignore str char))
                           'funcall))

(defun numbers-only-for-tree (walker)
  (lambda (proc tree)
    (!walker proc
       (filter (lambda (x) (or (listp x) (numberp x)))
		       tree))))

; と書ける。
;; 追記/numbers-only-for-treeの解釈を激しく間違っていたので修正しました(^^; 2008/5/15

2008-04-20

CLで学ぶ「プログラミングGauche」 (7)

| 14:39 | CLで学ぶ「プログラミングGauche」 (7) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (7) - わだばLisperになる

毎週日曜日にプログラミングGaucheをさらってみることにしました。

今回は、「7章 手続き」です。長いので、セクションごとに分割します。

7.1 手続きオブジェクト

CLは、Schemeとちがって名前空間が1つではありません。

とりあえず、sum-of-numbersを評価すると、sum-of-numbersの変数としての中身が出てきます。

defunで関数を定義するとシンボル(の関数の場所)に関数が登録されるので、シンボルに関連付けられた関数を取り出すには、

(function sum-of-numbers)

;; 略記
#'sum-of-numbers

;; symbol-functionを使った方法
(symbol-function 'sum-of-numbers)

とする必要があります。

こうすると、Gaucheのように

#<FUNCTION SUM-OF-NUMBERS>

のような結果が返って来ます。

CLでの#< 〜 >の定義ですが、#<というのは、読み戻した場合にはエラーにするための構文です。

割と、#< 〜 >の出力を読み戻して使いたいけど、できないんですが…というのはFAQっぽいですが、#<で囲まれているということは、わざわざ読み戻させないように書いているということなので、できない、と考えても良いかもしれません。(ちなみにLispマシンや、SLIMEの会話的操作では可能です。恐らく会話的操作だとできた方が便利だからではないでしょうか。)

別の名前を付ける
(define x sum-of-numbers)

に相当するのは、

(setf (symbol-function 'x) #'sum-of-numbers)

となるかと思います。Schemeと同様にsum-of-numbersが別の内容に定義されてもxは元の定義のままです。ただし、これはシンボルに関連付けられているので、defineと違ってどこで定義しようが大域的になります。ローカルにしたい場合は、letに変数として格納し、funcallを付けて呼び出す等々…になるので、別の名前を付けるという視点ではローカルの場合defineのようにはいかないようです。

無名関数について

CLの場合も同じく無名関数はlambdaで作れます。

ここでdefineについて説明がありますが、defunは関数オブジェクトと名前を関連付ける以外にもドキュメント等色々と関連付けることができ、その他拡張でソースコードの場所を記録したりもします。これはもちろん、1つのシンボルが沢山の情報を属性として分けて格納することができるためです。

無名関数の使われる場面
(defun len (lst)
  (flet ((increment2 (a b)
           (declare (ignore b))
           (1+ a)))
    (reduce #'increment2 lst :initial-value 0)))

;; 無名関数で
(defun len (lst)
  (reduce (lambda (a b) (declare (ignore b))
           (1+ a))
          lst :initial-value 0))

(defun max-number (lst)
  (if (endp lst)
      (error "max-number needs at least one number")
      (reduce (lambda (a b) (if (> a b) a b))
              (cdr lst) :initial-value (car lst))))

(defun print-elements (lst)
  (reduce (lambda (a b) (declare (ignore a)) (print b)) lst
          :initial-value nil))

ここでは無名関数の使われ方が説明されています。CLにはfoldがないので、reduceを使ってみましたが、処理する関数が取る引数の順番が逆なのでややこしいです。srfi-1には、foldのリストが1つだけとれるバージョンのreduceという名前の関数もありますが、これもCLとは逆です。

また、(declare (ignore 〜))が加わっていますが、これはコンパイラに使われない引数を無視するように指示するものです。無くても大丈夫ですが、SBCLだと未使用変数が警告になるので、自分は付けるようにしています。面倒ですがバグが入りにくくなるメリットもあったりはします。

2008-04-13

CLで学ぶ「プログラミングGauche」 (6)

| 18:13 | CLで学ぶ「プログラミングGauche」 (6) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (6) - わだばLisperになる

今回は6章「リスト」です。

6.1 リストの二つの顔

ここはCL/Scheme共通だと思います。

6.2 リストの基本操作

()のcar、cdr適用は動作が違っているのは、CL/Schemeでの違いでも割と有名な事項だと思います。

CLでは、伝統に則って空リストにcarとcdrを適用すると、()が返ります。

色々深遠な理由があるとも言われているようですが、LISP 1.5では、このような動作ではなく、PDP-1 LISPからかと思っていましたが、(cdr () )は、()のプロパティが返るのでnilが返って来ている訳ではありませんでした。そうなると、PDP-6 LISP以降だと思うのですが、いまいちはっきりしません。まあ、誰も拘ってないと思いますが(笑)

()にcarや、cdrを適用してもエラーにならないというのは、便利なところもありますが、

(defun foo (lst)
  (when (atom (car lst))
    (car lst)))

のように書くと、

(foo ())
;=> nil
(foo '(()))
;=> nil

では、区別がつかないし、エラーにもならないしで気付かないバグを入れていることが自分は多いです。ということで

(defun *car (lst)
  (when (null lst)
    (warn "()にcarを適用しました。"))
  (car lst))

のようなものを作って使ってみたりもしますが、いまいちです。

ちなみに、TAOでは、デフォルトの挙動を大域変数で変更できてエラーにすることも、nilを返すこともできたようです。

  • null?、pair?

CLでは、null、pair?はそれぞれnullと、conspになります。

最後に、-pが付くか、-?が付くかはSchemeと伝統的LISPの習慣の違いかと思いますが、atomと、nullには、-pが付かないので一貫性がなかったりします。これは、LISP 1.5からそうなので、50年来の伝統というほかないんでしょう。処理系によっては、atompや、nullpもあったりするようです。

空リストかを判定する関数としては、nullの他に、endpがあります。endpは、リスト以外を与えるとエラーになります。

6.3 リストの操作

  • fold => reduce

ここでは、foldがでてきます。CLには、foldという名前の関数はありませんが、同じような機能としてreduceがあります。

;; fold
(fold <手続き> <初期値> <リスト> ... <リストN>)

;; reduce / CL
(reduce <手続き> <リスト> :initial-value <初期値>)

reduceでは、初期値をキーワードで与えることと、複数のリストを与えることができないというところが違っています。

また、このセクションででてくる+inf.0、-inf.0のようなものはCLにはありません。

most-negative-〜定数があるので、それが近いといえば近いのかもしれませんが、どうなのでしょう。

  • 内部define => flet、labels

恐らく、Schemeでは、名前空間が一つで変数/関数の名前の衝突を避ける必要があるのでローカル関数は多用される傾向があるんじゃないかと思います。

CLでは空間が別々で変数と関数の名前は衝突せず、割と大らかに大域で定義してしまうことが多いように思います。

個人的には、関数内関数は個別にデバッグするのが面倒に感じるので、大域で定義することが多いです。まあ、デバッグが済んでから合体すれば良いのですが…。

また、CLでは、さらにパッケージを分割することもできるので、名前空間の汚染に関してはそれほど気にする必要はないのかもしれません。

「いちいちfuncallを付けなくてはいけない面倒臭ささ」と「名前の衝突回避のノウハウを頭の片隅に常駐させて置く負担」はトレードオフな気もします。

そして、CLでは、defunの中でdefunを使うような書き方は普通されず、

(defun max-number (lst)
  (defun pick-greater (a b)
    (if (> a b) a b))
  (reduce #'pick-greater lst
          :initial-value most-negative-long-float))

(defun max-number (lst)
  (flet ((pick-greater (a b)
           (if (> a b) a b)))
    (reduce #'pick-greater lst
            :initial-value most-negative-long-float)))

下の例のように、fletや、再帰する場合、labelsを使ってローカル関数を定義します。

内部defunは以前のSBCLでは警告が出たと思ったのですが、今回改めて試してみると警告はでなくなっているようです。

他の処理系でも警告は出ないのですが、これは書法としてOKなのでしょうか…。

6.4 foldの定義

リストの操作を学習する上で、foldの定義をしてみるというのは教材として良いアイディアではないかと思いました。

ここで#?=を使用したデバッグプリントがでてきますが、CLにはないので、適当に以前作ったものを、また載せてみます。

(defmacro debug-print (obj &optional name (output t))
  `(let ((name (if ,name ,name 0)))
     (format ,output "~&#?=[~A]:~A~%#-~4T~A~%" name ',obj ,obj)
     ,obj))

(defun gauche-debug-print (stream char arg)
  (declare (ignore char))
  (if (char= #\= (peek-char t stream))
      (read-char stream))
  `(debug-print ,(read stream t nil t) ,arg t))

(set-dispatch-macro-character #\# #\? #'Gauche-debug-print)

;; #?=を仕込む
(defun fold (proc init lst)
  (if (null lst)
      init
      (fold proc
            #111?=(funcall proc (car lst) init)
            #555?=(cdr lst))))

;; 使ってみる
(fold #'+ 0 '(1 2 3 4 5))
;>>>
;#?=[111]:(FUNCALL PROC (CAR LST) INIT)
;#-  1
;#?=[555]:(CDR LST)
;#-  (2 3 4 5)
;#?=[111]:(FUNCALL PROC (CAR LST) INIT)
;#-  3
;#?=[555]:(CDR LST)
;#-  (3 4 5)
;#?=[111]:(FUNCALL PROC (CAR LST) INIT)
;#-  6
;#?=[555]:(CDR LST)
;#-  (4 5)
;#?=[111]:(FUNCALL PROC (CAR LST) INIT)
;#-  10
;#?=[555]:(CDR LST)
;#-  (5)
;#?=[111]:(FUNCALL PROC (CAR LST) INIT)
;#-  15
;#?=[555]:(CDR LST)
;#-  NIL

Gaucheのようにソースファイルの行を表示することは、難しかったのですが、ディスパッチマクロ文字は、10進数の引数が取れるので番号付けで代用してみています。

しかし、CLには、普通にtraceがあるので、

(trace fold)

で、

  0: (FOLD #<FUNCTION (SB-C::&OPTIONAL-DISPATCH +) {10007DEFC9}> 0 (1 2 3 4 5))
    1: (FOLD #<FUNCTION (SB-C::&OPTIONAL-DISPATCH +) {10007DEFC9}> 1 (2 3 4 5))
      2: (FOLD #<FUNCTION (SB-C::&OPTIONAL-DISPATCH +) {10007DEFC9}> 3 (3 4 5))
        3: (FOLD #<FUNCTION (SB-C::&OPTIONAL-DISPATCH +) {10007DEFC9}> 6 (4 5))
          4: (FOLD #<FUNCTION (SB-C::&OPTIONAL-DISPATCH +) {10007DEFC9}> 10 (5))
            5: (FOLD #<FUNCTION (SB-C::&OPTIONAL-DISPATCH +) {10007DEFC9}> 15
                     NIL)
            5: FOLD returned 15
          4: FOLD returned 15
        3: FOLD returned 15
      2: FOLD returned 15
    1: FOLD returned 15
  0: FOLD returned 15

のように表示することもできるので、普通はこっちを使えば良いかなと思います。

6.5 簡単なリスト処理

ここでは、CLの関数で言えば、last、copy-list、copy-tree/練習問題、append、reverse、find-ifを自作することによってリスト処理を学びます。

deep-copy-listは、CLの標準関数でいうと、copy-treeになるかと思います。

一応、課題を書いてみました。

(defun deep-copy-list (lst)
  (if (consp lst)
      (cons (deep-copy-list (car lst))
            (deep-copy-list (cdr lst)))
      lst))
  • char-alphabetic? => alpha-char-p

char-alphabetic?は、CL標準では、alpha-char-pとして存在しています。

  • find => find-if

ここでのfindは、CLでは、find-ifです。

また、condの説明がでてきますが、Schemeのようにelseがキーワードになってはいません。

慣例的にtを書きますが、CLでは、nil以外は全部真なので、'Tでも'elseでも:elseでもOKです。

また、RSR6風の括弧の使い方ですが、CLにはこのようなものはないので欲しい場合は、自作することになると思います。

(defun open-bracket-macro-char (stream macro-char)
  (declare (ignore macro-char))
  (read-delimited-list #\] stream t))
(set-macro-character #\[ #'open-bracket-macro-char)
(set-macro-character #\] (get-macro-character #\)))

;; 使用例
(defun my-find-if (pred lst)
  (cond [(null lst) nil]
        [(funcall pred (car lst)) (car lst)]
        [:else (my-find-if pred (cdr lst))]))

6.6 2種類の再帰

末尾再帰とそれ以外の再帰についてのセクションです。

Schemeでは末尾再帰が最適化されるというところは、Schemeのプログラミング書法にはかなり大きく影響していると思います。

CLでは、最適化することを義務付けてはいないので、処理系によってするものもあればしないものもあるといった感じです。

ということで、末尾再帰が必ず最適化されることを期待して書くということは推奨されていないようで普通にループで書くことが多いようです。

イレギュラーなところでは、

(defun len (lst)
  (prog ((lst lst) (n 0))
    =>  (return (if (null lst)
                    n
                    (progn (setq lst (cdr lst) n (1+ n))
                           (go =>))))

のように書けば、関数呼び出し気分なgotoを書けるので、もの好きな方にはお勧めしたいです(笑)

このブログでも、末尾再帰の最適化機構付きのtail-recursive-defunというマクロを古いMacLISPのコードからみつけて動作を考えてみたことがありましたが、マクロのレベルで構文を解析して、末尾再帰的記述をループに書き換えるというのはどの程度有効なのでしょう。

どうしても、変数の代入と束縛というところが違ってきてしまう気はしますが…。