Viewing file:  pr39740.c (2.73 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
/* { dg-do compile } */
/* { dg-options "-O3 -std=c99 -mexplicit-relocs" } */
typedef int R_len_t;
typedef unsigned int SEXPTYPE;
struct sxpinfo_struct
{
SEXPTYPE type:5;
};
struct vecsxp_struct
{
R_len_t length;
R_len_t truelength;
};
struct listsxp_struct
{
struct SEXPREC *carval;
struct SEXPREC *cdrval;
struct SEXPREC *tagval;
};
typedef struct SEXPREC
{
struct sxpinfo_struct sxpinfo;
union
{
struct listsxp_struct listsxp;
} u;
} SEXPREC, *SEXP;
typedef struct VECTOR_SEXPREC
{
struct vecsxp_struct vecsxp;
} VECTOR_SEXPREC, *VECSEXP;
typedef union
{
VECTOR_SEXPREC s;
double align;
} SEXPREC_ALIGN;
extern SEXP R_NilValue;
extern SEXP R_MissingArg;
int Rf_envlength (SEXP rho);
SEXP Rf_protect (SEXP);
const char *Rf_translateChar (SEXP);
inline R_len_t
Rf_length (SEXP s)
{
int i;
switch (((s)->sxpinfo.type))
{
case 0:
return 0;
case 24:
return (((VECSEXP) (s))->vecsxp.length);
case 6:
case 17:
i = 0;
while (s != ((void *) 0) && s != R_NilValue)
{
i++;
s = ((s)->u.listsxp.cdrval);
}
return i;
case 4:
return Rf_envlength (s);
default:
return 1;
}
}
inline SEXP
Rf_lang3 (SEXP s, SEXP t, SEXP u)
{
return s;
}
typedef SEXP (*CCODE) (SEXP, SEXP, SEXP, SEXP);
static SEXP PlusSymbol;
static SEXP MinusSymbol;
static SEXP DivideSymbol;
int isZero (SEXP s);
SEXP PP (SEXP s);
SEXP AddParens (SEXP expr);
SEXP Rf_install ();
static int
isUminus (SEXP s)
{
if (((s)->sxpinfo.type) == 6 && ((s)->u.listsxp.carval) == MinusSymbol)
{
switch (Rf_length (s))
{
case 2:
return 1;
case 3:
if (((((((s)->u.listsxp.cdrval))->u.listsxp.cdrval))->u.listsxp.
carval) == R_MissingArg)
return 1;
else
return 0;
}
}
else
return 0;
}
static SEXP
simplify (SEXP fun, SEXP arg1, SEXP arg2)
{
SEXP ans;
if (fun == PlusSymbol)
{
if (isZero (arg1))
ans = arg2;
else if (isUminus (arg1))
ans =
simplify (MinusSymbol, arg2,
((((arg1)->u.listsxp.cdrval))->u.listsxp.carval));
else if (isUminus (arg2))
ans =
simplify (MinusSymbol, arg1,
((((arg2)->u.listsxp.cdrval))->u.listsxp.carval));
}
else if (fun == DivideSymbol)
{
ans = Rf_lang3 (DivideSymbol, arg1, arg2);
}
return ans;
}
static SEXP
D (SEXP expr, SEXP var)
{
return simplify (PlusSymbol,
PP (D
(((((expr)->u.listsxp.cdrval))->u.listsxp.carval),
var)),
PP (D
(((((((expr)->u.listsxp.cdrval))->u.listsxp.cdrval))->
u.listsxp.carval), var)));
}
SEXP
do_D (SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP expr, var;
var = Rf_install ();
expr = ((args)->u.listsxp.carval);
Rf_protect (expr = D (expr, var));
expr = AddParens (expr);
return expr;
}
|
