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 |

2010-09-10

KMRCLを眺める(204) GENERALIZED-EQUAL

| 23:05 | KMRCLを眺める(204) GENERALIZED-EQUAL - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(204) GENERALIZED-EQUAL - わだばLisperになる

今回は、KMRCLのequal.lispからGENERALIZED-EQUALです。

GENERALIZED-EQUALは、これまで眺めたequal.lispで定義されている関数群の集大成です。

定義は、

(defun generalized-equal (obj1 obj2)
  (if (not (equal (type-of obj1) (type-of obj2)))
      (progn
        (terpri)
        (describe obj1)
        (describe obj2)
        nil)
    (typecase obj1
      (double-float
       (let ((diff (abs (/ (- obj1 obj2) obj1))))
         (if (> diff (* 10 double-float-epsilon))
             nil
           t)))
      (complex
       (and (generalized-equal (realpart obj1) (realpart obj2))
            (generalized-equal (imagpart obj1) (imagpart obj2))))
      (structure-object
       (generalized-equal-fielded-object obj1 obj2))
      (standard-object
       (generalized-equal-fielded-object obj1 obj2))
      (hash-table
       (generalized-equal-hash-table obj1 obj2))
      (function
       (generalized-equal-function obj1 obj2))
      (string
       (string= obj1 obj2))
      (array
       (generalized-equal-array obj1 obj2))
      (t
       (equal obj1 obj2)))))

となっていて、それぞれの型に応じて切り分けられています。

型が一致していなかった時にDESCRIBEしてみせるというのが面白いですね。

動作は、

(KL:GENERALIZED-EQUAL 'CL:PROGN 1)
;->
COMMON-LISP:PROGN
  [symbol]

PROGN names a special operator:
  Lambda-list: (&REST FORMS)
  Documentation:
    PROGN form*
    
    Evaluates each FORM in order, returning the values of the last form. With no
    forms, returns NIL.
  Source file: SYS:SRC;COMPILER;IR1-TRANSLATORS.LISP

Symbol-plist:
  LTD::CVT-FN -> #<FUNCTION (LAMBDA (EXP)) {1000..
  CL-IRREGSEXP::SIMPLIFIER -> #S(CL-IRREGSEXP::SIMPLIFIER..
  SERIES::SCAN-TEMPLATE -> (SERIES::Q . #1=(SERIES::E . #1..
  SB-WALKER::WALKER-TEMPLATE -> (NIL SB-WALKER::REPEAT (EVAL))
1
  [fixnum]

というところ。

総じて言えることとしてはGENERALIZED-EQUAL-FUNCTIONが処理系によっては上手く機能しないというのが残念ですね。

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20100910