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

俺Arc祭り 2008冬 (7)

| 02:46 | 俺Arc祭り 2008冬 (7) - わだばLisperになる を含むブックマーク はてなブックマーク - 俺Arc祭り 2008冬 (7) - わだばLisperになる

もう少しで終了の俺Arc祭り。知らぬ間に世の中では、俺Scheme/Lisp祭りが始まっている様子。

今年、Schemeは盛り上がりそうだなー。

Common Lispも、意味なく盛り上がんないかな。

Common Lisp面白いと思うんだけどなあ。

それはさておき、

16. Overloading

クラスを作るときに関数を指定して実行時に指定した関数をオーバーロードするとのことですが、ギブアップです(;´Д`)

 (= pt (class nil 'x 0 'y 0 pr my-pr))

とかすると、ptの呼び出しでは、prじゃなくて、my-prが呼び出される、ということでしょうか。

どうすれば良いのか検討もつかないなあ。

17. DBs are hashes/alists

dbというものが定義されて、これは、連想リストや、ハッシュ的なものだそうです。

  • newdb、db、get

newdbで新規のdbを作成、dbは簡略版で、問い合わせのテストにeqを過程するものだそうです。

getで、キーを指定して値を取り出します。

また、問い合わせに失敗した場合は、大域変数*fail*を返すとのこと。

;;
;; 動作
;(newdb eq 'x 'a 'y 'b)

(= foo (db x 'a y 'b))

(get x foo)
;-> a

(each x (db x 1 y 2)
   (pr x)
   (keep key))
;12
;(X Y)

;; おれおれ定義
(cl:defmacro newdb (test &rest keys-&-vals)
  `(loop :with ht = (make-hash-table :test #',test)
         :for kv :on ',keys-&-vals :by #'cddr
         :do (setf (cl:gethash (car kv) ht) (%unquote (cadr kv)))
         :finally (return ht)))

(cl:defmacro db (&rest keys-&-vals)
  `(newdb eq ,@keys-&-vals))

(shadow 'get)

(defparameter *fail* nil)

(cl:defmacro get (key db)
  `(multiple-value-bind (val test) (cl:gethash ',key ,db)
     (cl:if test val '*fail*)))

;; dbを扱えるようにeachを拡張。禁斷のeval発動…。
(macro each body
  (if (hash-table-p (eval (cadr body)))
      `(with-keep-or-sum 
	 (each/hash ,@body))
      `(with-keep-or-sum 
	 (each1 ,@body))))

(cl:defun %keys+values (ht)
  (loop :for k :being :the :hash-keys :in ht :using (:hash-value v)
        :collect k :into ks
        :collect v :into vs
        :finally (return (values (coerce ks 'vector) (coerce vs 'vector)))))

(cl:defmacro each/hash (var ht cl:&body body)
  (with (/v (gensym) /k (gensym) /cnt (gensym))
    `(multiple-value-bind (,/k ,/v) (%keys+values ,ht)
       (cl:let (,var key)
	 (declare (ignorable key ,var))
	 (to1 ,/cnt (length ,/k)
	   (setq ,var (aref ,/v ,/cnt) key (aref ,/k ,/cnt))
	   ,@body)))))

;; with-keep-or-sumの定義が変だったので変更
(cl:defmacro with-keep-or-sum (&body body)
  (with (s (x-finder 'sum body) k (x-finder 'keep body))
    (cl:cond ((and s k) (error "SUMとKEEPはどちらかでお願いしたい。"))
	     (s `(with-sum
		   ,@body))
	     (k `(with-keep
		   ,@body))
	     ('T `(progn ,@body)))))