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

添字的symbol-macrolet

| 17:18 | 添字的symbol-macrolet - わだばLisperになる を含むブックマーク はてなブックマーク - 添字的symbol-macrolet - わだばLisperになる

Common Lispの標準では、[]は単なる文字なので、添字のように使ってみようという思い付き。

;; 添字
(let ((foo '(1 2 3 4)))
  (symbol-macrolet ((foo[1] (nth 0 foo))
                    (foo[2] (nth 1 foo))
                    (foo[3] (nth 2 foo))
                    (foo[4] (nth 3 foo))
                    (foo[5] (nth 4 foo))
                    (foo[6] (nth 5 foo))
                    (foo[7] (nth 6 foo)))
    (list foo[2] foo[3] foo[1])))
;=> (2 3 1)

;; ハッシュ
(let ((ht (make-hash-table)))
  (setf (gethash :foo ht) 30)
  (symbol-macrolet ((ht[foo] (gethash :foo ht)))
    (setf ht[foo] 40)
    ht[foo]))
;=> 40 , T

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))

with-??? その2

| 14:16 | with-??? その2 - わだばLisperになる を含むブックマーク はてなブックマーク - with-??? その2 - わだばLisperになる

前回、入れ子にして使うのは不便ということが分かったので、複数の引数に対応してみようということで、拡張してみましたが、作成途中で、シンボルの連結を"-"ではなくて、"."にすると、Arcみたいに書けることに気付いたので、"."で連結してみることにしました。連結を逆にすると、JAVA等でお馴染の連結順にもなります。

(import 'pg:symb)
(import 'kmrcl:mapappend)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *fn*
    '(car cdr rest first second third forth fifth sixth seventh eighth ninth tenth 
      reverse length null gensym 1+ 1-)))

(defmacro with-??? ((&rest args) &body body)
  (let ((xx (mapappend (lambda (y)
                         (mapcar (lambda (x)
                                   `(,(symb x "." y) (,x ,y))) *fn*))
                       args)))
    `(symbol-macrolet ,xx
       ,@body)))

(defmacro with-???-reverse ((&rest args) &body body)
  (let ((xx (mapappend (lambda (y)
                         (mapcar (lambda (x)
                                   `(,(symb y "." x) (,x ,y))) *fn*))
                       args)))
    `(symbol-macrolet ,xx
       ,@body)))

;; 適当に書いてみる。
(defun encode-direct (coll &aux (g "G"))
  (with-??? (coll tem g acc cnt reverse.acc)
    (if null.coll
        ()
        (labels ((recur (coll tem acc)
                   (let ((cnt first.tem) (item second.tem))
                     (cond (null.coll cdr.reverse.acc)
                           ((eql car.coll item)
                            (recur cdr.coll (list 1+.cnt car.coll) acc))
                           (:else
                            (recur cdr.coll 
                                   `(1 ,car.coll)
                                   (cons (if (= 1 cnt)
                                             item
                                             tem)
                                         acc)))))))
          (recur `(,@coll ,gensym.g)
                 `(1 ,gensym.g)
                 () )))))

;; 逆順で連結
(defun encode-direct (coll &aux (g "G"))
  (with-???-reverse (coll tem g acc cnt acc.reverse)
    (if coll.null
        ()
        (labels ((recur (coll tem acc)
                   (let ((cnt tem.first) (item tem.second))
                     (cond (coll.null acc.reverse.cdr)
                           ((eql coll.car item)
                            (recur coll.cdr (list cnt.1+ coll.car) acc))
                           (:else
                            (recur coll.cdr
                                   `(1 ,coll.car)
                                   (cons (if (= 1 cnt)
                                             item
                                             tem)
                                         acc)))))))
          (recur `(,@coll ,g.gensym)
                 `(1 ,g.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))

という感じでなんとなくArcっぽく書けますが、なんにしろカオスな感じです。

defunや、defmacroと合体してみるというのもアリな気もしてきました。

ClojureでL-99 (P14 要素を2回繰り返す)

| 13:09 | ClojureでL-99 (P14 要素を2回繰り返す) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P14 要素を2回繰り返す) - わだばLisperになる

Clojureにも畳み込み用のreduceがあります。

(defn
  #^{:doc "P14 (*) Duplicate the elements of a list."
     :test (do (test= (dupli []) [])
               (test= (dupli '(a b c c d))
                      '(a a b b c c c c d d))) }
; -----
  dupli
; -----
  ([coll]
     (reduce #(concat % (list %2 %2))
             []
             coll)))

anaphoric-destructuring-bind改め、with-???

| 01:05 | anaphoric-destructuring-bind改め、with-??? - わだばLisperになる を含むブックマーク はてなブックマーク - anaphoric-destructuring-bind改め、with-??? - わだばLisperになる

前回のエントリでは、anaphoric-destructuring-bindとかいう名前の変なマクロを考えてみたわけなのですが、前に出てきたものを参照してるわけでもなんでもないので、anaphoricというのは変だということに気付きました。

また、使い方もリストに限定されているわけでもないので、destructuring-bindという訳でもないということに気付きました。

とりあえず、変だということは分かったのですが、かといって上手い名前も思い付かず…。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *fn*
    '(car cdr rest first second third forth fifth sixth seventh eighth ninth tenth 
      reverse length null)))

(defmacro with-??? (list &body body)
  (let ((xx (mapcar (lambda (x) `(,x (,x ,list))) *fn*)))
    `(symbol-macrolet ,xx
       ,@body)))

;---- 
(let ((foo (list 1 2 3 4)))
  (with-??? foo
    (list :orig foo
          :reverse reverse
          :length length
          :null null)))
;=> (:ORIG (1 2 3 4) :REVERSE (4 3 2 1) :LENGTH 4 :NULL NIL)

;; 適当に何か書いてみる。
(defun encode-direct (coll)
  (with-??? coll
    (if null
        ()
        (labels ((recur (coll tem acc)
                   (with-??? coll
                     (destructuring-bind (cnt item) tem
                       (cond (null (cdr (reverse acc)))
                             ((eql car item)
                              (recur cdr (list (+ 1 cnt) car) acc))
                             (:else
                              (recur cdr 
                                     (list 1 car)
                                     (cons (if (= 1 cnt)
                                               item
                                               tem)
                                           acc))))))))
          (recur (append coll (list (gensym)))
                 (list 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)) 

適当に小物を書いてみたのですが、with-???は、入れ子だと名前が競合して使いにくいことが判明しました。(当然といえば当然なのですが)

(with-??? foo bar ... )とした場合、foo-car、bar-first等で参照できるようにすると解決できそうではありますが、混沌としたものになりそうです…。