Skip to content

Commit

Permalink
Add locale column to 13!:13; allow column selection
Browse files Browse the repository at this point in the history
  • Loading branch information
@HenryHRich
HenryHRich committed Oct 19, 2024
1 parent 687f9c9 commit 75bea4a
Show file tree
Hide file tree
Showing 3 changed files with 84 additions and 20 deletions.
75 changes: 56 additions & 19 deletions jsrc/dc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,34 +11,71 @@ static F1(jtdfrep){ARGCHK1(w); R NOUN&AT(w)?w:lrep(w);}

static SYMWALK(jtdloc,A,BOX,5,2,1,{RZ(*zv++=incorp(sfn(0,d->name))); RZ(*zv++=incorp(dfrep(d->val)));})

static B jtdrow(J jt,DC si,DC s0,A*zv){A fs,q,*qv,y,z;C c;
static B jtdrow(J jt,DC si,DC s0,A*zv,UI ncollist,I* collist){A fs,q,*qv,y,z;C c;UI col;
fs=si->dcf;
GATV0(q,BOX,!!si->dcx+!!si->dcy,1); qv=AAV(q); // allo place to store arg list
if(si->dcx)RZ(*qv++=incorp(dfrep(si->dcx))); // fill in x if any
if(si->dcy)RZ(*qv++=incorp(dfrep(si->dcy))); // fill in y if any
RZ(*zv++=incorp(si->dca&&si->dcnmlev!=3?over(sfn(0,si->dca),str(si->dcnmlev,">>")):mtv)); // 0 name - decorated
RZ(*zv++=incorp(sc(si->dcj))); /* 1 error number */
RZ(*zv++=incorp(sc(lnumsi(si)))); /* 2 line number */
*zv++=num(ADV&AT(fs)?1:CONJ&AT(fs)?2:3); /* 3 name class */
RZ(*zv++=incorp(jtlrep((J)((I)jt|(JTEXPVALENCEOFFD>>si->dcdyad)),fs))); // linear rep, but only the correct valence
*zv++=0; /* 5 script name, filled in later */
RZ(*zv++=incorp(q)); /* 6 argument list */
if(si->dcloc&&si->dcc){RZ(y=dloc(si->dcloc)); RZ(*zv++=incorp(grade2(y,ope(IRS1(y,0L,1L,jthead,z)))));} // local symbols only if explicit defn
else RZ(*zv++=incorp(iota(v2(0L,2L)))); /* 7 locals */ // empty so cannot be readonly
c=si->dcsusp||s0&&DCPARSE==s0->dctype&&s0->dcsusp?'*':' ';
RZ(*zv++=incorp(scc(c))); /* 8 * if begins a suspension */

for(col=0;col<ncollist;++col){
switch(collist[col]){
case 0:
RZ(*zv++=incorp(si->dca&&si->dcnmlev!=3?over(sfn(0,si->dca),str(si->dcnmlev,">>")):mtv)); // 0 name - decorated
break;
case 1:
RZ(*zv++=incorp(sc(si->dcj))); /* 1 error number */
break;
case 2:
RZ(*zv++=incorp(sc(lnumsi(si)))); /* 2 line number */
break;
case 3:
*zv++=num(ADV&AT(fs)?1:CONJ&AT(fs)?2:3); /* 3 name class */
break;
case 4:
RZ(*zv++=incorp(jtlrep((J)((I)jt|(JTEXPVALENCEOFFD>>si->dcdyad)),fs))); // 4 linear rep, but only the correct valence
break;
case 5:
I scriptx=-1; A snm; if(si->dca&&AN(si->dca)&&((snm=box(sfn(0,si->dca)))!=0)){ // name exists, is nonempty, & well formed
RZ(snm=scind(snm)); scriptx=IAV(snm)[0]; // get script index from the symbol, -1 if not found
READLOCK(JT(jt,startlock)) // lock the slist table while we refer to it
if(BETWEENO(scriptx,0,AN(JT(jt,slist))))snm=AAV(JT(jt,slist))[scriptx]; else snm=mtv; // get string form of filename, possibly empty
READUNLOCK(JT(jt,startlock))
}else snm=mtv; // missing name, use empty string for it
*zv++=incorp(snm); // 5 script name
break;
case 6:
RZ(*zv++=incorp(q)); /* 6 argument list */
break;
case 7:
if(si->dcloc&&si->dcc){RZ(y=dloc(si->dcloc)); RZ(*zv++=incorp(grade2(y,ope(IRS1(y,0L,1L,jthead,z)))));} // local symbols only if explicit defn
else RZ(*zv++=incorp(iota(v2(0L,2L)))); /* 7 locals */ // empty so cannot be readonly
break;
case 8:
c=si->dcsusp||s0&&DCPARSE==s0->dctype&&s0->dcsusp?'*':' ';
RZ(*zv++=incorp(scc(c))); /* 8 * if begins a suspension */
break;
case 9:
y=si->dcloc?sfn(0,LOCNAME(AKGST(si->dcloc))):mtv; y=y?y:mtv; // get implied locale from the stack frame
RZ(*zv++=incorp(y)); /* 8 * if begins a suspension */
break;
}
}
R 1;
} /* construct one row of function stack- called only for DCCALL type */

F1(jtdbcall){A y,*yv,z,zz,*zv;DC si,s0=0;I c=9,m=0,*s;
ASSERTMTV(w);
F1(jtdbcall){A y,*yv,z,zz,*zv;DC si,s0=0;I c=10,m=0,*s; // c is # columns
UI *collist, ncollist; // arrays of columns, and its length
ASSERT(AR(w)<2,EVRANK); // must be atom or list
if(AN(w)==0){collist=&iotavec[-IOTAVECBEGIN]; ncollist=9; // default is IX(9)
}else{RZ(w=vib(w)) collist=IAV(w); ncollist=AN(w); DO(ncollist, ASSERT(BETWEENO(collist[i],0,c),EVINDEX))
}
si=jt->sitop;
NOUNROLL while(si){if(DCCALL==si->dctype)++m; si=si->dclnk;} // count # rows in result
GATV0(z,BOX,m*c,2); s=AS(z); s[0]=m; s[1]=c; // allocate result, install shape
GATV0(z,BOX,m*ncollist,2); s=AS(z); s[0]=m; s[1]=ncollist; // allocate result, install shape
si=jt->sitop; zv=AAV(z);
NOUNROLL while(si){if(DCCALL==si->dctype){RZ(drow(si,s0,zv)); zv+=c;} s0=si; si=si->dclnk;} // create one row for each CALL, in z
RZ(y=from(scind(IRS1(z,0L,1L,jthead,zz)),over(snl(mtv),ds(CACE)))); // get script index for each line of stack; then fetch the name, or a: if no name
yv=AAV(y); zv=5+AAV(z);
DQ(m, *zv=incorp(*yv); yv++; zv+=c;); // copy the script names into column 5
NOUNROLL while(si){if(DCCALL==si->dctype){RZ(jtdrow(jt,si,s0,zv,ncollist,collist)); zv+=ncollist;} s0=si; si=si->dclnk;} // create one row for each CALL, in z
// obsolete RZ(y=from(scind(IRS1(z,0L,1L,jthead,zz)),over(snl(mtv),ds(CACE)))); // get script index for each line of stack; then fetch the name, or a: if no name
// obsolete yv=AAV(y); zv=5+AAV(z);
// obsolete DQ(m, *zv=incorp(*yv); yv++; zv+=c;); // copy the script names into column 5
RETF(z);
} /* 13!:13 function stack */
28 changes: 28 additions & 0 deletions test/g13x.ijs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,9 @@ foo =: foo , (];._2 (0 : 0)) -: ": h }. a: 5}"1 (13!:13)''
| | | | | ||+-+|+-+-+| |
+---+--+-+-+-------------------------------++---+-----+-+
)
(13!:13 -: ({"1 (13!:13)@'')) 3 2 1 NB. verify that selecting columns of 13!:13 works
(13!:13 -: ({"1 (13!:13)@'')) 0 2 8 NB. verify that selecting columns of 13!:13 works

(13!:23) 13!:21'' NB. Into on line with no call
foo =: foo , (];._2 (0 : 0)) -: ": h }. a: 5}"1 (13!:13)''
+---+--+-+-+-------------------------------++---+-----+-+
Expand Down Expand Up @@ -243,6 +246,30 @@ foo =: foo , (];._2 (0 : 0)) -: ": a: 5}"1 h }. (13!:13)''
i. 0 0 [ 9!:7 original
foo NB. Test results of stack/result checks

'index error' -: 13!:13 etx 8 9 10 NB. invalid column
'rank error' -: 13!:13 etx i. 2 2
'domain error' -: 13!:13 etx o. 0 3 2

13!:0 ] 1
a_z_ =: {{ b y }}
b_loc_ =: {{ c y }}
c_z_ =: d_loc2_
d_loc2_ =: {{ 13!:13 ] 0 1 9 }}
(];._2 (0 : 0)) -: ": h }. a_loc_ ''
+-------+-+----+
|d_loc2_|0|loc2|
+-------+-+----+
|b |0|loc |
+-------+-+----+
|a_loc_ |0|loc |
+-------+-+----+
)
13!:0 ] 0
4!:55 ;:'a_z_ b_loc_ c_z_ d_loc2_'
18!:55 ;:'loc loc2'



foo =: foo_loc1_
foo_loc1_ =: foo_loc2_ /
foo_loc2_ =: foo_loc3_ ~
Expand Down Expand Up @@ -309,6 +336,7 @@ f=: 3 : '''my error'' assert 0'
'assertion failure' -: f etx 0
'|my error' ([ -: #@[ {. ]) 13!:12'' NB. User's error is stored even in adverse


NB. stops ---------------------------------------------------------------

'' -: 13!:2 ''
Expand Down
1 change: 0 additions & 1 deletion test/g412.ijs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,6 @@ pc=: (9!:12 '') e. 0 1 2 6 7
13 F 2
13 F 4
13 F 5
13 F 13
13 F 14
13 F 17
13 F 18
Expand Down

0 comments on commit 75bea4a

Please sign in to comment.