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 |

2008-01-31

お題(127): 指定コマンドを別プロセスで起動、Arcで参加etc

| 20:09 | お題(127): 指定コマンドを別プロセスで起動、Arcで参加etc - わだばLisperになる を含むブックマーク はてなブックマーク - お題(127): 指定コマンドを別プロセスで起動、Arcで参加etc - わだばLisperになる

Common Lisp部門

今回のお題は、指定コマンドを別プロセスで起動とのこと。

とりあえず、KMRCLのcommand-outputを紹介して終わりました。

Arc部門

もっと「俺も俺も」とドッカンドッカン投稿されるのかと思ってたんですが、今日現在盛り上がってるのは、アジア圏内参加者では私一人だけのようです。

関数名等がCommon Lisp系のものが殆どなので、Common Lispに馴染みがあるとなんとなく気軽かなという気はしています。

そんな感じなので、Schemeの人とかは、Schemeの標準関数とかSRFIを片っ端から作ってしまうという学習方法もアリな気もします(笑)

決められた枠が非常にゆるい気がするので、やりたい放題な印象も受けますし…。

あと、システムのソースのarc.arcを眺めるとやりたいことが、存外さっと見付かって良い感じです。

それはさておき、そういった感じで、簡単なのをつらつらと投稿しております。

  • Hello, world!

とりあえず、昨日のうちに記念で投稿しました。

  • 与えられた数字のケタ数

文字列にして勘定の方向で

  • コラッツ・角谷の問題

前にCLで作ったのを翻訳してみたんですが、元が遅いので動作が遅いままです。

afnってのがあるんですが、結構便利な気がします。

ネーミングはitの代りにselfで参照できるアナフォリック無名関数ってことなんでしょうか。

((afn (x)
   (if (< x 2)
       x
       (+ (self (- n 1))
	  (self (- n 2)))))
 2)

とか。

  • 重複無し乱数

Common Lispのrotatefを使った感じで作ってみました。

  • 重複する要素を取り除く

CL版をそのまま書き直し

  • アレイのuniq

元からあるので、それを紹介

  • n人中m人が当選するくじ

「重複する要素を取り除く」の解答を流用してやっつけ気味

Arcを使ってみてのちょっとしたこと
  1. 全体的に短く書けるだけに、無闇に短くしたくなる。
  2. 関数名が大体3文字に略された単語なので、自分が付ける名前もそんな感じになって行く…。
  3. cdr:memとか割と良い感じに思える。多分馴れると常套句が沢山できる気がする。とりあえず、引数を1つしか取らないのを見付けると、すぐ合体してみたくなる。
  4. (lst 3)とかも案外良い感じ、要するに、lst[3]ということなのだけれど…。
  5. (push (pop (nchcdr lst (rand (len lst)))) res)とかしたかったけど、現状では駄目らしい。

末尾再帰的DEFUN (2)

| 04:53 | 末尾再帰的DEFUN (2) - わだばLisperになる を含むブックマーク はてなブックマーク - 末尾再帰的DEFUN (2) - わだばLisperになる

何となく釈然としないまま、一旦放置した末尾再帰的DEFUNですが、何となく眺めていると末尾再帰をgo-toに変換するんじゃないのかなあ、という気がしてきました。

つまり明示的に末尾再帰で書かれたものを、完全なループに変換するという目的のものだったのではないかと思えてきました。

そう考えると、関数呼び出しの個所をgo-toに変換すれば良いのですが、

(defun fib (n &optional (a1 1) (a2 0))
  (if (< n 2)
      a1
      (fib (1- n) (+ a1 a2) a1))))

のような末尾再帰の定義は

(defun fib (n &optional (a1 1) (a2 0))
  (prog ()
    L   (if (< n 2)
	    (return a1)
	    ((lambda (t1 t2 t3) (setq n t1 a1 t2 a2 t3) (go L)) (1- n) (+ a1 a2) a1)))))

のようにすれば、マクロで置き換えるのも、そんなに大変でもないかなと。

本当は、

(defun fib (n &optional (a1 1) (a2 0))
  (prog ()
    L   (if (< n 2)
	    (return a1)
	    (progn (setq n (1- n) a1 (+ a1 a2) a2 a1) (go L))))))

という風にするべきな気もします。スタックの使われ方とか、その辺に違いがありそうですが、disassemしても良く分からなかったので、とりあえず、lambdaの方で行くことにしました。

それで、この場合、PROGの中に展開されるので、最終的に値を返すところには、returnを付けないといけない訳なのですが、それがどこなのか判別するのは至難の技なので、逆にRETURNの中に展開してしまうことにしました。オリジナルもこういう感じなのですが、こういうことなのかも知れません。

(defun fib (n &optional (a1 1) (a2 0))
  (prog ()
    L   (return (if (< n 2)
		    a1
		    ((lambda (t1 t2 t3) (setq n t1 a1 t2 a2 t3) (go L)) (1- n) (+ a1 a2) a1))))))

