/*******************************************************************/
/**                                                               **/
/**                 INPUT/OUTPUT SUBROUTINES                      **/
/**                                                               **/
/*******************************************************************/

#include "pari.h"
/* #include "anal.h" */
/* backward compatibility */
extern long compatible;
enum { NONE, WARN, OLDFUN, OLDALL };
#define new_fun_set (compatible == NONE || compatible == WARN)

extern char* GENtostr0(GEN,void(*)(GEN));

GEN confrac(GEN x); /* should be static here, but use hiremainder */
GEN convi(GEN x);
static void texi(GEN g, long nosign);
char * type_name(long t);
static char format;
static long decimals, chmp, initial;

/* output a space or do nothing depending on original caller */
static void (*sp)();


/********************************************************************/
/**                                                                **/
/**                         WRITE AN INTEGER                       **/
/**                                                                **/
/********************************************************************/
#define putsigne(x) pariputs((x>0)? " + " : " - ")
#define sp_sign_sp(x) sp(), pariputc(x>0? '+': '-'), sp()
#define sp_plus_sp() sp(), pariputc('+'), sp()
#define comma_sp() pariputc(','), sp()

static void wr_space() {pariputc(' ');}
static void no_space() {}

static void
blancs(long nb) { while (nb-- > 0) pariputc(' '); }

static void
zeros(long nb)  { while (nb-- > 0) pariputc('0'); }

static long
coinit(long x)
{
  char cha[10], *p = cha + 9;

  *p = 0;
  do { *--p = x%10 + '0'; x /= 10; } while (x);
  pariputs(p); return 9 - (p - cha);
}

static void
comilieu(long x)
{
  char cha[10], *p = cha + 9;

  for (*p = 0; p > cha; x /= 10) *--p = x%10 + '0';
  pariputs(cha);
}

static void
cofin(long x, long decim)
{
  char cha[10], *p = cha + 9;

  for (; p > cha; x /= 10) *--p = x%10 + '0';
  cha[decim] = 0; pariputs(cha);
}

static long
nbdch(long l)
{
  if (l<100000)
  {
    if (l<10) return 1;
    if (l<100) return 2;
    if (l<1000) return 3;
    if (l<10000) return 4;
    return 5;
  }
  if (l<1000000) return 6;
  if (l<10000000) return 7;
  if (l<100000000) return 8;
  if (l<1000000000) return 9;
  return 10; /* not reached */
}

/* write an int. fw = field width (pad with ' ') */
static void
wr_int(GEN x, long fw, long nosign)
{
  long *res,*re,i, sx=signe(x);

  if (!sx) { blancs(fw-1); pariputc('0'); return; }
  setsigne(x,1); re = res = convi(x);
  setsigne(x,sx);
  i = nbdch(*--re); while (*--re >= 0) i+=9;
  if (nosign || sx>0) blancs(fw-i);
  else
     { i++; blancs(fw-i); pariputc('-'); }
  coinit(*--res); while (*--res >= 0) comilieu(*res);
}

static void
wr_vecsmall(GEN g)
{
  long i,l;
  pariputc('['); l = lg(g);
  for (i=1; i<l; i++)
  {
    pariputsf("%ld", g[i]);
    if (i<l-1) comma_sp();
  }
  pariputc(']');
}
/********************************************************************/
/**                                                                **/
/**                        WRITE A REAL NUMBER                     **/
/**                                                                **/
/********************************************************************/
static void wr_exp(GEN x);

/* assume x != 0 and print |x| in floating point format */
static void
wr_float(GEN x)
{
  long *res, ex,s,d,e,decmax,deceff, dec = decimals;
  GEN p1;

  if (dec>0) /* round if needed */
  {
    GEN arrondi = cgetr(3);
    arrondi[1] = (long) (x[1]-((double)BITS_IN_LONG/pariK)*dec-2);
    arrondi[2] = x[2]; x = addrr(x,arrondi);
  }
  ex = expo(x);
  if (ex >= bit_accuracy(lg(x))) { wr_exp(x); return; }

/* integer part */
  p1 = gcvtoi(x,&e); s = signe(p1);
  if (e > 0) err(bugparier,"wr_float");
  if (!s) { pariputc('0'); d=1; }
  else
  {
    setsigne(p1,1); res = convi(p1); d = coinit(*--res);
    setsigne(p1,s);
    while (*(--res) >= 0) { d += 9; comilieu(*res); }
    x = subri(x,p1);
  }
  pariputc('.');

/* fractional part: 0 < x < 1 */
  if (!signe(x))
  {
    if (dec<0) dec=(long) (-expo(x)*L2SL10+1);
    dec -= d; if (dec>0) zeros(dec);
    return;
  }
  if (!s)
  {
    for(;;)
    {
      p1=mulsr(1000000000,x); if (expo(p1)>=0) break;
      pariputs("000000000"); x=p1;
    }
    for(;;)
    {
      p1=mulsr(10,x); if (expo(p1)>=0) break;
      pariputc('0'); x=p1;
    }
    d=0;
  }
  res = (long *) confrac(x); decmax = d + *res++;
  if (dec<0) dec=decmax;
  deceff = dec-decmax; dec -= d;
  while (dec>8)
  {
    if (dec>deceff) comilieu(*res++); else pariputs("000000000");
    dec -= 9;
  }
  if (dec>0)
  {
    if (dec>deceff) cofin(*res,dec); else zeros(dec);
  }
}

