r - 研究原始和内部R函数的源代码: How is R connected with C?

Question

Ben Bolkers 对 this question 的回答和 article by Uwe Ligges已经非常有用了当我尝试“解码”原始或内部 R 函数时。但是原始 R 函数如何与其相应的 C 函数连接呢？我猜想 .Primitive 必须以某种方式提供这个缺失的链接。以is.na为例:

> is.na
function (x)  .Primitive("is.na")

文件“names.c”中的

FUNTAB R_FunTab[]包含

{"is.na",   do_isna,    0,  1,  1,  {PP_FUNCALL, PREC_FN,   0}},

这意味着is.na使用C函数do_isna。do_isna 在文件“coerce.c”中定义:

SEXP attribute_hidden do_isna(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP ans, dims, names, x;
    R_xlen_t i, n;

    checkArity(op, args);
    check1arg(args, call, "x");

    if (DispatchOrEval(call, op, "is.na", args, rho, &ans, 1, 1))
    return(ans);
    PROTECT(args = ans);
#ifdef stringent_is
    if (!isList(CAR(args)) && !isVector(CAR(args)))
    errorcall_return(call, "is.na " R_MSG_list_vec);

#endif
    x = CAR(args);
    n = xlength(x);
    PROTECT(ans = allocVector(LGLSXP, n));
    if (isVector(x)) {
    PROTECT(dims = getAttrib(x, R_DimSymbol));
    if (isArray(x))
        PROTECT(names = getAttrib(x, R_DimNamesSymbol));
    else
        PROTECT(names = getAttrib(x, R_NamesSymbol));
    }
    else dims = names = R_NilValue;
    switch (TYPEOF(x)) {
    case LGLSXP:
       for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = (LOGICAL(x)[i] == NA_LOGICAL);
    break;
    case INTSXP:
    for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = (INTEGER(x)[i] == NA_INTEGER);
    break;
    case REALSXP:
    for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = ISNAN(REAL(x)[i]);
    break;
    case CPLXSXP:
    for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = (ISNAN(COMPLEX(x)[i].r) ||
                   ISNAN(COMPLEX(x)[i].i));
    break;
    case STRSXP:
    for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = (STRING_ELT(x, i) == NA_STRING);
    break;

/* Same code for LISTSXP and VECSXP : */
#define LIST_VEC_NA(s)                          \
    if (!isVector(s) || length(s) != 1)             \
        LOGICAL(ans)[i] = 0;                    \
    else {                              \
        switch (TYPEOF(s)) {                    \
        case LGLSXP:                        \
        case INTSXP:                        \
            LOGICAL(ans)[i] = (INTEGER(s)[0] == NA_INTEGER);    \
            break;                      \
        case REALSXP:                       \
            LOGICAL(ans)[i] = ISNAN(REAL(s)[0]);        \
            break;                      \
        case STRSXP:                        \
            LOGICAL(ans)[i] = (STRING_ELT(s, 0) == NA_STRING);  \
            break;                      \
        case CPLXSXP:                       \
            LOGICAL(ans)[i] = (ISNAN(COMPLEX(s)[0].r)       \
                       || ISNAN(COMPLEX(s)[0].i));  \
            break;                      \
        default:                        \
            LOGICAL(ans)[i] = 0;                \
        }                           \
    }

    case LISTSXP:
    for (i = 0; i < n; i++) {
        LIST_VEC_NA(CAR(x));
        x = CDR(x);
    }
    break;
    case VECSXP:
    for (i = 0; i < n; i++) {
        SEXP s = VECTOR_ELT(x, i);
        LIST_VEC_NA(s);
    }
    break;
    case RAWSXP:
    /* no such thing as a raw NA */
    for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = 0;
    break;
    default:
    warningcall(call, _("%s() applied to non-(list or vector) of type '%s'"),
            "is.na", type2char(TYPEOF(x)));
    for (i = 0; i < n; i++)
        LOGICAL(ans)[i] = 0;
    }
    if (dims != R_NilValue)
    setAttrib(ans, R_DimSymbol, dims);
    if (names != R_NilValue) {
    if (isArray(x))
        setAttrib(ans, R_DimNamesSymbol, names);
    else
        setAttrib(ans, R_NamesSymbol, names);
    }
    if (isVector(x))
    UNPROTECT(2);
    UNPROTECT(1);
    UNPROTECT(1); /*ans*/
    return ans;
}

