Skip to content

Commit

Permalink
Untangle paths for gerund} and u^:gerund
Browse files Browse the repository at this point in the history
  • Loading branch information
HenryHRich committed Oct 28, 2024
1 parent 08504f9 commit a6f2fc5
Show file tree
Hide file tree
Showing 5 changed files with 131 additions and 131 deletions.
86 changes: 75 additions & 11 deletions jsrc/am.c
Original file line number Diff line number Diff line change
Expand Up @@ -771,16 +771,6 @@ indexforonecell:; // cellframelen, wframelen (always 0), and ind0 must be set
}
static A jtamendn2c(J jt,A a,A w,A self){R jtamendn2(jt,a,w,VAV(self)->fgh[0],self);} // entry point from normal compound

// Execution of x -@:{`[`]}"r y
static DF2(jtamnegate){F2PREFIP;
ARGCHK2(a,w);
// if y is CMPX/FL/QP, execute markd x} y which means negate
if(AT(w)&FL+CMPX+QP)R jtamendn2(jtinplace,markd((AT(w)>>FLX)&(FL+CMPX>>FLX)),w,a,self);
// otherwise, revert to x -@:{`[`]}"r y, processed by jtgav2
US ranks=jt->ranks; RESETRANK;
R rank2exip(a,w,self,AR(a),MIN((RANKT)ranks,AR(w)),AR(a),MIN((RANKT)ranks,AR(w)),jtgav2);
}