そんなこんなでいつものごとくガチャガチャと自分なりに作ってみました。

RETURN式の中から外にgotoとかして良いのかしら、とか思ったりしますが、これって手法としてはありななんですかねえ。

lispList

末尾再帰的DEFUN

| 02:12 | 末尾再帰的DEFUN - わだばLisperになる を含むブックマーク はてなブックマーク - 末尾再帰的DEFUN - わだばLisperになる

今日は、Arcもいじっていたのですが、なんとなくSAILのMACLISPのコードも漁っていました。

SAILのものは非常に野心的というか、変態的というか、妙なコードが多いのですが、ふと以前から気になっていたTAIL-RECURSIVE-DEFUNのコードを追っ掛けてみることにしました。

実際のコードはこちらです。

SAILの変態っぷりは、恐らくRichard P.Gabriel氏によるところが非常に大きいと思うのですが、何となくこのTAIL-RECURSIVE-DEFUNもそんな香りがします。

とりあえず、探ってみたいのは、このコードです。

(DEFUN (TAIL-RECURSIVE-DEFUN MACRO)(X)
  ((LAMBDA(?F-NAME *TYPE)
    ((LAMBDA(*ARGS *DEFINITION)
      ((LAMBDA(?GO-LABEL)
	(α-GRAB-TAILS *ARGS *DEFINITION ?GO-LABEL)
	(CCODE (DEFUN ?F-NAME *TYPE (*ARGS) (PROG NIL
						  ?GO-LABEL
						  (RETURN (PROGN *DEFINITION))))))
       (GENSYM)))
     (COND (*TYPE (CADDDR X))(T (CADDR X)))
     (COND (*TYPE (CDDDDR X))(T (CDDDR X)))))
   (CADR X)
   (COND ((MEMQ (CADDR X) '(EXPR FEXPR))
	  (LIST (CADDR X)))
	 (T NIL))))
 ;

これは一体何をするものなのか。自動で末尾再帰に変換してくれるのか。それとも他に末尾再帰的な何かの特長があるのか、謎です…。

とりあえず、もの凄くLAMBDAがネストしているのですが、これはLETの役割です。それで、DEFUNになっているのですが、MACLISPでは、DEFUNでマクロも定義でき、この場合、マクロを定義しています。

最終的には、(defun foo (n) ...body)のように展開されたものができるんじゃないかと思います。

それでこのTAIL-RECURSIVE-DEFUNが依存している関数で独自に定義されたものを追っ掛けてみます。

とりあえず、MACLISPからCLへ移植してみました。CLにないMACLISP標準は自作しています。

(DEFUN ANY-MEMQ(X Y)
  (COND ((NULL Y)NIL)
	((ATOM Y)(EQ X Y))
	(T(OR (ANY-MEMQ X (CAR Y))
	      (ANY-MEMQ X (CDR Y))))))

;(any-memq 'x '(y (((((x(((())))))))) z))
;=> t

(defmacro ccode (X) `(DO-CODE ,x))

(DEFUN DO-CODE(X)
  (COND ((NULL X)NIL)
	((ATOM X)
	 ((LAMBDA(CHAR1)
	   (COND ((MEMQ CHAR1 '(? *))X)
		 (T (LIST 'QUOTE X))))
	  (GETCHAR X 1)))
	((AND (ATOM (CAR X))(EQ '* (GETCHAR (CAR X) 1)))
	 (LIST 'APPEND (DO-CODE (CAR X)) (DO-CODE (CDR X))))
	(T(LIST 'CONS (DO-CODE (CAR X)) (DO-CODE (CDR X))))))

(DEFUN α-GRAB-TAILS (ARGS DEF ?GO-LABEL)
 (COND ((ATOM DEF)NIL)
       ((AND (ATOM(CAR DEF)) (EQ 'TAIL-RECUR (CAR DEF)))
	(COND ((EQUAL ARGS (CDR DEF))		;calling with same args!
	       (RPLACA DEF 'GO)
	       (RPLACD DEF (LIST ?GO-LABEL)))
	      (T(DO ((ARGS ARGS (CDR ARGS))
		     (NEWARGS (CDR DEF) (CDR NEWARGS))
		     (SETS NIL (NCONC SETS
				      (COND ((EQ (CAR ARGS) (CAR NEWARGS))
					     NIL)
					    (T (NCONS
						((LAMBDA(SYM)
						  (CONS (CONS (CAR ARGS)SYM)
							(LIST 'SETQ
							      (CAR ARGS)
							      (SUBLIS (MAPCAR 'CAR
									      SETS)
								      (CAR NEWARGS)))))
						 (GENSYM))))))))
		    ((NULL ARGS)
		     ((LAMBDA(L-EXP)
		       (RPLACA DEF (CAR L-EXP))
		       (RPLACD DEF (CDR L-EXP)))
		      (α-OPTIMIZE-λ (MAPCAR 'CDAR SETS)
				    (NCONC (MAPCAR 'CDR SETS)
					   (NCONS(LIST 'GO ?GO-LABEL)))
				    (MAPCAR 'CAAR SETS))))))))
       (T(MAPC (FUNCTION(LAMBDA(DEF)
			 (α-GRAB-TAILS ARGS DEF ?GO-LABEL)))
	       DEF))))

(DEFUN α-OPTIMIZE-λ (VARS BODY BINDINGS)
  (DO ((VARS VARS (CDR VARS))
       (BINDINGS BINDINGS (CDR BINDINGS))
       (NVARS NIL (NCONC NVARS
			 (COND ((ANY-MEMQ (CAR VARS) BODY)(NCONS (CAR VARS)))
			       (T NIL))))
       (NBINS NIL (NCONC NBINS
			 (COND ((ANY-MEMQ (CAR VARS) BODY)(NCONS (CAR BINDINGS)))
			       (T NIL)))))
      ((NULL VARS)(CONS (CONS 'LAMBDA (CONS NVARS BODY))
			NBINS))))

;; オリジナルに割と忠実版
(defmacro TAIL-RECURSIVE-DEFUN (&whole X &body body)
  (declare (ignore body))
  ((LAMBDA(?F-NAME *TYPE)
     ((LAMBDA(*ARGS *DEFINITION)
	((LAMBDA(?GO-LABEL)
	   `(progn
	      ,@(α-GRAB-TAILS *ARGS *DEFINITION ?GO-LABEL)
	      (DEFUN ,?F-NAME ,*TYPE (,@*ARGS) (PROG NIL
						  ,?GO-LABEL
						  (RETURN (PROGN ,@*DEFINITION))))))
	 (GENSYM)))
      (COND (*TYPE (CADDDR X))(T (CADDR X)))
      (COND (*TYPE (CDDDDR X))(T (CDDDR X)))))
   (CADR X)
   (COND ((MEMQ (CADDR X) '(EXPR FEXPR))
	  (LIST (CADDR X)))
	 (T NIL))))

