2008-10-15
【どう書く】MDL/Muddleのmapfを作る
MDL |
deliciousを眺めていたところ、MDLの古いマニュアルをみつけることができました。
MDLとは、MITで開発されていたLISP系の処理系でZetalisp〜Common Lispのオプショナル引数等の複雑なラムダリストキーワドやバッククオートのアイディアの源泉らしいです。
The MDL Programming Language Primer:
ということで、つらつらとマニュアルを眺めていたのですが、このマニュアルで紹介されているmapfというのが何だか面白そうなので再現してみることにしました。
しかし、ただ再現するだけでは面白くないので、挑戦問題として掲げてみることにしました。
mapfの仕様は下記の通りです。
(mapf final-function loop-function &rest lists)
基本動作
殆どmapcarのようなものなのですが、結果にfinal-functionを適用するというのが違います。
副作用のみに使用する等の目的でfinal-functionにはnilも指定でき、final-functionを省略可能です。
(mapf #'list #'identity '(1 2 3 4))
;=> (1 2 3 4)
(defun mappend (fn &rest lists)
(apply #'mapf #'append fn lists))
(mappend #'list
'(1 2 3 4 5)
'(a b c d e))
;=> (1 A 2 B 3 C 4 D 5 E)
loop-function内で利用できる関数
mapleave
mapleaveという関数が利用でき、呼び出された場合は、mapleaveの引数を返り値にして終了します。(returnみたいなもの)
(defun first-nonzero (list)
(mapf ()
(lambda (x)
(when (not (zerop x)) (mapleave x)))
list))
(first-nonzero '(0 0 0 0 9 0 0))
;=> 9
mapret
mapretという関数が利用でき、呼び出された場合は、mapretの引数を蓄積します。
複数の値が指定された場合は、1つのリストで合体するのではなく、スプライスされた状態でくっつきます。
また、mapretの引数が省略された場合は、何も蓄積されません。
(defun odd-list (list)
(mapf #'list
(lambda (x) (if (oddp x)
x
(mapret)))
list))
(odd-list '(1 2 3 4 5))
;=> (1 3 5)
(defun odd-list2 (list)
(mapf #'list
(lambda (x) (if (oddp x)
x
(mapret 'e 'ven)))
list))
(odd-list2 '(1 2 3 4 5))
;=> (1 E VEN 3 E VEN 5)
mapstop
mapstopという関数が利用でき、呼び出された場合は、それまでの蓄積された結果と、mapstopの引数を合成して返します。
(defun first-ten (list)
(let ((cnt 10))
(mapf #'list
(lambda (x)
(when (zerop (decf cnt)) (mapstop 10))
x)
list)))
(first-ten '(1 2 3 4 5 6 7 8 9 10 11 12))
;=> (1 2 3 4 5 6 7 8 9 10)
引数指定でリストを省略できる
mapfでは、final-functionと、loop-functionのみで、リストを取らずに使用することも可能です。
この場合、mapstopや、mapleaveで抜ける必要があり、loop-functionでの値は蓄積されます。
(defun lnum (n &aux (cnt 0))
(mapf #'list
(lambda ()
(if (<= n (incf cnt))
(mapstop n)
cnt))))
;=> (lnum 10)
(1 2 3 4 5 6 7 8 9 10)
というような仕様です。コードの例は、MDLの例をCLに翻訳してみました。
詳しくは、マニュアルを眺めてみると分かりやすいかもしれません。
CLでの実装は、割と良い感じにトリッキーなコードにならざるを得ないと思うので、暇な時のパズルにでもどうでしょうか!
自分の解答は、来週位にエントリしてみたいと思います。…誰も挑戦してくれなさそうですが挑戦お待ちしています!
■
lisp2で、functionがうざい問題
一定周期で耳にするCLの#'がうざい問題ですが、今日のチャットでも話題になったので、また色々考えてみました。
前のネタとしては、symbol-valueに、symbol-functionの値をグローバルにセットしてしまえば、#'を書く手間だけは省けるだろうというものでしたが、
そういえば、lisp1という、CLをlisp1的に書く試みがどっかにあったなと思い出したので、探して試してみました。
ちょっと試してみたのですが、ネタ的には、やはり、symbol-functionの値をsymbol-valueにセットするというのが骨子なようです(笑)
ついでにローカルな感じでlisp1的に書けるwith-lisp1ってのを考えてみました。ちなみに局所関数には対応してません。
(import 'kmrcl:flatten)
(defmacro with-lisp1 (&body body)
(let ((syms (remove-if-not (lambda (x)
(and (symbolp x)
(fboundp x)
(not (eq 'quote x))))
(flatten body))))
`(let ,(mapcar (lambda (x) `(,x (symbol-function ',x))) syms)
(declare (ignorable ,@syms))
,@body)))
;; 動作
(with-lisp1
(mapcar 1+ '(1 2 3 4)))
;=> (2 3 4 5)
(with-lisp1
(sort (list 38 29 3 1) <))
;=> (1 3 29 38)
■