SEXP PlotManipulator::getUserVisibleValuesList() const
{
SEXP variablesSEXP = get(".variables");
if (variablesSEXP != R_NilValue)
{
r::exec::RFunction userValuesFunction("manipulate:::userVisibleValues");
userValuesFunction.addParam(sexp());
userValuesFunction.addParam(variablesSEXP);
r::sexp::Protect rProtect;
SEXP valuesSEXP;
Error error = userValuesFunction.call(&valuesSEXP, &rProtect);
if (error)
{
LOG_ERROR(error);
return R_NilValue;
}
else
{
return valuesSEXP;
}
}
else
{
return R_NilValue;
}
}
SEXP PlotManipulator::get(const std::string& name) const
{
if (!empty())
{
r::exec::RFunction getFunction("get");
getFunction.addParam(name);
getFunction.addParam("envir", sexp());
r::sexp::Protect rProtect;
SEXP valueSEXP;
Error error = getFunction.call(&valueSEXP, &rProtect);
if (error)
{
LOG_ERROR(error);
return R_NilValue;
}
else
{
return valueSEXP;
}
}
else
{
return R_NilValue;
}
}
sexp call_lambda_as_ffi_closure(sexp lambda,sexp arg){
void **closure;
closure=make_closure(lambda,env_sexp(cur_env_ptr),1);
if(!closure){
return error_sexp("error constructing ffi_closure");
}
sexp(*f)(sexp)=(sexp(*)(sexp))(closure[0]);
sexp retval=f(arg);
return retval;
}
Integer CompartmentSpaceVectorImpl::num_molecules(const Species& sp) const
{
SpeciesExpressionMatcher sexp(sp);
Integer retval(0);
for (species_map_type::const_iterator i(index_map_.begin());
i != index_map_.end(); ++i)
{
if (sexp.match((*i).first))
{
do
{
retval += num_molecules_[(*i).second];
} while (sexp.next());
}
}
return retval;
}
static int
sexp(void)
{
int p1;
unsigned char *p2;
p1 = e1();
p2 = nxtarg(1);
if (p2 != 0)
{
if (eq(p2, "-o"))
return(p1 | sexp());
/* if (!eq(p2, ")"))
failed("test", synmsg); */
}
ap--;
return(p1);
}
int
test(int argn, unsigned char *com[])
{
ac = argn;
av = com;
ap = 1;
if (eq(com[0],"["))
{
if (!eq(com[--ac], "]"))
failed("test", "] missing");
}
com[ac] = 0;
if (ac <= 1)
return(1);
#ifdef SUS
if (ac == 2)
return(eq(nxtarg(0), ""));
if (ac == 3 || ac == 4)
return(!e3());
#endif /* SUS */
return(sexp() ? 0 : 1);
}
struct sexp *parse()
{
struct sexp *s, *s1, *s2, *s3;
lex();
while(tok[0]) {
if(strcmp(tok, "(") == 0) {
lex();
if(strcmp(tok, "+") == 0) {
s1 = parse();
s2 = parse();
s = sexp(ADD, s1, s2, NULL);
} else if (strcmp(tok, "-") == 0) {
s1 = parse();
s2 = parse();
s = sexp(SUB, s1, s2, NULL);
} else if (strcmp(tok, "*") == 0) {
s1 = parse();
s2 = parse();
s = sexp(MUL, s1, s2, NULL);
} else if (strcmp(tok, "/") == 0) {
s1 = parse();
s2 = parse();
s = sexp(DIV, s1, s2, NULL);
} else if (strcmp(tok, "<") == 0) {
s1 = parse();
s2 = parse();
s = sexp(LT, s1, s2, NULL);
} else if (strcmp(tok, ">") == 0) {
s1 = parse();
s2 = parse();
s = sexp(GT, s1, s2, NULL);
} else if (strcmp(tok, "=") == 0) {
s1 = parse();
s2 = parse();
s = sexp(EQ, s1, s2, NULL);
} else if (strcmp(tok, "if") == 0) {
s1 = parse();
s2 = parse();
s3 = parse();
s = sexp(IF, s1, s2, s3);
} else if (strcmp(tok, "let") == 0) {
lex(); //(
s1 = parse();
s2 = parse();
lex(); //)
s3 = parse();
s = sexp(LET, s1, s2, s3);
}
lex(); //)
return s;
} else if(strcmp(tok, "true") == 0) {
return atom_b(true);
} else if(strcmp(tok, "false") == 0) {
return atom_b(false);
} else if(tok[0] >= 'a' && tok[0] <= 'z') {
return atom_n(tok);
} else if(tok[0] >= '0' && tok[0] <= '9') {
int v;
sscanf(tok, "%d", &v);
return atom_i(v);
}
}
return NULL;
}
static int
e3(void)
{
int p1;
register unsigned char *a;
unsigned char *p2;
long long ll_1, ll_2;
a = nxtarg(0);
if (eq(a, "("))
{
p1 = sexp();
if (!eq(nxtarg(0), ")"))
failed("test",") expected");
return(p1);
}
p2 = nxtarg(1);
ap--;
if ((p2 == 0) || (!eq(p2, "=") && !eq(p2, "!=")))
{
if (eq(a, "-r"))
return(chk_access(nxtarg(0), S_IREAD, 0) == 0);
if (eq(a, "-w"))
return(chk_access(nxtarg(0), S_IWRITE, 0) == 0);
if (eq(a, "-x"))
return(chk_access(nxtarg(0), S_IEXEC, 0) == 0);
#ifdef SUS
if (eq(a, "-e"))
return(access(nxtarg(0), F_OK) == 0);
if (eq(a, "-S"))
return(filtyp(nxtarg(0), S_IFSOCK));
if (eq(a, "!"))
return(!e3());
#endif /* SUS */
if (eq(a, "-d"))
return(filtyp(nxtarg(0), S_IFDIR));
if (eq(a, "-c"))
return(filtyp(nxtarg(0), S_IFCHR));
if (eq(a, "-b"))
return(filtyp(nxtarg(0), S_IFBLK));
if (eq(a, "-f"))
if (ucb_builtins) {
struct stat statb;
return(stat((char *)nxtarg(0), &statb) >= 0 &&
(statb.st_mode & S_IFMT) != S_IFDIR);
}
else
return(filtyp(nxtarg(0), S_IFREG));
if (eq(a, "-u"))
return(ftype(nxtarg(0), S_ISUID));
if (eq(a, "-g"))
return(ftype(nxtarg(0), S_ISGID));
if (eq(a, "-k"))
return(ftype(nxtarg(0), S_ISVTX));
if (eq(a, "-p"))
return(filtyp(nxtarg(0), S_IFIFO));
if (eq(a, "-h") || eq(a, "-L"))
return(filtyp(nxtarg(0), S_IFLNK));
if (eq(a, "-s"))
return(fsizep(nxtarg(0)));
if (eq(a, "-t"))
{
if (ap >= ac) /* no args */
return(isatty(1));
else if (eq((a = nxtarg(0)), "-a") || eq(a, "-o"))
{
ap--;
return(isatty(1));
}
else
return(isatty(atoi((char *)a)));
}
if (eq(a, "-n"))
return(!eq(nxtarg(0), ""));
if (eq(a, "-z"))
return(eq(nxtarg(0), ""));
}
p2 = nxtarg(1);
if (p2 == 0)
return(!eq(a, ""));
if (eq(p2, "-a") || eq(p2, "-o"))
{
ap--;
return(!eq(a, ""));
}
if (eq(p2, "="))
return(eq(nxtarg(0), a));
if (eq(p2, "!="))
return(!eq(nxtarg(0), a));
ll_1 = stoifll(a);
ll_2 = stoifll(nxtarg(0));
if (eq(p2, "-eq"))
return (ll_1 == ll_2);
if (eq(p2, "-ne"))
return (ll_1 != ll_2);
if (eq(p2, "-gt"))
return (ll_1 > ll_2);
if (eq(p2, "-lt"))
return (ll_1 < ll_2);
if (eq(p2, "-ge"))
return (ll_1 >= ll_2);
if (eq(p2, "-le"))
return (ll_1 <= ll_2);
bfailed(btest, badop, p2);
/* NOTREACHED */
return 0;
}
