/* Copyright 1990-2011, Jsoftware Inc.  All rights reserved. */
/* License in license.txt.                                   */
/*                                                                         */
/* Words: Numeric Input Conversion                                         */

#include "j.h"

#if (SYS & SYS_LINUX)
#include <stdlib.h>
#endif

#define NUMH(f)  B f(J jt,I n,C*s,void*vv)

/* numd    floating point number (double)                      */
/* numj    complex number                                      */
/* numx    extended precision integer                          */
/* nume    extended precision floating point number (not used) */
/* numr    rational number                                     */
/* numq    nume or numr                                        */
/* numbpx  3b12 or 3p12 or 3x12 number                         */
/*                                                             */
/* numb    subfunction of numbpx                               */
/*                                                             */
/* converts a single number and assigns into result pointer    */
/* returns 0 if error, 1 if ok                                 */

static NUMH(jtnumd){C c,*t;D*v,x,y;
 RZ(n);
 v=(D*)vv;
 if('-'==*s&&3>n)
  if(1==n){*v=inf; R 1;}
  else{
   c=*(1+s);
   if('-'==c){*v=infm; R 1;}
   else if('.'==c){*v=jnan; R 1;}
  }
 x=strtod(s,&t);
 if(t<s+n-1&&'r'==*t){y=strtod(1+t,&t); x=y?x/y:0<x?inf:0>x?infm:0;}
 R t>=s+n?(*v=x,1):0;
}

static NUMH(jtnumj){C*t,*ta;D x,y;Z*v;
 v=(Z*)vv;
 if(t=memchr(s,'j',n))ta=0; else t=ta=memchr(s,'a',n);
 RZ(numd(t?t-s:n,s,&x));
 if(t){t+=ta?2:1; RZ(numd(n+s-t,t,&y));} else y=0;
 if(ta){C c;
  c=*(1+ta);
  RZ(0<=x&&(c=='d'||c=='r'));
  if(c=='d')y*=PI/180; if(y<=-P2||P2<=y)y-=P2*jfloor(y/P2); if(0>y)y+=P2;
  v->re=y==0.5*PI||y==1.5*PI?0:x*cos(y); v->im=y==PI?0:x*sin(y);
 }else{v->re=x; v->im=y;}
 R 1;
}

static NUMH(jtnumi){B neg;C*t;I j;static C*dig="0123456789";
 if(neg='-'==*s){++s; --n; RZ(n);}
 RZ(19>=n);
 j=0; DO(n, RZ(t=memchr(dig,*s++,10L)); j=10*j+(t-dig););
 RZ(0<=j||neg&&j==IMIN);
 *(I*)vv=0>j||!neg?j:-j;
 R 1;
}     /* called only if SY_64 */

static NUMH(jtnumx){A y;B b,c;C d,*t;I j,k,m,*yv;X*v;static C*dig="0123456789";
 v=(X*)vv;
 d=*(s+n-1); b='-'==*s; c='x'==d||'r'==d; s+=b;
 if('-'==d){RZ(2>=n); RZ(*v=vci(1==n?XPINF:XNINF)); R 1;}
 n-=b+c; RZ(m=(n+XBASEN-1)/XBASEN); k=n-XBASEN*(m-1);
 GA(y,INT,m,1,0); yv=m+AV(y);
 DO(m, j=0; DO(k, RZ(t=memchr(dig,*s++,10L)); j=10*j+(t-dig);); *--yv=b?-j:j; k=XBASEN;);
 RZ(*v=yv[m-1]?y:xstd(y));
 R 1;
}

static X jtx10(J jt,I e){A z;I c,m,r,*zv;
 m=1+e/XBASEN; r=e%XBASEN;
 GA(z,INT,m,1,0); zv=AV(z);
 DO(m-1, *zv++=0;);
 c=1; DO(r, c*=10;); *zv=c;
 R z;
}     /* 10^e as a rational number */

static NUMH(jtnume){C*t,*td,*te;I e,ne,nf,ni;Q f,i,*v,x,y;
 v=(Q*)vv;
 nf=0; i.d=iv1; f.d=iv1;
 if(te=memchr(s,'e',n)){ne=n-(te-s)-1; e=strtol(1+te,&t,10);  RZ(!*t&&10>ne);}
 if(td=memchr(s,'.',n)){nf=te?(te-td)-1:n-(td-s)-1; if(nf)RZ(numx(nf,td+1,&f.n));}
 ni=td?td-s:te?te-s:n; RZ(numx(ni,s,&i.n));
 x=i;
 if(nf){y.n=iv1; y.d=x10(nf); RE(x='-'==*s?qminus(x,qtymes(f,y)):qplus(x,qtymes(f,y)));}
 if(te){if(0>e){y.n=iv1; y.d=x10(-e);}else{y.n=x10(e); y.d=iv1;} RE(x=qtymes(x,y));}
 *v=x;
 R 1;
}

