Archive for the ‘pull’ Tag
newLISP で On Lisp する...第12章(その2)
(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp に定義してあります。)
第12章 汎変数 の 更に複雑なユーティリティ から。
Common Lisp のマクロ incf は、newLISP では、 組込 ++ (または、浮動小数点用の inc)になります。
> (++ 1) 2 > (setq x 1) 1 > (++ x) 2 > x 2 > (setq x '(1 2)) (1 2) > (++ (x 1) 2) 4 > x (1 4) >
先頭の例のように、Common Lisp の incf と違って、即値にも対応しています。
さて、setf の上に作る更に複雑なマクロ は、次のようになります。
(define-macro (_f op)
; (_f op place &rest args)
(letex (_place (args 0)
_args (append (list op) '($it) (1 (args))))
(setf _place _args)))
(define-macro (pull)
; (pull obj place)
(letex (_x (gensym)
_place (args 1)
_obj (args 0))
(setf _place (let (_x $it) (replace _obj _x)))))
(define-macro (pull-if)
; (pull test place)
(letex (_x (gensym)
_place (args 1)
_test (args 0))
(setf _place (let (_x $it) (find-all nil _x $it (fn (x y) (not (_test y))))))))
(define-macro (popn)
; (popn n place &rest args)
(letex (_x (gensym)
_place (args 1)
_n (args 0))
(let (_y)
(setf _place (let (_x $it)
(setq _y (0 _n _x))
(if (< _n (length _x))
(_n _x) '())))
_y)))
マクロ_f は、“On Lisp” 本書にある誤り例の ,place を $it に置き換えたものです。第12章(その1)で見たように、newLISP では、これで十分なはずです。
マクロpull の動作は、
> (let (x '(1 2 (a b) 3)) (println (pull 2 x)) x) (1 (a b) 3) (1 (a b) 3) > (let (x '(1 2 (a b) 3)) (println (pull '(a b) x)) x) (1 2 3) (1 2 3) >
そして、マクロpull-if は、
> (let (x '(0 1 2 3 4 5)) (println (pull-if oddp x)) x) (0 2 4) (0 2 4) > (let (x '(0 1 2 3 4 5)) (println (pull-if (curry = 2) x)) x) (0 1 3 4 5) (0 1 3 4 5) >
さらに、マクロpopn の動作は、
> (let (x '(a b c d e f g)) (println (popn 3 x)) x) (a b c) (d e f g) >
となります。全て、$it を使って、適切なインバージョンになっているはず。
さてと、 更に複雑なユーティリティ 最大の難関、マクロ sortf です。
(defun add-c-1st (lst)
(labels ((add/c (x) (if (symbol? x) (letex (_x x) ''_x) x)))
(if (atom? lst) (add/c lst)
(begin (setf (first lst) (add/c $it)) lst))))
(define-macro (sortf op)
(letn (_vars (map (fn (x) (if (list? x) ((curry map eval) x) (eval x))) (map add-c-1st (args)))
_vals (sort (map eval (map eval _vars)) op))
(letex (_body (cons 'setf (apply append (transpose (list _vars _vals)))))
'_body)))
予め断っておきますが、現段階で、適切なインバージョンが行われるのは、インデックス機能だけです。マクロがこれだけで済んでいるのは、ソートを組込sort に任せているからです。
> (setq x 1 y 2 z 3) 3 > (sortf > x y z) 1 > (list x y z) (3 2 1) > (setq i 0 x 2 ar '(2 1 2) lst '(3 1 1)) (3 1 1) > (sortf > x (ar (inc i)) (lst (dec i))) 1 > x 3 > ar (2 2 2) > lst (1 1 1) >
あと、nth や first 等のインバージョンを追加すればいいのですが、ここは、出来るということを示せればいいかな、ということで(汗)。さらりと書いていますが、newLISP でここまで出来るとは思ってみませんでした。newLISP には、get-setf-method なんてありませんからね。
最後の例を、例によって、展開式で見てみると、
> (setq i 0 x 2 ar '(2 1 2) lst '(3 1 1)) (3 1 1) > (sortf > x (ar (++ i)) (lst (-- i))) (setf x 3 (ar 1) 2 (lst 0) 1) > (sortf
となります。
長くなってきたので、インバージョンを定義する は、次回に。
以上、如何でしょうか?