/* as above in exponential format */
static void
wr_exp(GEN x)
{
  GEN dix = cgetr(lg(x)+1);
  long ex = expo(x);

  ex = (ex>=0)? (long)(ex*L2SL10): (long)(-(-ex*L2SL10)-1);
  affsr(10,dix); if (ex) x = mulrr(x,gpuigs(dix,-ex));
  if (absr_cmp(x, dix) >= 0) { x=divrr(x,dix); ex++; }
  wr_float(x); sp(); pariputsf("\\cdot10^{%ld}",ex);
}

/* Write real number x.
 * format: e (exponential), f (floating point), g (as f unless x too small)
 *   if format isn't correct (one of the above) act as e.
 * decimals: number of decimals to print (all if <0).
 */
#define print_float(fo,ex) ((fo == 'g' && ex >= -32) || fo == 'f')
static void
wr_real(GEN x, long nosign)
{
  long ltop, sx = signe(x), ex = expo(x);

  if (!sx) /* real 0 */
  {
    if (print_float(format,ex))
    {
      if (decimals<0)
      {
        long d = 1+((-ex)>>TWOPOTBITS_IN_LONG);
        if (d < 0) d = 0;
        decimals=(long)(pariK*d);
      }
      pariputs("0."); zeros(decimals);
    }
    else
    {
      pariputs("0.");
      /*
      ex = (ex>=0)? (long)(ex*L2SL10): (long)(-(-ex*L2SL10)-1);
      pariputsf("0.\\cdot10^{%ld}", ex+1);
      */
    }
    return;
  }
  if (!nosign && sx < 0) pariputc('-'); /* print sign if needed */
  ltop = avma;
  if (print_float(format,ex)) wr_float(x); else wr_exp(x);
  avma = ltop;
}
#undef print_float

/********************************************************************/
/**                                                                **/
/**                       HEXADECIMAL OUTPUT                       **/
/**                                                                **/
/********************************************************************/

static void
sorstring(char* b, long x)
{
#ifdef LONG_IS_64BIT
  pariputsf(b,(ulong)x>>32,x & MAXHALFULONG);
#else
  pariputsf(b,x);
#endif
}

/* English ordinal numbers -- GN1998Apr17 */
static const char *ordsuff[4] = {"st","nd","rd","th"};

const char*
eng_ord(long i)                        /* i > 0 assumed */
{
  switch (i%10)
  {
    case 1:
      if (i%100==11) return ordsuff[3]; /* xxx11-th */
      return ordsuff[0];         /* xxx01-st, xxx21-st,... */
    case 2:
      if (i%100==12) return ordsuff[3]; /* xxx12-th */
      return ordsuff[1];         /* xxx02-nd, xxx22-nd,... */
    case 3:
      if (i%100==13) return ordsuff[3]; /* xxx13-th */
      return ordsuff[2];         /* xxx03-rd, xxx23-rd,... */
    default:
      return ordsuff[3];         /* xxxx4-th,... */
  }
}

static char
vsigne(GEN x)
{
  long s = signe(x);
  if (!s) return '0';
  return (s > 0) ? '+' : '-';
}

/********************************************************************/
/**                                                                **/
/**                        FORMATTED OUTPUT                        **/
/**                                                                **/
/********************************************************************/
static char *
get_var(long v, char *buf)
{
  entree *ep = varentries[v];

  if (ep) return ep->name;
  if (v==MAXVARN) return "#";
  sprintf(buf,"#<%d>",(int)v); return buf;
}

