tak0kadaの何でもノート

発声練習、生存確認用。

医学関連は 医学ノート

RのオブジェクトのC実装

以下https://cran.r-project.org/doc/manuals/r-release/R-ints.htmlとコードを眺めながら書いた駄文。ドキュメントは充実しているので良い。その他書き足す気力が失われたがmode、typeof、is.XX関数は重要と思われる。コードを読んでいると結局Rのオブジェクトを表すSEXPREC構造体の要素を理解しているか(していないので厳しい)がコード全体の理解のポイントではないかと思った。

1. Rのオブジェクト

SEXPRECという名前の構造体でオブジェクトを表す。関数の返り値はポインタであるSEXPになっているものが多い。命名は心が汚れているので違うものに見えるが、Rの元になったSの表現(expression)と関係があるらしい。Rinternals.hを見ると、

#define SEXPREC_HEADER \
    struct sxpinfo_struct sxpinfo; \
    struct SEXPREC *attrib; \
    struct SEXPREC *gengc_next_node, *gengc_prev_node

typedef struct SEXPREC {
    SEXPREC_HEADER;
    union {
        struct primsxp_struct primsxp;
        struct symsxp_struct symsxp;
        struct listsxp_struct listsxp;
        struct envsxp_struct envsxp;
        struct closxp_struct closxp;
        struct promsxp_struct promsxp;
    } u;
} SEXPREC, *SEXP;

XXXsxpという構造体を複数まとめたものになっている。SEXPRECC_HEADERで定義されるポインタのうち後ろattribは属性を登録していくのに使い、gengc_xxはオブジェクトがノードとして数珠つなぎにして管理されている様子を表す。sxpinfoは

#define TYPE_BITS 5
struct sxpinfo_struct {
    SEXPTYPE type      :  TYPE_BITS;/* ==> (FUNSXP == 99) %% 2^5 == 3 == CLOSXP
                             * -> warning: `type' is narrower than values
                             *              of its type
                             * when SEXPTYPE was an enum */
    unsigned int obj   :  1;
    unsigned int named :  2;
    unsigned int gp    : 16;
    unsigned int mark  :  1;
    unsigned int debug :  1;
    unsigned int trace :  1;  /* functions and memory tracing */
    unsigned int spare :  1;  /* currently unused */
    unsigned int gcgen :  1;  /* old generation number */
    unsigned int gccls :  3;  /* node class */
}; /*               Tot: 32 */

というビットフィールドを使って情報を詰め込んだ構造体であり、最初の5ビットでオブジェクトの種類を表すことになっている(どうしてTYPE_BITSをマクロで定義したんだろうか)。SEXPTYPEはunsinged intで、

typedef unsigned int SEXPTYPE;

#define NILSXP       0    /* nil = NULL */
#define SYMSXP       1    /* symbols */
#define LISTSXP      2    /* lists of dotted pairs */
#define CLOSXP       3    /* closures */
#define ENVSXP       4    /* environments */
...
#define S4SXP       25    /* S4, non-vector */

/* used for detecting PROTECT issues in memory.c */
#define NEWSXP      30    /* fresh node created in new page */
#define FREESXP     31    /* node released by GC */

#define FUNSXP      99    /* Closure or Builtin or Special */

となっている。S4クラスは特別に識別用のフラグが割り当てられていることが分かる。

2. S3オブジェクト、class(obj) <- "Dog"

2.1 Rで調べる

疲れてきたので調べが甘いが、ベクトルでも行列でもclassで自由にクラスを変更できたのでS4以外のオブジェクトは基本的にS3クラスのはず。

> a <- "hoge"
> class(a) <- "Cat"

> print(a)
[1] "hoge"
attr(,"class")
[1] "Cat"

> attributes(a)$klass <- "Dog"
[1] "hoge"
attr(,"class")
[1] "Cat"
attr(,"klass")
[1] "Dog"

となり、classは属性の一つとして文字列で"Cat"とペアになっているだけなことが分かる。実際"klass"と"Dog"も登録できた。

2.2 C実装

class(厳密には"class<-")関数はCではR_do_set_class(SEXP call, SEXP op, SEXP args, SEXP env)と定義されている。

  • callは「SEXP call: the complete call to the function. CAR(call) gives the name of the function (as a symbol); CDR(call) gives the arguments.SEXP call: the complete call to the function.」(分からん)
  • opはPRIMFUN(op)でc関数に対応
  • argsは引数
  • envは関数が実行された環境