// Execution of x u} y. Call (x u y) to get the indices, convert to cell indexes, then
// call merge2 to do the merge. Pass inplaceability into merge2.
static DF2(amccv2){F2PREFIP;A fs=FAV(self)->fgh[0]; AF f2=FAV(fs)->valencefns[1];
Expand Down Expand Up @@ -851,13 +841,87 @@ B jtgerexact(J jt, A w){A*wv;
R 1;
} /* 0 if w is definitely not a gerund; 1 if possibly a gerund */

// this is [x] u^:gerund y and [x] gerund} y
// Here, f1 is the original u and g1 is the original v; hs points to the gerund
// First, we run hv[1]->valencefns[0] on y (this is gerund v1, the selector/power);
// then we run (sv->id)->valencefns[1] on fs (the original u) and the result of selector/power (with self set to (sv->id):
// sv->id is the original conjunction, executed a second time now that we have the selector/power
// this is a conjunction execution, executing a u^:n form, and creates a derived verb to perform that function; call that verb ff
// then we execute gerund v2 on y (with self set to v2)
// then we execute ff on the result of (v2 y), with self set to ff scaf combine all 4 into 1

// verb executed for v0`v1`v2} y
static DF1(jtgav1){V* RESTRICT sv=FAV(self); A ff,ffm,ffx,*hv=AAV(sv->fgh[2]);
// first, get the indexes to use. Since this is going to call m} again, we protect against
// stack overflow in the loop in case the generated ff generates a recursive call to }
// If the AR is a noun, just leave it as is
df1(ffm,w,hv[1]); // x v1 y - no inplacing
RZ(ffm);
// obsolete if(sv->id!=CAMEND)SEGFAULT; // scaf
// obsolete RZ(df1(ff,ffm,ds(sv->id))); // now ff represents (v1 y)}
RZ(ff=amend(ffm)); // now ff represents (v1 y)}. scaf avoid this call, go straight to mergn1
if(AT(hv[2])&NOUN){ffx=hv[2];}else{RZ(df1(ffx,w,hv[2]))}
R df1(ffm,ffx,ff);
}

// verb executed for x v0`v1`v2} y
static DF2(jtgav2){F2PREFIP;V* RESTRICT sv=FAV(self); A ff,ffm,ffx,ffy,*hv=AAV(sv->fgh[2]); // hv->verbs, already converted from gerunds
A protw = (A)(intptr_t)((I)w+((I)jtinplace&JTINPLACEW)); A prota = (A)(intptr_t)((I)a+((I)jtinplace&JTINPLACEA)); // protected addresses
// first, get the indexes to use. Since this is going to call m} again, we protect against
// stack overflow in the loop in case the generated ff generates a recursive call to }
// If the AR is a noun, just leave it as is
df2(ffm,a,w,C(hv[1])); // x v1 y - no inplacing.
RZ(ffm);
// obsolete if(sv->id!=CAMEND)SEGFAULT; // scaf
// obsolete RZ(df1(ff,ffm,ds(sv->id))); // now ff represents (x v1 y)} . Alas, ffm can no longer be virtual
RZ(ff=amend(ffm)); // now ff represents(x v1 y)} . scaf avoid this call, go straight to mergn1
// Protect any input that was returned by v1 (must be ][)
if(a==ffm)jtinplace = (J)(intptr_t)((I)jtinplace&~JTINPLACEA); if(w==ffm)jtinplace = (J)(intptr_t)((I)jtinplace&~JTINPLACEW);
PUSHZOMB
// execute the gerunds that will give the arguments to ff. But if they are nouns, leave as is
// x v2 y - can inplace an argument that v0 is not going to use, except if a==w
RZ(ffy = (FAV(C(hv[2]))->valencefns[1])(a!=w&&(FAV(C(hv[2]))->flag&VJTFLGOK2)?(J)(intptr_t)((I)jtinplace&(sv->flag|~(VFATOPL|VFATOPR))):jt ,a,w,C(hv[2]))); // flag self about f, since flags may be needed in f
// x v0 y - can inplace any unprotected argument
RZ(ffx = (FAV(C(hv[0]))->valencefns[1])((FAV(C(hv[0]))->flag&VJTFLGOK2)?((J)(intptr_t)((I)jtinplace&((ffm==w||ffy==w?~JTINPLACEW:~0)&(ffm==a||ffy==a?~JTINPLACEA:~0)))):jt ,a,w,C(hv[0])));
// execute ff, i. e. ffx (x v1 y)} ffy . Allow inplacing xy unless protected by the caller. No need to pass WILLOPEN status, since the verb can't use it. ff is needed to give access to m
POPZOMB; R (FAV(ff)->valencefns[1])(FAV(ff)->flag&VJTFLGOK2?( (J)(intptr_t)((I)jt|((ffx!=protw&&ffx!=prota?JTINPLACEA:0)+(ffy!=protw&&ffy!=prota?JTINPLACEW:0))) ):jt,ffx,ffy,ff);
}

// handle v0`v1[`v2]} to create the verb to process it when [x] and y arrive
// The id is the pseudocharacter for the function, which is passed in as the pchar for the derived verb
static A jtgadv(J jt,A w){A hs;I n;
ARGCHK1(w);
ASSERT(BOX&AT(w),EVDOMAIN);
// obsolete n=AN(w);
// obsolete ASSERT(1>=AR(w),EVRANK);
ASSERT(BETWEENC(AN(w),2,3),EVLENGTH); // verify 2-3 gerunds
// obsolete ASSERT(BOX&AT(w),EVDOMAIN);
// obsolete RZ(hs=fxeach(3==n?w:behead(reshape(num(4),w)),(A)(&jtfxself[0]))); // convert to v0`v0`v0, v1`v0`v1, or v0`v1`v2; convert each gerund to verb
RZ(hs=fxeachv(1,3==AN(w)?w:behead(reshape(num(4),w)))); // convert to v1`v0`v1 or v0`v1`v2; convert each gerund to verb
// hs is a BOX array, but its elements are ARs
// The derived verb is ASGSAFE if all the components are; it has gerund left-operand; and it supports inplace operation on the dyad
// obsolete ASSERT(AT(C(AAV(hs)[0]))&AT(C(AAV(hs)[1]))&AT(C(AAV(hs)[2]))&VERB,EVDOMAIN);
I alr=atoplr(C(AAV(hs)[0])); // Also set the LSB flags to indicate whether v0 is u@[ or u@]
I flag=(FAV(C(AAV(hs)[0]))->flag&FAV(C(AAV(hs)[1]))->flag&FAV(C(AAV(hs)[2]))->flag&VASGSAFE)+(VGERL|VJTFLGOK2)+(alr-2>0?alr-2:alr);
R fdef(0,CRBRACE,VERB, jtgav1,jtgav2, w,0L,hs,flag, RMAX,RMAX,RMAX); // create the derived verb
}

// Execution of x -@:{`[`]}"r y
static DF2(jtamnegate){F2PREFIP;
ARGCHK2(a,w);
// if y is CMPX/FL/QP, execute markd x} y which means negate
if(AT(w)&FL+CMPX+QP)R jtamendn2(jtinplace,markd((AT(w)>>FLX)&(FL+CMPX>>FLX)),w,a,self);
// otherwise, revert to x -@:{`[`]}"r y, processed by jtgav2
US ranks=jt->ranks; RESETRANK;
R rank2exip(a,w,self,AR(a),MIN((RANKT)ranks,AR(w)),AR(a),MIN((RANKT)ranks,AR(w)),jtgav2);
}

// u} handling. This is not inplaceable but the derived verb is
F1(jtamend){F1PREFIP;
ARGCHK1(w);
if(VERB&AT(w)) R fdef(0,CRBRACE,VERB,(AF)mergv1,(AF)amccv2,w,0L,0L,VASGSAFE|VJTFLGOK2, RMAX,RMAX,RMAX); // verb}
else if(ger(jt,w)){A z;
RZ(z=gadv(w,CRBRACE)) // get verbs for v0`v1`v2}, as verbs
RZ(z=gadv(w)) // get verbs for v0`v1`v2}, as verbs
A *hx=AAV(FAV(z)->fgh[2]);
if((FAV(hx[0])->id&~1)==CATCO&&FAV(FAV(hx[0])->fgh[0])->id==CMINUS&&AT(FAV(hx[0])->fgh[1])&VERB&&FAV(FAV(hx[0])->fgh[1])->id==CFROM&&FAV(hx[1])->id==CLEFT&&FAV(hx[2])->id==CRIGHT){
FAV(z)->valencefns[1]=jtamnegate; // if gerund is -@[:]{`[`], change the dyad function pointer to the special code
Expand Down
99 changes: 0 additions & 99 deletions jsrc/cg.c
Original file line number Diff line number Diff line change
Expand Up @@ -371,107 +371,8 @@ F2(jtagendai){F2PREFIP;I flag;
}


// When u^:gerund is encountered, we replace it with a verb that comes to one of these.
// This creates several names:
// sv->self data; fs=sv->fgh[0] (the A block for the f operand); f1=f1 in sv->fgh[0] (0 if sv->fgh[0]==0); f2=f2 in sv->fgh[0] (0 if sv->fgh[0]==0);
// gs=sv->fgh[1] (the A block for the g operand); g1=f1 in sv->fgh[1] (0 if sv->fgh[1]==0); g2=f2 in sv->fgh[1] (0 if sv->fgh[1]==0)


// this is u^:gerund y
// Here, f1 is the original u and g1 is the original v; hs points to the gerund
// First, we run hv[1]->valencefns[0] on y (this is gerund v1, the selector/power);
// then we run (sv->id)->valencefns[1] on fs (the original u) and the result of selector/power (with self set to (sv->id):
// sv->id is the original conjunction, executed a second time now that we have the selector/power
// this is a conjunction execution, executing a u^:n form, and creates a derived verb to perform that function; call that verb ff
// then we execute gerund v2 on y (with self set to v2)
// then we execute ff on the result of (v2 y), with self set to ff scaf combine all 4 into 1
static DF1(jtgcl1){V* RESTRICT sv=FAV(self); A gs=sv->fgh[1]; A ff,z0,z1,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df1(z0,w,C(hv[1]))) df2(ff,z0,gs,ds(sv->id));
RZ(df1(z1,w,C(hv[2]))) R df1(z0,z1,ff);
}

static DF1(jtgcr1){V* RESTRICT sv=FAV(self); A fs=sv->fgh[0]; A ff,z0,z1,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df1(z0,w,C(hv[1]))) df2(ff,fs,z0,ds(sv->id));
RZ(df1(z1,w,C(hv[2]))) R df1(z0,z1,ff);
}

static DF2(jtgcl2){V* RESTRICT sv=FAV(self); A gs=sv->fgh[1]; A ff,z0,z1,z2,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df2(z0,a,w,C(hv[1]))) df2(ff,z0,gs,ds(sv->id));
RZ(df2(z1,a,w,C(hv[0]))) RZ(df2(z2,a,w,C(hv[2]))) R df2(z0,z1,z2,ff);
}

static DF2(jtgcr2){V* RESTRICT sv=FAV(self); A fs=sv->fgh[0]; A ff,z0,z1,z2,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df2(z0,a,w,C(hv[1]))) df2(ff,fs,z0,ds(sv->id));
RZ(df2(z1,a,w,C(hv[0]))) RZ(df2(z2,a,w,C(hv[2]))) R df2(z0,z1,z2,ff);
}