static char *
get_texvar(long v, char *buf)
{
  entree *ep = varentries[v];
  char *s, *t = buf;

  if (!ep) err(talker, "this object uses debugging variables");
  s = ep->name;
  if (strlen(s)>=64) err(talker, "TeX variable name too long");
  while(isalpha((int)*s)) *t++ = *s++;
  *t = 0; if (isdigit((int)*s) || *s++ == '_') sprintf(t,"_{%s}",s);
  return buf;
}

static void
monome(char *v, long deg)
{
  if (deg)
  {
    pariputs(v);
    if (deg!=1) pariputsf("^%ld",deg);
  }
  else pariputc('1');
}

static void
texnome(char *v, long deg)
{
  if (deg)
  {
    pariputs(v);
    if (deg!=1) pariputsf("^{%ld}",deg);
  }
  else pariputc('1');
}

#define padic_nome(p,e) {pariputs(p); if (e != 1) pariputsf("^%ld",e);}
#define padic_texnome(p,e) {pariputs(p); if (e != 1) pariputsf("^{%ld}",e);}

/********************************************************************/
/**                                                                **/
/**                           RAW OUTPUT                           **/
/**                                                                **/
/********************************************************************/
#define isnull_for_pol(g)  ((typ(g)==t_INTMOD)? !signe(g[2]): isnull(g))

/* is to be printed as '0' */
static long
isnull(GEN g)
{
  long i;
  switch (typ(g))
  {
    case t_SMALL:
      return !smalltos(g);
    case t_INT:
      return !signe(g);
    case t_COMPLEX:
      return isnull((GEN)g[1]) && isnull((GEN)g[2]);
    case t_QUAD:
      return isnull((GEN)g[2]) && isnull((GEN)g[3]);
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return isnull((GEN)g[1]);
    case t_POLMOD:
      return isnull((GEN)g[2]);
    case t_POL:
      for (i=lgef(g)-1; i>1; i--)
	if (!isnull((GEN)g[i])) return 0;
      return 1;
  }
  return 0;
}

/* return 1 or -1 if g is 1 or -1, 0 otherwise*/
static long
isone(GEN g)
{
  long i;
  switch (typ(g))
  {
    case t_SMALL:
      switch(smalltos(g))
      {
        case  1: return  1;
        case -1: return -1;
      }
      break;
    case t_INT:
      return (signe(g) && is_pm1(g))? signe(g): 0;
    case t_COMPLEX:
      return isnull((GEN)g[2])? isone((GEN)g[1]): 0;
    case t_QUAD:
      return isnull((GEN)g[3])? isone((GEN)g[2]): 0;
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return isone((GEN)g[1]) * isone((GEN)g[2]);
    case t_POL:
      if (!signe(g)) return 0;
      for (i=lgef(g)-1; i>2; i--)
	if (!isnull((GEN)g[i])) return 0;
      return isone((GEN)g[2]);
  }
  return 0;
}

/* if g is a "monomial", return its sign, 0 otherwise */
static long
isfactor(GEN g)
{
  long i,deja,sig;
  switch(typ(g))
  {
    case t_INT: case t_REAL:
      return (signe(g)<0)? -1: 1;
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return isfactor((GEN)g[1]);
    case t_COMPLEX:
      if (isnull((GEN)g[1])) return isfactor((GEN)g[2]);
      if (isnull((GEN)g[2])) return isfactor((GEN)g[1]);
      return 0;
    case t_PADIC:
      return !signe((GEN)g[4]);
    case t_QUAD:
      if (isnull((GEN)g[2])) return isfactor((GEN)g[3]);
      if (isnull((GEN)g[3])) return isfactor((GEN)g[2]);
      return 0;
    case t_POL: deja = 0; sig = 1;
      for (i=lgef(g)-1; i>1; i--)
        if (!isnull((GEN)g[i]))
	{
	  if (deja) return 0;
	  sig=isfactor((GEN)g[i]); deja=1;
	}
      return sig? sig: 1;
    case t_SER:
      for (i=lg(g)-1; i>1; i--)
        if (!isnull((GEN)g[i])) return 0;
  }
  return 1;
}