static NUMH(jtnumr){C c,*t;I m,p,q;Q*v;
 v=(Q*)vv;
 m=(t=memchr(s,'r',n))?t-s:n; RZ(numx(m,s,&v->n)); v->d=iv1;
 if(t){
  c=s[n-1]; RZ('r'!=c&&'x'!=c);
  RZ(numx(n-m-1,s+m+1,&v->d));
  p=*AV(v->n); q=*AV(v->d); 
  RZ(p!=XPINF&&p!=XNINF||q!=XPINF&&q!=XNINF);
  RE(*v=qstd(*v));
 }
 R 1;
}

static NUMH(jtnumq){B b=0;C c,*t;
 t=s; DO(n, c=*t++; if(c=='e'||c=='.'){b=1; break;});
 R b?nume(n,s,vv):numr(n,s,vv);
}

static Z zpi={PI,0};

static B jtnumb(J jt,I n,C*s,Z*v,Z b){A c,d,y;I k;
  static C dig[]="0123456789abcdefghijklmnopqrstuvwxyz";I m=strlen(dig);
 if(!n){*v=zeroZ; R 1;}
 RZ(d=indexof(str(m,dig),str(n,s)));
 RZ(all0(eps(sc(m),d)));
 k=sizeof(Z);
 GA(c,CMPX,1,0,0); MC(AV(c),&b,k); RZ(y=base2(c,d)); MC(v,AV(y),k);
 R 1;
}

static NUMH(jtnumbpx){B ne,ze;C*t,*u;I k,m;Z b,p,q,*v,x,y;
 v=(Z*)vv;
 if(t=memchr(s,'b',n)){
  RZ(numbpx(t-s,s,&b));
  ++t; if(ne='-'==*t)++t;
  m=k=n+s-t; if(u=memchr(t,'.',m))k=u-t;
  RZ(ne||m>(1&&u));
  RZ(numb(k,t,&p,b));
  if(u){
   k=m-(1+k);
   if(ze=!(b.re||b.im))b.re=1;
   RZ(numb(k,1+u,&q,b));
   if(ze){if(q.re)p.re=inf;} else{DO(k,q=zdiv(q,b);); p=zplus(p,q);}
  }
  *v=p; if(ne){v->re=-v->re; v->im=-v->im;}
  R 1;
 }
 if(t=memchr(s,'p',n))u=0; else t=u=memchr(s,'x',n);
 if(!t)R numj(n,s,v);
 RZ(numj(t-s,s,&x)); ++t; RZ(numj(n+s-t,t,&y));
 if(u)*v=ztymes(x,zexp(y)); else *v=ztymes(x,zpow(zpi,y));
 R 1;
}

/* (n,s) string containing the vector constant                */
/* j:  1 iff contains 1j2 or 1ad2 or 1ar2                     */
/* b:  1 iff has 1b1a or 1p2 or 1x2 (note: must handle 1j3b4) */
/* x:  1 iff contains 123x                                    */
/* q:  1 iff contains 3r4                                     */
/* ii: 1 iff integer (but not x)                              */

static void jtnumcase(J jt,I n,C*s,B*b,B*j,B*x,B*q,B*ii){B e;C c;
 *x=*q=*ii=0;
 *j=memchr(s,'j',n)||memchr(s,'a',n);
 *b=memchr(s,'b',n)||memchr(s,'p',n);
 if(!*j&&!*b){
#if SY_64
  *ii=1;
#endif
  if(memchr(s,'x',n)){*b=*x=1; *ii=0;}
  if(memchr(s,'r',n)){*q=1;    *ii=0;}
  if(!*x&&!*q&!*ii)R;
  DO(n, c=s[i]; e=!s[1+i]; if(c=='.'||c=='e'||c=='x'&&!e){*x=*q=*ii=0; R;});
}}

A jtconnum(J jt,I n,C*s){PROLOG;A y,z;B b,(*f)(),ii,j,p=1,q,x;C c,*v;I d=0,e,k,m,t,*yv;
 if(1==n)                {if(k=s[0]-'0',0<=k&&k<=9)R num[ k]; else R ainf;}
 else if(2==n&&CSIGN==*s){if(k=s[1]-'0',0<=k&&k<=9)R num[-k];}
 RZ(y=str(1+n,s)); s=v=CAV(y); s[n]=0;
 GA(y,INT,1+n,1,0); yv=AV(y);
 DO(n, c=*v; *v++=c=c==CSIGN?'-':c==CTAB||c==' '?C0:c; b=C0==c; if(p!=b)yv[d++]=i; p=b;);
 if(d%2)yv[d++]=n; m=d/2;
 numcase(n,s,&b,&j,&x,&q,&ii);
 f=q?jtnumq:x?jtnumx:b||j?jtnumbpx:ii?jtnumi:jtnumd; 
 t=q?RAT   :x?XNUM  :b||j?CMPX    :ii?INT   :FL;     k=bp(t);
 GA(z,t,m,1!=m,0); v=CAV(z);
 if(ii){
  DO(m, d=i+i; e=yv[d]; if(!numi(yv[1+d]-e,e+s,v)){ii=0; break;} v+=k;);
  if(!ii){t=FL; f=jtnumd; GA(z,t,m,1!=m,0); v=CAV(z);}
 }
 if(!ii)DO(m, d=i+i; e=yv[d]; ASSERT(f(jt,yv[1+d]-e,e+s,v),EVILNUM); v+=k;);
 if(t&FL+CMPX)RZ(z=cvt0(z));
 EPILOG(bcvt(0,z));
}