// called for gerund} or ^:gerund forms. id is the pseudocharacter for the modifier (} or ^:)
// Creates a verb that will run jtgc[rl][12] to execute the gerunds on the xy arguments, and
// then execute the operation
// a is the original u, w is the original v
A jtgconj(J jt,A a,A w,C id){A hs,y;B na;I n;
ARGCHK2(a,w);
ASSERT(((AT(a)|AT(w))&(VERB|BOX))==(VERB|BOX),EVDOMAIN); // v`box or box`v
na=ISDENSETYPE(AT(a),BOX); y=na?a:w; n=AN(y); // na is 1 for gerund}; y is the gerund
ASSERT(1>=AR(y),EVRANK);
ASSERT((n&-2)==2,EVLENGTH); // length is 2 or 3
ASSERT(BOX&AT(y),EVDOMAIN);
// obsolete RZ(hs=fxeach(3==n?y:jlink(scc(CLBKTC),y),(A)&jtfxself[0]));
RZ(hs=fxeachv(1,3==n?y:jlink(scc(CLBKTC),y)));
R fdef(0,id,VERB, na?jtgcl1:jtgcr1,na?jtgcl2:jtgcr2, a,w,hs, na?VGERL:VGERR, RMAX,RMAX,RMAX);
}

// verb executed for v0`v1`v2} y
static DF1(jtgav1){V* RESTRICT sv=FAV(self); A ff,ffm,ffx,*hv=AAV(sv->fgh[2]);
// first, get the indexes to use. Since this is going to call m} again, we protect against
// stack overflow in the loop in case the generated ff generates a recursive call to }
// If the AR is a noun, just leave it as is
df1(ffm,w,hv[1]); // x v1 y - no inplacing
RZ(ffm);
RZ(df1(ff,ffm,ds(sv->id))); // now ff represents (v1 y)}
if(AT(hv[2])&NOUN){ffx=hv[2];}else{RZ(df1(ffx,w,hv[2]))}
R df1(ffm,ffx,ff);
}

