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 |

2007-09-28


SRFI-61 CONDの拡張

| 18:25 | SRFI-61 CONDの拡張 - わだばLisperになる を含むブックマーク はてなブックマーク - SRFI-61 CONDの拡張 - わだばLisperになる

またもや、「Gaucheクックブック」を読んでいて、cond拡張が便利だなと思ったので、前に自分で作りかけていてやめたcond拡張を再作成してみることにしました。

HTTPヘッダフィールド名をきれいに整形する:

http://d.hatena.ne.jp/rui314/20070924/p1

作ってみている過程でどうでも良いような良くないような、次のような素朴な疑問が何点か浮んできました。

  1. condのT節(else節)がない場合の返り値はどうなるんだろう。
  2. 条件節の結果が多値を返した場合、どうなるんだろう。

まず、1ですが、事の発端は、Gaucheで動作を確認してる最中に

(define (superreverse lst)
  (if (null? lst)
      '()
      (append (superreverse (cdr lst)) 
	      (list (cond ((car lst) pair? => superreverse))))))

(superreverse '(foo bar (foo f)))
 ((#<undef> #<undef>) #<undef> #<undef>)

という風になったので、「あれ、なんでなのかしら?」と思ったわけです。

(define (superreverse lst)
  (if (null? lst)
      '()
      (append (superreverse (cdr lst)) 
	      (list (cond ((car lst) pair? => superreverse)
			  (else (car lst)))))))

なら意図した通りに動きます。

それで定義ですが、R5RSで確認してみたら、else節がない場合で抜けた場合は、未定義ということでした。たまたまですが、Schemeが世に現われた最初の論文*1でも、それらしきことが書いてあるのを今日見付けました。なんらかの美学というか確固とした理由があるんだと思いますが、なんでなんでしょう。CLTL2にもcondのスタイル問題について書いてありますが、GLSの愛なんでしょうか。

それで2ですが、R5RSの定義では、「1引数を取る式でなければならない」とあるので、引数は一つのようです。ということは、多値は取らないのかー、と思って、SRFI-61を読んでみたら、多値の処理もできるようにするのも目的だった様子。そうなのか、ガードが取れるようにした拡張だけじゃなかったのかー、と思って試してみたら、

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

(cond ((values 1 2) values => values)
→1,2

(cond ((values 1 2) (lambda val (even? (length val))) => values))
 1 2

(cond ((values 1 2 3) (lambda val (even? (length val))) => values)
      (else 'foo))
 foo

でした。なるほど。

ということで、自分なりにグチャグチャと作ってみました。

(defmacro cond-61 (&body forms)
  (if (every #'null (mapcar (lambda (form) (member '=> form :test #'eq)) forms))
      `(cl:cond ,@forms)		;Basic
      (let (retforms gss)
	(dolist (f forms `(let ,gss (cond ,@(nreverse retforms))))
	  (if (member '=> f :test #'eq)
	      (cl:cond ((and (eq '=> (third f)) (= 4 (list-length f))) ;SRFI-61
			(destructuring-bind (generator guard => receiver) f
			  (declare (ignore =>))
			  (let ((gs (gensym)))
			    (push `((multiple-value-call 
					,guard (values-list 
						(setq ,gs (multiple-value-list 
							   ,generator))))
				    (multiple-value-call ,receiver (values-list ,gs)))
				  retforms)
			    (push `((values-list ,gs)) retforms) ;fall thru
			    (push gs gss))))
		       ((and (eq '=> (second f)) (= 3 (list-length f)))	; R5RS
			(destructuring-bind (generator => receiver) f
			  (declare (ignore =>))
			  (let ((gs (gensym)))
			    (push `((setq ,gs ,generator) (funcall ,receiver ,gs)) retforms))))
		       ('T (error "srfi:COND: bad clause in cond?: ~S" f)))
	      (push f retforms))))))

...
(cond-61 ((values 1 2) => #'values))1      

(cond-61 ((values 1 2) #'values => #'values))1,2

(cond-61 ((values 1 2) (lambda (&rest val) (evenp (length val))) => #'values))1 2

(cond-61 ((values 1 2 3) (lambda (&rest val) (evenp (length val))) => #'values)
	 ('T 'foo))
→ foo

Common Lispなのでelse節がない場合は上から値が落ちてくる値が返ることにしました。ということで、

(defun superreverse (lst)
  (and lst
       (append (superreverse (cdr lst)) 
	       (list (cond-61 ((car lst) #'consp => #'superreverse))))))

(superreverse '(foo bar baz (1 2 3)))((3 2 1) BAZ BAR FOO)

はありにしました。

*1:SCHEME: an interpreter for extended lambda calculus, AI Memo No. 349