| /* { 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; |
| } |