Mercurial > hg > jgplsrc
view sn.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 |
parents | |
children |
line wrap: on
line source
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ /* License in license.txt. */ /* */ /* Symbol Table: Names */ #include "j.h" B jtvnm(J jt,I n,C*s){B b=0;C c,d,t;I j,k; RZ(n); c=*s; d=*(s+n-1); if(jt->dotnames&&2==n&&'.'==d&&('m'==c||'n'==c||'u'==c||'v'==c||'x'==c||'y'==c))R 1; RZ(CA==ctype[c]); c='a'; DO(n, d=c; c=s[i]; t=ctype[c]; RZ(t==CA||t==C9); if(c=='_'&&d=='_'&&!b&&i!=n-1){j=1+i; b=1;}); if(c=='_'){DO(j=n-1, if('_'==s[--j])break;); k=n-j-2; R!b&&j&&(!k||vlocnm(k,s+j+1));} if(!b)R 1; k=2; DO(n-j, c=s[j+i]; if(2>k)k+='_'==c; else{RZ(CA==ctype[c]); k=0;}); R !k; } /* validate name s, return type or 0 if error */ B vlocnm(I n,C*s){C c,t; if(!n)R 0; DO(n, t=ctype[c=s[i]]; RZ(c!='_'&&(t==CA||t==C9));); if(C9==ctype[*s]){RZ(1==n||'0'!=*s); DO(n, c=s[i]; RZ('0'<=c&&c<='9'););} R 1; } /* validate locale name */ A jtnfs(J jt,I n,C*s){A z;C c,f,*t;I m,p;NM*zv; DO(n, if(' '!=*s)break; ++s; --n;); t=s+n-1; DO(n, if(' '!=*t)break; --t; --n;); if((1==n||2==n&&'.'==s[1])&&strchr("mnuvxy",c=*s)){ if(1==n)R c=='y'?ynam:c=='x'?xnam:c=='v'?vnam:c=='u'?unam:c=='n'?nnam:mnam; else R c=='y'?ydot:c=='x'?xdot:c=='v'?vdot:c=='u'?udot:c=='n'?ndot:mdot; } ASSERT(n,EVILNAME); GA(z,NAME,n,1,0); zv=NAV(z); memcpy(zv->s,s,n); *(n+zv->s)=0; f=0; m=n; p=0; if('_'==*t){--t; while(s<t&&'_'!=*t)--t; f=NMLOC; p=n-2-(t-s); m=n-(2+p);} else DO(n, if('_'==s[i]&&'_'==s[1+i]){ f=NMILOC; p=n-2-i; m=n-(2+p); break;}); ASSERT(m<=255&&p<=255,EVLIMIT); zv->flag=f; zv->sn=0; zv->e=0; zv->m=(UC)m; zv->hash=NMHASH(m,s); R z; } /* name from string */ A jtsfn(J jt,B b,A w){NM*v; RZ(w); v=NAV(w); R str(b?v->m:AN(w),v->s);} /* string from name: 0=b full name; 1=b non-locale part of name */ F1(jtnfb){A y;C*s;I n; RZ(w); ASSERT(BOX&AT(w),EVDOMAIN); ASSERT(!AR(w),EVRANK); RZ(y=vs(ope(w))); n=AN(y); s=CAV(y); ASSERTN(vnm(n,s),EVILNAME,nfs(n,s)); R nfs(n,s); } /* name from scalar boxed string */ static F1(jtstdnm){C*s;I j,n,p,q; RZ(w=vs(w)); n=AN(w); s=CAV(w); RZ(n); j=0; DO(n, if(' '!=s[j++])break;); p=j-1; j=n-1; DO(n, if(' '!=s[j--])break;); q=(n-2)-j; RZ(vnm(n-(p+q),p+s)); R nfs(n-(p+q),p+s); } /* 0 result means error or invalid name */ F1(jtonm){A x,y; RZ(x=ope(w)); y=stdnm(x); ASSERTN(y,EVILNAME,nfs(AN(x),CAV(x))); R y;} F1(jtnc){A*wv,x,y,z;I i,n,t,wd,*zv;L*v; RZ(w); n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w); ASSERT(!n||BOX&AT(w),EVDOMAIN); GA(z,INT,n,AR(w),AS(w)); zv=AV(z); for(i=0;i<n;++i){ x=0; RE(y=stdnm(WVR(i))); if(y&&(v=syrd(y,0L))){x=v->val; t=AT(x);} zv[i]=!y?-2:!x?-1:t&NOUN?0:t&VERB?3:t&ADV?1:2; } R z; } /* 4!:0 name class */ static SYMWALK(jtnlxxx, A,BOX,20,1, jt->nla[*((UC*)NAV(d->name)->s)]&&jt->nlt&AT(d->val), RZ(*zv++=sfn(1,d->name)) ) SYMWALK(jtnlsym, A,BOX,20,1, jt->nla[*((UC*)NAV(d->name)->s)], RZ(*zv++=sfn(1,d->name)) ) static I nlmask[] = {NOUN,ADV,CONJ,VERB, MARK,MARK,SYMB,MARK}; static F1(jtnlx){A z=mtv;B b;I m=0,*v,x; RZ(w=vi(w)); v=AV(w); DO(AN(w), x=*v++; m|=nlmask[x<0||6<x?7:x];); jt->nlt=m&RHS; b=1&&jt->nlt&RHS; ASSERT(!(m&MARK),EVDOMAIN); if(b )RZ(z=nlxxx(jt->global)); if(b&&jt->local)RZ(z=over(nlxxx(jt->local),z)); if(m&SYMB )RZ(z=over(nlsym(jt->stloc),z)); R nub(grade2(z,ope(z))); } F1(jtnl1){memset(jt->nla,C1,256L); R nlx(w);} /* 4!:1 name list */ F2(jtnl2){UC*u; RZ(a&&w); ASSERT(LIT&AT(a),EVDOMAIN); memset(jt->nla,C0,256L); u=UAV(a); DO(AN(a),jt->nla[*u++]=1;); R nlx(w); } /* 4!:1 name list */ F1(jtscind){A*wv,x,y,z;I n,wd,*zv;L*v; RZ(w); n=AN(w); ASSERT(!n||BOX&AT(w),EVDOMAIN); wv=AAV(w); wd=(I)w*ARELATIVE(w); GA(z,INT,n,AR(w),AS(w)); zv=AV(z); DO(n, x=WVR(i); RE(y=stdnm(x)); ASSERTN(y,EVILNAME,nfs(AN(x),CAV(x))); v=syrd(y,0L); RESETERR; zv[i]=v?v->sn:-1;); R z; } /* 4!:4 script index */ static A jtnch1(J jt,B b,A w,I*pm,A ch){A*v,x,y;C*s,*yv;I*e,i,k,m,p,wn;L*d; RZ(w); wn=AN(w); e=AV(w); /* locale */ x=(A)(*e+jt->sympv)->name; p=AN(x); s=NAV(x)->s; /* locale name */ m=*pm; v=AAV(ch)+m; /* result to appended to */ for(i=1;i<wn;++i,++e)if(*e){ d=*e+jt->sympv; while(1){ if(LCH&d->flag&&d->name&&d->val){ d->flag^=LCH; if(b){ if(m==AN(ch)){RZ(ch=ext(0,ch)); v=m+AAV(ch);} x=d->name; k=NAV(x)->m; GA(y,LIT,k+2+p,1,0); yv=CAV(y); MC(yv,NAV(x)->s,k); MC(1+k+yv,s,p); yv[k]=yv[1+k+p]='_'; *v++=y; ++m; }} if(!d->next)break; d=d->next+jt->sympv; }} *pm=m; R ch; } F1(jtnch){A ch,*pv;B b;I*e,i,m,n;L*d; RZ(w=cvt(B01,w)); ASSERT(!AR(w),EVRANK); b=*BAV(w); GA(ch,BOX,20,1,0); m=0; if(jt->stch){ n=AN(jt->stloc); e=1+AV(jt->stloc); pv=AAV(jt->stptr); for(i=1;i<n;++i,++e)if(*e){ d=*e+jt->sympv; while(1){ RZ(ch=nch1(b,d->val,&m,ch)); if(!d->next)break; d=d->next+jt->sympv; }} n=AN(jt->stptr); DO(n, if(pv[i])RZ(ch=nch1(b,pv[i],&m,ch));); } jt->stch=b; AN(ch)=*AS(ch)=m; R grade2(ch,ope(ch)); } /* 4!:5 names changed */ F1(jtex){A*wv,y,z;B*zv;I i,n,wd;L*v; RZ(w); n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w); ASSERT(!n||BOX&AT(w),EVDOMAIN); GA(z,B01,n,AR(w),AS(w)); zv=BAV(z); for(i=0;i<n;++i){ RE(y=stdnm(WVR(i))); zv[i]=1&&y; if(y&&(v=syrd(y,0L))){if(jt->db)RZ(redef(mark,v)); nvrredef(v->val); RZ(symfree(v));} } R z; } /* 4!:55 expunge */