Posted 2022-02-13 04:09:18 GMT
前回は、muLISPの暗黙のcondをリーダーマクロで再現してみましたが、コードウォーキングのお題としても使えそうな気がしたので、今回は暗黙のcondをコードウォーカーを使って再現してみたいと思います。
今回利用するコードウォーカーはarnesi
のwalk-form
です。
S式をパーズしてフォームのオブジェクトに変換し、それをアンパーズしてS式に戻す、という方式です。
変換の戦略としては、muLISPの暗黙のcondは、Common Lispの適用フォームとしては不正なので、これを検知して式を変換します。
具体的には、carにcons
が来るのはlambda
式の時のみなので、それ以外のcons
のフォームを暗黙のcondと見做せば良さそうですが、arnesiでは、lambda式は既にlambda-application-form
としてハンドリングされているので、それ以外のfree-application-form
の方にメソッドを定義します。
(ql:quickload '(alexandria arnesi))(defpackage mu
(:use)
(:export defun))
(defun get-block-name (env)
#+sbcl (caar (sb-c::lexenv-blocks env))
#+lispworks (caar (compiler::compiler-environment-benv env)))
(defmacro return-innermost (val &environment env)
`(return-from ,(get-block-name env) ,val))
;;;((foo ...) ...) => (when (foo ...) ... (return-innermost ...))
(arnesi:defunwalker-handler arnesi:free-application-form (arnesi:operator arnesi:arguments)
(typecase arnesi:operator
(cons (destructuring-bind (pred &rest body)
(call-next-method)
`(when ,pred ,@(butlast body)
(return-innermost ,@(last body)))))
(atom (call-next-method))))
(defmacro mu:defun (name (&rest args) &body body)
(multiple-value-bind (body decl doc)
(alexandria:parse-body body :documentation T)
`(defun ,name (,@args)
,@(if doc `(,doc) `())
,@decl
,(arnesi:unwalk-form
(arnesi:walk-form `(progn ,@body))))))
(mu:defun fib (n)
"fib"
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (type fixnum n))
(labels ((fib (n &aux n1 n2)
((< n 1) 0)
((< n 2) 1)
(setq n1 (1- n))
(setq n2 (- n 2))
(+ (fib n1)
(fib n2))))
(fib n)))
===>
(defun fib (n)
"fib"
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (type fixnum n))
(progn
(labels ((fib (n &aux n1 n2)
(when (< n 1) (return-innermost 0))
(when (< n 2) (return-innermost 1))
(setq n1 (1- n))
(setq n2 (- n 2))
(+ (fib n1) (fib n2))))
(fib n))))(fib 40)
→ 102334155
(mu:defun fizzbuzz (n)
(flet ((fizzp (n) ((zerop (rem n 3)) T) nil)
(buzzp (n) ((zerop (rem n 5)) T) nil))
((buzzp n)
((fizzp n) "fizzbuzz")
"buzz")
((fizzp n) "fizz")
n))
===>
(defun fizzbuzz (n)
(progn
(flet ((fizzp (n) (when (zerop (rem n 3)) (return-innermost t)) nil)
(buzzp (n) (when (zerop (rem n 5)) (return-innermost t)) nil))
(when (buzzp n) (when (fizzp n) (return-innermost "fizzbuzz")) (return-innermost "buzz"))
(when (fizzp n) (return-innermost "fizz"))
n)))
(loop :for i :from 1 :repeat 100 :collect (fizzbuzz i))
→ (1 2 "fizz" 4 "buzz" "fizz" 7 8 "fizz" "buzz" 11 "fizz" 13 14 "fizzbuzz" 16 17 "fizz" 19 "buzz" "fizz" 22 23 "fizz" "buzz" 26 "fizz" 28 29 "fizzbuzz" 31 32 "fizz" 34 "buzz" "fizz" 37 38 "fizz" "buzz" 41 "fizz" 43 44 "fizzbuzz" 46 47 "fizz" 49 "buzz" "fizz" 52 53 "fizz" "buzz" 56 "fizz" 58 59 "fizzbuzz" 61 62 "fizz" 64 "buzz" "fizz" 67 68 "fizz" "buzz" 71 "fizz" 73 74 "fizzbuzz" 76 77 "fizz" 79 "buzz" "fizz" 82 83 "fizz" "buzz" 86 "fizz" 88 89 "fizzbuzz" 91 92 "fizz" 94 "buzz" "fizz" 97 98 "fizz" "buzz")
arnesi
のwalk-form
を利用してmuLISPの暗黙のcondを再現してみました。
SBCLやLispWorksに付属のPCL系のwalk-form
でも可能ですが、arnesiのものはカスタマイズしたい部分にメソッドを定義してやるだけなので簡潔かと思います。
ただし、今回のような定義では、arnesi
のunwalk-form
全体に影響を及ぼしてしまうので、フォームオブジェクトをサブクラス化してカスタマイズに使う等の工夫が必要になるかと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0