/* return 1 if g is a "truc" (see anal.c) */
static long
isdenom(GEN g)
{
  long i,deja;
  switch(typ(g))
  {
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return 0;
    case t_COMPLEX: return isnull((GEN)g[2]);
    case t_PADIC: return !signe((GEN)g[4]);
    case t_QUAD: return isnull((GEN)g[3]);

    case t_POL: deja = 0;
      for (i=lgef(g)-1; i>1; i--)
        if (!isnull((GEN)g[i]))
	{
	  if (deja) return 0;
	  if (i==2) return isdenom((GEN)g[2]);
	  if (!isone((GEN)g[i])) return 0;
	  deja=1;
	}
      return 1;
    case t_SER:
      for (i=lg(g)-1; i>1; i--)
	if (!isnull((GEN)g[i])) return 0;
  }
  return 1;
}

/* write a * v^d */
static void
wr_texnome(GEN a, char *v, long d)
{
  long sig = isone(a);

  if (sig) { putsigne(sig); texnome(v,d); }
  else
  {
    sig = isfactor(a);
    if (sig) { putsigne(sig); texi(a,sig); }
    else
    {
      pariputs("+("); texi(a,sig); pariputc(')');
    }
    if (d) texnome(v,d);
  }
}

static void
wr_lead_monome(GEN a, char *v, long d, long nosign)
{
  long sig = isone(a);
  if (sig)
  {
    if (!nosign && sig<0) pariputc('-');
    monome(v,d);
  }
  else
  {
    if (isfactor(a)) bruti(a,nosign);
    else
    {
      pariputc('('); bruti(a,0); pariputc(')');
    }
    if (d) { pariputc('*'); monome(v,d); }
  }
}

static void
wr_lead_texnome(GEN a, char *v, long d, long nosign)
{
  long sig = isone(a);
  if (sig)
  {
    if (!nosign && sig<0) pariputc('-');
    texnome(v,d);
  }
  else
  {
    if (isfactor(a)) texi(a,nosign);
    else
    {
      pariputc('('); texi(a,0); pariputc(')');
    }
    if (d) texnome(v,d);
  }
}

static void
sor_monome(GEN a, char *v, long d)
{
  long sig = isone(a);
  if (sig) { putsigne(sig); monome(v,d); }
  else
  {
    sig = isfactor(a);
    if (sig) { putsigne(sig); if (sig < 0) a = gneg(a); }
    else pariputs(" + ");
    sori(a); if (d) { pariputc(' '); monome(v,d);}
  }
}

static void
sor_lead_monome(GEN a, char *v, long d)
{
  long sig = isone(a);
  if (sig)
  {
    if (sig < 0) pariputc('-');
    monome(v,d);
  }
  else
  {
    sori(a);
    if (d) { pariputc(' '); monome(v,d); }
  }
}

/********************************************************************/
/**                                                                **/
/**                           TeX OUTPUT                           **/
/**                                                                **/
/********************************************************************/