但是，例如，如果我们要计算 is.na(x=3)，参数如何生成了 call、op、args、rho 吗？至少必须使用一些外部信息，x=3 是不够的。而且，乍一看根本没有使用x=3，这当然是错误的:

> is.na
function (x)  .Primitive("is.na")

.Primitive的R代码没有给出提示:

> .Primitive
function (name)  .Primitive(".Primitive")

考虑到所有这些，is.na 的看似出色的 isNA 副本失败也就不足为奇了:

> isNA <- function (x)  .Primitive("is.na")
> isNA
function (x)  .Primitive("is.na")
> is.na
function (x)  .Primitive("is.na")
> isNA(x=3)
function (x)  .Primitive("is.na")
> is.na(x=3)
[1] FALSE

说实话:所有 C 函数 do_... 都有这些参数call、op、args、rho。当调用原始 R 函数时，它们是通过什么公式计算的？

Answer 1

很好的问题。我在 gdb R -d gdb 下启动 R，在 do_isna 设置断点，然后继续 R 并输入 is.na(3)。

$ R -d gdb
(gdb) run
Starting program: /home/mtmorgan/bin/R-3-3-branch/bin/exec/R --no-save --no-restore --silent
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
> ## break, cntrl-C
Program received signal SIGINT, Interrupt.
0x00007ffff722fd83 in __select_nocancel () at ../sysdeps/unix/syscall-template.S:81
81  ../sysdeps/unix/syscall-template.S: No such file or directory.
(gdb) b do_isna
Breakpoint 1 at 0x7ffff77e0b3b: file /home/mtmorgan/src/R-3-3-branch/src/main/coerce.c, line 1982.
(gdb) continue
Continuing.

> is.na(3)

Breakpoint 1, do_isna (call=0x1838888, op=0x628218, args=0x1838770, rho=0x63f648)
    at /home/mtmorgan/src/R-3-3-branch/src/main/coerce.c:1982
1982        checkArity(op, args);
(gdb)

在 gdb 提示符下我询问

(gdb) where
#0  do_isna (call=0x1838888, op=0x628218, args=0x1838770, rho=0x63f648) at /home/mtmorgan/src/R-3-3-branch/src/main/coerce.c:1982
#1  0x00007ffff7869170 in Rf_eval (e=0x1838888, rho=0x63f648) at /home/mtmorgan/src/R-3-3-branch/src/main/eval.c:717
#2  0x00007ffff78b36af in Rf_ReplIteration (rho=0x63f648, savestack=0, browselevel=0, state=0x7fffffffcaf0) at /home/mtmorgan/src/R-3-3-branch/src/main/main.c:258
...

从 #2 开始，Rf_ReplIteration 是尝试评估 is.na(3) 的 REPL(读取-求值-打印循环)。它提供了调用该函数的环境。当它在第 258 行调用 Rf_eval() 时，它知道环境和调用

(gdb) call Rf_PrintValue(rho)
<environment: R_GlobalEnv>
(gdb) call Rf_PrintValue(thisExpr)
is.na(3)

到#1 (eval.c:717)，R 已经计算出 op 和 tmp 的值。

(gdb) call Rf_PrintValue(op)
function (x)  .Primitive("is.na")
(gdb) call TYPEOF(op)
$2 = 8

(类型 8 是“BUILTINSXP”，来自 Rinternals.h 中的表)。它通过发现e是一个LANGSXP(第614行)，即.na是一个SYMSXP(第670行)以及它引用的函数(op )是一个 BUILTINSXP(第 700 行)。然后它使用(第 717 行)

(gdb) call PRIMFUN(op)
$8 = (SEXP (*)(SEXP, SEXP, SEXP, SEXP)) 0x7ffff77e0b20 <do_isna>

发现它应该使用它发现的值调用do_isna。

希望这能消除一些神秘感，并指出代码的相关部分。