KMRCLを眺める(200) GENERALIZED-EQUAL-HASH-TABLE — #:g1

Posted 2010-09-06 13:21:00 GMT

今回は、KMRCLのequal.lispからGENERALIZED-EQUAL-HASH-TABLEです。
KMRCLを眺めつづけてとうとう200回になってしまいました。まだ残りは結構あります…。
今回も引き続きで、名前からしてハッシュテーブルの同値性を判定するものと思われます。
定義は、

(defun generalized-equal-hash-table (obj1 obj2)
  (block test
    (when (not (= (hash-table-count obj1) (hash-table-count obj2)))
      (return-from test nil))
    (maphash
     #'(lambda (k v)
         (multiple-value-bind (value found) (gethash k obj2)
           (unless (and found (generalized-equal v value))
             (return-from test nil))))
     obj1)
    (return-from test t)))
HASH-TABLE-COUNT でサイズを勘定して比較し同じでないなら脱出。サイズが同じなら今度は再帰的にハッシュの要素について GENERALIZED-EQUAL で判定、ということで前回のGENERALIZED-EQUAL-ARRAYと同じ構成です。
(LET ((TAB1 (MAKE-HASH-TABLE))
      (TAB2 (MAKE-HASH-TABLE :TEST 'EQUAL)))
  (KL::GENERALIZED-EQUAL-HASH-TABLE TAB1 TAB2))
;⇒ T
(G000001::AUTO-IMPORT 'ALIST->HASH-TABLE)
;⇒ (:FARE-UTILS)

(LET ((TAB1 (ALIST->HASH-TABLE '((:A . 1) (:B . 2) (:C . 3)))) (TAB2 (ALIST->HASH-TABLE '((:A . 1) (:B . 2) (:c . 3))))) (KL::GENERALIZED-EQUAL-HASH-TABLE TAB1 TAB2)) ;⇒ T


comments powered by Disqus