diff sl.c @ 0:e0bbaa717f41 draft default tip

lol J
author Jordi GutiƩrrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500 (2013-11-25)
parents
children
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/sl.c
@@ -0,0 +1,258 @@
+/* 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; 
+ 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) */