// verb executed for x v0`v1`v2} y
DF2(jtgav2){F2PREFIP;V* RESTRICT sv=FAV(self); A ff,ffm,ffx,ffy,*hv=AAV(sv->fgh[2]); // hv->verbs, already converted from gerunds
A protw = (A)(intptr_t)((I)w+((I)jtinplace&JTINPLACEW)); A prota = (A)(intptr_t)((I)a+((I)jtinplace&JTINPLACEA)); // protected addresses
// first, get the indexes to use. Since this is going to call m} again, we protect against
// stack overflow in the loop in case the generated ff generates a recursive call to }
// If the AR is a noun, just leave it as is
df2(ffm,a,w,C(hv[1])); // x v1 y - no inplacing.
RZ(ffm);
RZ(df1(ff,ffm,ds(sv->id))); // now ff represents (x v1 y)} . Alas, ffm can no longer be virtual
// Protect any input that was returned by v1 (must be ][)
if(a==ffm)jtinplace = (J)(intptr_t)((I)jtinplace&~JTINPLACEA); if(w==ffm)jtinplace = (J)(intptr_t)((I)jtinplace&~JTINPLACEW);
PUSHZOMB
// execute the gerunds that will give the arguments to ff. But if they are nouns, leave as is
// x v2 y - can inplace an argument that v0 is not going to use, except if a==w
RZ(ffy = (FAV(C(hv[2]))->valencefns[1])(a!=w&&(FAV(C(hv[2]))->flag&VJTFLGOK2)?(J)(intptr_t)((I)jtinplace&(sv->flag|~(VFATOPL|VFATOPR))):jt ,a,w,C(hv[2]))); // flag self about f, since flags may be needed in f
// x v0 y - can inplace any unprotected argument
RZ(ffx = (FAV(C(hv[0]))->valencefns[1])((FAV(C(hv[0]))->flag&VJTFLGOK2)?((J)(intptr_t)((I)jtinplace&((ffm==w||ffy==w?~JTINPLACEW:~0)&(ffm==a||ffy==a?~JTINPLACEA:~0)))):jt ,a,w,C(hv[0])));
// execute ff, i. e. ffx (x v1 y)} ffy . Allow inplacing xy unless protected by the caller. No need to pass WILLOPEN status, since the verb can't use it. ff is needed to give access to m
POPZOMB; R (FAV(ff)->valencefns[1])(FAV(ff)->flag&VJTFLGOK2?( (J)(intptr_t)((I)jt|((ffx!=protw&&ffx!=prota?JTINPLACEA:0)+(ffy!=protw&&ffy!=prota?JTINPLACEW:0))) ):jt,ffx,ffy,ff);
}

