Mercurial > hg > jgplsrc

annotate rl.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: Linear and Paren */
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 #if !SY_WINCE
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 extern int isdigit(int);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 static F1(jtlnoun);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 static F1(jtlnum);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 static F1(jtlrr);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 #define NUMV(c) (c==C9||c==CD||c==CA||c==CS)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 static B jtlp(J jt,A w){B b=1,p=0;C c,d,q=CQUOTE,*v;I j=0,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 n=AN(w); v=CAV(w); c=*v; d=*(v+n-1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 if(1==n||(2==n||3>=n&&' '==c)&&(d==CESC1||d==CESC2)||vnm(n,v))R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 if(C9==ctype[c])DO(n-1, d=c; c=ctype[*++v]; if(b=!NUMV(c)||d==CS&&c!=C9)break;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 else if(c==q) DO(n-1, c=*v++; if(c==q)p=!p; if(b=p?0:c!=q)break;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 else if(c=='(') DO(n-1, c=*v++; j+=c=='('?1:c==')'?-1:0; if(b=!j)break;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 R b;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 } /* 1 iff put parens around w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 static A jtlcpa(J jt,B b,A w){A z=w;C*zv;I n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 if(b){n=AN(w); GA(z,LIT,2+n,1,0); zv=CAV(z); *zv='('; MC(1+zv,AV(w),n); zv[1+n]=')';}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 } /* if b then (w) otherwise just w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 static A jtlcpb(J jt,B b,A w){A z=w;B p;C c,*v,*wv,*zv;I n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 n=AN(w); wv=CAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 if(!b){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 c=ctype[*wv]; v=wv; p=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 if (c==CQ)DO(n-1, c=ctype[*++v]; if(c==CQ)p=!p; else if(p){b=1; break;})
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 else if(c==C9)DO(n-1, c=ctype[*++v]; if(!(c==C9 ||c==CS )){b=1; break;})
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 else DO(n-1, c= *++v ; if(!(c==CESC1||c==CESC2)){b=1; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 if(b&&vnm(n,wv))b=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 if(b){GA(z,LIT,2+n,1,0); zv=CAV(z); *zv='('; MC(1+zv,wv,n); zv[1+n]=')';}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 static A jtlcpx(J jt,A w){RZ(w); R CALL2(jt->lcp,lp(w),w,0);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 static F1(jtltiea){A t,*v,*wv,x,y;B b;C c;I n,wd;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w); RZ(t=spellout(CGRAVE));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 GA(y,BOX,n+n,1,0); v=AAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 DO(n, *v++=i?t:mtv; x=WVR(i); c=ID(x); RZ(x=lrr(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 b=c==CHOOK||c==CFORK||i&&lp(x); RZ(*v++=CALL2(jt->lcp,b,x,0)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 R raze(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 static F1(jtltieb){A pt,t,*v,*wv,x,y;B b;C c,*s;I wd,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w); RZ(t=spellout(CGRAVE)); RZ(pt=over(scc(')'),t));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 GA(y,BOX,n+n,1,0); v=AAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 if(1>=n)x=mtv; else{GA(x,LIT,n-2,1,0); s=CAV(x); DO(n-2, *s++='(';);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 DO(n, *v++=0==i?x:1==i?t:pt; x=WVR(i); c=ID(x); RZ(x=lrr(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 b=c==CHOOK||c==CFORK||i&&lp(x); RZ(*v++=CALL2(jt->lcp,b,x,0)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 R raze(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 static F1(jtlsh){R over(thorn1(shape(w)),spellout(CDOLLAR));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 static F1(jtlshape){I r,*s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 r=AR(w); s=AS(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 R 2==r&&(1==s[0]||1==s[1]) ? spellout((C)(1==s[1]?CCOMDOT:CLAMIN)) : !r ? mtv :
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 1<r ? lsh(w) : 1<AN(w) ? mtv : spellout(CCOMMA);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 static F1(jtlchar){A y;B b,p=1,r1;C c,d,*u,*v;I j,k,m,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 m=AN(alp); n=AN(w); j=n-m; r1=1==AR(w); u=v=CAV(w); d=*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 if(0<=j&&r1&&!memcmp(v+j,AV(alp),m)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 if(!j)R cstr("a.");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 RZ(y=lchar(1==j?scc(*v):str(j,v)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 R lp(y)?over(cstr("a.,~"),y):over(y,cstr(",a."));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 if(r1&&m==n&&(y=icap(ne(w,alp)))&&m>AN(y)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 if(1==AN(y))RZ(y=head(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 R over(over(cstr("a. "),lcpx(lnum(y))),over(cstr("}~"),lchar(from(y,w))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 j=2; b=7<n||1<n&&1<AR(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 DO(n, c=*v++; if(c==CQUOTE)++j; b&=c==d; p&=31<c&&c<127;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 if(b){n=1; j=MIN(3,j);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 if(!p){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 k=(UC)d; RZ(y=indexof(alp,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 if(r1&&n<m&&(!k||k==m-n)&&equ(y,apv(n,k,1L)))R over(thorn1(sc(d?-n:n)),cstr("{.a."));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 RZ(y=lnum(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 R lp(y)?over(cstr("a.{~"),y):over(y,cstr("{a."));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 GA(y,LIT,n+j,1,0); v=CAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 *v=*(v+n+j-1)=CQUOTE; ++v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 if(2==j)MC(v,u,n); else DO(n, *v++=c=*u++; if(c==CQUOTE)*v++=c;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 R over(b?lsh(w):lshape(w),y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 } /* non-empty character array */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 static F1(jtlbox){A p,*v,*vv,*wv,x,y;B b=0;I n,wd;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 if(equ(ace,w)&&B01==AT(AAV0(w)))R cstr("a:");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 DO(n, x=WVR(i); if(BOX&AT(x)){b=1; break;}); b=b||1==n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 GA(y,BOX,n+n-!b,1,0); v=vv=AAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 if(b){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 RZ(p=cstr("),(<"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 DO(n, x=WVR(i); *v++=p; RZ(*v++=lnoun(x)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 RZ(*vv=cstr(1==n?"<":"(<")); if(1<n)RZ(vv[n+n-2]=cstr("),<"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 R over(lshape(w),raze(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 DO(n, x=WVR(i); if(b=1!=AR(x)||!(LIT&AT(x)))break;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 if(!b){C c[256],d,*t;UC*s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 DO(256,c[i]=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 RZ(x=raze(w)); s=UAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 DO(AN(x), c[*s++]=0;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 if(c[CQUOTE]&&equ(w,words(x)))R over(cstr(";:"),lchar(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 if(c[d=' ']||c[d='|']||c[d='/']||c[d=',']||c[d=';']){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 GA(y,LIT,n+AN(x),1,0); t=CAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 DO(n, x=WVR(i); *t++=d; MC(t,AV(x),AN(x)); t+=AN(x););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 RZ(y=lchar(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 R over(lshape(w),over(cstr(isdigit(*CAV(y))?"<;.(_1) ":"<;._1 "),y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 RZ(p=cstr(";"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 DO(n-1, RZ(*v++=lcpx(lnoun(WVR(i)))); *v++=p;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 RZ(*v=lnoun(WVR(n-1)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 R over(lshape(w),raze(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 } /* non-empty boxed array */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 static F1(jtlnum1){A z;I t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 t=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 RZ(z=t&FL+CMPX?df1(w,fit(ds(CTHORN),sc((I)18))):thorn1(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 R t&XNUM+RAT&&!memchr(CAV(z),t&XNUM?'x':'r',AN(z))?over(z,scc('x')):z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 } /* dense non-empty numeric vector */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 static F1(jtlnum){A b,d,t,*v,y;B p;I n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 RZ(t=ravel(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 n=AN(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 if(7<n||1<n&&1<AR(w)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 d=minus(from(one,t),b=from(zero,t)); if(jt->jerr)RESETERR;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 p=equ(t,plus(b,tymes(d,IX(n)))); if(jt->jerr)RESETERR;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 if(p){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 if(equ(d,zero))R over(lsh(w),lnum1(b));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 GA(y,BOX,6,1,0); v=AAV(y); v[0]=v[1]=v[2]=v[3]=mtv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 if(p=!(equ(b,sc(n-1))&&equ(d,num[-1]))){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 if (!equ(b,zero )){v[0]=lnum1(b); v[1]=spellout(CPLUS);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 if ( equ(d,num[-1])) v[1]=spellout(CMINUS);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 else if(!equ(d,one )){v[2]=lnum1(d); v[3]=spellout(CSTAR);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 v[4]=spellout(CIOTA); v[5]=thorn1(p?shape(w):negate(shape(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 RE(y); R raze(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 R over(lshape(w),lnum1(t));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 } /* dense numeric non-empty array */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 static F1(jtlsparse){A a,e,q,t,x,y,z;B ba,be,bn;I j,r,*v;P*p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 r=AR(w); p=PAV(w); a=SPA(p,a); e=SPA(p,e); y=SPA(p,i); x=SPA(p,x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 bn=0; v=AS(w); DO(r, if(!*v++){bn=1; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 ba=0; if(r==AR(a)){v=AV(a); DO(r, if(i!=*v++){ba=1; break;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168 be=!(AT(w)&SFL&&0==*DAV(e));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 if(be)RZ(z=over(lnoun(e),cstr(SB01&AT(w)?"":SINT&AT(w)?"+-~2":SFL&AT(w)?"+-~2.1":"+-~2j1")));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 if(be||ba){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171 RZ(z=be?over(lcpx(lnoun(a)), over(scc(';'),z)):lnoun(a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 RZ(z= over(lcpx(lnoun(shape(w))),over(scc(';'),z)) );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 }else RZ(z=lnoun(shape(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174 RZ(z=over(cstr("1$."),z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 if(bn||!*AS(y))R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 if(AN(a)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 RZ(x=lcpx(lnoun(x)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 RZ(y=1==r?lnoun(ravel(y)):over(cstr("(<\"1)"),lnoun(y)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 RZ(t=over(x,over(cstr(" ("),over(y,cstr(")}")))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 }else RZ(t=over(lcpx(lnoun(head(x))),cstr(" a:}")));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 ba=0; v=AV(a); DO(AN(a), if(i!=*v++){ba=1; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 if(!ba)R over(t,z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 RZ(q=less(IX(r),a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 RZ(z=over(over(lcpx(lnoun(q)),cstr("|:")),z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 RZ(z=over(t,z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 RZ(q=grade1(over(less(IX(r),q),q)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 j=r; v=AV(q); DO(r, if(i!=*v++){j=i; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 R over(lcpx(lnoun(drop(sc(j),q))),over(cstr("|:"),z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 } /* sparse array */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 static F1(jtlnoun0){A s,x;B r1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193 r1=1==AR(w); RZ(s=thorn1(shape(w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 switch(AT(w)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 default: R over(cstr("i."),s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 case LIT: x=cstr( "''"); R r1?x:over(over(s,scc('$')),x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 case C2T: x=cstr("u: ''"); R r1?x:over(over(s,scc('$')),x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 case BOX: R over(s,cstr("$a:" ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 case B01: R over(s,cstr("$0" ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200 case FL: R over(s,cstr("$0.5" ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 case CMPX: R over(s,cstr("$0j5" ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 case XNUM: R over(s,cstr("$0x" ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203 case RAT: R over(s,cstr("$1r2" ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204 case SBT: R over(s,cstr("$s: ' '"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205 }} /* empty dense array */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207 static F1(jtlnoun){I t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 t=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 if(t&SPARSE)R lsparse(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 if(!AN(w))R lnoun0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
212 switch(t){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
213 case LIT: R lchar(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
214 case C2T: R over(cstr("u: "),lnum(uco2(num[3],w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215 case BOX: R lbox(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216 case SBT: R over(cstr("s: "),lbox(sb2(num[5],w)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217 default: R lnum(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 static A jtlsymb(J jt,C c,A w){A t;C buf[20],d,*s;I*u;V*v=VAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 if(VDDOP&v->flag){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222 u=AV(v->h); s=buf;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 *s++=' '; *s++='('; s+=sprintf(s,FMTI,*u); spellit(CIBEAM,s); s+=2; s+=sprintf(s,FMTI,u[1]); *s++=')';
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 RZ(t=str(s-buf,buf));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225 }else RZ(t=spella(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 d=cf(t);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227 R d==CESC1||d==CESC2?over(chr[' '],t):t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 static B laa(A a,A w){C c,d;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 c=ctype[cl(a)]; d=ctype[cf(w)];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 R (c==C9||c==CA)&&(d==C9||d==CA);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236 static B lnn(A a,A w){C c; RZ(a&&w); c=cl(a); R ('x'==c||C9==ctype[c])&&C9==ctype[cf(w)];}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238 static F2(jtlinsert){A*av,f,g,h,t,t0,t1,t2,*u,y;B b,ft,gt,ht,vb;C c,id;I ad,n;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240 n=AN(a); av=AAV(a); ad=(I)w*ARELATIVE(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 vb=VERB==AT(w); v=VAV(w); id=v->id;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242 b=id==CCOLON&&VXOP&v->flag;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 if(1<=n){f=AVR(0); t=v->f; c=ID(t); ft=c==CHOOK||c==CFORK||c==CADVF||id==CFORK&&NOUN&AT(t)&&lp(f);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 if(2<=n){g=AVR(1); t=v->g; c=ID(t); gt=vb ?c==CHOOK||c==CFORK:lp(g);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 if(3<=n){h=AVR(2); t=v->h; c=ID(t); ht=vb&&!b?c==CHOOK :lp(h);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246 switch(!b?id:2==n?CHOOK:CFORK){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 case CADVF:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
248 case CHOOK:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
249 GA(y,BOX,3,1,0); u=AAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
250 u[0]=f=CALL2(jt->lcp,ft||lnn(f,g),f,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
251 u[2]=g=CALL2(jt->lcp,gt||b, g,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
252 u[1]=str(' '==cf(g)||id==CADVF&&!laa(f,g)&&!(lp(f)&&lp(g))?0L:1L," ");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
253 RE(0); R raze(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
254 case CFORK:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
255 GA(y,BOX,5,1,0); u=AAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
256 RZ(u[0]=f=CALL2(jt->lcp,ft||lnn(f,g), f,0));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
257 RZ(u[2]=g=CALL2(jt->lcp,gt||lnn(g,h)||b,g,0)); RZ(u[1]=str(' '==cf(g)?0L:1L," "));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
258 RZ(u[4]=h=CALL2(jt->lcp,ht, h,0)); RZ(u[3]=str(' '==cf(h)?0L:1L," "));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
259 R raze(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
260 default:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
261 t0=CALL2(jt->lcp,ft||NOUN&AT(v->f)&&!(VGERL&v->flag)&&lp(f),f,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
262 t1=lsymb(id,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
263 y=over(t0,laa(t0,t1)?over(chr[' '],t1):t1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
264 if(1==n)R y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
265 t2=lcpx(g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
266 R over(y,laa(y,t2)?over(chr[' '],t2):t2);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
267 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
268
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
269 static F1(jtlcolon){A*v,x,y;C*s,*s0;I m,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
270 RZ(y=unparsem(one,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
271 n=AN(y); v=AAV(y); RZ(x=lrr(VAV(w)->f));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
272 if(2>n||2==n&&1==AN(v[0])&&':'==*CAV(v[0])){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
273 if(!n)R over(x,str(5L," : \'\'"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
274 y=lrr(v[2==n]);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
275 if(2==n)y=over(str(5L,"\':\'; "),y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
276 R over(over(x,str(3L," : ")),lcpx(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
277 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
278 m=0; DO(n, m+=AN(v[i]););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
279 GA(y,LIT,2+n+m,1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
280 s=s0=CAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
281 DO(n, *s++=CLF; y=v[i]; m=AN(y); MC(s,CAV(y),m); s+=m;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
282 *s++=CLF; *s++=')';
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
283 RZ(y=str(s-s0,s0));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
284 jt->ltext=jt->ltext?over(jt->ltext,y):y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
285 R over(x,str(4L," : 0"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
286 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
287
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
288 static F1(jtlrr){A fs,gs,hs,t,*tv;C id;I fl,m;V*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
289 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
290 if(AT(w)&NOUN)R lnoun(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
291 if(AT(w)&NAME)R sfn(0,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
292 v=VAV(w); id=v->id; fs=v->f; gs=v->g; hs=v->h; fl=v->flag;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
293 if(fl&VXOPCALL)R lrr(hs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
294 m=!!fs+!!gs+(id==CFORK)+(hs&&id==CCOLON&&VXOP&fl);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
295 if(!m)R lsymb(id,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
296 if(evoke(w))R sfn(0,fs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
297 if(!(VXOP&fl)&&hs&&BOX&AT(hs)&&id==CCOLON)R lcolon(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
298 GA(t,BOX,m,1,0); tv=AAV(t);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
299 if(2<m)RZ(tv[2]=lrr(hs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
300 if(1<m)RZ(tv[1]=fl&VGERR?CALL1(jt->ltie,fxeach(gs),0L):lrr(gs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
301 if(0<m)RZ(tv[0]=fl&VGERL?CALL1(jt->ltie,fxeach(fs),0L):lrr(fs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
302 R linsert(t,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
303 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
304
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
305 F1(jtlrep){PROLOG;A z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
306 jt->ltext=0; jt->lcp=(AF)jtlcpa; jt->ltie=jtltiea;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
307 RE(z=lrr(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
308 if(jt->ltext)z=over(z,jt->ltext);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
309 jt->ltext=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
310 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
311 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
312
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
313 F1(jtprep){PROLOG;A z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
314 jt->ltext=0; jt->lcp=(AF)jtlcpb; jt->ltie=jtltieb;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
315 RE(z=lrr(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
316 if(jt->ltext)z=over(z,jt->ltext);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
317 jt->ltext=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
318 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
319 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
320