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-02-03

リーダーマクロも深すぎる

| 02:01 | リーダーマクロも深すぎる - わだばLisperになる を含むブックマーク はてなブックマーク - リーダーマクロも深すぎる - わだばLisperになる

Arcについてのブログ記事で、Common Lispのリーダーマクロでhash.keyとか、(hash => key)とか、(hash key)とかできるのか否か、という話題がありました。

面白そうだったので、自分もあれこれ考えて挑戦してみることにしました!

とりあえず、全然関係ないですが、Arcの[ _]構文から、

;; 動作
(mapcar [* 3 _] '(1 2 3 4))
;=> (3 6 9 12)

;; 定義
(set-macro-character #\[ 
		     (lambda (stream char)
		       (declare (ignore char))
		       (let ((body (read-delimited-list #\] stream t)))
			 `#'(lambda (,(intern "_")) ,body))))

(set-macro-character #\] (get-macro-character #\)))

次に、

  1. hash.key
  2. (hash => key)
  3. ("string" 1)
  4. ('(foo bar baz) 1)

のような記法。

本当は丸括弧にしたいところですが、{}で囲んでごまかしています。

丸括弧にも関数は対応しているわけなので、その関数を拡張すれば良いんだろうなと、なんとなくの見当は付いた気はしますが、荷が重いので、今後の課題とすることにしました…。本当に果てしないなあ…。

;; 動作
(let ((l '(foo bar baz))
      (ht (make-hash-table)))
  (setf (gethash 'key ht) 'val)
  (list
   {"foo" 1}
  {'(foo bar baz) 2}
  {l 2}
  {ht 'key}				;(ht 'key)
  {ht => key}				;(ht => key)
  {progn
     ht.key})) 				;ht.key
;=> (#\o BAZ BAZ VAL VAL VAL)

;; ごみごみとした適当な定義
(set-macro-character #\} (get-macro-character #\)))

(set-macro-character #\{
		     (lambda (str char)
		       (declare (ignore char))
		       (let ((body (read-delimited-list #\} str t)))
			 (cond ((eq '=> (cadr body))                 ; (hash => key)
				`(obcall ,(car body) ',(caddr body)))
			       ((some #'sym.bol-p body)              ; hash.key
				(mapcar (lambda (x)
					  (if (sym.bol-p x)
					      (hash.key->gethash x)
					      x))
					body))
			       ('T `(obcall ,@body))))))

(defun sym.bol-p (sym)
  (and (symbolp sym)
       (position #\. (string sym)) t))
      
(defun obcall (obj arg)
  (etypecase obj
    (hash-table (gethash arg obj))
    (sequence (elt obj arg))))

(defun hash.key->gethash (sym)
  (let* ((str (string sym))
	 (sep (position #\. str)))
    (flet ((intern-upcase (str) (intern (string-upcase str))))
      `(gethash ',(intern-upcase (subseq str (1+ sep)))
		,(intern-upcase (subseq str 0 sep))))))
;