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 |

2007-12-29

Common Lispであんまり衛生的ではないdefine-syntax

| 02:03 | Common Lispであんまり衛生的ではないdefine-syntax - わだばLisperになる を含むブックマーク はてなブックマーク - Common Lispであんまり衛生的ではないdefine-syntax - わだばLisperになる

2月にはGauche本が出版されるとのことで、2月位からSchemeの風が吹きまくると思われ、来年は、ちょっとしたSchemeブームになると思うのです。

On Lispを買いそびれている、Schemeのことはあんまり知らない、どっちかっていうとCommon Lispしか知らない自分でさえ買っちゃおう、と思っているのですから絶対来ると思うのです。

それで、Common Lispですが、Schemeブームのお蔭でそれなりに耳目も集まると思うのです。

Common Lispもなんとはなしに盛り上がると良いですね。

自分もGauche本買ったら、Common Lispで試してみたいと思います(*'-')

そんなSchemeですが、SchemeにはCommon Lispみたいなマクロの機構以外にパターンマッチングをベースにした衛生的なマクロ機構がR5RSで規定されています。

これのCommon Lispがあったので試してみました。

作者は、t-y-schemeのDorai Sitaram氏で配布元は、Scheme Macros for Common Lispです。

これを見付けた時には、これで、SRFI-42を移植しよう!とか思ったのですが、実際に色々試してみるとそんなにするするっと達成できることでもなさそうです。

これを使うと、


(define-syntax aif
  (syntax-rules ()
    ((aif expression then else) (let ((it expression))
				  (if it then else))))
    ((aif expression then) (let ((it expression))
			     (if it then)))))

のようにほとんど、まんまR5RSのdefine-syntaxのようにマクロが書けます。

ちなみに...はCommon Lisp的に実用的でないので、デフォルトは***に設定されています。

SRFI-42はとりあえず置いて、練習としてSRFI-26のcutを移植してみました。


(defpackage :srfi-26
  (:use :cl :mbe)           ;mbeとしてパッケージを作って取り込んでみています。
  (:export :cut :cute))

(in-package :srfi-26)

(define-syntax srfi-26-internal-cut
  (syntax-rules (<> <...>)

    ;; construct fixed- or variable-arity procedure:
    ;;   (begin proc) throws an error if proc is not an <expression>
    ((srfi-26-internal-cut (slot-name ***) (proc arg ***))
     (lambda (slot-name ***) (funcall (progn proc) arg ***)))
    ((srfi-26-internal-cut (slot-name ***) (proc arg ***) <...>)
     (with ((rest-slot (gensym)))
       (lambda (slot-name *** &rest rest-slot) (apply proc arg *** rest-slot))))

    ;; process one slot-or-expr
    ((srfi-26-internal-cut (slot-name ***)   (position ***)      <>  . se)
     (with ((x (gensym)))
       (srfi-26-internal-cut (slot-name *** x) (position *** x)        . se)))
    ((srfi-26-internal-cut (slot-name ***)   (position ***)      nse . se)
     (srfi-26-internal-cut (slot-name ***)   (position *** nse)      . se))))

; exported syntax

(define-syntax cut
  (syntax-rules ()
    ((cut . slots-or-exprs)
     (srfi-26-internal-cut () () . slots-or-exprs))))

殆ど、まんまでOKで、LISP-1と、LISP-2の違いを手動で修正すれば良いだけという感じなのですが、残念ながら、MBEは、define-syntaxが衛生的と言われる所以でもある変数補足の問題までは全自動で解決できないので、(gensym)を使って回避する必要があります。(with 〜)で囲んでgensymと置き換える訳なのですが、これの見極めがちょっと難しい。馴れてないということもあるんでしょうが、どれが補足される可能性があるのか普通のマクロより難しい気がします。

ということで、一応動くことは動くんですが、これで良いのやらという感じです。

しかしこのマクロはかなり凄い気がするので、仕組を理解できたら良いなとは思っています。

;; 動作
;(cut cons (+ a 1) <>) 	is the same as 	(lambda (x2) (cons (+ a 1) x2))
(let ((a 3))
  (funcall (cut #'cons (+ a 1) <>) 3))
;==> (4 . 3)

;(cut list 1 <> 3 <> 5) 	is the same as 	(lambda (x2 x4) (list 1 x2 3 x4 5))
(funcall (cut #'list 1 <> 3 <> 5) 2 4)
;==> (1 2 3 4 5)

;(cut list) 	is the same as 	(lambda () (list))
(funcall (cut #'list))
;==> nil

;(cut list 1 <> 3 <...>) 	is the same as 	(lambda (x2 . xs) (apply list 1 x2 3 xs))
(funcall (cut #'list 1 <> 3 <...>) 2 4 5 6 7)
;==> (1 2 3 4 5 6 7)

;(map (cut * 2 <>) '(1 2 3 4))
(mapcar (cut #'* 2 <>) '(1 2 3 4))
;==> (2 4 6 8)

;(map (cut vector-set! x <> 0) indices)
(let ((x (make-array '(5) ) )
      (indices '(1 3 0 2 4)))
  (flet ((vector-set! (vec idx obj)
	   (setf (aref vec idx) obj)))
    (mapc (cut #'vector-set! x <> 0) indices)
    x))
;==> #(0 0 0 0 0)

;(for-each (cut write <> port) exprs)
(let ((exprs '("foo" "bar" "baz") ) )
  (mapc (cut #'write <> :stream *standard-output*) exprs))
;==> "foo" "bar" "baz"

;(map (cut <> x y z) (list min max))
(let ((x 1) (y 2) (z 3))
  (mapcar (cut <> x y z) (list #'min #'max)))
;==> (1 3)

;(for-each (cut <>) thunks)
(let ((thunks (list (lambda () (print "hello") )
		   (lambda () (print "world")))))
  (mapc (cut <>) thunks))
;==>"hello" "world"