#define EXEC2F(f,f1,t,T) \
 A f(J jt,A a,A w,I n,I m,I c){A z;B b;C d,*u,*uu,*x,*y;I i,j,k,mc,r;T a0,*zv;  \
  i=0; mc=m*c; u=CAV(w); y=u+n; j=c; uu=u+AN(w); if(mc)*(uu-1)=' ';         \
  r=AR(w)-(1==c); r=MAX(0,r);                                               \
  GA(z,t,mc,r,AS(w)); if(1<r&&1!=c)*(AS(z)+r-1)=c; zv=(T*)AV(z);            \
  RZ(a=cvt(t,a)); a0=*(T*)AV(a);                                            \
  while(i<mc){                                                              \
   while(u<uu&&C0==*u)++u;                                                  \
   while(u>=y){while(i<j)zv[i++]=a0; j+=c; y+=n; if(i==mc)R z;}             \
   x=strchr(u,C0); if(x<uu)k=x-u; else{*(uu-1)=C0; k=uu-1-u;}               \
   b=','==u[0]||','==u[k-1];                                                \
   x=u; DO(k, d=u[i]; if(','!=d)*x++=d==CSIGN?'-':d;); *x=C0;               \
   if(b||!f1(x-u,u,i+zv))zv[i]=a0;                                          \
   ++i; u+=1+k;                                                             \
  }                                                                         \
  R z;                                                                      \
 }

static EXEC2F(jtexec2x,numx,  XNUM,X)  /* note: modifies argument w */
static EXEC2F(jtexec2q,numq,  RAT, Q)
static EXEC2F(jtexec2z,numbpx,CMPX,Z)

static A jtexec2r(J jt,A a,A w,I n,I m,I c){A z;B b,e;C d,*u,*uu,*v,*x,*y;D a0,*zv;I i,j,mc,r;
 i=0; mc=m*c; u=CAV(w); y=u+n; j=c; uu=u+AN(w);
 r=AR(w)-(1==c); r=MAX(0,r); 
 GA(z,FL,mc,r,AS(w)); if(1<r&&1!=c)*(AS(z)+r-1)=c; zv=DAV(z); 
 RZ(a=cvt(FL,a)); a0=*DAV(a);
 while(i<mc){
  while(u<uu&&C0==*u)++u; 
  while(u>=y){while(i<j)zv[i++]=a0; j+=c; y+=n; if(i==mc)R z;}
  zv[i]=strtod(u,&v);
  switch(*v){
   case C0:
    i++; u=v; continue;
   case ',':   
    b=u==v; x=v; 
    while(d=*++v)if(','!=d)*x++=d; 
    if(b||','==*(v-1)){zv[i++]=a0; u=v;}else while(v>x)*x++=C0; 
    continue;
   case '-': 
    e=u==v; v++; d=*v++; b=e&&C0==*v;
    if     (e&& C0==d){zv[i++]=inf;  u=v;}
    else if(b&&'-'==d){zv[i++]=infm; u=v;}
    else if(b&&'.'==d){zv[i++]=jnan; u=v;}
    else{zv[i++]=a0; --v; while(C0!=*v++); u=v;}
    continue;
   case 'a':  case 'b':  case 'j':  case 'p':  case 'r':  case 'x':
    if(u!=v)R exec2z(a,w,n,m,c);
   default:  
    zv[i++]=a0; while(C0!=*++v); u=v;
 }}
 R z;
}

F2(jtexec2){A z;B b,ii,j,p,q,x;C d,*v;I at,c,i,k,m,n,r,*s;
 RZ(a&&w);
 ASSERT(!AR(a),EVRANK);
 at=AT(a);
 ASSERT(at&NUMERIC,EVDOMAIN);
 if(!(LIT&AT(w)))RZ(w=toc1(0,w));
 m=n=c=0; r=AR(w);
 if(!r||*(AS(w)+r-1)){
  RZ(w=irs2(w,chr[' '],0L,1L,0L,jtover));  /* will be modified in place */
  v=CAV(w); r=AR(w); s=AS(w); n=s[r-1]; m=prod(r-1,s);
  for(i=0;i<m;++i){I j;
   b=1; k=0; 
   for(j=0;j<n;++j){
    p=b; d=*v; b=' '==d;
    switch(d){
     case ' ':   *v=C0;  break;
     case CSIGN: *v='-'; 
    }
    ++v; if(p>b)++k;
   } 
   if(k>c)c=k;
 }}
 numcase(m*n,CAV(w),&b,&j,&x,&q,&ii);
 if(at&CMPX)                z=cvt0(exec2z(a,w,n,m,c));
 else if(q)                 z=     exec2q(a,w,n,m,c);
 else if(x&&at&B01+INT+XNUM)z=     exec2x(a,w,n,m,c);
 else                       z=cvt0(exec2r(a,w,n,m,c));
 R bcvt(0,z);
}