The R Project SVN R

#include "embeddedRCall.h"

void bar1() ;
void source(const char *name);
/*
  Creates and evaluates a call 
  to a function giving named arguments
   plot(1:10, pch="+")
 */
int
main(int argc, char *argv[])
{
    char *localArgs[] = {"R", "--silent"};
    init_R(sizeof(localArgs)/sizeof(localArgs[0]), localArgs);
    source("foo.R");
    bar1();

    end_R();
    return(0);
}


/*
 This arranges for the command source("foo.R")
 to be called and this defines the function we will
 call in bar1.
 */
void
source(const char *name)
{
    SEXP e;

    PROTECT(e = lang2(install("source"), mkString(name)));
    R_tryEval(e, R_GlobalEnv, NULL);
    UNPROTECT(1);
}

/* 
  Call the function foo() with 3 arguments, 2 of which
  are named.
   foo(pch="+", id = 123, c(T,F))

  Note that PrintValue() of the expression seg-faults.
  We have to set the print name correctly.
*/

void
bar1() 
{
    SEXP fun, pch;
    SEXP e;

    PROTECT(e = allocVector(LANGSXP, 4));
    fun = findFun(install("foo"), R_GlobalEnv);
    if(fun == R_NilValue) {
    fprintf(stderr, "No definition for function foo. Source foo.R and save the session.\n");
    UNPROTECT(1);
    exit(1);
    }
    SETCAR(e, fun);

    SETCADR(e, mkString("+"));
    SET_TAG(CDR(e), install("pch"));

    SETCADDR(e, ScalarInteger(123));   
    SET_TAG(CDR(CDR(e)), install("id"));

    pch = allocVector(LGLSXP, 2);
    LOGICAL(pch)[0] = TRUE;
    LOGICAL(pch)[1] = FALSE;
    SETCADDDR(e, pch);   

    PrintValue(e);
    eval(e, R_GlobalEnv);

    SETCAR(e, install("foo"));
    PrintValue(e);
    R_tryEval(e, R_GlobalEnv, NULL);

    UNPROTECT(1);
}