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-10-01

with-l/ists

| 16:57 | with-l/ists - わだばLisperになる を含むブックマーク はてなブックマーク - with-l/ists - わだばLisperになる

前回のwith-???では、名前の競合を接頭/尾語を付けることによって解決してみたのですが、リストの名前の最初の一文字をcar残りをcdrであると見立ててみるのはどうかと思い、試してみました。

問題点は、temの場合、t、emとなる訳ですが、tは使えないということと、人工的に名前が作られるので意図しない競合の管理が大変そうです。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun symbol-car (sym)
    (intern (subseq (string sym) 0 1)))
  (defun symbol-cdr (sym)
    (intern (subseq (string sym) 1))))

(defmacro with-l/ists ((&rest lists) &body body)
  (let ((xx (mapappend (lambda (x)
                         `((,(symbol-car x) (car ,x))
                           (,(symbol-cdr x) (cdr ,x))))
                       lists)))
    `(symbol-macrolet ,xx
       ,@body)))

;; 動作
(let ((foo '(1 2 3 4))
      (bar '(a b c d)))
  (with-l/ists (foo bar)
    (list f oo b ar)))
;=> (1 (2 3 4) A (B C D))

;; もうちょっと混み入った例
(defun encode-direct (list)
  (with-l/ists (list item)
    (if (null list)
        ()
        (labels ((recur (list item acc)
                   (cond ((null list) 
                          (cdr (reverse acc)))
                         ((eql l tem)
                          (recur ist `(,(1+ i) . ,l) acc))
                         (:else
                          (recur ist 
                                 `(1 . ,l)
                                 (cons (if (= 1 i)
                                           tem
                                           `(,i ,tem))
                                       acc))))))
          (recur `(,@list ,(gensym)) 
                 `(1 . ,(gensym))
                 () )))))
(encode-direct '(a a a a b c c a a d e e e e))
;=> ((4 A) B (2 C) (2 A) D (4 E))