Mercurial > hg > jgplsrc

annotate rt.c @ 0:e0bbaa717f41 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
1 /* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
2 /* License in license.txt. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
3 /* */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
4 /* Representations: Tree */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
5
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
6 #include "j.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
7
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8 static F1(jttrr);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 static F1(jttrc){A bot,p,*v,x,y;B b;C*bv,c,ul,ll,*pv;I j,k,m,*s,xn,*xv,yn,*yv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 s=AS(w); v=AAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 xn=s[0]; RZ(x=apv(xn,0L,0L)); xv=AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 yn=s[1]; RZ(y=apv(yn,0L,0L)); yv=AV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 j=0; DO(xn, xv[i]=IC(v[j]); j+=yn;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 GA(bot,LIT,yn,1,0); bv=CAV(bot);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18 ul=jt->bx[0]; ll=jt->bx[6];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 for(j=b=0;j<xn;++j,b=0<j)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 for(k=0;k<yn;++k){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 p=*v++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 if(AN(p)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 m=*(1+AS(p)); yv[k]=MAX(yv[k],m);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 pv=CAV(p); c=*pv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 if(b&&(c==ul&&' '!=bv[k]||c!=' '&&ll==bv[k])){xv[j-1]+=1; b=0;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 bv[k]=*(pv+AN(p)-m);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 }else bv[k]=' ';
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 R link(x,y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 static I jtpad(J jt,A a,A w,C*zv){C dash,*u,*v,*wv;I c,d,r,*s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 s=AV(a); r=s[0]; d=s[1];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 if(AN(w)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 c=*(1+AS(w)); wv=CAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 if(c==d)MC(zv,wv,AN(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 zv-=d; v=zv+c-1; u=wv-c; dash=jt->bx[10];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 DO(IC(w), MC(zv+=d,u+=c,c); v+=d; if(dash==*v)memset(1+v,dash,d-c););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 R r*d;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 static F1(jtgraft){A p,q,t,*u,x,y,z,*zv;C*v;I d,j,k,m,n,*pv,*s,xn,*xv,yn,*yv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 RZ(t=trc(w)); u=AAV(t);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 x=u[0]; xn=AN(x); xv=AV(x); m=0; DO(xn,m+=xv[i];);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 y=u[1]; yn=AN(y); yv=AV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 RZ(p=v2(0L,0L)); pv=AV(p);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 GA(z,BOX,yn,1,0); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 u=AAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 for(j=0;j<yn;++j){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 RE(k=mult(m,yv[j])); GA(q,LIT,k,2,0); s=AS(q); *s=m; *++s=yv[j];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 v=CAV(q); memset(v,' ',AN(q));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 pv[1]=yv[j]; k=j-yn; DO(xn, *pv=xv[i]; RE(v+=pad(p,u[k+=yn],v)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 zv[j]=q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 t=zv[0]; n=yv[0];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 if(1==m)RZ(p=scc(jt->bx[10]))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 v=CAV(t); DO(m, if(' '!=*v){j=i; break;} v+=n;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 v=CAV(t)+AN(t)-n; DO(m, if(' '!=*v){k=m-i; break;} v-=n;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 d=k-j;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 GA(p,LIT,m,1,0); v=CAV(p); memset(v,' ',m);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 if(1==d)*(v+j)=jt->bx[10]; else{memset(v+j,jt->bx[9],d); *(v+j)=*jt->bx; *(v+k-1)=jt->bx[6];}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 RZ(zv[0]=stitch(p,t));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 static A jtcenter(J jt,A a,I j,I k,I m){A z;C*x;I n,*s,zn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 RZ(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 n=AN(a); RE(zn=mult(m,n)); GA(z,LIT,zn,2,0); s=AS(z); *s=m; *++s=n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 x=CAV(z); memset(x,' ',AN(z)); MC(x+n*(j+(m-(j+k))/2),AV(a),n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78 static F2(jttroot){A t,x;B b;C*u,*v;I j=0,k=0,m,n,*s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 m=AN(a); u=CAV(a); b=!m||1==m&&'0'<=*u&&*u<='9';
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 GA(x,LIT,b?1:4+m,1,0); v=CAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 *v=jt->bx[10]; if(!b){v[3+m]=jt->bx[10]; v[1]=v[2+m]=' '; MC(2+v,u,m);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 t=*AAV(w); s=AS(t); m=*s; n=*(1+s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 u=CAV(t); DO(m, if(' '!=*u){j=i; break;} u+=n;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 u=CAV(t)+(m-1)*n; DO(m, if(' '!=*u){k=i; break;} u-=n;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 R link(center(x,j,k,m),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 static F1(jttleaf){A t,z;C*v;I n,*s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 n=AN(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 GA(t,LIT,2+n,2,0); s=AS(t); s[0]=1; s[1]=2+n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 v=CAV(t); v[0]=jt->bx[10]; v[1]=' '; MC(2+v,AV(w),n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 GA(z,BOX,1,1,0); *AAV(z)=t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 static F1(jttconnect){A*wv,x,y,z;B b,d;C c,*u,*xv,*yv,*zv;I e,i,j,m,n,p,q,zn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 n=AN(w); wv=AAV(w); y=*wv; m=*AS(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 e=0; DO(n,e+=*(1+AS(wv[i])););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 RE(zn=mult(m,e)); GA(z,LIT,zn,2,AS(y)); *(1+AS(z))=e; zv=CAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 for(i=0;i<n;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 y=wv[i]; q=*(1+AS(y)); yv=CAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 if(i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 xv=CAV(x)+p-1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 for(j=0;j<m;++j){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 b=jt->bx[10]==*xv; c=*yv; d=jt->bx[10]==*(1+yv);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 if(b&&c==jt->bx[9])c=jt->bx[5];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 if(d&&c==jt->bx[5])c=jt->bx[4];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 if(d&&c==jt->bx[9])c=jt->bx[3];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 if(b&&c==jt->bx[6])c=jt->bx[7];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 *yv=c; yv+=q; xv+=p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 u=zv-e; yv=CAV(y)-q; DO(m, MC(u+=e,yv+=q,q);); zv+=q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 x=y; p=q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 static F1(jttreach){R troot(scc('0'),graft(ope(every(w,0L,jttrr))));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 static F1(jttrr){PROLOG;A fs,gs,hs,s,t,*x,z;B ex,xop;C id;I fl,*hv,m;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 if(AT(w)&NOUN+NAME)R tleaf(lrep(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 v=VAV(w); id=v->id; fl=v->flag; fs=v->f; gs=v->g; hs=v->h;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 if(fl&VXOPCALL)R trr(hs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 xop=1&&VXOP&fl; ex=id==CCOLON&&hs&&!xop;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 m=!!fs+(gs||ex)+(id==CFORK||xop&&hs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 if(!m)R tleaf(spella(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 if(evoke(w))R tleaf(sfn(0,fs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 GA(t,BOX,m,1,0); x=AAV(t);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 if(0<m)RZ(x[0]=fl&VGERL?treach(fxeach(fs)):trr(fs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 if(1<m)RZ(x[1]=fl&VGERR?treach(fxeach(gs)):ex?trr(unparsem(zero,w)):trr(gs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 if(2<m)RZ(x[2]=trr(hs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 s=xop?spellout('0'):fl&VDDOP?(hv=AV(hs),over(thorn1(sc(hv[0])),over(spellout(id),thorn1(sc(hv[1]))))):spellout(id);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137 z=troot(s,graft(ope(t)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 F1(jttrep){PROLOG; EPILOG(tconnect(troot(mtv,trr(w))));}