// handle v0`v1[`v2]} to create the verb to process it when [x] and y arrive
// The id is the pseudocharacter for the function, which is passed in as the pchar for the derived verb
A jtgadv(J jt,A w,C id){A hs;I n;
ARGCHK1(w);
ASSERT(BOX&AT(w),EVDOMAIN);
n=AN(w);
ASSERT(1>=AR(w),EVRANK);
ASSERT(BETWEENC(n,1,3),EVLENGTH); // verify 1-3 gerunds
ASSERT(BOX&AT(w),EVDOMAIN);
RZ(hs=fxeach(3==n?w:behead(reshape(num(4),w)),(A)(&jtfxself[0]))); // convert to v0`v0`v0, v1`v0`v1, or v0`v1`v2; convert each gerund to verb
// hs is a BOX array, but its elements are ARs
// The derived verb is ASGSAFE if all the components are; it has gerund left-operand; and it supports inplace operation on the dyad
ASSERT(AT(C(AAV(hs)[0]))&AT(C(AAV(hs)[1]))&AT(C(AAV(hs)[2]))&VERB,EVDOMAIN);
I alr=atoplr(C(AAV(hs)[0])); // Also set the LSB flags to indicate whether v0 is u@[ or u@]
I flag=(FAV(C(AAV(hs)[0]))->flag&FAV(C(AAV(hs)[1]))->flag&FAV(C(AAV(hs)[2]))->flag&VASGSAFE)+(VGERL|VJTFLGOK2)+(alr-2>0?alr-2:alr);
R fdef(0,id,VERB, jtgav1,jtgav2, w,0L,hs,flag, RMAX,RMAX,RMAX); // create the derived verb
}


