sl.c

/* Copyright 1990-2011, Jsoftware Inc.  All rights reserved. */
/* License in license.txt.                                   */
/*                                                                         */
/* Symbol Table: Locales                                                   */

#include "j.h"


A jtstcreate(J jt,C k,I p,I n,C*u){A g,*pv,x,y;C s[20];I m,*nv;L*v;
 GA(g,SYMB,ptab[p],1,0); 
 RZ(v=symnew(AV(g))); v->flag|=LINFO; v->sn=jt->symindex++;
 switch(k){
  case 0:  /* named    locale */
   RZ(x=nfs(n,u));
   LOCNAME(g)=x; LOCPATH(g)=ra(1==n&&'z'==*u?vec(BOX,0L,0L):zpath);
   symbis(x,g,jt->stloc);
   break;
  case 1:  /* numbered locale */
   ASSERT(0<=jt->stmax,EVLOCALE);
   sprintf(s,FMTI,n); RZ(x=nfs(strlen(s),s));
   LOCNAME(g)=x; LOCPATH(g)=ra(zpath);
   ++jt->stused;
   m=AN(jt->stnum);
   if(m<jt->stused){
    x=ext(1,jt->stnum); y=ext(1,jt->stptr); RZ(x&&y); jt->stnum=x; jt->stptr=y;
    nv=m+AV(jt->stnum); pv=m+AAV(jt->stptr); DO(AN(x)-m, *nv++=-1; *pv++=0;); 
   }
   pv=AAV(jt->stptr);
   DO(AN(jt->stnum), if(!pv[i]){pv[i]=ra(g); *(i+AV(jt->stnum))=n; break;});
   jt->stmax=n<IMAX?MAX(jt->stmax,1+n):-1;
   break;
  case 2:  /* local symbol table */
   ;
 }
 R g;
}    /* create locale, named (0==k) or numbered (1==k) */

B jtsymbinit(J jt){A q;I n=40;
 jt->locsize[0]=3;  /* default hash table size for named    locales */
 jt->locsize[1]=2;  /* default hash table size for numbered locales */
 RZ(symext(0));     /* initialize symbol pool                       */
 GA(q,SYMB,ptab[3],1,0); jt->stloc=q;
 RZ(q=apv(n,-1L,0L));    jt->stnum=q;
 GA(q,INT,n,1,0);        jt->stptr=q; memset(AV(q),C0,n*SZI);
 RZ(jt->global=stcreate(0,5L,4L,"base"));
 RZ(           stcreate(0,7L,1L,"z"   ));
 R 1;
}


F1(jtlocsizeq){I*v; ASSERTMTV(w); v=jt->locsize; R v2(v[0],v[1]);}
     /* 9!:38 default locale size query */

F1(jtlocsizes){I p,q,*v;
 RZ(w);
 ASSERT(1==AR(w),EVRANK);
 ASSERT(2==AN(w),EVLENGTH);
 RZ(w=vi(w)); v=AV(w); p=v[0]; q=v[1];
 ASSERT(0<=p&&0<=q,EVDOMAIN);
 ASSERT(p<nptab&&q<nptab,EVLIMIT);
 jt->locsize[0]=p;
 jt->locsize[1]=q;
 R mtm;
}    /* 9!:39 default locale size set */


static A jtstfindnum(J jt,B b,I k){A y;I j;
 RZ(y=indexof(jt->stnum,sc(k))); j=*AV(y); 
 if(j<AN(jt->stnum))R*(j+AAV(jt->stptr)); 
 else if(b){ASSERT(k>=jt->stmax,EVLOCALE); R stcreate(1,jt->locsize[1],k,0L);}
 else R 0;
}    /* stfind for numbered locales */

A jtstfind(J jt,B b,I n,C*u){I old;L*v;
 if(!n){n=4; u="base";}
 if('9'>=*u)R stfindnum(b,strtol(u,NULL,10));
 else{
  old=jt->tbase+jt->ttop; v=probe(nfs(n,u),jt->stloc); tpop(old);
  R v?v->val:b?stcreate(0,jt->locsize[0],n,u):0;
}}   /* find the symbol table for locale u, create if b and non-existent */

static A jtvlocnl(J jt,B b,A w){A*wv,y;C*s;I i,m,n,wd;
 RZ(w);
 n=AN(w);
 ASSERT(!n||BOX&AT(w),EVDOMAIN);
 wv=AAV(w); wd=(I)w*ARELATIVE(w);
 for(i=0;i<n;++i){
  y=WVR(i); m=AN(y); s=CAV(y);
  ASSERT(1>=AR(y),EVRANK);
  ASSERT(m,EVLENGTH);
  ASSERT(LIT&AT(y),EVDOMAIN);
  if(b)ASSERTN(vlocnm(m,s),EVILNAME,nfs(m,s));
 }
 R w;
}    /* validate namelist of locale names */