;; バッサリとMACLISP特有の部分を切り捨てた版
(defmacro TAIL-RECURSIVE-DEFUN (?f-name *args &body *definition)
  (let ((?GO-LABEL (gensym)))
    `(progn
       ,(α-GRAB-TAILS *ARGS *DEFINITION ?GO-LABEL)
       (DEFUN ,?F-NAME (,@*ARGS) 
	 (PROG NIL
	    ,?GO-LABEL
	       (RETURN (PROGN ,@*DEFINITION)))))))


;; ML標準の関数達
(defun ncons (n) (list n))

(defun memq (x y)
  (member x y :test #'eq))

(defun getchar (x index)
  (values (intern (string (char (string x) (1- index))))))
 ; 

中身の動作なのですが、とりあえず、

(α-GRAB-TAILS '(x y z) '(tail-recur) 'go)
;-> ((LAMBDA () (SETQ X NIL) (SETQ Y NIL) (SETQ Z NIL) (GO GO))) 

(α-GRAB-TAILS '(x y z) '(tail-recur x) 'go)
;-> ((LAMBDA () (SETQ Y NIL) (SETQ Z NIL) (GO GO))) 

(α-GRAB-TAILS '(x y z) '(tail-recur y z x) 'go)
;-> ((LAMBDA (#:G2999) (SETQ X Y) (SETQ Y Z) (SETQ Z #:G2999) (GO GO)) X) 

(α-GRAB-TAILS '(x y z) '( y z x) 'go)
;-> (Y Z X) 

(do-code '(?foobarbaz hello one))
;(CONS ?FOOBARBAZ (CONS 'HELLO (CONS 'ONE NIL))) 

(do-code '(*foobarbaz hello one))
;(APPEND *FOOBARBAZ (CONS 'HELLO (CONS 'ONE NIL))) 

(tail-recursive-defun xyz (x y z)
  tail-recur
  (list x y z))
; マクロ展開結果
;->
(PROGN
 ((LAMBDA () (SETQ X (LIST X Y Z)) (SETQ Y NIL) (SETQ Z NIL) (GO #:G2995)))
 (DEFUN XYZ (X Y Z)
   (PROG ()
    #:G2995
     (RETURN
      (PROGN
       ((LAMBDA ()
          (SETQ X (LIST X Y Z))
          (SETQ Y NIL)
          (SETQ Z NIL)
          (GO #:G2995))))))))

という感じです。

α-OPTIMIZE-λは、どうやら不要な変数束縛を取り除いて簡略化するもののようで、これは理解できました。

これを呼び出しているα-GRAB-TAILSが良く分からないのですが、名前からすると、末尾部分を抽出するもののようなのですが、動きが良く分からない…。

何がどう末尾再帰なのか…、纏められないままエントリを終わります(笑)

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20080131