static DF1(jtgf1){A z,h=FAV(self)->fgh[2]; R df1(z, w,C(AAV(h)[0]));}
static DF2(jtgf2){A z,h=FAV(self)->fgh[2]; R df2(z,a,w,C(AAV(h)[0]));}
Expand Down
67 changes: 51 additions & 16 deletions jsrc/cp.c
Original file line number Diff line number Diff line change
Expand Up @@ -303,19 +303,6 @@ DF2(jtply2){PROLOG(107);A fs=FAV(self)->fgh[0]; A gs=FAV(self)->fgh[1]; A z, zz;
// obsolete static DF1(jtpowg1){A z,h=FAV(self)->fgh[2]; R df1(z, w,C(AAV(h)[0]));}
// obsolete static DF2(jtpowg2){A z,h=FAV(self)->fgh[2]; R df2(z,a,w,C(AAV(h)[0]));}
// obsolete
// When u^:v is encountered, we replace it with a verb that comes to one of these.
// This creates a verb, jtpowxx, which calls jtdf1 within a PROLOG/EPILOG pair, after creating several names:
// sv->self data; fs=sv->fgh[0] (the A block for the f operand); f1=f1 in sv->fgh[0] (0 if sv->fgh[0]==0); f2=f2 in sv->fgh[0] (0 if sv->fgh[0]==0);
// gs=sv->fgh[1] (the A block for the g operand); g1=f1 in sv->fgh[1] (0 if sv->fgh[1]==0); g2=f2 in sv->fgh[1] (0 if sv->fgh[1]==0)
// Here, f1 is the original u and g1 is the original v
// We call g1 (=original v), passing in y (and gs as self). This returns v y
// We then call powop(original u,result of v y), which is the VN case for u^:(v y) and creates a derived verb to perform that function
// Finally df1 treats the powop result as self, calling self/powop->valencefns[0] (the appropriate power case based on v y)
// with the y arg as the w operand (and self/powop included to provide access to the original u)
// We allow v to create a gerund, but we do not allow a gerund to create a gerund.

// We catch the special cases 0 & 1 here, mostly for branch-prediction purposes. All results of g1/g2 will be nouns, while
// most instances of u^:v (run through powop) have v as verb

#if 0 // obsolete
// here for u^:v y
Expand Down Expand Up @@ -359,7 +346,8 @@ static DF2(jtpowv2acell){F2PREFIP;A z;PROLOG(0110);
}

#else
// [x] u^:v y, fast when result of v is 0 or 1 (=if statement). jtflagging is that required by u. JTDOWHILE can be set to indicate that this is called from ^:_. in which case we return (A)1 if u was 0
// [x] u^:v y, fast when result of v is 0 or 1 (=if statement). jtflagging is that required by u. JTDOWHILE can be set to indicate that this is called from ^:_. in which case we return (A)1 if v returned 0
// if result of v is not 0/1, we reexecute [x] u^:n y where n is ([x] v y)
static DF2(jtpowv12cell){F2PREFIP;A z;PROLOG(0110);
w=AT(w)&VERB?0:w; // w is 0 for monad
A u,uc; I u0; A gs=FAV(self)->fgh[1]; A fs=FAV(self)->fgh[0]; AF uf=FAV(fs)->valencefns[!!w]; // fetch uself, which we always need, and uf, which we will need in the fast path
Expand All @@ -374,11 +362,58 @@ static DF2(jtpowv12cell){F2PREFIP;A z;PROLOG(0110);
}
EPILOG(z);
}

// obsolete jtinplace=FAV(fs)->flag&(VJTFLGOK1<<(!!w))?jtinplace:jt;
// obsolete
#endif

#if 0 // obsolete
static DF1(jtgcl1){V* RESTRICT sv=FAV(self); A gs=sv->fgh[1]; A ff,z0,z1,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df1(z0,w,C(hv[1]))) df2(ff,z0,gs,ds(sv->id));
RZ(df1(z1,w,C(hv[2]))) R df1(z0,z1,ff);
}

static DF2(jtgcl2){V* RESTRICT sv=FAV(self); A gs=sv->fgh[1]; A ff,z0,z1,z2,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df2(z0,a,w,C(hv[1]))) df2(ff,z0,gs,ds(sv->id));
RZ(df2(z1,a,w,C(hv[0]))) RZ(df2(z2,a,w,C(hv[2]))) R df2(z0,z1,z2,ff);
}

