/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* picks APL2 V1.0.0 *************************************************** * Called by execspez to handle selective specification where the form * * is (l`Xr)#n, and `X is RIGHT_SHOE (pick). * ***********************************************************************/ #define INCLUDES APLCHDEF+APLTOKEN+APLCB+TREE #include "includes.h" Aplcb picks(axistok, ritename, rite) Apltoken axistok; /* token for x in e.g. (l`X[x]r)#n */ char *ritename; /* name for r in e.g. (l`Xr)#n */ Aplcb rite; /* Aplcb for r in e.g. (l`Xr)#n */ { Aplnest; Assign; Enlistd; Execexed; Execexek; Execfree; Execgetp; Exectok; Lifo; Pick; Pop; extern Treelist treehdr; extern int aplerr; Aplcb left=NULL, new=NULL, out=NULL; Apltoken op; int i, off; for (;;) { /* lets me use break */ execexed(); /* mainline expression evaluation for left */ left = execgetp(execexek()); if (axistok) { aplerr = 89; /* bad axis */ break; } if (treehdr->avlexec->avloprst) { off = treehdr->avlexec->avloprst->token_offset; new = execgetp(pop(&(treehdr->avlexec->avloprst))); } else aplerr = 59; /* new not found */ if (aplerr) break; if (left->aplcount == 0) { endoper(left); left = NULL; out = assign(ritename,new); /* total replacement */ } else { if (!(rite->aplflags & APLAPL)) if (new->aplrank) rite = assign(ritename,aplnest(rite)); else { i = rite->aplflags & APLTEMP; if (!matchok(&rite,&new,APLMASK+APLAPL)) break; if (i==0 && (rite->aplflags & APLTEMP)) rite = assign(ritename,rite); } out = pick(left,rite,new); } left = rite = new = NULL; if (aplerr) break; op = lifo(&(treehdr->avlexec->avloprst), exectok(out,off)); break; } endoper(left); endoper(rite); endoper(new); return(NULL); }