static I jtprobenum(J jt,C*u){I j; 
 RE(j=i0(indexof(jt->stnum,sc((I)strtol(u,NULL,(I)10))))); 
 R j<AN(jt->stnum)?j:-1;
}    /* probe for numbered locales */


F1(jtlocnc){A*wv,y,z;C c,*u;I i,m,n,wd,*zv;
 RZ(vlocnl(0,w));
 n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w);
 GA(z,INT,n,AR(w),AS(w)); zv=AV(z);
 for(i=0;i<n;++i){
  y=WVR(i); m=AN(y); u=CAV(y); c=*u; 
  if(!vlocnm(m,u))zv[i]=-2;
  else if(c<='9') zv[i]=0<=probenum(u)?1:-1;
  else            zv[i]=probe(nfs(m,u),jt->stloc)?0:-1;
 }
 R z;
}    /* 18!:0 locale name class */

static F1(jtlocnlx){A*pv,y,*yv,z;B*wv;C s[20];I m=0,n=0,*nv;
 RZ(w=cvt(B01,w)); wv=BAV(w); DO(AN(w), m|=1+wv[i];);
 if(1&m)z=nlsym(jt->stloc);
 if(2&m){
  GA(y,BOX,jt->stused,1,0); yv=AAV(y); pv=AAV(jt->stptr); nv=AV(jt->stnum);
  DO(AN(jt->stptr), if(pv[i]){sprintf(s,FMTI,nv[i]); 
      if(jt->nla[*s]){RZ(yv[n++]=cstr(s)); if(n==jt->stused)break;}});
  y=take(sc(n),y);
 }
 z=0==m?mtv:1==m?z:2==m?y:over(y,z);
 R grade2(z,ope(z));
}

F1(jtlocnl1){memset(jt->nla,C1,256); R locnlx(w);}
    /* 18!:1 locale name list */

F2(jtlocnl2){UC*u;
 RZ(a&&w);
 ASSERT(LIT&AT(a),EVDOMAIN);
 memset(jt->nla,C0,256); 
 u=UAV(a); DO(AN(a),jt->nla[*u++]=1;);
 R locnlx(w); 
}    /* 18!:1 locale name list */

static A jtlocale(J jt,B b,A w){A g,*wv,y;I wd;
 RZ(vlocnl(1,w));
 wv=AAV(w); wd=(I)w*ARELATIVE(w);
 DO(AN(w), y=WVR(i); RZ(g=stfind(b,AN(y),CAV(y))););
 R g;
}    /* last locale (symbol table) from boxed locale names */

F1(jtlocpath1){A g; F1RANK(0,jtlocpath1,0); RZ(g=locale(1,w)); R LOCPATH(g);}
     /* 18!:2  query locale path */

F2(jtlocpath2){A g,x;
 F2RANK(1,0,jtlocpath2,0);
 RZ(  locale(1,a)); RZ(x=every(ravel(a),0L,jtravel));
 RZ(g=locale(1,w));
 fa(LOCPATH(g)); LOCPATH(g)=ra(x);
 R mtm;
}    /* 18!:2  set locale path */


static F2(jtloccre){A g,y;C*s;I n,p,*u;L*v;
 RZ(a&&w);
 if(MARK&AT(a))p=jt->locsize[0]; else{RE(p=i0(a)); ASSERT(0<=p,EVDOMAIN); ASSERT(p<nptab,EVLIMIT);}
 y=AAV0(w); n=AN(y); s=CAV(y);
 if(v=probe(nfs(n,s),jt->stloc)){
  g=v->val; 
  u=1+AV(g); DO(AN(g)-1, ASSERT(!u[i],EVLOCALE););
  RZ(symfreeh(g,v));
 } 
 RZ(stcreate(0,p,n,s));
 R box(ca(y));
}    /* create a locale named w with hash table size a */

static F1(jtloccrenum){C s[20];I k=jt->stmax,p;
 RZ(w);
 if(MARK&AT(w))p=jt->locsize[1]; else{RE(p=i0(w)); ASSERT(0<=p,EVDOMAIN); ASSERT(p<nptab,EVLIMIT);}
 RZ(stcreate(1,p,k,0L));
 sprintf(s,FMTI,k); 
 R box(cstr(s));
}    /* create a numbered locale with hash table size n */