を表す。coerce.cのR_do_set_classからR_set_class(SEXP obj, SEXP value, SEXP call)setAttrib(obj, R_ClassSymbol, R_NilValue)(attrib.c)は

SEXP setAttrib(SEXP vec, SEXP name, SEXP val)
{
    ...
    if (name == R_NamesSymbol)
        return namesgets(vec, val);
    else if (name == R_DimSymbol)
        return dimgets(vec, val);
    else if (name == R_DimNamesSymbol)
        return dimnamesgets(vec, val);
    else if (name == R_ClassSymbol)
        return classgets(vec, val);
    else if (name == R_TspSymbol)
        return tspgets(vec, val);
    else if (name == R_CommentSymbol)
        return commentgets(vec, val);
    else if (name == R_RowNamesSymbol)
        return row_names_gets(vec, val);
    else
        return installAttrib(vec, name, val);
}

となっている。結局Rオブジェクトobjに対して、特定の属性nameの場合、それにvalを登録し、そうでない場合新しい属性nameでvalを登録することになっているらしい。例えばinstallAttribを見てみると、

static SEXP installAttrib(SEXP vec, SEXP name, SEXP val)
{
    SEXP t = R_NilValue; /* -Wall */

    if(TYPEOF(vec) == CHARSXP)
        error("cannot set attribute on a CHARSXP");
    /* this does no allocation */
    for (SEXP s = ATTRIB(vec); s != R_NilValue; s = CDR(s)) {
        if (TAG(s) == name) {
            SETCAR(s, val);
            return val;
        }
        t = s; // record last attribute, if any
    }

    /* The usual convention is that the caller protects,
       but a lot of existing code depends assume that
       setAttrib/installAttrib protects its arguments */
    PROTECT(vec); PROTECT(name); PROTECT(val);
    SEXP s = CONS(val, R_NilValue);
    SET_TAG(s, name);
    if (ATTRIB(vec) == R_NilValue) SET_ATTRIB(vec, s); else SETCDR(t, s);
    UNPROTECT(3);
    return val;
}

SET_ATTRIBはSEXPREC_HEADERで定義されていたattrib(SEXP型の変数)にsを登録するよう。sはすぐ上でCONS(←lispにある関数と同名!!)という関数でvalをリストに連結するものだろうと考えられる。

3. S4、R5、R6オブジェクト

3.1 S4

  • S4クラスのフラグ

Rinternal.hを見ると、

/* S4 object bit, set by R_do_new_object for all new() calls */
#define S4_OBJECT_MASK ((unsigned short)(1<<4))
#define IS_S4_OBJECT(x) ((x)->sxpinfo.gp & S4_OBJECT_MASK)
#define SET_S4_OBJECT(x) (((x)->sxpinfo.gp) |= S4_OBJECT_MASK)
#define UNSET_S4_OBJECT(x) (((x)->sxpinfo.gp) &= ~S4_OBJECT_MASK)

コメントによるとnew()を呼ぶとgpを1<<4(=16)に設定するらしい。IS_S4_OBJECT(x)はisS4()でも呼び出される。

※ 上で見たようにx->sxpinfo.typeでS4クラスかどうかの確認は出来るはずで、実際TYPEOF(x)マクロではそのように定義されている。coerce.cにはif(IS_S4_OBJECT(x) && TYPEOF(x) == S4SXP) {のような条件式があるが重複にならない理由は不明。

  • 機能(@)

attrib.cにdo_AT関数が定義されている。

3.2 R5、R6

R5クラスのインスタンスはS4クラスのよう。

> Dog <- setRefClass(Class = "Dog")
> b <- Dog$new()
> isS4(a)
TRUE
> isS4(b)
TRUE
> b@.xData
<environment: 0xc3d050>
> Dog@
Dog@.Data      Dog@generator  Dog@className  Dog@package    

実際、Dog、bともに@で色々な変数が見えていることも踏まえると、(確認したわけではないが)R5クラスはS4クラスから実装したのだと考えて良いと思う。

残した調べもの

SEXPREC構造体の理解、mode、typeof、is.XX関数の理解、S4クラスのC実装