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-??? その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と合体してみるというのもアリな気もしてきました。