わだばLisperになる

L-99 (60)

学びましょう, L-99 | 16:38 |

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

P59変形で、高さの代わりにノード数を与え、バランス

の取れた木を生成するというお題。

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

P60

解答
N = 15のとき生成される木の組み合わせは、1553通り。
(length (hbal-tree-nodes 15))
=> 1553
;;; ---------------------------------------------------------------------------
;;; common lisp
;;; ---------------------------------------------------------------------------
(defun max-nodes (h)
  (1- (expt 2 h)))

(defun min-nodes (h)
  (do ((h h (1- h))
       (res 2 (+ 1 res acc))
       (acc 1 res))
      ((< h 3) res)))

#|(defun min-nodest (h a1 a2)
  (if (< h 3)
      a1
      (min-nodest (1- h) (+ 1 a1 a2) a1)))|#

(defun max-height (n)
  (do ((i 0 (1+ i)))
      ((> (min-nodes i) n) (1- i))))

(defun min-height (n)
  (1+ (truncate (log n 2))))

(defun hbal-tree-nodes (n)
  (let ((min-height (min-height n))
	(max-height (max-height n)))
    (do ((h min-height (1+ h))
	 res)
	((> h max-height) res)
      (setq res `(,@(remove-if-not (lambda (x) (= n (count-leaf x)))
				   (hbal-tree h))
		    ,@res)))))

ツイートする

.3

読みましょう, MACLISP | 00:31 |

今回は、以前から分析してみたかったコードに挑戦してみました。

お題は、30年以上前のコードと思われるMaclispのrdsylの定義です。

Maclisp/maklap.lsp

http://www.google.com/codesearch?hl=ja&q=+DEFUN%5C+RDSYL+show:vVmLEzSQCwQ:uCPQVGUIK4w:K_YYdzk_7EY&sa=N&cd=1&ct=rc&cs_p=ftp://ftp.ultimate.com/pdp10/maclisp/maclsp804.tar.gz&cs_f=maclsp804/maklap.lsp#a0

(DEFUN RDSYL (L DF) 
  (PROG (LL BRAKP ANS CH)
	(SETQ DF (MERGEF DF '((* *) * *)))
     AA	(SETQ LL (SETQ BRAKP () ))
     A	(SETQ CH (OR (CAR L) #/_))
        (COND ((OR (= CH #/^Q) (= CH #//))	 			;"/", "^Q" ;^Qはコントロール文字
	       (POP L)
	       (SETQ CH (CAR L)))
	      ((AND (= CH #/[) (NOT #%(ITSP)))				;"["
	       (SETQ BRAKP 'T))
	      ((AND (= CH #/]) (NOT #%(ITSP))) (SETQ BRAKP () ))	;"]"
	      ((OR (= CH #/( ) (= CH #/) )) (RETURN () ))		;Cant have parens here
	      ((= CH #/,)					;Comma
	       (COND ((NOT BRAKP)
		      (POP L)
		      (GO RET))))
	      ((= CH #/_) (GO RET)))
	(PUSH CH LL)
	(POP L)
	(GO A)
   RET  (SETQ DF (MERGEF (NAMELIST (MAKNAM (NREVERSE LL))) DF))
	(SETQ ANS (NCONC ANS (LIST DF)))
	(AND (= CH #/,) (GO AA))
	(RETURN ANS) ))

だいぶ前に、自分もスティーブン・レビーの「ハッカーズ」を図書館から借りて読みました。それで、Greenblatt氏に興味を持って適当に検索していたら、lispmeister.comのブログでcomp.lang.lispで、奇怪なコードが典型的なGreenblatt氏のスタイルとして紹介されている、というエントリを目にして以来いつか分析してみたいなと思っていました。

http://lispmeister.com/blog/lisp-news/richard-greenblatt.html

日本のLispUser.netさんのところでも紹介されてます。

http://lispuser.net/memo/lisp/2006-06-25-10-20.html

ということで、写経してみたいのですが、ちょっとこれは動作自体が想像できず、記憶もできないので、今回は、分解して一体何をするものなのかということを解明してみることにします。

前準備:

• 全体的な動作

コードから動作が想像できないので、実際にMaclispを実際に動かしてみて確認してみたところ、どうやらファイル名を受け取ってシステムで使用できる名前に整える関数のようです。

• エスケープ文字

Common Lispだと、キャラクタは、#\Aの様に表現されますが、Maclispは、/がエスケープ文字なので、#/Aの様に表現されます。

• 関数名:RDSYL

Read Symbol Listとかその辺の短縮じゃないかと思うのですが実際のところ何なんでしょう。

• MERGEF

Common Lispのmerge-pathnamesみたいな関数です。

• NAMELIST

デバイスとディレクトリ、ファイル名、拡張子をシステムが扱える形式にして出力する関数のようです。

• MAKNAM

何とも説明しにくいのですが、

(defun maknam (syms)
  (intern
   (map 'string (lambda (x) (char (string x) 0))
	syms)))

のような動作をする関数です。

• #%

#.とか#,とかその辺の動作と同じなんでしょうか、詳細は分かりませんでした。あってもなくても大体の動作は同じでした。

• ITSP

ITS上のMaclispでもTOPS-20でも試してみましたが、ITSPはありませんでした。恐らく名前からして、#+ITSみたいなもんだろうとは思います。

大体見通しが付いたので、細かいOS依存のところは無視して、UNIX上で動くCommon Lisp版といった感じに訳してみました。

(defun rdsyl-ux (filename directory) 
  (prog (ll brakp ans ch fn dir)
        (setq fn (coerce filename 'list))
        (setq dir (coerce directory 'list))
     aa	(setq ll (setq brakp () ))
     a	(setq ch (or (car fn) #\_))	;一文字読みこむ。デフォルトは#\_。#\_は番兵としてループから抜ける判断にも使用される。
        (cond ((or (char= ch #\Nul) (char= ch #\/)) ;読み飛ばす。
	       (pop fn)
	       (setq ch (car fn)))
	      ((char= ch #\[) (setq brakp 't)) ;","文字のエスケープ開始
	      ((char= ch #\]) (setq brakp () )) ;","文字のエスケープ解除
	      ((or (char= ch #\( ) (char= ch #\) )) (return () )) ;括弧は名前に使わないので、nilを返して終了
	      ((char= ch #\,)	        ;エスケープされていない","の場合RETへ飛ぶ。
	       (cond ((not brakp)
		      (pop fn)
		      (go ret))))
	      ((char= ch #\_) (go ret))) ;#\_なら、RETへ飛ぶ。
	(push ch ll)
	(pop fn)
	(go a)
   ret  (setq dir (append dir (nreverse ll)))
	(setq ans (nconc ans (list dir)))
	(and (char= ch #\,) (go aa))
	(return (coerce (car ans) 'string)) ))

動作の解析:

• ファイル名中の#\Nulと"/"は無視し読み飛ばされる。(UNIX風に変更してみました)
• ","と"_"はファイル名に使えず、終端文字として機能する。
• "["が","より先に出現していれば、","は終端文字にならない。
• ファイル名に"()"は使えない。

(rdsyl-ux "f/o/o.txt" "/tmp/")
=> "/tmp/foo.txt"

のように動作します。

"["と"]"が特別扱いされていますが、これは恐らく、TOPS-10か、SAILのWAITS上でディレクトリが、[30,20]や、[MAC, LSP]の様に表現される為の処理じゃないかと想像しています。ITSは、DSK:DIR;FOO 1のようなファイル名の形式になるので、ITSか、それ以外のOSかを振り分けているのでしょう。

感想:

どうやってループから抜けているのか分からずしばらく悩みました。

多分こういうスタイルにも常套句が色々あって、それに則ったスタイルなんじゃないかなとは思います。

雑感:

それで、結局このコードはGreenblatt氏のコードなのかというと、署名もなにもないのでソースを眺めただけでは分かりません。

Maclispは、JonL White氏がメインで活躍していたみたいなので、JonL氏の可能性も高いと思います。

そして、ループは、progを使用するというスタイルですが、comp.lang.lispでこのコードを紹介したMarshall氏が公開しているLMIの各種Lispマシンのソースコード中のGreenblatt氏のホームディレクトリのLispのファイルを眺めてみてもdoとか普通に使ってるみたいです。ただ70年代の初期のLispマシンの開発においては、progのループでゴリゴリ書いていた可能性は高いとは思います。これは、個人のスタイルというより、70年代全般のスタイルみたいで全体的にdoのループより多いんじゃないかという位です。

それと、Kent Pitman氏のgoタグ使い過ぎの警告についてですが、メッセージを探してみた人がいるみたいですが、見付けられなかったみたいです。自分も暇なので、結構探してみましたが、見付けられませんでした。あるとしたら警告の内容も揶揄するような内容にも思われるので、多分、LMIのライバルのSymbolics社のLispマシンじゃないかなと思います。

ということで、極東の地で壮大に一人でネタに釣られてみました。

ツイートする