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
      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
      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
      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
     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
     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
     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  }