static DF2(con2){A h,*hv,*x,z;V*sv; PREF2(con2); sv=VAV(self); h=sv->h; hv=AAV(h); GA(z,BOX,AN(h),AR(h),AS(h)); x=AAV(z); DO(AN(h), RZ(*x++=(VAV(*hv)->f2)(a,w,*hv)); ++hv); R ope(z); }
static DF1(insert){PROLOG;A hs,*hv,z;I hn,j,k,m,n; RZ(w); m=IC(w); hs=VAV(self)->h; hn=AN(hs); hv=AAV(hs); if(!m)R df1(w,iden(*hv)); j=n=MAX(hn,m-1); RZ(z=AR(w)?from(sc(n%m),w):ca(w)); if(1==n)R z; DO(n, --j; k=j%hn; RZ(z=(VAV(hv[k])->f2)(from(sc(j%m),w),z,hv[k]))); EPILOG(z); }
static A jttayamp(J jt,A w,B nf,A x,A h){A y;B ng=!nf;I j,n;V*v=VAV(h); ASSERT(AR(x)<=(nf?v->lr:v->rr),EVRANK); switch(v->id){ case CPLUS: R tpoly(over(x,one)); case CMINUS: R tpoly(nf?over(x,num[-1]):over(negate(x),one)); case CSTAR: R tpoly(over(zero,x)); case CDIV: ASSERT(ng,EVDOMAIN); R tpoly(over(zero,recip(x))); case CJDOT: R tpoly(nf?over(x,a0j1):over(jdot1(x),one)); case CPOLY: ASSERT(nf,EVDOMAIN); R tpoly(BOX&AT(x)?poly1(x):x); case CHGEOM: ASSERT(nf,EVDOMAIN); RE(j=i0(x)); ASSERT(0<=j,EVDOMAIN); y=IX(j); R tpoly(divide(hgcoeff(y,h),fact(y))); case CBANG: ASSERT(nf,EVDOMAIN); RE(j=i0(x)); ASSERT(0<=j,EVDOMAIN); R tpoly(divide(poly1(box(iota(x))),fact(x))); case CEXP: if(nf)R eva(x,"(^.x)&^ % !"); RE(n=i0(x)); R 0<=n?tpoly(over(reshape(x,zero),one)):atop(ds(CDIV),amp(h,sc(-n))); case CFIT: ASSERT(nf&&CPOLY==ID(v->f),EVDOMAIN); y=over(x,IX(IC(x))); R tpoly(mdiv(df2(x,y,h),atab(CEXP,y,IX(IC(x))))); case CCIRCLE: switch(i0(x)){ case 1: R eval("{&0 1 0 _1@(4&|) % !"); case -3: R eval("{&0 1 0 _1@(4&|) % ]"); case 2: R eval("{&1 0 _1 0@(4&|) % !"); case 5: R eval("2&| % !"); case -7: R eval("2&| % ]"); case 6: R eval("2&|@>: % !"); case -1: R eval("(2&| % ]) * ([: */ (1&+ % 2&+)@(i.@<.&.-:))\"0"); case -5: R eval("({&0 1 0 _1@(4&|) % ]) * ([: */ (1&+ % 2&+)@(i.@<.&.-:))\"0"); }} ASSERT(0,EVDOMAIN); }
static F1(jtfacit){A c;V*u,*v; RZ(c=coeff(w)); if(AN(c))R tpoly(tymes(c,fact(AT(c)&XNUM+RAT?xco1(IX(IC(c))):IX(IC(c))))); v=VAV(w); if(CFORK==v->id)switch(ID(v->g)){ case CDIV: if(CBANG==ID(v->h))R v->f; break; case CSTAR: if(CFORK==ID(v->h)&&(u=VAV(v->h),CDIV==ID(u->g)&&CBANG==ID(u->h)))R folk(v->f,v->g,u->f); RZ(c=atop(ds(CDIV),ds(CBANG))); if(equ(c,v->f))R v->h; if(equ(c,v->h))R v->f; } R folk(ds(CBANG),ds(CSTAR),w); }
static F2(jtfitct){D d;V*sv; RZ(a&&w); ASSERT(!AR(w),EVRANK); sv=VAV(a); RZ(w=cvt(FL,w)); d=*DAV(w); ASSERT(0<=d&&d<5.82076609134675e-11,EVDOMAIN); R CDERIV(CFIT,jtfitct1,jtfitct2,sv->mr,sv->lr,sv->rr); }
static void qqset(A a,AF*f1,AF*f2,I*flag){A f,g;C c,d,e,p,q;I m=0;V*v; static C at1[]={CFLOOR,CLE,CCEIL,CGE,CPLUS,CPLUSDOT,CPLUSCO, CSTAR,CSTARDOT,CSTARCO,CMINUS,CNOT,CHALVE,CDIV,CSQRT,CEXP,CLOG, CSTILE,CBANG,CLEFT,CRIGHT,CQUERY,CHGEOM,CJDOT,CCIRCLE, CPCO,CQCO,CRDOT,CTDOT,CXCO,0}; /* f monad <-> f"r monad */ static C ir1[]={CCOMMA,CLAMIN,CLEFT,CRIGHT,CCANT,CROT,CTAKE,CDROP,CGRADE,CDGRADE, CBOX,CNE,CTAIL,CCTAIL,CSLASH,CBSLASH,CBSDOT,CCOMDOT,CPCO,CATDOT,0}; static C ir2[]={CCOMMA,CLAMIN,CLEFT,CRIGHT,CCANT,CROT,CTAKE,CDROP,CGRADE,CDGRADE, CDOLLAR,CPOUND,CIOTA,CICO,CEPS,CLBRACE,CMATCH, CEQ,CLT,CMIN,CLE,CGT,CMAX,CGE,CPLUS,CPLUSDOT,CPLUSCO,CSTAR,CSTARDOT,CSTARCO, CMINUS,CDIV,CEXP,CNE,CSTILE,CBANG,CCIRCLE,0}; if(NOUN&AT(a)){*f1=cons1; *f2=cons2; *flag=0; R;} v=VAV(a); c=v->id; if(strchr(ir1,c))m+=VIRS1; if(strchr(ir2,c))m+=VIRS2; if(!(m&VIRS1)&&v->flag&VIRS1&&c!=CQQ)m+=VIRS1; if(!(m&VIRS2)&&v->flag&VIRS2&&c!=CQQ)m+=VIRS2; if(!m){ p=0; if(f=v->f){d=ID(f);p=VERB&AT(f)&&strchr(ir2,d);}; q=0; if(g=v->g){e=ID(g);q=VERB&AT(g)&&strchr(ir2,e);}; switch(c){ case CFIT: if(p&&d!=CEXP)m+=VIRS2; if(d==CNE)m+=VIRS1; break; case CTILDE: if(p)m+=VIRS1+VIRS2; break; case CAMP: if(p&&NOUN&AT(g)||q&&NOUN&AT(f))m+=VIRS1; break; case CFORK: if(v->f1==(AF)jtmean)m+=VIRS1; }} *f1=strchr(at1,c) ? v->f1 : m&VIRS1 ? rank1i : rank1; *f2= m&VIRS2 ? rank2i : rank2; *flag=m; }
A jtspella(J jt,A w){C c,s[3];V*v; RZ(w); v=VAV(w); c=v->id; if(c==CFCONS)R over(thorn1(v->h),chr[':']); spellit(c,s); R str(s[2]?3L:s[1]?2L:1L,s); }
static DF2(case2){A u;V*sv; PREF2(case2); sv=VAV(self); RZ(u=from(df2(a,w,sv->g),sv->h)); ASSERT(!AR(u),EVRANK); R df2(a,w,*AV(u)); }
static DF1(case1){A u;V*sv; PREF1(case1); sv=VAV(self); RZ(u=from(df1(w,sv->g),sv->h)); ASSERT(!AR(u),EVRANK); R df1(w,*AV(u)); }
static DF1(jtgsuffix){A h,*hv,z,*zv;I m,n,r; RZ(w); if(jt->rank&&jt->rank[1]<AR(w)){r=jt->rank[1]; jt->rank=0; R rank1ex(w,self,jt->rank[1],jtgsuffix);} jt->rank=0; n=IC(w); h=VAV(self)->h; hv=AAV(h); m=AN(h); GATV(z,BOX,n,1,0); zv=AAV(z); DO(n, RZ(zv[i]=df1(drop(sc(i),w),hv[i%m])););
// Derived verb for f//. y static DF1(jtobqfslash){A y,z;B b=0,p;C er,id,*wv;I c,d,k,m,m1,mn,n,n1,r,*s,wt; RZ(w); r=AR(w); s=AS(w); wt=AT(w); wv=CAV(w); if(!(AN(w)&&1<r&&DENSE&wt))R oblique(w,self); // revert to default if rank<2, empty, or sparse y=VAV(self)->f; y=VAV(y)->f; id=vaid(y); m=s[0]; m1=m-1; n=s[1]; n1=n-1; mn=m*n; d=m+n-1; PROD(c,r-2,2+s); if(1==m||1==n){GA(z,wt,AN(w),r-1,1+s); *AS(z)=d; MC(AV(z),wv,AN(w)*bp(wt)); R z;} if(wt&FL+CMPX)NAN0; if(1==c)switch(OBQCASE(CTTZ(wt),id)){ case OBQCASE(B01X, CNE ): OBQLOOP(B,B,wt,x=*u, x^=*u ); break; case OBQCASE(B01X, CEQ ): OBQLOOP(B,B,wt,x=*u, x=x==*u ); break; case OBQCASE(B01X, CMAX ): case OBQCASE(B01X, CPLUSDOT): OBQLOOP(B,B,wt,x=*u, x|=*u ); break; case OBQCASE(B01X, CMIN ): case OBQCASE(B01X, CSTAR ): case OBQCASE(B01X, CSTARDOT): OBQLOOP(B,B,wt,x=*u, x&=*u ); break; case OBQCASE(B01X, CLT ): OBQLOOP(B,B,wt,x=*u, x=*u< x ); break; case OBQCASE(B01X, CLE ): OBQLOOP(B,B,wt,x=*u, x=*u<=x ); break; case OBQCASE(B01X, CGT ): OBQLOOP(B,B,wt,x=*u, x=*u> x ); break; case OBQCASE(B01X, CGE ): OBQLOOP(B,B,wt,x=*u, x=*u>=x ); break; case OBQCASE(B01X, CPLUS ): OBQLOOP(B,I,INT,x=*u, x+=*u ); break; case OBQCASE(SBTX, CMAX ): OBQLOOP(SB,SB,wt,x=*u, x=SBGT(x,*u)?x:*u ); break; case OBQCASE(SBTX, CMIN ): OBQLOOP(SB,SB,wt,x=*u, x=SBLT(x,*u)?x:*u ); break; case OBQCASE(FLX, CMAX ): OBQLOOP(D,D,wt,x=*u, x=MAX(x,*u) ); break; case OBQCASE(FLX, CMIN ): OBQLOOP(D,D,wt,x=*u, x=MIN(x,*u) ); break; case OBQCASE(FLX, CPLUS ): OBQLOOP(D,D,wt,x=*u, x+=*u ); break; case OBQCASE(CMPXX,CPLUS ): OBQLOOP(Z,Z,wt,x=*u, x=zplus(x,*u)); break; case OBQCASE(XNUMX,CMAX ): OBQLOOP(X,X,wt,x=*u, x=1==xcompare(x,*u)? x:*u); break; case OBQCASE(XNUMX,CMIN ): OBQLOOP(X,X,wt,x=*u, x=1==xcompare(x,*u)?*u: x); break; case OBQCASE(XNUMX,CPLUS ): OBQLOOP(X,X,wt,x=*u, x=xplus(x,*u)); break; case OBQCASE(RATX, CMAX ): OBQLOOP(Q,Q,wt,x=*u, x=1==QCOMP(x,*u)? x:*u); break; case OBQCASE(RATX, CMIN ): OBQLOOP(Q,Q,wt,x=*u, x=1==QCOMP(x,*u)?*u: x); break; case OBQCASE(RATX, CPLUS ): OBQLOOP(Q,Q,wt,x=*u, x=qplus(x,*u)); break; case OBQCASE(INTX, CBW0001 ): OBQLOOP(I,I,wt,x=*u, x&=*u ); break; case OBQCASE(INTX, CBW0110 ): OBQLOOP(I,I,wt,x=*u, x^=*u ); break; case OBQCASE(INTX, CBW0111 ): OBQLOOP(I,I,wt,x=*u, x|=*u ); break; case OBQCASE(INTX, CMAX ): OBQLOOP(I,I,wt,x=*u, x=MAX(x,*u) ); break; case OBQCASE(INTX, CMIN ): OBQLOOP(I,I,wt,x=*u, x=MIN(x,*u) ); break; case OBQCASE(INTX, CPLUS ): er=0; OBQLOOP(I,I,wt,x=*u, {p=0>x; x+=*u; BOV(p==0>*u&&p!=0>x);}); if(er>=EWOV)OBQLOOP(I,D,FL,x=(D)*u, x+=*u); }
A traverse(A y, AF1 f1) { V *v; A *a; SY *sy; I n; RZ(y); n=AN(y); switch (AT(y)) { case ADV: case CONJ: case VERB: { v=VAV(y); DO(n, f1(v->f); f1(v->g); f1(v->h)); break; } case BOX: { a=AAV(y); DO(n, f1(*a++)); break; } case SYMB: { sy=SYAV(y); DO(n, f1(sy->name); f1(sy->value); sy++); break; } } R one; }
static A jttcoamp(J jt,A w,B nf,A x,A h){I j;V*v=VAV(h); ASSERT(AR(x)<=v->mr,EVRANK); switch(v->id){ case CEXP: if(nf)R amp(logar1(x),ds(CEXP)); break; case CHGEOM: ASSERT(nf,EVDOMAIN); RE(j=i0(x)); ASSERT(0<=j,EVDOMAIN); R tpoly(hgcoeff(IX(j),h)); } R facit(tayamp(w,nf,x,h)); }
static B jtpdef(J jt,C id,I t,AF f1,AF f2,I m,I l,I r){A z;V*v; GA(z,t,1,0,0); ACX(z); v=VAV(z); v->f1=f1?f1:jtdomainerr1; /* monad C function */ v->f2=f2?f2:jtdomainerr2; /* dyad C function */ v->mr=m; /* monadic rank */ v->lr=l; /* left rank */ v->rr=r; /* right rank */ v->fdep=1; /* function depth */ v->id=id; /* spelling */ pst[(UC)id]=z; /* other fields are zeroed in ga() */ R 1; }
static DF1(jtbasis1){DECLF;A z;D*x;I j;V*v; PREF1(jtbasis1); RZ(w=vi(w)); switch(*AV(w)){ case 0: GA(z,FL,3,1,0); x=DAV(z); v=VAV(fs); j=v->mr; x[0]=j<=-RMAX?-inf:j>=RMAX?inf:j; j=v->lr; x[1]=j<=-RMAX?-inf:j>=RMAX?inf:j; j=v->rr; x[2]=j<=-RMAX?-inf:j>=RMAX?inf:j; R pcvt(INT,z); case -1: R lrep(inv (fs)); case 1: R lrep(iden(fs)); default: ASSERT(0,EVDOMAIN); }}
AF jtatcompf(J jt,A a,A w,A self){AF f;I ar,at,m,wr,wt; RZ(a&&w); at=AT(a); ar=AR(a); wt=AT(w); wr=AR(w); m=VAV(self)->flag%256; if(1<ar||1<wr){if(32<=m&&m<=37||40<=m&&m<=45||48<=m&&m<=53)R(AF)jtfslashatg; RZ(7==m%8);} ASSERT(AN(a)==AN(w)||!ar||!wr||5<m%8,EVLENGTH); f=atcompX[m]; if(!f){ if(at&B01+INT+FL&&wt&B01+INT+FL)f=atcompxy[9*m+3*(at&B01?0:at&INT?1:2)+(wt&B01?0:wt&INT?1:2)]; else if(at&LIT&&wt&LIT) f=atcompC[m]; else if(at&SBT&&wt&SBT) f=atcompSB[m]; } R f; } /* function table look-up for comp i. 1: and i.&1@:comp etc. */
// This is the derived verb for f/. y static DF1(jtoblique){A x,y;I m,n,r,*u,*v; RZ(w); r=AR(w); // r = rank of w // create y= ,/ w - the _2-cells of w arranged in a list // we just create a header for y, pointing to the data from w RZ(y=gah(MAX(r-1,1),w)); u=AS(w); v=AS(y); // u,v->shape of y if(1>=r){*v=m=AN(w); n=1;}else{m=*u++; n=*u++; *v++=m*n; ICPY(v,u,r-2);} // set shape of y as _2-cells of w // Create x=+"0 1&i./ 2 {. $y RZ(x=irs2(IX(m),IX(n),0L,0L,1L,jtplus)); AR(x)=1; *AS(x)=AN(x); // perform x f/. y, which does the requested operation RZ(x=df2(x,y,sldot(VAV(self)->f))); // Final tweak: the result should have (0 >. <: +/ 2 {. $y) cells. It will, as long as // m and n are both non0: when one is 0, result has 0 cells (but that cell is the correct result // of execution on a fill-cell). Correct the length of the 0 case, when the result length should be nonzero // if((m==0 || n==0) && (m+n>0)){R reitem(sc(m+n-1),x);} This change withdrawn pending further deliberation R x; }
/*static*/ void disp(A w){C err;I t; t=AT(w); switch(t){ case BOOL: case INT: case FL: case CMPX: if(nflag)jputc(' '); err=jerr; jerr=0; w=thorn1(w); jerr=err; if(w)dwr(w); else jputs(" (ws full in numeric display) "); break; case NAME: dname(w); break; case CHAR: dwrq(w); break; case LPAR: jputc('('); break; case RPAR: jputc(')'); break; case ASGN: jputs(*AV(w)?"=.":"=:"); break; case MARK: break; default: dspell(VAV(w)->id); } nflag=t&NAME+NUMERIC?1:0; }
static DF2(cons2) { V*sv=VAV(self); I*v=AV(sv->h); RZ(a&&w); R rank2ex(a,w,self,efr(AR(a),v[1]),efr(AR(w),v[2]),cons2a); }
I rr(A w) { R VAV(w)->rr; }
static DF1(cons1) { V*sv=VAV(self); RZ(w); R rank1ex(w,self,efr(AR(w),*AV(sv->h)),cons1a); }
static DF2(cons2a) { R VAV(self)->f; }
static DF1(cons1a) { R VAV(self)->f; }
I lr(A w) { R VAV(w)->lr; }
I mr(A w) { R VAV(w)->mr; }
static DF2(jtnvv2){F1PREFIP;DECLFGH;PROLOG(0033); PUSHZOMB; A protw = (A)((I)w+((I)jtinplace&JTINPLACEW)); A prota = (A)((I)a+((I)jtinplace&JTINPLACEA)); A hx=(h2)((VAV(hs)->flag&VINPLACEOK2)?jtinplace:jt,a,w,hs); POPZOMB; A z=(g2)(VAV(gs)->flag&VINPLACEOK2&&hx!=protw&&hx!=prota?( (J)((I)jt|JTINPLACEW) ):jt,fs,hx,gs); EPILOG(z);}
static DF2(secf2){A h=VAV(self)->h; ASSERT(!jt->seclev,EVSECURE); R CALL2((AF)*(1+AV(h)),a,w,self);}
static DF1(secf1){A h=VAV(self)->h; ASSERT(!jt->seclev,EVSECURE); R CALL1((AF)* AV(h) , w,self);}
static DF1(jtcharmapb){V*v=VAV(self); R charmap(w,VAV(v->f)->f,VAV(v->h)->f);}
// Create the derived verb for a fork. Insert in-placeable flags based on routine, and asgsafe based on fgh A jtfolk(J jt,A f,A g,A h){A p,q,x,y;AF f1=jtfolk1,f2=jtfolk2;B b;C c,fi,gi,hi;I flag,j,m=-1;V*fv,*gv,*hv,*v; RZ(f&&g&&h); gv=VAV(g); gi=gv->id; hv=VAV(h); hi=hv->id; // Start flags with ASGSAFE (if g and h are safe), and with INPLACEOK to match the setting of f1,f2 flag=(VINPLACEOK1|VINPLACEOK2)+((gv->flag&hv->flag)&VASGSAFE); // We accumulate the flags for the derived verb. Start with ASGSAFE if all descendants are. if(NOUN&AT(f)){ /* y {~ x i. ] */ // Temporarily raise the usecount of the noun. Because we are in the same tstack frame as the parser, the usecount will stay // raised until any inplace decision has been made regarding this derived verb, protecting the derived verb if the // assigned name is the same as a name appearing here. If the derived verb is used in another sentence, it must first be // assigned to a name, which will protects values inside it. rat1s(f); // This justifies keeping the result ASGSAFE f1=jtnvv1; if(LIT&AT(f)&&1==AR(f)&&gi==CTILDE&&CFROM==ID(gv->f)&&hi==CFORK){ x=hv->f; if(LIT&AT(x)&&1==AR(x)&&CIOTA==ID(hv->g)&&CRIGHT==ID(hv->h)){f1=jtcharmapa; flag &=~(VINPLACEOK1);} } R fdef(CFORK,VERB, f1,jtnvv2, f,g,h, flag, RMAX,RMAX,RMAX); } fv=VAV(f); fi=fv->id; if(fi!=CCAP)flag &= fv->flag|~VASGSAFE; // remove ASGSAFE if f is unsafe switch(fi){ case CCAP: f1=jtcork1; f2=jtcork2; break; /* [: g h */ case CTILDE: if(NAME&AT(fv->f)){f1=jtcorx1; f2=jtcorx2;} break; /* name g h */ case CSLASH: if(gi==CDIV&&hi==CPOUND&&CPLUS==ID(fv->f)){f1=jtmean; flag|=VIRS1; flag &=~(VINPLACEOK1);} break; /* +/%# */ case CAMP: /* x&i. { y"_ */ case CFORK: /* (x i. ]) { y"_ */ if(hi==CQQ&&(y=hv->f,LIT&AT(y)&&1==AR(y))&&equ(ainf,hv->g)&& (x=fv->f,LIT&AT(x)&&1==AR(x))&&CIOTA==ID(fv->g)&& (fi==CAMP||CRIGHT==ID(fv->h))){f1=jtcharmapb; flag &=~(VINPLACEOK1);} break; case CAT: /* <"1@[ { ] */ if(gi==CLBRACE&&hi==CRIGHT){ p=fv->f; q=fv->g; if(CLEFT==ID(q)&&CQQ==ID(p)&&(v=VAV(p),x=v->f,CLT==ID(x)&&equ(one,v->g))){f2=jtsfrom; flag &=~(VINPLACEOK2);} }} switch(fi==CCAP?gi:hi){ case CQUERY: if(hi==CDOLLAR||hi==CPOUND){f2=jtrollk; flag &=~(VINPLACEOK2);} break; case CQRYDOT: if(hi==CDOLLAR||hi==CPOUND){f2=jtrollkx; flag &=~(VINPLACEOK2);} break; case CICAP: m=7; if(fi==CCAP){if(hi==CNE)f1=jtnubind; else if(FIT0(CNE,hv)){f1=jtnubind0; flag &=~(VINPLACEOK1);}} break; case CSLASH: c=ID(gv->f); m=c==CPLUS?4:c==CPLUSDOT?5:c==CSTARDOT?6:-1; if(fi==CCAP&&vaid(gv->f)&&vaid(h)){f2=jtfslashatg; flag &=~(VINPLACEOK2);} break; case CFCONS: if(hi==CFCONS){x=hv->h; j=*BAV(x); m=B01&AT(x)?(gi==CIOTA?j:gi==CICO?2+j:-1):-1;} break; case CRAZE: if(hi==CLBRACE){f2=jtrazefrom; flag &=~(VINPLACEOK2);} else if(hi==CCUT){ j=i0(hv->g); if(CBOX==ID(hv->f)&&!j){f2=jtrazecut0; flag &=~(VINPLACEOK2);} else if(boxatop(h)&&j&&-2<=j&&j<=2){f1=jtrazecut1; f2=jtrazecut2; flag &=~(VINPLACEOK1|VINPLACEOK2);} }} if(0<=m){ v=4<=m?hv:fv; b=CFIT==v->id&&equ(zero,v->g); switch(b?ID(v->f):v->id){ case CEQ: f2=b?jtfolkcomp0:jtfolkcomp; flag|=0+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CNE: f2=b?jtfolkcomp0:jtfolkcomp; flag|=1+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CLT: f2=b?jtfolkcomp0:jtfolkcomp; flag|=2+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CLE: f2=b?jtfolkcomp0:jtfolkcomp; flag|=3+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CGE: f2=b?jtfolkcomp0:jtfolkcomp; flag|=4+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CGT: f2=b?jtfolkcomp0:jtfolkcomp; flag|=5+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CEBAR: f2=b?jtfolkcomp0:jtfolkcomp; flag|=6+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; case CEPS: f2=b?jtfolkcomp0:jtfolkcomp; flag|=7+8*m; flag &=~(VINPLACEOK1|VINPLACEOK2); break; }} // If this fork is not a special form, set the flags to indicate whether the f verb does not use an // argument. In that case h can inplace the unused aegument. if(f1==jtfolk1 && f2==jtfolk2) flag |= atoplr(f); R fdef(CFORK,VERB, f1,f2, f,g,h, flag, RMAX,RMAX,RMAX); }