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-26

.6

| 18:35 | .6 - わだばLisperになる を含むブックマーク はてなブックマーク - .6 - わだばLisperになる

今回は、またMaclispのファイルで、UMLMAC.LSPというファイルのdolistを観察/再現してみました。

1981年より前のファイルのようです。

お題:

(defmacro DOLIST ((var form index) &rest body &aux dummy decls)
   (setq decls (cond ((and body 
			   (not (atom (car body)))
			   (eq (caar body) 'DECLARE))
		      (prog2 () (cdar body) (pop body)))))
   (cond (index (push `(FIXNUM ,INDEX) decls)
		(setq index (ncons `(,INDEX 0 (1+ ,INDEX)) ))))
   (and decls (setq decls  (ncons `(DECLARE ,.decls))))
   (si:gen-local-var dummy)
   `(DO ((,DUMMY ,FORM (CDR ,DUMMY)) (,VAR) ,.index )
	((NULL ,DUMMY))
      ,@decls
      (SETQ ,VAR (CAR ,DUMMY))  ,.BODY))

再現:

(defmacro my-old-dolist ((var list &optional index) &body body &aux decls dummy) ;indexの扱いが良く分からない。
  (setq decls (cond ((and (consp (car body)) ;ちょっと違うけど同じことだと思う。
			  (eq (caar body) 'declare)
			  (prog2 () (cdar body) (pop body))))))
  (cond (index (push `(fixnum ,index) decls)
	       (setq index `((,index 0 (1+ ,index)))))) ;`(())と二重にするんじゃなくてncons使ってました。
  (push 'declare decls)			;indexがnilの場合の対策漏れ。(declare)というものが出来てしまう。-> (and decls (push 'declare decls))
  (setq dummy (gensym))
  `(do ((,dummy ,list (cdr ,dummy))
	(,var)				;抜けてました。
	,@index)			;,.使ってました。
       ((null ,dummy))
     ,decls
     (setq ,var (car ,dummy))
     ,@body))				;,.使ってました。

間違ったところ:

  1. varをdo内部で宣言するのを抜かしてしまった。
  2. declareされなかった場合の処理を抜かしてしまった。

考察:

  • 現行のCommon Lispのdolistでは、変数束縛のところの3つ目は、結果を返すところになってますが、これは、インデックスの変数を指定する場所になってます。
(my-dolist (i '(foo bar baz) idx)
  (format t "~A: ~A~%" idx i))
=> 
0: FOO
1: BAR
2: BAZ

これはこれで使えそうな気がします。

  • 返り値は、nil
  • (prog2 () 返したい処理 ~)
    • これはこの当時のイディオムの様で、今ならprog1を使うところだと思います。prog1より先にprog2が存在していた理由は謎です。
  • si:gen-local-var
    • これは、gentemp+適用した変数をローカル扱い?にするもののようですが詳細は謎です。gensymに置き換えて再現で良いんだとは思います。
  • ncons
(defun ncons (x)
  (cons x () ))

のような関数のようです。`( (foo))とは書かずに、(ncons `(foo))と書いています。

  • &optionalでなくても引数を省略できている様子

Tops-20のMaclispで動作を確認しましたが、index引数は省略できてました。詳細は謎です。

  • ,.(コンマドット)
    • Maclispでも、Common Lispのように,.と,@の違いは、nconcを使うか、appendを使うかの違いなのか不明ですが、使い分けしてるようなので、多分、Common Lispと同じのようです。

その他

  • マクロの展開される本体の部分は、大文字で書く」派
  • 「関数/マクロ名は大文字にする」派

Lisp Tutorial

| 15:27 | Lisp Tutorial - わだばLisperになる を含むブックマーク はてなブックマーク - Lisp Tutorial - わだばLisperになる

Practical Common Lisp著者である、Peter Seibel氏が自身のブログで呼びかけるところによれば、Googleの検索キーワード「lisp tutorial」で、Practical Common Lispのページが上位に表示されるようになりたいんだそうで、リンクしてくれよのお願いをしているようです。

自分は、Practical Common Lispはまだ読んでないのでアレですが、何となく参加してみます。

(一週間前は、結構下だったんですが、確認してみたら、もう既に大分上位になってきたようです。)

Lisp tutorial

Bomb me--please!:

http://www.gigamonkeys.com/blog/2007/09/19/bomb-me.html

L-99 (63)

| 02:58 | L-99 (63) - わだばLisperになる を含むブックマーク はてなブックマーク - L-99 (63) - わだばLisperになる

L-99 P63に挑戦 - L-99:Ninety-Nine Lisp Problems

今回は、木の各ノードに番号を振ってゆくというお題。

左のノードを優先して埋めて行き、かつノードの番号付

けは、

         1
   2           3
 4    5     6     7
8 9 10 11 12 13 14 15

のようになるようなので、そういう風に作ったつもりで

ございます。

残りの問題:'(66 80-94 96-99) 解答状況 65/84

P63

回答
;;; ---------------------------------------------------------------------------
;;; common lisp
;;; ---------------------------------------------------------------------------
(load "max-nodes")

(defun complete-binary-tree (n &optional (base 1))
  (if (zerop n)
      ()
      (let ((cn-max-size (max-nodes (1- (cbt-height n))))
	    (gcn-max-size (max-nodes (- (cbt-height n) 2)))
	    (cn (1- n)))
	(cond ((= cn (* 2 cn-max-size))
	       `(,base ,(complete-binary-tree cn-max-size (* 2 base))
		       ,(complete-binary-tree cn-max-size (1+ (* 2 base)))))
	      ((> cn cn-max-size)
	       `(,base ,(complete-binary-tree cn-max-size (* 2 base))
		       ,(complete-binary-tree (- cn cn-max-size) (1+ (* 2 base)))))
	      ((<= cn cn-max-size)
	       `(,base ,(complete-binary-tree (- cn gcn-max-size) (* 2 base))
		       ,(complete-binary-tree gcn-max-size (1+ (* 2 base)))))))))

(defun cbt-height (n)
  (if (zerop n) n (1+ (truncate (log n 2)))))