F1(jtloccre1){
 RZ(w);
 if(AN(w))R rank2ex(mark,vlocnl(1,w),0L,0L,0L,jtloccre);
 ASSERT(1==AR(w),EVRANK);
 R loccrenum(mark);
}    /* 18!:3  create locale */

F2(jtloccre2){
 RZ(a&&w);
 if(AN(w))R rank2ex(a,vlocnl(1,w),0L,0L,0L,jtloccre);
 ASSERT(1==AR(w),EVRANK);
 R rank1ex(a,0L,0L,jtloccrenum);
}    /* 18!:3  create locale with specified hash table size */


F1(jtlocswitch){A g; 
 RZ(w); /* DM 111129 */
 ASSERT(!AR(w),EVRANK); 
 RZ(g=locale(1,w)); 
 jt->global=g; jt->stswitched=1;
 R mtm;
}    /* 18!:4  switch locale */

F1(jtlocname){A g=jt->global;
 ASSERTMTV(w);
 ASSERT(g,EVLOCALE);
 R box(sfn(0,LOCNAME(g)));
}    /* 18!:5  current locale name */

static SYMWALK(jtlocmap1,I,INT,18,3,1,
    {I t=AT(d->val);
     *zv++=i; 
     *zv++=t&NOUN?0:t&VERB?3:t&ADV?1:t&CONJ?2:t&SYMB?6:-2;
     *zv++=(I)sfn(1,d->name);})

F1(jtlocmap){A g,q,x,y,*yv,z,*zv;I c=-1,d,j=0,m,*qv,*xv;
 RZ(w);
 ASSERT(!AR(w),EVRANK);
 RE(g=equ(w,zero)?jt->stloc:equ(w,one)?jt->local:locale(0,w));
 ASSERT(g,EVLOCALE);
 RZ(q=locmap1(g)); qv=AV(q);
 m=*AS(q);
 GA(x,INT,m*3,2,AS(q)); xv= AV(x);
 GA(y,BOX,m,  1,0    ); yv=AAV(y);
 DO(m, *xv++=d=*qv++; *xv++=j=c==d?1+j:0; *xv++=*qv++; c=d; *yv++=(A)*qv++;);
 GA(z,BOX,2,1,0); zv=AAV(z); zv[0]=x; zv[1]=y;
 R z;
}    /* 18!:30 locale map */

static SYMWALK(jtredefg,B,B01,100,1,1,RZ(redef(mark,d)))
     /* check for redefinition (erasure) of entire symbol table */

F1(jtlocexmark){A g,*pv,*wv,y,z;B b,c,*zv;C*u;I i,j,m,n,*nv,wd;L*v;
 RZ(vlocnl(1,w));
 n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w);
 nv=AV(jt->stnum); pv=AAV(jt->stptr);
 GA(z,B01,n,AR(w),AS(w)); zv=BAV(z);
 for(i=0;i<n;++i){
  zv[i]=1; y=WVR(i); g=0; m=AN(y); u=CAV(y); b='9'>=*u;
  if(b){j=probenum(u);               if(0<=j)g=pv[j]; }
  else {v=probe(nfs(m,u),jt->stloc); if(v   )g=v->val;}
  if(g){
   c=1;
   DO(1+jt->fcalli, if(g==jt->fcallg[i].g){jt->fcallg[i].flag=1+b; jt->fcallg[i].ptr=b?j:(I)v; c=0; break;});
   if(c){
    if(b){RZ(redefg(g)); RZ(symfreeh(g,0L)); pv[j]=0; nv[j]=-1; --jt->stused;}
    else {RZ(redefg(g)); RZ(symfreeh(g,v ));}
    if(g==jt->global)jt->global=0;
 }}}
 R z;
}    /* 18!:55 destroy a locale (but only mark for destruction if on stack) */

B jtlocdestroy(J jt,I i){A g,*pv;B b;I j,*nv;L*v;
 nv=AV(jt->stnum); pv=AAV(jt->stptr);
 g=jt->fcallg[i].g; b=1==jt->fcallg[i].flag?0:1;
 if(b){j=(I )jt->fcallg[i].ptr; RZ(redefg(g)); RZ(symfreeh(g,0L)); pv[j]=0; nv[j]=-1; --jt->stused;}
 else {v=(L*)jt->fcallg[i].ptr; RZ(redefg(g)); RZ(symfreeh(g,v ));}
 if(g==jt->global)jt->global=0;
 R 1;
}    /* destroy locale jt->callg[i] (marked earlier by 18!:55) */