#endif
#if 1 // obsolete
static DF1(jtgcr1){V* RESTRICT sv=FAV(self); A fs=sv->fgh[0]; A ff,z0,z1,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df1(z0,w,C(hv[1]))) df2(ff,fs,z0,ds(sv->id));
RZ(df1(z1,w,C(hv[2]))) R df1(z0,z1,ff);
}

static DF2(jtgcr2){V* RESTRICT sv=FAV(self); A fs=sv->fgh[0]; A ff,z0,z1,z2,*hv=AAV(sv->fgh[2]);
STACKCHKOFL RZ(df2(z0,a,w,C(hv[1]))) df2(ff,fs,z0,ds(sv->id));
RZ(df2(z1,a,w,C(hv[0]))) RZ(df2(z2,a,w,C(hv[2]))) R df2(z0,z1,z2,ff);
}
#else
// execution of [x] gerund} y and [x] u^:gerund y
// Apply the gerunds to xy, then apply u^:n scaf combine the above, support inplacing
static DF2(jtgrl12){
}
#endif

// called for ^:(v0`v1`v2) forms.
// Creates a verb that will run jtgc[rl][12] to execute the gerunds on the xy arguments, and
// then execute the operation
// a is the original u (a verb), w is the original n (boxed)
// obsolete A jtgconj(J jt,A a,A w,C id){A hs;
static A jtgconj(J jt,A a,A w){A hs;
ARGCHK2(a,w);
// obsolete ASSERT(((AT(a)|AT(w))&(VERB|BOX))==(VERB|BOX),EVDOMAIN); // v`box or box`v
// obsolete na=ISDENSETYPE(AT(a),BOX); y=na?a:w; n=AN(y); // na is 1 for gerund}; y is the gerund
// obsolete ASSERT(1>=AR(w),EVRANK);
ASSERT((AN(w)&-2)==2,EVLENGTH); // length is 2 or 3
// obsolete ASSERT(BOX&AT(y),EVDOMAIN);
// obsolete RZ(hs=fxeach(3==n?y:jlink(scc(CLBKTC),y),(A)&jtfxself[0]));
RZ(hs=fxeachv(1,3==AN(w)?w:jlink(scc(CLBKTC),w))); // convert gerund to aray of A blocks, each verified to be a verb
// obsolete R fdef(0,id,VERB, na?jtgcl1:jtgcr1,na?jtgcl2:jtgcr2, a,w,hs, na?VGERL:VGERR, RMAX,RMAX,RMAX);
R fdef(0,CPOWOP,VERB, jtgcr1,jtgcr2, a,w,hs, VGERR, RMAX,RMAX,RMAX);
}



// This executes the conjunction u^:v to produce a derived verb. If the derived verb
// contains verb v or gerund v, it executes v on the xy arguments and then calls jtpowop
Expand Down Expand Up @@ -424,7 +459,7 @@ DF2(jtpowop){F2PREFIP;B b;V*v;
// obsolete fdeffill(z,0L,CPOWOP,VERB,f1,f2,a,w,0L,VFLAGNONE, RMAX,RMAX,RMAX) // never allow inplacing when there are multiple results
encn = FAV(z)->localuse.lu1.poweratom=((ABS(n)-1)<<POWERABSX)+(n<0?POWERANEG:0)+POWERAMULT; // save the power, in flagged form. count is # powers to evaluate, which is n-1
// obsolete RETF(z);
}else R gconj(a,w,CPOWOP); // not <numatom or a: . Create the derived verb for [v0`]v1`v2, return that
}else R gconj(a,w); // not <numatom or a: . Create the derived verb for [v0`]v1`v2, return that
// ASSERT(self!=0,EVDOMAIN); // If gerund returns gerund, error. This check is removed pending further design
// falling through for boxed numeric to fill in the result
h=0; // must be 0 if unused
Expand Down
Loading

0 comments on commit a6f2fc5

Please sign in to comment.