use Data::Util -fast_isa; の詳細

(2008/11/16 追記: perl/5.10.1からUNIVERSAL::isa()が改善されることに伴い，Data::Util/0.20から-fast_isaオプションは削除されました)

昨日の続き。

UNIVERSAL::isaとData::Util::fast_isaで何が違うのかというと，核心部分のソースはこんな感じ。細部はともかく，要はmro_get_linear_isa()で目的のパッケージの直列化されたISA配列を取ってきて，それをループでまわしてその目的のクラスと等値比較をしているというのは両方とも同じです。
しかしその比較が，UNIVERSAL::isa()ではその名前に対応するシンボルテーブルを得て比較しているのに対し，Data::Util::fast_isa()では与えられた名前から一意の名前を取得する*1canon_pkg()で得た名前を比較している点が異なります。名前からシンボルテーブルを探し出すgv_stashsv()は比較的重い処理なので，それを行わない分少しだけ高速にすることができたというわけです。

/* Data-Util/Util.xs - Data::Util::fast_isa() */
static int
my_isa_lookup(pTHX_ HV* const stash, const char* klass_name){
  const char* const stash_name = canon_pkg(HvNAME(stash));

  klass_name = canon_pkg(klass_name);

  if(strEQ(stash_name, klass_name)){
    return TRUE;
  }
  else{
    AV*  const stash_linear_isa = mro_get_linear_isa(stash);
    SV**       svp = AvARRAY(stash_linear_isa) + 1;
    SV** const end = svp + AvFILLp(stash_linear_isa);

    while(svp != end){
      if(strEQ(klass_name, canon_pkg(SvPVX(*svp)))){
        return TRUE;
      }
      svp++;
    }
    return strEQ(klass_name, "UNIVERSAL");
  }
}

/* PERL-DIST/universal.c - UNIVERSAL::isa() */
/* なお，本筋に関係ない警告用のコードなどを削除してある */
STATIC bool
S_isa_lookup(pTHX_ HV *stash, const char * const name, const HV* const name_stash)
{
    dVAR;
    AV* stash_linear_isa;
    SV** svp;
    const char *hvname;
    I32 items;

    /* A stash/class can go by many names (ie. User == main::User), so 
       we compare the stash itself just in case */
    if (name_stash && ((const HV *)stash == name_stash))
        return TRUE;

    hvname = HvNAME_get(stash);

    if (strEQ(hvname, name))
  return TRUE;
    if (strEQ(name, "UNIVERSAL"))
  return TRUE;

    stash_linear_isa = mro_get_linear_isa(stash);
    svp = AvARRAY(stash_linear_isa) + 1;
    items = AvFILLp(stash_linear_isa);
    while (items--) {
  SV* const basename_sv = *svp++;
        HV* const basestash = gv_stashsv(basename_sv, 0);
  if (!basestash) {
      continue;
  }
        if(name_stash == basestash || strEQ(name, SvPVX(basename_sv)))
      return TRUE;
    }
    return FALSE;
}

*1:つまり"main::Foo"などから"Foo"を得る。