/* this follows bruti exactly */
static void
texi(GEN g, long nosign)
{
  long tg,i,j,l,r;
  GEN a,b;
  char *v, buf[67];

  if (isnull(g)) { pariputs("{0}"); return; }
  r = isone(g); pariputc('{');
  if (r)
  {
    if (!nosign && r<0) pariputc('-');
    pariputs("1}"); return;
  }

  tg = typ(g);
  switch(tg)
  {
    case t_INT: wr_int(g,0,nosign); break;
    case t_REAL: wr_real(g,nosign); break;

    case t_INTMOD: case t_POLMOD:
      texi((GEN)g[2],0); pariputs(" \\mod ");
      texi((GEN)g[1],0); break;

    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      pariputs("\\frac");
      texi((GEN)g[1],nosign);
      texi((GEN)g[2],0); break;

    case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD);
      a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "\\omega": "i";
      if (isnull(a))
      {
        wr_lead_texnome(b,v,1,nosign);
        break;
      }
      texi(a,nosign);
      if (!isnull(b)) wr_texnome(b,v,1);
      break;

    case t_POL: v = get_texvar(ordvar[varn(g)],buf);
      /* hack: we want g[i] = coeff of degree i. */
      i = lgef(g)-3; g += 2; while (isnull((GEN)g[i])) i--;
      wr_lead_texnome((GEN)g[i],v,i,nosign);
      while (i--)
      {
        a = (GEN)g[i];
        if (!isnull_for_pol(a)) wr_texnome(a,v,i);
      }
      break;

    case t_SER: v = get_texvar(ordvar[varn(g)],buf);
      i = valp(g);
      if (signe(g))
      { /* hack: we want g[i] = coeff of degree i. */
        l = i + lg(g)-2; g += (2-i);
        wr_lead_texnome((GEN)g[i],v,i,nosign);
        while (++i < l)
        {
          a = (GEN)g[i];
          if (!isnull_for_pol(a)) wr_texnome(a,v,i);
        }
        pariputc('+');
      }
      pariputs("O("); texnome(v,i); pariputc(')'); break;

    case t_PADIC:
    {
      GEN p = (GEN)g[2];
      i = valp(g); l = precp(g)+i;
      g = (GEN)g[4]; v = GENtostr(p);
      for (; i<l; i++)
      {
	g = dvmdii(g,p,&a);
	if (signe(a))
	{
	  if (!i || !is_pm1(a))
	  {
	    wr_int(a,0,1); if (i) pariputs("\\cdot");
	  }
	  if (i) padic_texnome(v,i);
	  pariputc('+');
	}
      }
      pariputs("O("); padic_texnome(v,i); pariputc(')');
      free(v); break;
    }
    case t_QFR: case t_QFI: r = (tg == t_QFR);
      if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi(");
      texi((GEN)g[1],0); pariputs(", ");
      texi((GEN)g[2],0); pariputs(", ");
      texi((GEN)g[3],0);
      if (r) { pariputs(", "); texi((GEN)g[4],0); }
      pariputc(')'); break;

    case t_VEC:
      pariputs("\\pmatrix{ "); l = lg(g);
      for (i=1; i<l; i++)
      {
	texi((GEN)g[i],0); if (i<lg(g)-1) pariputc('&');
      }
      pariputs("\\cr}\n"); break;

    case t_LIST:
      pariputs("\\pmatrix{ "); l = lgef(g);
      for (i=2; i<l; i++)
      {
	texi((GEN)g[i],0); if (i<lgef(g)-1) pariputc('&');
      }
      pariputs("\\cr}\n"); break;

    case t_COL:
      pariputs("\\pmatrix{ "); l = lg(g);
      for (i=1; i<l; i++)
      {
	texi((GEN)g[i],0); pariputs("\\cr\n");
      }
      pariputc('}'); break;

    case t_STR:
      pariputs("\\mbox{"); pariputs(GSTR(g));
      pariputc('}'); break;

    case t_MAT:
      pariputs("\\pmatrix{\n "); r = lg(g);
      if (r>1)
      {
        l = lg(g[1]);
        for (i=1; i<l; i++)
        {
          for (j=1; j<r; j++)
          {
            texi(gcoeff(g,i,j),0); if (j<r-1) pariputc('&');
          }
          pariputs("\\cr\n ");
        }
      }
      pariputc('}'); break;
  }
  pariputc('}');
}

/*******************************************************************/
/**                                                               **/
/**                        USER OUTPUT FUNCTIONS                  **/
/**                                                               **/
/*******************************************************************/

static void
calltexi(GEN g) {
  long av = avma;
  texi(changevar(g,polvar),0);
  avma = av;
}

static GEN
strtogstr(char *str) {
  long len;
  GEN gstr;

  len = strlen(str);
  gstr = cgetg(len+2,t_STR);
  strcpy(GSTR(gstr),str);
  free(str);
  return gstr;
}

GEN
GENtolatexstr(GEN x, long d) {
  char *str;
  void (*oldsp)() = sp;
  long flag = 1;

  sp = (flag ? &wr_space : &no_space);
  format = 'g'; decimals = d;
  str = GENtostr0(x,calltexi);
  sp = oldsp;

  return strtogstr(str);
}

static void
outputfactorization(GEN inx) {
  GEN x;

  if (typ(inx) != t_INT) err(talker,"input must be integer");

  if (signe(inx) == 0) pariputc('0');
  else {
    if (signe(inx) == -1) { pariputc('-'); x = negi(inx); } else x = inx;
    if (!cmpis(x,1)) pariputc('1');
    else {
      GEN M;
      long j,numfactors,started = 0;

      M = factor(x);
      numfactors = lg((GEN) M[1]) - 1;
      
      for (j = 1; j <= numfactors; j++) {
	if (started) pariputs(" \\cdot ");
	outbrute((GEN) ((GEN) M[1])[j]);
	if (cmpis((GEN) ((GEN) M[2])[j],1) == 1) {
	  pariputc('^'); pariputc('{');
	  outbrute((GEN) ((GEN) M[2])[j]); pariputc('}');
	}
	started = 1;
      }
    }
  }
}

GEN
factorstolatexstr(GEN x) {
  char *str;
  str = GENtostr0(x,outputfactorization);
  return strtogstr(str);
}