1 /* { dg-do compile } */
2 /* { dg-options "-O3 -std=c99 -mexplicit-relocs" } */
3
4 typedef int R_len_t;
5 typedef unsigned int SEXPTYPE;
6 struct sxpinfo_struct
7 {
8 SEXPTYPE type:5;
9 };
10
11 struct vecsxp_struct
12 {
13 R_len_t length;
14 R_len_t truelength;
15 };
16
17 struct listsxp_struct
18 {
19 struct SEXPREC *carval;
20 struct SEXPREC *cdrval;
21 struct SEXPREC *tagval;
22 };
23
24 typedef struct SEXPREC
25 {
26 struct sxpinfo_struct sxpinfo;
27 union
28 {
29 struct listsxp_struct listsxp;
30 } u;
31 } SEXPREC, *SEXP;
32
33 typedef struct VECTOR_SEXPREC
34 {
35 struct vecsxp_struct vecsxp;
36 } VECTOR_SEXPREC, *VECSEXP;
37
38 typedef union
39 {
40 VECTOR_SEXPREC s;
41 double align;
42 } SEXPREC_ALIGN;
43
44 extern SEXP R_NilValue;
45 extern SEXP R_MissingArg;
46
47 int Rf_envlength (SEXP rho);
48 SEXP Rf_protect (SEXP);
49 const char *Rf_translateChar (SEXP);
50
51 inline R_len_t
Rf_length(SEXP s)52 Rf_length (SEXP s)
53 {
54 int i;
55 switch (((s)->sxpinfo.type))
56 {
57 case 0:
58 return 0;
59 case 24:
60 return (((VECSEXP) (s))->vecsxp.length);
61 case 6:
62 case 17:
63 i = 0;
64 while (s != ((void *) 0) && s != R_NilValue)
65 {
66 i++;
67 s = ((s)->u.listsxp.cdrval);
68 }
69 return i;
70 case 4:
71 return Rf_envlength (s);
72 default:
73 return 1;
74 }
75 }
76
77 inline SEXP
Rf_lang3(SEXP s,SEXP t,SEXP u)78 Rf_lang3 (SEXP s, SEXP t, SEXP u)
79 {
80 return s;
81 }
82
83 typedef SEXP (*CCODE) (SEXP, SEXP, SEXP, SEXP);
84
85 static SEXP PlusSymbol;
86 static SEXP MinusSymbol;
87 static SEXP DivideSymbol;
88
89 int isZero (SEXP s);
90 SEXP PP (SEXP s);
91 SEXP AddParens (SEXP expr);
92 SEXP Rf_install ();
93
94 static int
isUminus(SEXP s)95 isUminus (SEXP s)
96 {
97 if (((s)->sxpinfo.type) == 6 && ((s)->u.listsxp.carval) == MinusSymbol)
98 {
99 switch (Rf_length (s))
100 {
101 case 2:
102 return 1;
103 case 3:
104 if (((((((s)->u.listsxp.cdrval))->u.listsxp.cdrval))->u.listsxp.
105 carval) == R_MissingArg)
106 return 1;
107 else
108 return 0;
109 }
110 }
111 else
112 return 0;
113 }
114
115 static SEXP
simplify(SEXP fun,SEXP arg1,SEXP arg2)116 simplify (SEXP fun, SEXP arg1, SEXP arg2)
117 {
118 SEXP ans;
119 if (fun == PlusSymbol)
120 {
121 if (isZero (arg1))
122 ans = arg2;
123 else if (isUminus (arg1))
124 ans =
125 simplify (MinusSymbol, arg2,
126 ((((arg1)->u.listsxp.cdrval))->u.listsxp.carval));
127 else if (isUminus (arg2))
128 ans =
129 simplify (MinusSymbol, arg1,
130 ((((arg2)->u.listsxp.cdrval))->u.listsxp.carval));
131 }
132 else if (fun == DivideSymbol)
133 {
134 ans = Rf_lang3 (DivideSymbol, arg1, arg2);
135 }
136
137 return ans;
138 }
139
140
141 static SEXP
D(SEXP expr,SEXP var)142 D (SEXP expr, SEXP var)
143 {
144 return simplify (PlusSymbol,
145 PP (D
146 (((((expr)->u.listsxp.cdrval))->u.listsxp.carval),
147 var)),
148 PP (D
149 (((((((expr)->u.listsxp.cdrval))->u.listsxp.cdrval))->
150 u.listsxp.carval), var)));
151 }
152
153 SEXP
do_D(SEXP call,SEXP op,SEXP args,SEXP env)154 do_D (SEXP call, SEXP op, SEXP args, SEXP env)
155 {
156 SEXP expr, var;
157 var = Rf_install ();
158 expr = ((args)->u.listsxp.carval);
159 Rf_protect (expr = D (expr, var));
160 expr = AddParens (expr);
161 return expr;
162 }
163